Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Struggling with XML

by Anonymous Monk
on Oct 05, 2012 at 11:47 UTC ( #997452=perlquestion: print w/replies, xml ) Need Help??
Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Hi A complete Perl newbie and have started as looking at Perl and XML this week as have a requirement to access data via a web service and am struggling a little. Can anyone assist? My code:
use strict; use warnings; use Net::SSL(); BEGIN { $Net::HTTPS::SSL_SOCKET_CLASS = "Net::SSL"; $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0; $ENV{HTTPS_PROXY} = 'http://<proxyip>:<proxyport>'; } use LWP::UserAgent; use XML::Simple qw(:strict); #use XML::Simple; use Data::Dumper; my $url = 'https://<ip>:<port>/<webservice>?ip=10.11.13.10&ser +vers=10.7.11.7'; my $ua = LWP::UserAgent->new(); my $req = HTTP::Request->new('GET', $url); my $res = $ua->request($req); my $config = XMLin($res->content(), KeyAttr => { dict => 'key' }, + ForceArray => [ 'dict', 'value' ]); print "status: " , $config->{dict}->{status}->{value}->[0] , "\n"; print "subnet: " , $config->{dict}->{data}->{list}->{dict}->{subnet}- +>{value}->[0] , "\n"; print "netmask: " , $config->{dict}->{data}->{list}->{dict}->{netmask} +->{value}->[0] , "\n"; print "gateway: " , $config->{dict}->{data}->{list}->{dict}->{gateway} +->{value}->[0] , "\n";
Which outputs: status: success subnet: 10.11.24.0 netmask: 255.255.255.0 gateway: 10.11.13.1 But I need to output ALL the routes defined not just the first. The XML received from the web service is formatted like so:
<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>

Replies are listed 'Best First'.
Re: Struggling with XML
by runrig (Abbot) on Oct 05, 2012 at 16:03 UTC
    Another way, w/XML::Rules:
    use XML::Rules; my @rules = ( list => sub { my $dict = $_[1]{dict}; for my $d (@$dict) { print "$d->{key}: $d->{value}\n"; } return; }, dict => [ '/root' => sub { my $d = $_[1]; print "$d->{key}: $d->{value}\n" if $d->{key} eq 'status'; return; }, 'no content array', ], value => 'content', ); my $xr = XML::Rules->new( rules => \@rules ); $xr->parse($xml);
    Updated to also print status. A possibly simpler way(?):
    my @rules = ( "^dict" => sub { return $_[1]{key} =~ /^(?:status|subnet|gateway|netmask|data)$/; }, dict => sub { my $d = $_[1]; return if $d->{key} eq 'data'; print "$d->{key}: $d->{value}\n"; }, value => 'content', );
Re: Struggling with XML
by choroba (Chancellor) on Oct 05, 2012 at 12:04 UTC
    Using XML::XSH2:
    open 1.xml ; echo Status: /root/dict[@key="status"]/value ; for /root/dict[@key="data"]/list/dict[@key="subnet" or @key="netmask" +or @key="gateway"] echo :s @key ': ' (value) ;
    لսႽ ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
Re: Struggling with XML
by remiah (Hermit) on Oct 05, 2012 at 13:05 UTC

    Hello.

    With XML::Twig, maybe something like this. Twig has nice tutorial.

    use strict;use warnings; use XML::Twig; my $t=XML::Twig->new( twig_roots => { '/root/dict[@key="data"]/list/dict' => sub { my ($twig,$elt)=@_; printf "%s = %s\n", $elt->att("key"), $elt->first_child_te +xt; }, }, )->parsefile('your.xml');

      Looks like my login timed out whilst posting original. Thanks for responses. As I say I'm very new to Perl, ie. a couple of days, and not sure I fully understand the first response and cannot get XML::Twig to compile.
      Writing Makefile for XML::Twig malformed JSON string, neither array, object, number, string or atom, +at character offset 0 (before "(end of string)") at Makefile.PL line +147
      Therefore ideally a solution with XML::Simple or XML::LibXML would be preferable if possible. I think I'm close with the existing code just maybe not quite understanding something.
Re: Struggling with XML
by tobyink (Abbot) on Oct 05, 2012 at 21:26 UTC

    This does the trick...

    perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'

      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'
      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: perlquestion [id://997452]
Approved by toolic
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (6)
As of 2016-09-26 22:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Extraterrestrials haven't visited the Earth yet because:







    Results (492 votes). Check out past polls.