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

2023-08-10 22:59:22

继周六的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-]+)/;

    my $a = $;

    $end =~ /^<\/([a-zA-Z_0-]+)/;

    my $b = $;

    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();

    }

  }

=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();

    }

  }

=cut

}

sub _XmlCheckValue

{

  my $refNode = shift;

}

sub Xml_Version

{

  my @params = @_;

  &_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);

  my @pair;

  my %xml = (VERSION=>$params[], PAIR=>\@pair);

  return \%xml;

}

sub Xml_VersionPair

{

  my @params = @_;

  &_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);

  my %xml = (VERSION=>$params[], PAIR=>$params[]);

  return $params[];

}

sub Pair_BeginEnd

{

  my @params = @_;

  &_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);

  my %node;

  $node{BEGIN} = $params[];

  $node{END} = $params[];

  &_XmlCheckNode(\%node);

  my @pair = (\%node,);

  return \@pair;

}

sub Pair_BeginValueEnd

{

  my @params = @_;

  &_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);

  my %node;

  $node{BEGIN} = $params[];

  $node{VALUE} = $params[];

  $node{END} = $params[];

  &_XmlCheckNode(\%node);

  my @pair = (\%node,);

  return \@pair;

}

sub Pair_Sigton

{

  my @params = @_;

  &_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);

  my %node;

  $node{SIGTON} = $params[];

  my @pair = ($params[],);

  return \@pair;

}

sub Pair_Comment

{

  my @params = @_;

  &_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);

  my %node;

  $node{COMMENT} = $params[];

  my @pair = (\%node,);

  return \@pair;

}

sub Pair_BeginPairEnd

{

  my @params = @_;

  &_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);

  my %node;

  $node{BEGIN} = $params[];

  $node{PAIR} = $params[];

  $node{END} = $params[];

  &_XmlCheckNode(\%node);

  my @pair = (\%node,);

  return \@pair;

}

sub Pair_BeginValuePairEnd

{

  my @params = @_;

  &_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);

  my %node;

  $node{BEGIN} = $params[];

  $node{VALUE} = $params[];

  $node{PAIR} = $params[];

  $node{END} = $params[];

  &_XmlCheckNode(\%node);

  my @pair = (\%node,);

  return \@pair;

}

sub Pair_PairPair

{

  my @params = @_;

  &_XmlDebugMock(&zError::FunName().' ['.&zError::FileLine().']', \@_);

  push @{$params[]}, @{$params[]};

  return $params[];

}

最后是应用程序部分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，待有机会好好整理下。

码农公寓

相关文章