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\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，待有机会好好整理下。