1

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でこれを行うにはどうすればよいですか？

4

1 に答える 1

1

Selectドキュメント全体が、ルートとして1つ、異なる名前の子ノード（衝突は処理されない）、およびこれらの子ノードの任意の数のpropsを含む厳密なスキーマに従っていると仮定すると、考えられる解決策が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;
}

これは、すべての作業を行うサブルーチンです。ドキュメントを受け取り、フォーマットに準拠したハッシュ参照を返します。

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が使用されるように作られました。

実装に関する問題の一部は、（欠落しているエラー処理は別として）「スタック」を使用して複雑な体操を行うことです。

外側のループの最初の反復の前に、@stackis +{}（空のハッシュへの参照）があります。

この行$stack[$#stack]->{$rootnode}は、スタックの最後の要素（として記述した方がよい$stack[-1]）にアクセスし、値をハッシュrefとして扱い、。という名前のエントリを検索し$rootnodeます。これはに評価されundefます。次に、この値をスタックにプッシュします。混沌が続く。

于 2013-01-24T18:04:22.000 に答える