PERL/LEX/YACC技术实现文本解析--XML解析

zolo

　　继周六的p_enum.pl后，再来一篇说说我用perl做的lex，yacc工具。之前说了，我学习lex和yacc的最初动机是为了做个C语言解释器的SHELL；但后来工作中的实际需要也是制作perl版lex和yacc的一个动机。Perl库里有lex和yacc，我没研究过，想来应该比我做的强大，不过对新手来说，未必能容易入手。
　　我的第一个应用场景是做一个xml配置文件的排序。XML是标签标记语言，同一级下，TAG顺序本身是无所谓的；但对于测试工作来说，经常要通过文本比较工作来确定两个配置文件差别。如果没有办法将配置文件内容正确排序，对比一个几十K的配置文件，就会耗费个把钟头。对于有频繁对比内容的测试需要来说，这绝对是无法忍受。
　　那期间，我正在研究编译原理，以及lex和yacc，自然萌生了做个xml解析器的想法。有了xml解析器，就能将xml内容按hash、array组合方式在perl里表达成对应的数据结构，而排序也就自然不再是个问题。
　　工具及xml示例下载地址：
http://files.cnblogs.com/files/hhao020/perl_zlib_re0.001.rar
　　要做xml的解析，首先需要定义lex词法文件xml.lex：



%%prioritized from top to bottom
<!--.*-->  := comment
<\?.*?>    := version
</.*?>       := end
<.*?/ >      := sigton
<.*>         := begin
:= value
　　接着，需要定义yacc的语法文件xml.yacc：





%yacc%
%%prioritized from bottom to top
xml := version EOF       { Xml_Version }
| version pair EOF  { Xml_VersionPair }
pair := pair pair        { Pair_PairPair }
pair := begin end        { Pair_BeginEnd }
| begin value end       { Pair_BeginValueEnd }
| begin pair end        { Pair_BeginPairEnd }
| begin value pairs end { Pair_BeginValuePairEnd }
| sigton                { Pair_Sigton }
| comment               { Pair_Comment }     
%code%
package xml;
use strict;
use warnings;
sub _XmlAlarmMock
{
print @_;
}
sub _XmlDebugMock
{
my $debugInfo = shift;
#print "$debugInfo\n";
sub _printMock{print @_;};
#&zDebug::DataDump(\&_printMock, \@_);
}
sub _XmlCheckNode
{
my $refNode = shift;
if($refNode->{BEGIN})
{
my $begin = $refNode->{BEGIN}->{TEXT};
my $end  = $refNode->{END}->{TEXT};
printf("##### check node $begin, $end.\n");
$begin =~ /^<([a-zA-Z_0-9]+)/;
my $a = $1;
$end =~ /^<\/([a-zA-Z_0-9]+)/;
my $b = $1;
if($a ne $b)
{
&zDebug::DataDump(\&_XmlAlarmMock, $refNode);
&zDebug::DataDump(\&_XmlAlarmMock, $refNode->{BEGIN});
&zDebug::DataDump(\&_XmlAlarmMock, $refNode->{END});
my $line = $refNode->{BEGIN}->{LINE};
print "\nBEGIN <$a> at LINE [$line] missing END!!!\n";
exit(0);
}
}
=pod  
if($refNode->{VALUE})
{
my $value = $refNode->{VALUE}->{TEXT};
if($value =~ /[<>]/)
{
&zDebug::DataDump(\&_XmlAlarmMock, $refNode);
&zDebug::DataDump(\&_XmlAlarmMock, $refNode->{VALUE});
print "\nVALUE contains <>!!!\n";
exit(0);
}
}
=cut  
}
sub _XmlCheckValue
{
my $refNode = shift;

}
sub Xml_Version
{
my @params = @_;  
&_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);
my @pair;
my %xml = (VERSION=>$params[0], PAIR=>\@pair);
return \%xml;
}
sub Xml_VersionPair
{
my @params = @_;  
&_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);
my %xml = (VERSION=>$params[0], PAIR=>$params[1]);
return $params[0];
}
sub Pair_BeginEnd
{
my @params = @_;  
&_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);
my %node;
$node{BEGIN} = $params[0];
$node{END} = $params[1];
&_XmlCheckNode(\%node);
my @pair = (\%node,);
return \@pair;
}
sub Pair_BeginValueEnd
{
my @params = @_;  
&_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);
my %node;
$node{BEGIN} = $params[0];
$node{VALUE} = $params[1];
$node{END} = $params[2];
&_XmlCheckNode(\%node);
my @pair = (\%node,);
return \@pair;
}
sub Pair_Sigton
{
my @params = @_;  
&_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);
my %node;
$node{SIGTON} = $params[0];
my @pair = ($params[0],);
return \@pair;
}
sub Pair_Comment
{
my @params = @_;  
&_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);
my %node;
$node{COMMENT} = $params[0];
my @pair = (\%node,);
return \@pair;
}
sub Pair_BeginPairEnd
{
my @params = @_;  
&_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);
my %node;
$node{BEGIN} = $params[0];
$node{PAIR} = $params[1];
$node{END} = $params[2];
&_XmlCheckNode(\%node);
my @pair = (\%node,);
return \@pair;
}
sub Pair_BeginValuePairEnd
{
my @params = @_;  
&_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);
my %node;
$node{BEGIN} = $params[0];
$node{VALUE} = $params[1];
$node{PAIR} = $params[2];
$node{END} = $params[3];
&_XmlCheckNode(\%node);
my @pair = (\%node,);
return \@pair;
}
sub Pair_PairPair
{
my @params = @_;   
&_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);
push @{$params[0]}, @{$params[1]};
return $params[0];
}
View Code　　最后是应用程序部分p_xml.pl：





#/usr/bin/perl
use strict;
use warnings;
use zFile;
use zTrace;
use zError;
use zDebug;
use zLex;
use zLex;
use zYacc;
sub main
{
my $lex = zLex->New(@ARGV);
$lex->SetupFile('xml.lex');
#$lex->PrintDocLex();
my $yacc = zYacc->New(@ARGV);
$yacc->SetupFile('xml.yacc');  
$yacc->SaveCode('xml.pm');
#$yacc->ImportCode('xml', 'xml');
$yacc->PrintGrammarTree();
$yacc->PrintConflictTree();
my $text = $lex->ParserFile('sample0.xml');
&DataDump(\&TraceDebug, $text);
my @re = $yacc->Compile($text);
&DataDump(undef, \@re);
}
&main();
View Code　　样例只做了xml到内存数据结构的解析。
　　测试用xml文件sample0.xml：



<?xml version="1.0" encoding="UTF-8"?>
<!--Settings for MSP-->
<Config>
<tag1> value1 </tag1>
< Single Node / >
</Config>
　　
　　很可惜，当时做的最终版本丢了，只有这个中间版本，对某些细节处理不是很好。YACC在不能做reduce操作时，应该进行shift操作。这个版本当时大概为了解决大文本文件信息摘录问题，新加了冲突预测优化，导致某些时候错误的拒绝shift操作。等过些天有空了，将这个问题修正后再更新。比如，下面这个文件处理会因此失败：



<?xml version="1.0" encoding="UTF-8"?>
<!--Settings for MSP-->
<Config> abc
<tag1> value1 </tag1>
< Single Node / >
</Config>
　　
　　运行perl p_xml.pl -dstack -dcompile可以看到shift，reduce过程。
　　Lex相对比较简单。Yacc在设计时，常常会被移进和归约规则困挠。基本原理很简单，就是不能归约时，即移进。但现实情况下，不同的问题需要的处理过程差别还是蛮大。这也是的我做的Lex和Yacc多次改动，也就带来了bug，待有机会好好整理下。