Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

sub that finds ancestor elements

by jccunning (Acolyte)
on Sep 12, 2012 at 23:51 UTC ( #993332=perlquestion: print w/ replies, xml ) Need Help??
jccunning has asked for the wisdom of the Perl Monks concerning the following question:

Can someone tell me why the following cannot find the string "pciReg" but can find the strings in the other two calls that are commented out.
#!/usr/bin/perl use feature ":5.14"; use warnings FATAL => qw(all); use strict; use Data::Dump qw(dump pp); use XML::Simple; my @list; my $x = XMLin(<<'END', KeyAttr=>['declaration_name', 'name']); <classes name="Panoply::BAR"> <public_methods> <members name="BAR" const="no" kind="function" protection="publi +c" static="no" virtualness="non_virtual" volatile="no"> <parameters declaration_name="pciReg" type="Register::Ptr" /> </members> </public_methods> <enums> <members name="ObjectState" kind="enum" protection="public" stat +ic="no" virtualness="non_virtual"> <values name="NEW"> </values> <values name="REFRESHED"> </values> <values name="DIRTY"> </values> </members> </enums> </classes> END sub r($$$;$); sub r($$$;$) {my ($r, $l, $e, $a) = @_; $a = [] unless $a; return unless $l and ref($l); if (ref($l) =~ /HASH/) {for(sort keys %$l) {unless (/$e/) {push @$a, $_; r($r, $l->{$_}, $e, $a); pop @$a; } else {&$r(@$a); } } } elsif (ref($l) =~ /ARRAY/) {for(1..@$l) {unless ($l->[$_-1] =~ /$e/) {push @$a, $_; r($r, $l->[$_-1], $e, $a); pop @$a; } else {&$r(@$a); } } } } # r sub {push (@list, join(" => ", @_))}, $x, "parameters"; r sub {push (@list, join(" => ", @_))}, $x, "pciReg"; # r sub {push (@list, join(" => ", @_))}, $x, "DIRTY"; my $elist = join("\n", @list); print "$elist\n";

Comment on sub that finds ancestor elements
Download Code
Re: sub that finds ancestor elements
by tobyink (Abbot) on Sep 13, 2012 at 02:00 UTC

    Code using XML::Simple rarely ends up being simple. It would be much easier if you used XML::LibXML...

    #!/usr/bin/perl use feature ":5.14"; use warnings FATAL => qw(all); use strict; use XML::LibXML 2; my $x = XML::LibXML::->load_xml(string => <<'END'); <classes name="Panoply::BAR"> <public_methods> <members name="BAR" const="no" kind="function" protection="public +" static="no" virtualness="non_virtual" volatile="no"> <parameters declaration_name="pciReg" type="Register::Ptr" /> </members> </public_methods> <enums> <members name="ObjectState" kind="enum" protection="public" stati +c="no" virtualness="non_virtual"> <values name="NEW"> </values> <values name="REFRESHED"> </values> <values name="DIRTY"> </values> </members> </enums> </classes> END sub _universal_find { my $text = shift; join '|', "//$text", # Element name "//*/\@$text", # Attribute name "//*/text()[.='$text']", # Element contents "//*/\@*[.='$text']", # Attribute value } my $coolNodeName = sub { ($_[0]->isa('XML::LibXML::Attr')?'@':'').$_[0 +]->nodeName }; for my $text (qw[ parameters pciReg DIRTY ]) { say "Search for '$text'..."; for my $node ($x->findnodes( _universal_find($text) )) { say join ' => ', $node->findnodes("ancestor::*")->map(sub { $coolNodeName-> +($_) }), $coolNodeName->($node), } say ""; } __END__ Search for 'parameters'... classes => public_methods => members => parameters Search for 'pciReg'... classes => public_methods => members => parameters => @declaration_nam +e Search for 'DIRTY'... classes => enums => members => values => @name

    (Update: improved _universal_find to return attribute nodes instead of element nodes when attribute nodes are more appropriate; improved output.)

    perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'
      I have had no success installing XML::LibXML 2 maybe you can help. I am on Windows 7 enterprise 32-bit, activestate perl 5.14. Tried installing "ppm install XML::LibXML::2.0004 but error said no package available.
      Why the colons between the module name and version number? (I doubt you need to specify the version number at all - ppm presumably defaults to the latest version available.)
      perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'
        When I install using "ppm install XML-LibXML" then version 1.70 of XML-LibXML is installed as the latest. Your script indicated "use XML::LibXML 2;". Of course, I get error that version 2 is required.
Re: sub that finds ancestor elements
by GrandFather (Cardinal) on Sep 13, 2012 at 02:06 UTC

    XML::Simple isn't. The immediate problem is a need to use ForceArray. However your code can stand a fair bit of tidying up generally. There is no need to use prototypes. You should avoid overloading identifiers (r used for the name of two different subs especially is nasty). Identifiers generally should indicate their purpose. Consider:

    #!/usr/bin/perl use warnings FATAL => qw(all); use strict; use Data::Dump qw(dump pp); use XML::Simple qw(:strict); run(); sub run { my $xml = XMLin( <<'END', ForceArray => ['parameters'], KeyAttr => ['declaratio +n_name', 'name']); <classes name="Panoply::BAR"> <public_methods> <members name="BAR" const="no" kind="function" protection="publi +c" static="no" virtualness="non_virtual" volatile="no" > <parameters declaration_name="pciReg" type="Register::Ptr" /> </members> </public_methods> <enums> <members name="ObjectState" kind="enum" protection="public" stat +ic="no" virtualness="non_virtual"> <values name="NEW"> </values> <values name="REFRESHED"> </values> <values name="DIRTY"> </values> </members> </enums> </classes> END my @list; my $sub = sub {push(@list, shift(@_) . ": " . join(" => ", @_))}; findPath($sub, $xml, "pciReg"); findPath($sub, $xml, "DIRTY"); findPath($sub, $xml, "parameters"); print join("\n", @list), "\n"; } sub findPath { my ($sub, $xmlFrag, $match, @path) = @_; return unless $xmlFrag; if (ref($xmlFrag) =~ /HASH/) { for my $key (sort keys %$xmlFrag) { if ($key !~ /$match/) { findPath($sub, $xmlFrag->{$key}, $match, @path, $key); } else { $sub->($match, @path); } } } elsif (ref($xmlFrag) =~ /ARRAY/) { for my $fragIdx (0 .. $#$xmlFrag) { unless ($xmlFrag->[$fragIdx] =~ /$match/) { findPath($sub, $xmlFrag->[$fragIdx], $match, @path, $fragIdx + 1); } else { $sub->($match, @path); } } } return; }

    Prints:

    pciReg: public_methods => members => parameters DIRTY: enums => members => values parameters: public_methods => members
    True laziness is hard work

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://993332]
Approved by GrandFather
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (9)
As of 2014-12-17 23:29 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (40 votes), past polls