in reply to Re^4: Need help with complex hash of hashes.
in thread Need help with complex hash of hashes.

If you run this against your XML it will filter out the relevant tags

 
#!/usr/bin/perl
use strict;
use XML::Twig;

my $input_xml = 'big.xml';

# tags to keep
my $re = qr/u_application_i|u_ci_id|sys_class_name|name|ip_address/;
my $twig = 'XML::Twig'->new( 
  twig_handlers =>  { result => \&record }, 
);
open my $fh,'>','small.xml' or die "$!";
$twig->parsefile($input_xml);

sub record {
  my ($e,$t) = @_;
  for ($t->children){
    $_->cut unless ($_->name =~ $re);
  }
  $t->flush($fh,pretty_print => 'indented');
}

[download]

Result

<result>
    <ip_address>10.10.10.10</ip_address>
    <u_application_id></u_application_id>
    <u_display_name>lnxnmsprag27</u_display_name>
    <name>lnxnmsprag27</name>
    <u_ci_id>CI10110212</u_ci_id>
    <sys_class_name>cmdb_ci_linux_server</sys_class_name>
 </result>

[download]
poj

Replies are listed 'Best First'.
Re^6: Need help with complex hash of hashes.
by vlturner (Sexton) on Jan 28, 2016 at 18:56 UTC

    Shouldn't this. 

    $twig->parsefile($input_xml);

    [download]

    Be this 

    $twig->parsefile($fh);

    [download]

    I got this error. 

    d_from_repair></returned_from_repair><ng_assignment_flag>ready</ng_ass
+ignment_flag><sys_class_name>cmdb_ci_esx_server</sys_class_name><u_pr
+ocurement_product_number></u_procurement_product_number><attributes><
+/attributes><u_location_stamp></u_location_stamp><fault_count>0</faul
+t_count><operational_status>1</operational_status><cfg_auto_change></
+cfg_auto_change></result></response>:
File name too long at vance.pl line 39.
 at vance.pl line 39.
 at /usr/lib/perl5/site_perl/5.22/XML/Twig.pm line 2874.
    XML::Twig::_croak("Couldn't open <?xml version=\"1.0\" encoding=\"
+UTF-8\"?><response"..., 0) called at /usr/lib/perl5/site_perl/5.22/XM
+L/Twig.pm line 794
    XML::Twig::_checked_parse_result(undef, "") called at /usr/lib/per
+l5/site_perl/5.22/XML/Twig.pm line 782
    XML::Twig::parsefile(XML::Twig=HASH(0x6003eb060), "<?xml version=\
+"1.0\" encoding=\"UTF-8\"?><response><result><chec"...) called at van
+ce.pl line 39
Debugged program terminated.  Use q to quit or R to restart,
use o inhibit_exit to avoid stopping after program termination,
h q, h R or h o to get additional info.
  DB<1> q

    [download]
[reply]
[d/l]
[select]

      In my code I had

      my $input_xml = 'big.xml';, a filename. What do you have ?

      If you have my $input_xml = $client->responseContent(); then use  $twig->parse($input_xml);

      poj
[reply]
[d/l]
[select]

        The code seems to blow up on the Twig call at line 33 now. Something in line 21 is not quite kosher...Need a conforming pickle! 

        use strict;
use warnings;
use XML::Twig;
use Text::CSV;
use Data::Dump 'pp';
use Data::Dumper;
use REST::Client;
use MIME::Base64;
use Text::Unidecode;
use utf8;

my @header   = ();
my @csv_rows = ();
my $order_by = 'u_ci_id';

my %seen = ();
my %arx_data = ();

# parse xml in chunks
my $twig = 'XML::Twig'->new( twig_handlers => { result => \&record });
my $client = REST::Client->new(host => 'https://host.com');
my $encoded_auth = encode_base64("user:password", '');

$client->GET("/api/now/table/cmdb_ci?sysparm_limit=1000",

                {'Authorization' => "Basic $encoded_auth",

                 'Accept' => 'application/xml'});

my $input_xml = $client->responseContent();

$twig->xparse($input_xml);

# data dump
pp \%arx_data;
#pp \@csv_rows;
#pp \@header;

# sort and dump csv
my @sorted = sort { $b->[0] cmp $a->[0] } @csv_rows;
unshift @sorted,[@header]; # add header

my $outfile = 'xmldump.csv';
my $csv = Text::CSV->new ( { binary => 1 } )  
    or die "Cannot use CSV: ".Text::CSV->error_diag ();
$csv->eol("\n"); 

if ($outfile){        
  open my $fh, ">:encoding(utf8)", $outfile or die "$outfile: $!";
  for (@sorted){
    shift @$_; # remove sort field
    $csv->print ($fh, $_);
  }
  close $fh or die "new.csv: $!"; 
} else {
  for (@sorted){
    shift @$_;
    $csv->print (\*STDOUT, $_);
  }
}  

# parse 1 record
sub record {
  my ($e,$t) = @_;
  
  # csv records
  unless (@header){
    my @info_tags = $t->children;
    @header = map{ $_->name } @info_tags;
    unshift @header,$order_by; # add sort field
  }
  
  # extract data in same order as header row
  my @data = map{ $t->field($_) } @header;
  push @csv_rows, clean(@data); #returns array ref
 
  # build hash structure
  my $app   = $t->field('u_application_id');
  my $u_ci  = $t->field('u_ci_id');
  my $class = $t->field('sys_class_name');
  my $name  = $t->field('name');
  my $ip    = $t->field('ip_address');
  my $fqdn  = $t->field('fqdn');
  my $dns   = $t->field('dns_domain');
  my $mac   = $t->field('mac');
  
  if ( $class eq 'cmdb_ci_appl'){
    $arx_data{$u_ci}{'name'} = $name;  
  } else {
    next if $seen{$app}{$ip}++;
    push @{$arx_data{$app}{'members'}},$ip;
  }
  
}

sub clean {
  my @f = @_;
  for (@f){
    s/\r|\n//g;  # Cleanup Carraige Returns
    s/, / /g;    # Cleanup Comma Space
    s/,/ /g;     # Cleanup Comma
    s/"//g;      # Cleanup Parentheses
    s/^\s+|\s+$//g;    # Trim spaces
    s/([^[:ascii:]]+)/unidecode($1)/ge;
  }
  return \@f;
}

        [download]
        main::(vance.pl:13):    my @header   = ();
  DB<1> c
Exiting subroutine via next at vance.pl line 91.
 at vance.pl line 91.
    main::record(XML::Twig=HASH(0x6003eaed0), XML::Twig::Elt=HASH(0x60
+2c20438)) called at /usr/lib/perl5/site_perl/5.22/XML/Twig.pm line 23
+48

        [download]
[reply]
[d/l]
[select]
Re^6: Need help with complex hash of hashes.
by poj (Abbot) on Jan 28, 2016 at 19:31 UTC
    please delete - dupl
[reply]

In Section Seekers of Perl Wisdom