求Perl語法解析庫及工具推薦

feiliang1983

我最近需要完成幾個和語法解析相關(guān)的工具，包括一個簡單的代碼自動生成工具和一個配置文件語法解析工具。

代碼自動生成工具：
場景1：
hello,q{1-3}c{1-5}:m,l{0-2,99}
m->MUSTERNTER
l->LEGAL

生成：
hello
    MUSTERNTER
    LEGAL
        0
        1
        2
        99
    END
END

q1
    MUSTERENTER
END

q1c1
    MUSTERENTER
    LEGAL
        0
        1
        2
        99
    END
END

q1c2
    MUSTERENTER
    LEGAL
        0
        1
        2
        99
    END
END

...

我現(xiàn)在有一個手寫的腳本可以完成簡單的語法解析，但是復(fù)雜的很容易出錯；
有沒有什么工具或庫可以自動解析像c{1-3} -> c1,c2,c3的語法解析工具？

zhlong8

cpan Parse::RecDescent

flw

cpan Parse::RecDescent
zhlong8 發(fā)表于 2010-11-08 11:55

你錯了，樓主要的不是這個。樓主要的是一個組合枚舉的東西。

feiliang1983

回復(fù) 2# zhlong8


    先謝了，我再在cpan上扒扒看。

其實(shí)我現(xiàn)在最需要的是一個用于展開{}內(nèi)內(nèi)容的示例或者一個可以解析很弱的正則表達(dá)式的示例。

我現(xiàn)在在做的是一個自動生成語法校驗(yàn)的輔助工具，手工敲一堆的驗(yàn)證命令很是麻煩，我想先把常用的命令通過表達(dá)式展開，但是不管是perl還是bash都沒有合適的工具

我現(xiàn)在已經(jīng)做了一個枚舉語法的小工具，能夠自用，但是已經(jīng)不能再擴(kuò)展了，所以需要一個成熟的工具/庫去整合這一堆語法

flw

感覺寫一個不是很難嘛。不知道有沒有這方面的 CPAN 模塊。

zhlong8

的確，只看后面配置文件語法解析了。樓主這個代碼生成看不太懂規(guī)則，樓主有設(shè)計語法和轉(zhuǎn)換規(guī)則那不就是個編譯器了

zhlong8

回復(fù) 4# feiliang1983

這樣能展開{}里面的內(nèi)容，不過要看情況可能有bug

1. sub trans;
   
2. my $s = 'hello,q{1-3}c{1-5}:m,l{0-2,99}';
   
3. 
   
4. $s =~ s/(\w\{.*?\})/trans $1/ge; #看你的轉(zhuǎn)換應(yīng)該是前面一個字符跟 {} 的形式
   
5. 
   
6. sub trans {
   
7.     my $s = shift;
   
8.     # 你的展開規(guī)則
   
9. }

復(fù)制代碼

總之感覺自己寫一個應(yīng)該也復(fù)雜不到哪里吧，用模塊什么的還要看一堆文檔，看完都搞定了估計

feiliang1983

回復(fù) 7# zhlong8

我需要的是一個代碼自動生成工具。

實(shí)際上我現(xiàn)在是在幫人寫一堆簡單的驗(yàn)證規(guī)則；驗(yàn)證規(guī)則中有%90以上的內(nèi)容就是：
key
    RANGE start end
    LEGAL
       1
       2
       99
   END
END
或
key
   LEGAL
       1
       0
   END
END
之類的東西

key的格式為q{1-25}[c{1-9}[c{1-5}]]，但是如果想做的更好一點(diǎn)，我想將key的格式作成更通用的模式。

我現(xiàn)在已經(jīng)完成的東西在通用性上做的很差，第一個文件可以采用
hello,world,q{1-10}c{1-5},q{11-12}c{0,1,2},q{13-19}c{0,1},q{20-25}:m
q{1-15}:l{0,1,99}
q{16-20}:l{0-7,99}
...
方式直接替換
但是來了一個新的文件，我保留的關(guān)鍵字q/c都變成了非關(guān)鍵字，結(jié)果導(dǎo)致替換完全失�。蝗绻�進(jìn)一步擴(kuò)張關(guān)鍵字集的話代碼量將超過我要寫的語法驗(yàn)證文件，從成本上講非常不劃算；如果我將新文件中的沖突給手動移除的話，之后的操作比用vi直接寫然后進(jìn)行字符串替換的效率只低不高；而且新的腳本能夠復(fù)用的可能性非常小，我不想去做。

現(xiàn)在我想做的是找一個能夠進(jìn)行宏解析的工具，通過定義自己的宏語法規(guī)則，完成一個類似編譯器的工具。
我不是計算機(jī)專業(yè)出身，對編譯原理不是很了解。想找一個合適的庫幫助解析語法，最好只需要填充對一個個token的回調(diào)函數(shù)。這樣就算我一個解釋腳本寫的不是很好，我也能保證在不需要對腳本做大的變動的基礎(chǔ)上完善腳本的目的。

我現(xiàn)在的問題是在cpan上我除了扒拉parser相關(guān)的庫之外還有什么方式快速找到一個適用的庫的方法。
我在cpan上找了好幾頁，目前沒有發(fā)現(xiàn)適用的package

zhlong8

回復(fù) 8# feiliang1983


    宏展開我只知道有個 m4，而且不會用

feiliang1983

回復(fù) 9# zhlong8

我的代碼如下：
我目前只定義了四個宏規(guī)則：
n -> 刪除MUSTENTER規(guī)則
s\d+e\d+ -> 輸出 RANGE start end規(guī)則
l{[\d+-\d+]|\d+} -> 輸出 LEGAL規(guī)則
j -> 輸出JUMPS模板

這個腳本的主要作用是在需要大量手工輸入簡單語法規(guī)則檢查(epidata)時，通過使用宏替換規(guī)則生成一個簡單的模板，然后使用一個高效的編輯器完成剩余的工作。

一個簡單的驗(yàn)證用模板輸入如下：
hello,world,s{1-5|7|9},s{good-bye|hello}:l{0|1|99}
haha,q{1-6}c{1-9|12|17|99}c{1-7}:s1e9,l{0|1}
q{7-9}c{1-9}:s1e8,j

目前簡單的替換規(guī)則語法簡單，工作良好；當(dāng)輸入行數(shù)超過1000行時比vi/notepad手工編輯效率高50%以上（腳本完成基本內(nèi)容的輸入，手工調(diào)整一下幾個跳轉(zhuǎn)規(guī)則即可）。
腳本長相相當(dāng)丑陋，繼續(xù)求可用的庫或成熟工具，最好能夠在100行以內(nèi)可以定義10組以下的宏替換規(guī)則，完成基本的宏擴(kuò)展功能；或者能夠在1000行以內(nèi)，可以定義約30個關(guān)鍵字完成一個小的語法生成工具。

1. #!/usr/bin/perl
   
2. #
   
3. 
   
4. use strict;
   
5. use warnings;
   
6. 
   
7. if (@ARGV < 2) {
   
8.     print "Usage:
   
9. $0 inputfile outputfile
   
10.   inputfile: formated template file for qes file
    
11.   outputfile: .chk file generated from inputfile\n";
    
12. 
    
13.   exit 1;
    
14. }
    
15. 
    
16. my ($inp, $outp) = @ARGV;
    
17. 
    
18. print "input file: $inp, output file: $outp\n";
    
19. 
    
20. open IN, "<$inp" or die "open $inp for read failed: $!\n";
    
21. open OUT, ">$outp" or die "open $outp for write failed: $!\n";
    
22. 
    
23. sub do_second_parse(@)
    
24. {
    
25.     my @origs = @_;
    
26.     my @keys;
    
27. 
    
28.     foreach my $orig (@origs) {
    
29.         if ($orig =~ /^([^{]*){([^}]*)}(.*)$/) {
    
30.             my ($p, $m, $a) = ($1, $2, $3);
    
31.             $a = "" if not defined $a;
    
32. 
    
33.             my @sps = split(/\|/, $m);
    
34.             foreach my $sp (@sps) {
    
35.                 my ($start, $end) = split(/-/, $sp);
    
36.                 if (not defined $end) {
    
37.                     push @keys, "$p$sp$a";
    
38.                 }
    
39.                 else {
    
40.                     if (int($end) > int($start)) {
    
41.                         push @keys, map { "$p$_$a" } ($start .. $end);
    
42.                     }
    
43.                     else {
    
44.                         push @keys, "$p$sp$a";
    
45.                     }
    
46.                 }
    
47.             }
    
48.         }
    
49.         else {
    
50.             push @keys, $orig;
    
51.         }
    
52.     }
    
53. 
    
54.     return @keys;
    
55. }
    
56. 
    
57. sub second_parse($)
    
58. {
    
59.     my $fp = shift;
    
60.     my @keys;
    
61. 
    
62.     push @keys, $fp;
    
63.     while ( grep {/{.*}/} @keys ) {
    
64.         @keys = do_second_parse(@keys);
    
65.     }
    
66. 
    
67.     return @keys;
    
68. }
    
69. 
    
70. sub parse_key($)
    
71. {
    
72.     my $orig = shift;
    
73.     my @first_parse = split(/,/, $orig);
    
74.     my @keys = ();
    
75. 
    
76.     foreach my $fp (@first_parse) {
    
77.         push @keys, second_parse($fp);
    
78.     }
    
79. 
    
80.     return @keys;
    
81. }
    
82. 
    
83. sub parse_rules ($)
    
84. {
    
85.     my $orig_rule = shift;
    
86.     my %rules = (
    
87.         enter => "    MUSTENTER\n",
    
88.         range => "",
    
89.         legal => "",
    
90.         jumps => "",
    
91.     );
    
92. 
    
93.     my @items = split(/,/, $orig_rule);
    
94.     if (grep { /^n$/ } @items) {
    
95.         enter => "";
    
96.     }
    
97. 
    
98.     my @ranges = grep { /^s\d+e\d+$/ } @items;
    
99.     if (@ranges) {
    
100.         my $range = $ranges[0];
     
101.         my ($start, $end) = ($range =~ /^s(\d+)e(\d+)$/);
     
102.         $rules{range} = "    RANGE $start $end\n";
     
103.     }
     
104. 
     
105.     my @legals = grep { /^l{.*}$/ } @items;
     
106.     if (@legals) {
     
107.         my $legal = $legals[0];
     
108.         my ($lr) = ($legal =~ /^l{(.*)}$/);
     
109.         my @bps = split(/\|/, $lr);
     
110.         my @aps;
     
111. 
     
112.         foreach my $bp (@bps) {
     
113.             my ($start, $end) = split(/-/, $bp);
     
114.             if (not defined $end) {
     
115.                 push @aps, $bp;
     
116.             }
     
117.             else {
     
118.                 if (int($end) > int($start)) {
     
119.                     push @aps, ($start .. $end);
     
120.                 }
     
121.                 else {
     
122.                     push @aps, $bp;
     
123.                 }
     
124.             }
     
125.         }
     
126. 
     
127.         $rules{legal} = "    LEGAL\n";
     
128.         foreach my $ap (@aps) {
     
129.             $rules{legal} .= "        $ap\n";
     
130.         }
     
131.         $rules{legal} .= "    END\n";
     
132.     }
     
133. 
     
134.     if (grep { /^j$/ } @items) {
     
135.         $rules{jumps} .= "    JUMPS\n";
     
136.         $rules{jumps} .= "        ###TODO###\n";
     
137.         $rules{jumps} .= "    END\n";
     
138.     }
     
139. 
     
140.     my $res = $rules{enter};
     
141.     if ($rules{range}) {
     
142.         $res .= $rules{range};
     
143.     }
     
144. 
     
145.     if ($rules{legal}) {
     
146.         $res .= $rules{legal};
     
147.     }
     
148. 
     
149.     if ($rules{jumps}) {
     
150.         $res .= $rules{jumps};
     
151.     }
     
152. 
     
153.     return $res;
     
154. }
     
155. 
     
156. while (<IN>) {
     
157.     chomp;
     
158. 
     
159.     s/#.*$//;
     
160.     s/\s*//;
     
161.     next if /^$/;
     
162. 
     
163.     my ($key, $rule) = split(/:/, $_);
     
164.     my @keys  = parse_key($key);
     
165.     #use Data::Dumper;
     
166.     #print Dumper(@keys);
     
167.     my $fmt = parse_rules($rule);
     
168.    
     
169.     foreach my $_key (@keys) {
     
170.         print OUT "$_key\n${fmt}END\n\n";
     
171.     }
     
172. }

復(fù)制代碼