sub that finds ancestor elements

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";
[download]

Comment on sub that finds ancestor elements Download Code

Replies are listed 'Best First'.
Re: sub that finds ancestor elements by GrandFather (Saint) 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; } [download] Prints: `pciReg: public_methods => members => parameters DIRTY: enums => members => values parameters: public_methods => members` [download] True laziness is hard work	[reply] [d/l] [select]
Re: sub that finds ancestor elements by tobyink (Canon) 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 [download] (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'`	[reply] [d/l] [select]
Re^2: sub that finds ancestor elements by tobyink (Canon) on Sep 13, 2012 at 20:52 UTC
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'`	[reply]
Re^3: sub that finds ancestor elements by jccunning (Acolyte) on Sep 13, 2012 at 21:47 UTC
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.	[reply]
Re^4: sub that finds ancestor elements by tobyink (Canon) on Sep 14, 2012 at 05:45 UTC
Re^2: sub that finds ancestor elements by jccunning (Acolyte) on Sep 13, 2012 at 19:23 UTC
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.	[reply]