在Perl中使用XML :: DOM構建哈希樹

Question

我想使用XML::DOM模塊解析簡單的XML文檔以哈希。

<?xml version ="1.0"?> 
<Select> 
    <book> 
    <prop Name = "prop1" Title = "title1" /> 
    <prop Name = "prop2" Title = "title2" /> 
    </book> 
    <fruit> 
    <prop Name = "prop3" Title = "title3" /> 
    <prop Name = "prop4" Title = "title4" /> 
    </fruit> 
</Select> 

和預期輸出是 -

$VAR1 = { 
    Select => { 
    book => { 
       prop => [ 
       { Name => "prop1", Title => "title1" }, 
       { Name => "prop2", Title => "title2" }, 
       ], 
      }, 
    fruit => { 
       prop => [ 
       { Name => "prop3", Title => "title3" }, 
       { Name => "prop4", Title => "title4" }, 
       ], 
      }, 
    }, 
} 

我寫這是代碼：

use strict; 
use XML::DOM; 
use Data::Dumper; 

my @stack; 
my %hash; 
push @stack,\%hash; 

my $parser = new XML::DOM::Parser; 
my $doc = $parser -> parsefile('demo.xml'); 
my $root = $doc->getDocumentElement(); 
my $rootnode = $root->getTagName; 

################################################################ 

foreach my $node ($doc->getElementsByTagName($rootnode)){ 
    push @stack,$stack[$#stack]->{$rootnode}; 
    my @childnode = $node->getChildNodes(); 

    foreach my $child(@childnode){ 
     if($child->isElementNode){ 
      my $childname = $child->getNodeName(); 
      pop(@stack); 
      push @stack,$stack[$#stack]->{$rootnode} = {$childname,{}}; 
      my @childnodes2 = $child->getChildNodes(); 

      foreach my $subchild(@childnodes2){ 
       if($subchild->isElementNode){ 
        my $subchildname = $subchild->getNodeName(); 

        my $name = $subchild->getAttributes->getNamedItem('Name')->getNodeValue; 
        my $title = $subchild->getAttributes->getNamedItem('Title')->getNodeValue; 
        pop(@stack); 
        push @stack,$stack[$#stack]->{$rootnode}->{$child->getNodeName()} = {$subchildname,{}}; #{} contains $name or $title 
       } 
      } 
     } 
    } 
} 

print Dumper(\%hash); 

我想，我是不是能夠正確地推動和陣列彈出。另外，我不想使用XML::Simple和遞歸。

我該如何在Perl中做到這一點？

Answer 1

這是一個可能的解決方案，假設整個文檔遵循一個嚴格的模式，一個Select作爲根，任何不同名稱的子節點（衝突將不會被處理），以及這些子節點的任何數量的prop ，其中Name和Title字段單獨有趣。

這是序言部分，我也用Carp來更好的錯誤處理。

#!/usr/bin/perl 

use strict; use warnings; use 5.012; 
use XML::DOM; 
use Data::Dumper; 
use Carp; 

這裏是主代碼。它啓動解析器（假設文檔位於特殊的DATA文件句柄中），並將生成的文檔從make_data_structure子例程中傳遞出去。我經常考慮讓腳本die儘早地發現錯誤。

{ 
    my $xml_parser = XML::DOM::Parser->new; 
    my $document_string = do{ local $/=undef; <DATA> }; 
    my $document = $xml_parser->parse($document_string) or die; 

    my $data_structure = make_data_structure($document) or die; 
    print Dumper $data_structure; 
} 

這是完成所有工作的子程序。它需要一個文檔並返回一個符合你的格式的hashref。

sub make_data_structure { 
    my ($document) = @_; 
    my $root = $document->getDocumentElement; 
    my $rootname = $root->getTagName // "undef"; 

    didnt_expect_anything(but=> "Select", as=> "the root tag", got=> $rootname) 
     unless $rootname eq "Select"; 

    my $dsc = +{ $rootname => +{} }; 
    CHILD: 
    for my $child ($root->getChildNodes) { 
     next CHILD unless $child->isElementNode; 

     my $childname = $child->getTagName 
      // couldnt_get("the tag name", of=> "a $rootname child"); 

     $dsc->{$rootname}{$childname} = undef; # unneccessary iff we have props 
     PROP: 
     for my $prop ($child->getChildNodes) { 
      next PROP unless $prop->isElementNode; 

      my $propname = $prop->getTagName // "undef"; 

      die didnt_expect_anything(but=> "prop", got=> $propname) 
       unless $propname eq "prop"; 

      my $attributes = $prop->getAttributes 
       // couldnt_get("the attributes", of=> "a prop node"); 

      # for minimum code duplication, and maximum error handling, 
      # use dataflow programming, and `map`. 
      my ($Name, $Title) = 
       map { $_->getNodeValue // couldnt_get("the node value", of=>"the attribute") } 
       map { $attributes->getNamedItem($_) // couldnt_get("the named item $_", of=> "the prop attributes") } 
        qw/Name Title/; 
      my $propvalue = +{ 
       Name => $Name, 
       Title => $Title, 
      }; 

      push @{ $dsc->{$rootname}{$childname}{$propname} }, $propvalue; 
     } 
    } 
    return $dsc; 
} 

以下是自定義錯誤處理子程序，使上面的代碼更具表現力。

sub didnt_expect_anything { 
    my %args = @_; 
    my $expected = $args{but} // croak qq(required named argument "but" missing); 
    my $role  = $args{as} // "a tag name"; 
    my $instead = $args{got} // croak qq(required named argument "got" missing); 
    croak qq(Didn't expect anything but "$expected" as $role here, got "$instead"); 
} 
sub couldnt_get { 
    my ($what, %args) = @_; 
    my $of_what = $args{of} // croak qq(required named argument "of" missing); 
    croak qq(Couldn't get $what of $of_what); 
} 

當然，正確的輸出產生，但這並不得到有正確的方式 - CPAN是爲了使用。

你的實現問題的一部分是（除了缺少錯誤處理），你用你的「堆棧」做了一些令人費解的體操。

在外循環的第一次迭代之前，@stack是+{}（對空散列的引用）。

行$stack[$#stack]->{$rootnode}訪問堆棧的最後一個元素（最好寫爲$stack[-1]），將該值視爲散列引用，並查找名爲$rootnode的條目。這評估爲undef。然後將此值推入堆棧。混沌隨之而來。