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，待有機會好好整理下。