vlturner has asked for the wisdom of the Perl Monks concerning the following question:

Here is my XML doc I am trying to deal with. I am trying to add code to give me the list of node names returned. Seems that regardless of the order I request the XML, it is returned in any other order, so I need positionally align my data based on columnar headers, and print the header as the first line returned. 


<?xml version="1.0" encoding="UTF-8"?>
<response>
    <result>
        <checked_in></checked_in>
        <change_request></change_request>
        <po_number></po_number>
        <correlation_id></correlation_id>
        <cfg_auto_provider></cfg_auto_provider>
        <supported_by></supported_by>
        <u_service_catalog>true</u_service_catalog>
        <first_discovered></first_discovered>
        <u_oem_part_numbe></u_oem_part_numbe>
        <sent_for_repair></sent_for_repair>
        <owned_by></owned_by>
        <gl_account></gl_account>
        <managed_by></managed_by>
        <asset></asset>
        <u_project_id></u_project_id>
        <maintenance_schedule></maintenance_schedule>
        <u_chg>false</u_chg>
        <category></category>
        <delivery_date></delivery_date>
        <install_status></install_status>
        <u_maintenance_window></u_maintenance_window>
        <virtual>false</virtual>
        <u_sub_class></u_sub_class>
        <dns_domain></dns_domain>
        <u_incident></u_incident>
        <u_parts_software_needed></u_parts_software_needed>
        <change_control></change_control>
        <checked_out></checked_out>
        <u_decommission_stamp></u_decommission_stamp>
        <purchase_date></purchase_date>
        <order_date></order_date>
        <u_template></u_template>
        <skip_sync></skip_sync>
        <lease_id></lease_id>
        <u_sevice_options></u_sevice_options>
        <vendor></vendor>
        <sys_id></sys_id>
        <u_maint_contract_sla></u_maint_contract_sla>
        <sys_created_by></sys_created_by>
        <u_sla_support_tie></u_sla_support_tie>
        <subcategory></subcategory>
        <start_date></start_date>
        <comments></comments>
        <location>
            <link></link>
            <value></value>
        </location>
        <unverified></unverified>
        <justification></justification>
        <u_disposal_date></u_disposal_date>
        <sys_tags></sys_tags>
        <sys_domain>
            <link></link>
            <value></value>
        </sys_domain>
        <sys_mod_count></sys_mod_count>
        <cost_cc></cost_cc>
        <u_total_purchase_cost></u_total_purchase_cost>
        <monitor></monitor>
        <sys_updated_on></sys_updated_on>
        <warranty_expiration></warranty_expiration>
        <invoice_number></invoice_number>
        <fqdn></fqdn>
        <cost></cost>
        <u_retail_grp></u_retail_grp>
        <u_server_type></u_server_type>
        <ip_address></ip_address>
        <u_manufacture_date_dummy></u_manufacture_date_dummy>
        <last_discovered></last_discovered>
        <model_id>
            <link></link>
            <value></value>
        </model_id>
        <manufacturer></manufacturer>
        <u_inc>false</u_inc>
        <company></company>
        <due></due>
        <cfg_auto_management_server></cfg_auto_management_server>
        <u_proposed></u_proposed>
        <u_change></u_change>
        <u_work_notes></u_work_notes>
        <u_store_location></u_store_location>
        <asset_tag></asset_tag>
        <discovery_source></discovery_source>
        <u_application_id></u_application_id>
        <assignment_group></assignment_group>
        <can_print></can_print>
        <u_problem></u_problem>
        <department></department>
        <u_manufacture_date></u_manufacture_date>
        <support_group>
            <link></link>
            <value></value>
        </support_group>
        <u_exclusion></u_exclusion>
        <sys_created_on></sys_created_on>
        <u_display_name></u_display_name>
        <u_alias></u_alias>
        <cost_center></cost_center>
        <short_description></short_description>
        <sys_updated_by></sys_updated_by>
        <name></name>
        <u_environment></u_environment>
        <u_function></u_function>
        <due_in></due_in>
        <u_change_approver></u_change_approver>
        <install_date></install_date>
        <assigned></assigned>
        <u_active_stamp></u_active_stamp>
        <u_retail_group></u_retail_group>
        <serial_number></serial_number>
        <u_work_notes__asset_></u_work_notes__asset_>
        <repair_contract_id></repair_contract_id>
        <assigned_to></assigned_to>
        <mac_address></mac_address>
        <model_number></model_number>
        <schedule></schedule>
        <u_ci_id></u_ci_id>
        <returned_from_repair></returned_from_repair>
        <ng_assignment_flag></ng_assignment_flag>
        <u_procurement_product_number></u_procurement_product_number>
        <sys_class_name></sys_class_name>
        <attributes></attributes>
        <u_location_stamp></u_location_stamp>
        <fault_count></fault_count>
        <cfg_auto_change></cfg_auto_change>
    </result>
</response>';

[download]

#!/usr/bin/perl -w
use strict;
use warnings;
use 5.014;
use MIME::Base64;
use Data::Dumper;

# Load the AnyData XML to CSV conversion modules
use XML::LibXML;
use XML::Simple;
use XML::Parser;
use XML::Twig;
 
 # http://search.cpan.org/~makamaka/JSON/lib/JSON.pm
 # Example install using cpanm:
 #   sudo cpanm -i JSON
 use JSON;
 
 # http://search.cpan.org/~mcrawfor/REST-Client/lib/REST/Client.pm
 # Example install using cpanm:
 #   sudo cpanm -i REST::Client
 use REST::Client;
 
 # Set the request parameters
 my $host = 'https://host.service-now.com';
 
 # Eg. User name="admin", Password="admin" for this code sample.
 my $user = 'USER';
 my $pwd = 'PASSWD';

 my $client = REST::Client->new(host => $host);
 
 my $encoded_auth = encode_base64("$user:$pwd", '');
 
my $header = 'u_ci_id,u_display_name,name,fqdn,ip_address,mac_address'
+;

#$client->GET("/api/now/table/cmdb_ci?sysparm_limit=100000000&sysparm_
+fields=u_ci_id, name, hostname, fqdn, ip_address, mac_address",
$client->GET("/api/now/table/cmdb_ci?sysparm_limit=1",
#$client->GET("/api/now/table/cmdb_ci?sysparm_limit=100&sysparm_fields
+=mac_address,ip_address,fqdn,name,u_display_name,u_ci_id",
                               
                {'Authorization' => "Basic $encoded_auth",
                 
                 'Accept' => 'application/xml'}); 
 
# print 'Response: ' . $client->responseContent() . "\n";

my $input_xml = $client->responseContent();
print Dumper ($input_xml);
print $header;
print "\n";
my $field= $ARGV[0] || 'u_ci_id';
my $twig= new XML::Twig;
$twig->xparse($input_xml);

my $root= $twig->root;
my @records = $root->children;

my @sorted= sort {    $b->first_child( $field)->text 
                  cmp $a->first_child( $field)->text }
            @records;

for my $record (@sorted) {
    my @info_tags = $record->children;
    my @data;

    for my $info_tag (@info_tags) {
        push @data, $info_tag->text;
    }
    say join ',', @data; 
}

[download]

Replies are listed 'Best First'.
Re: Need help with node names for creating header line
by choroba (Cardinal) on Dec 30, 2015 at 15:58 UTC
    Use the ->name method to retrieve the tag name.
    Read more... (2 kB)

    push @data, [ $info_tag->name, $info_tag->text ]; stores a two element array to the @data, so when printing it, you have to dereference it (that's what $_->[0] and $_->[1] do).

    Note that I removed the parts of the code irrelevant to the question. Using both XML::Twig and XML::LibXML in one program sounds very strange. 

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

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

      So I used this and it runs, But still not what I was working to get. What I want is a CSV file with a header 

      
COL_HDR1,COL_HDR2,COL_HDR3
   DATA1,   DATA2,   DATA3

      [download]
[reply]
[d/l]
        Keep a flag that tells you whether the header was already printed, if so, extract text, otherwise extract names: 
        my $header_printed;
for my $record (@sorted) {
    my @info_tags = $record->children;
    my @data;

    for my $info_tag (@info_tags) {
        my $extract = $header_printed ? 'text' : 'name';
        push @data, $info_tag->$extract;
    }
    $header_printed = 1;
    say join ',', @data;
}

        [download]
        ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

        [download]
[reply]
[d/l]
[select]
Re: Need help with node names for creating header line
by Corion (Patriarch) on Dec 30, 2015 at 15:43 UTC

    Your code contains a lot of stuff that does not really seem related to the problem.

    Can you please reduce the script so it does not try to make outside requests and uses only the XML::Twig module instead of also using XML::Simple and XML::Parser?

    Please also show us the output you currently get and an example of the output that you want.

[reply]
Re: Need help with node names for creating header line
by poj (Abbot) on Dec 30, 2015 at 16:31 UTC

    Try

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

my $header='u_ci_id,u_display_name,name,fqdn,ip_address,mac_address';
my $field = $ARGV[0] || 'u_ci_id';
my $input_xml = do { local $/; <DATA> };

my $twig = new XML::Twig;
$twig->xparse($input_xml);
my $root = $twig->root();

my @data = ();
my @cols = split ',',$header;
unshift @cols, $field; # added for sort

for my $record ($root->children) {
  push @data,[ map { $record->first_child($_)->text } @cols];
}

my @sorted = sort { $b->[0] cmp $a->[0] } @data;
print $header."\n";
for (@sorted){
  print join ',',@$_[1..$#cols]; # exclude sort col
  print "\n";
}

__DATA__
<?xml version="1.0" encoding="UTF-8"?>
<response>
 <result>
  <fqdn>fqdnB</fqdn>
  <ip_address>ip1</ip_address>
  <u_display_name>display1</u_display_name>
  <name>name1</name>
  <mac_address>mac5</mac_address>
  <u_ci_id>id 1</u_ci_id>
 </result>
 <result>
  <fqdn>fqdnA</fqdn>
  <ip_address>ip2</ip_address>
  <u_display_name>display2</u_display_name>
  <name>name2</name>
  <mac_address>mac4</mac_address>
  <u_ci_id>id 2</u_ci_id>
</result>
</response>

    [download]
    poj
[reply]
[d/l]
      I need this: 
      my $input_xml = $client->responseContent();

instead of

my $input_xml = do { local $/; <DATA> };

which breaks at

push @data,[ map { $record->first_child($_)->text } @cols];

Because of the $_

      [download]
[reply]
[d/l]

        Without $_

        for my $record ($root->children) {
  my @tmp=();
  for my $col (@cols){
    push @tmp,$record->first_child($col)->text;
  }
  push @data,[ @tmp ];
}

        [download]
        poj
[reply]
[d/l]
[reply]
[d/l]

Back to Seekers of Perl Wisdom