Re: sub that finds ancestor elements

in reply to sub that finds ancestor elements

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'

Comment on Re: sub that finds ancestor elements Select or Download Code
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]
Re^2: sub that finds ancestor elements by tobyink (Prior) 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 (Prior) on Sep 14, 2012 at 05:45 UTC
Replace this: `$node->findnodes("ancestor::")->map(sub { $coolNodeName->($_) })` [download] With this: `(map { $coolNodeName->($_) } $node->findnodes("ancestor::"))` [download] ... and you should be able to use XML::LibXML 1.70. `perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'`	[reply] [d/l] [select]


Perl Monk, Perl Meditation
	PerlMonks

Re: sub that finds ancestor elements

The best material for plates (tableware) is: