求Perl语法解析库及工具推荐

feiliang1983

我最近需要完成几个和语法解析相关的工具，包括一个简单的代码自动生成工具和一个配置文件语法解析工具。

代码自动生成工具：
场景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

...

我现在有一个手写的脚本可以完成简单的语法解析，但是复杂的很容易出错；
有没有什么工具或库可以自动解析像c{1-3} -> c1,c2,c3的语法解析工具？

zhlong8

cpan Parse::RecDescent

flw

cpan Parse::RecDescent
zhlong8 发表于 2010-11-08 11:55

你错了，楼主要的不是这个。楼主要的是一个组合枚举的东西。

feiliang1983

回复 2# zhlong8


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

其实我现在最需要的是一个用于展开{}内内容的示例或者一个可以解析很弱的正则表达式的示例。

我现在在做的是一个自动生成语法校验的辅助工具，手工敲一堆的验证命令很是麻烦，我想先把常用的命令通过表达式展开，但是不管是perl还是bash都没有合适的工具

我现在已经做了一个枚举语法的小工具，能够自用，但是已经不能再扩展了，所以需要一个成熟的工具/库去整合这一堆语法

flw

感觉写一个不是很难嘛。不知道有没有这方面的 CPAN 模块。

zhlong8

的确，只看后面配置文件语法解析了。楼主这个代码生成看不太懂规则，楼主有设计语法和转换规则那不就是个编译器了

zhlong8

回复 4# feiliang1983

这样能展开{}里面的内容，不过要看情况可能有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; #看你的转换应该是前面一个字符跟 {} 的形式
   
5. 
   
6. sub trans {
   
7.     my $s = shift;
   
8.     # 你的展开规则
   
9. }

复制代码

总之感觉自己写一个应该也复杂不到哪里吧，用模块什么的还要看一堆文档，看完都搞定了估计

feiliang1983

回复 7# zhlong8

我需要的是一个代码自动生成工具。

实际上我现在是在帮人写一堆简单的验证规则；验证规则中有%90以上的内容就是：
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}]]，但是如果想做的更好一点，我想将key的格式作成更通用的模式。

我现在已经完成的东西在通用性上做的很差，第一个文件可以采用
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}
...
方式直接替换
但是来了一个新的文件，我保留的关键字q/c都变成了非关键字，结果导致替换完全失败；如果进一步扩张关键字集的话代码量将超过我要写的语法验证文件，从成本上讲非常不划算；如果我将新文件中的冲突给手动移除的话，之后的操作比用vi直接写然后进行字符串替换的效率只低不高；而且新的脚本能够复用的可能性非常小，我不想去做。

现在我想做的是找一个能够进行宏解析的工具，通过定义自己的宏语法规则，完成一个类似编译器的工具。
我不是计算机专业出身，对编译原理不是很了解。想找一个合适的库帮助解析语法，最好只需要填充对一个个token的回调函数。这样就算我一个解释脚本写的不是很好，我也能保证在不需要对脚本做大的变动的基础上完善脚本的目的。

我现在的问题是在cpan上我除了扒拉parser相关的库之外还有什么方式快速找到一个适用的库的方法。
我在cpan上找了好几页，目前没有发现适用的package

zhlong8

回复 8# feiliang1983


    宏展开我只知道有个 m4，而且不会用

feiliang1983

回复 9# zhlong8

我的代码如下：
我目前只定义了四个宏规则：
n -> 删除MUSTENTER规则
s\d+e\d+ -> 输出 RANGE start end规则
l{[\d+-\d+]|\d+} -> 输出 LEGAL规则
j -> 输出JUMPS模板

这个脚本的主要作用是在需要大量手工输入简单语法规则检查(epidata)时，通过使用宏替换规则生成一个简单的模板，然后使用一个高效的编辑器完成剩余的工作。

一个简单的验证用模板输入如下：
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

目前简单的替换规则语法简单，工作良好；当输入行数超过1000行时比vi/notepad手工编辑效率高50%以上（脚本完成基本内容的输入，手工调整一下几个跳转规则即可）。
脚本长相相当丑陋，继续求可用的库或成熟工具，最好能够在100行以内可以定义10组以下的宏替换规则，完成基本的宏扩展功能；或者能够在1000行以内，可以定义约30个关键字完成一个小的语法生成工具。

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. }

复制代码