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

继周六的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
";
  
  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.
");

    $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 "
BEGIN <$a> at LINE [$line] missing END!!!
";
      exit(0);
    }
  }
=pod  
  if($refNode->{VALUE})
  {
    my $value = $refNode->{VALUE}->{TEXT};
  
    if($value =~ /[<>]/)
    {
      &zDebug::DataDump(&_XmlAlarmMock, $refNode);
      &zDebug::DataDump(&_XmlAlarmMock, $refNode->{VALUE});
    
      print "
VALUE contains <>!!!
";
      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];
}

最后是应用程序部分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();

样例只做了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，待有机会好好整理下。