• 热门专题

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

作者:hhao020  发布日期:2015-12-14 21:05:26
Tag标签:文本  技术  
  • 继周六的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,待有机会好好整理下。

延伸阅读:

About IT165 - 广告服务 - 隐私声明 - 版权申明 - 免责条款 - 网站地图 - 网友投稿 - 联系方式
本站内容来自于互联网,仅供用于网络技术学习,学习中请遵循相关法律法规