Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Re: Struggling with XML

by tobyink (Abbot)
on Oct 05, 2012 at 21:26 UTC ( #997550=note: print w/ replies, xml ) Need Help??


in reply to Struggling with XML

This does the trick...

use 5.010; use Data::Dumper; use XML::LibXML 1.70; my $xml = XML::LibXML->load_xml(IO => \*DATA); my @results; foreach my $dict ($xml->findnodes('//dict')) { my $key = $dict->getAttribute('key'); next unless $key ~~ [qw( subnet gateway cidr netmask )]; push @results, {} if $key eq 'subnet'; my $value = $dict->findvalue('.//value'); $results[-1]{ $key } = "$value"; } print Dumper \@results; __DATA__ <root> <dict key="status"> <value>success</value> </dict> <dict key="data"> <list> <dict key="subnet"> <value>10.11.14.0</value> </dict> <dict key="gateway"><value>10.11.13.1</value> </dict> <dict key="cidr"><value>10.11.14.0/21</value> </dict> <dict key="netmask"><value>255.255.248.0</value> </dict> <dict key="subnet"><value>10.11.15.0</value> </dict> <dict key="gateway"><value>10.11.13.1</value> </dict> <dict key="cidr"><value>10.11.15.0/24</value> </dict> <dict key="netmask"><value>255.255.255.0</value> </dict> <dict key="subnet"> <value>10.15.8.0</value> </dict> <dict key="gateway"> <value>10.11.13.1</value> </dict> <dict key="cidr"> <value>10.15.8.0/22</value> </dict> <dict key="netmask"> <value>255.255.252.0</value> </dict> <dict key="subnet"> <value>10.7.17.22</value> </dict> <dict key="gateway"> <value>10.11.13.1</value> </dict> <dict key="cidr"> <value>10.7.17.224/28</value> </dict> <dict key="netmask"> <value>255.255.255.240</value> </dict> <dict key="subnet"> <value>10.11.24.0</value> </dict> <dict key="gateway"> <value>10.11.13.1</value> </dict><dict key="cidr"> <value>10.11.24.0/24</value> </dict><dict key="netmask" ><value>255.255.255.0</value> </dict> </list> </dict> <dict key="exitCode"> <value>0</value> </dict> </root>
perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'


Comment on Re: Struggling with XML
Download Code
Re^2: Struggling with XML
by agentorange (Sexton) on Oct 08, 2012 at 11:18 UTC

    This I like though due to the fixed stack we have to work with I cannot use Perl later than 5.8.8 and also cannot use LibXML 1.70. I appreciate that is a whole topic of conversation in itself but those are the boundaries. I do appreciate the help though as this is very helpful in getting me going with Perl.

    However, I've done a little bit with the code to make it work with 5.8.8 and I'm almost there but currently only outputting subnet and I need gateway, cidr and netmask too.

    ... my $ua = LWP::UserAgent->new(); my $req = HTTP::Request->new('GET', $url); my $res = $ua->request($req); my $parser = XML::LibXML->new(); sub smart_match { my ($target, $param) = @_; if (ref $param eq 'Regexp') { return ($target =~ qr/$param/); } else { return ($target eq $param); } } my $xml = $parser->parse_string( $res->content() ); my @results; foreach my $dict ($xml->findnodes('//dict')) { my $key = $dict->getAttribute('key'); #next unless $key eq [qw( 'subnet', 'gateway', 'cidr', 'netmas +k' ) ]; next unless smart_match( $key, qw( subnet gateway cidr netmask + ) ); print Dumper($key); push @results, {} if $key eq 'subnet'; my $value = $dict->findvalue('.//value'); $results[-1]{ $key } = "$value"; } print Dumper \@results;
    Which outputs:
    $VAR1 = 'subnet'; $VAR1 = 'subnet'; $VAR1 = 'subnet'; $VAR1 = 'subnet'; $VAR1 = 'subnet'; $VAR1 = [ { 'subnet' => '10.11.14.0' }, { 'subnet' => '10.11.15.0' }, { 'subnet' => '10.15.8.0' }, { 'subnet' => '10.7.17.224' }, { 'subnet' => '10.11.24.0' } ];

      Meh... I replied to the wrong node. See Re^2: Struggling with XML.

      perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'
Re^2: Struggling with XML
by tobyink (Abbot) on Oct 08, 2012 at 12:58 UTC
    sub smart_match { my ($target, $param) = @_; if (ref $param eq 'Regexp') { return ($target =~ qr/$param/) } if (ref $param eq 'ARRAY') { return grep { smart_match($target, $_) } @$param } return ($target eq $param); } # ... next unless smart_match($key, [qw/subnet gateway cidr netmask/]);
    perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'
      tobyink thank you very much. There's a couple of things I'll need to study to ensure I've fully understood everything but I think I'm pretty much there with you assistance. Much appreciate all your input.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (21)
As of 2015-07-02 18:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (44 votes), past polls