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示例下载地址：
https://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