xmlsimple.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:55:01 2010 from xmlsimple.pl 2010/01/13 20 KB.

#!/perl -w
# NAME: xmlsimple.pl
# AIM: Explore XML simple interface ...
# 2009/10/15 - try again...
# 07/06/2008 - geoff mclane - http://geoffair.net/mperl/
# =====================================================================
# use XML::Simple;
# my $file = 'files/camelids.xml';
# my $xs1 = XML::Simple->new();
# my $doc = $xs1->XMLin($file);
# foreach my $key (keys (%{$doc->{species}})){
#   print $doc->{species}->{$key}->{'common-name'} . ' (' . $key . ') ';
#   print $doc->{species}->{$key}->{conservation}->final . "\n";
#}
# Other references
# http://search.cpan.org/dist/XML-Simple/lib/XML/Simple/FAQ.pod#How_do_I_use_XML::Simple?
# http://www.ibm.com/developerworks/xml/library/x-xmlperl1.html?ca=dgr-lnxw97XML-Simple
# $VAR1 = {
#      'passwd' => 'longNails',
#      'user' => 'freddy',
#      'books' => {
#             'book' => [
#                   {
#                 'title' => 'Cannery Row',
#                 'author' => 'Steinbeck'
# @{$config->{books}->{book}}[0]->{title} or 'Cannery Row' 
# =====================================================================
use strict;
use warnings;
use XML::Simple;
use Data::Dumper;
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
   my @tmpsp = split(/\\/,$pgmname);
   $pgmname = $tmpsp[-1];
}
my $outfile = "temp.$pgmname.txt";
open_log($outfile);
# prt( "$0 ... Hello, World ...\n" );
# features
my $test_camelids = 0;  # use the camlids data
my $maxtxt = 0;   # 5000;
my $doboth = 0;
my $add_force_array = 1;
my $out_trimmed_lines = 1;
my $inp_xml_file = 'C:\FG\27\data\Aircraft\A380\A380-set.xml';
# my $inp_xml_file = 'C:\Projects\hb\lame\vc_solution\vc9_libmp3lame.vcproj';
# my $inp_xml_file = 'C:\Projects\hb\lame\vc_solution\vc9_lame_config.vsprops';
# my $inp_xml_file = 'C:\Documents and Settings\Geoff McLane\Desktop\Maroc - June, 2008.flash\imagelist.xml';
sub show_hash_data($$$);
sub show_array_values($$$$);
sub show_hash_keys($$$$);
sub pgm_exit($$) {
   my ($val,$msg) = @_;
   if (length($msg)) {
      $msg .= "\n" if (!($msg =~ /\n$/));
      prt($msg);
   }
   close_log($outfile,1);
   exit($val);
}
# xml data
#<description>Airbus A380-House</description>
#<aircraft-version>1.0</aircraft-version>
#<status>beta</status>
#<flight-model>jsb</flight-model>
#<livery>../Textures/Livery/SA</livery>
#<aero>A380</aero>
# $VAR1 = {
#          'sim' => {
#                   'status' => 'beta',
#                   'model' => {
#                              'path' => 'Aircraft/A380/XML/A380.xml'
#                            },
#                   'flight-model' => 'jsb',
#                   'systems' => [
#                   'view' => [
#                   'weight' => {
#                   'help' => {
#                   'flaps' => {
#                   'allow-toggle-cockpit' => 'true',
#                   'sound' => [
#                   'tutorials' => {
#                   'livery' => '../Textures/Livery/SA',
#                   'menubar' => {
#                   'virtual-cockpit' => {
#                   'description' => 'Airbus A380-House',
#                   'rendering' => {
#                   'hud' => {
#                   'aero' => 'A380',
#                   'aircraft-version' => '1.0'
sub show_fg_xml_data($) {
   my ($rha) = @_;
   prt("FG Info (NOT using force array)\n");
   if (defined $rha->{'sim'}) {
      if (defined $rha->{'sim'}->{'aero'}) {
         prt("Aero        : ".$rha->{'sim'}->{'aero'}."\n" );
      }
      if (defined $rha->{'sim'}->{'status'}) {
         prt("Status      : ".$rha->{'sim'}->{'status'}."\n" );
      }
      if (defined $rha->{'sim'}->{'flight-model'}) {
         prt("Flight Model: ".$rha->{'sim'}->{'flight-model'}."\n");
      }
      if (defined $rha->{'sim'}->{'description'}) {
         prt("Description : ".$rha->{'sim'}->{'description'}."\n");
      }
      if (defined $rha->{'sim'}->{'aircraft-version'}) {
         prt("Version     : ".$rha->{'sim'}->{'aircraft-version'}."\n" );
      }
   }
}
# FORCE ARRAY
# $VAR1 = {
#          'sim' => [
#                   {
#                     'status' => [
#                                 'beta'
#                               ],
#          'sim' => [
#                   {
#                     'status' => [
#                                 'beta'
#                               ],
#                     'model' => [
#                                {
#                                  'path' => [
#                                            'Aircraft/A380/XML/A380.xml'
#                                          ]
#                                }
#                              ],
#                     'flight-model' => [
#                                       'jsb'
#                                     ],
#                     'systems' => [
#                     'view' => [
#                     'weight' => [
#                                 {
#                                   'weight-lb' => [
#                                                  '76000'
#                                                ],
#                                   'n' => '0',
#                                   'max-lb' => [
#                                               '80000'
#                                             ],
#                                   'name' => [
#                                             'pax/ bagagge'
#                                           ],
#                                   'min-lb' => [
#                                               '0'
#                                             ]
#                                 }
#                               ],
#                     'help' => [
#                     'flaps' => [
#                     'allow-toggle-cockpit' => [
#                     'sound' => [
#                     'tutorials' => [
#                     'livery' => [
#                                 '../Textures/Livery/SA'
#                               ],
#                     'menubar' => [
#                     'virtual-cockpit' => [
#                     'description' => [
#                                      'Airbus A380-House'
#                                    ],
#                     'rendering' => [
#                     'hud' => [
#                     'aero' => [
#                               'A380'
#                             ],
#                     'aircraft-version' => [
#                                           '1.0'
#                                         ]
#                   }
# FORCE ARRAY
sub show_fg_xml_data_fa($) {
   my ($rha) = @_;
   my ($r,$s);
   prt("FG Info (using force array)\n");
   if (defined $rha->{'sim'}) {
      my $ra = $rha->{'sim'}; # extract array ref
      if (defined ${$ra}[0]->{'aero'}) {
         $r = ${$ra}[0]->{'aero'};
         $s = ${$r}[0];
         prt( "Aero   = $s\n" );
      }
      if (defined ${$ra}[0]->{'status'}) {
         $r = ${$ra}[0]->{'status'};
         $s = ${$r}[0];
         prt( "Status = $s\n" );
      }
      if (defined ${$ra}[0]->{'flight-model'}) {
         $r = ${$ra}[0]->{'flight-model'};
         $s = ${$r}[0];
         prt( "FDM    = $s\n" );
      }
      if (defined ${$ra}[0]->{'description'}) {
         $r = ${$ra}[0]->{'description'};
         $s = ${$r}[0];
         prt( "Desc.  = $s\n" );
      }
      if (defined ${$ra}[0]->{'aircraft-version'}) {
         $r = ${$ra}[0]->{'aircraft-version'};
         $s = ${$r}[0];
         prt( "Vers   = $s\n" );
      }
      #if (defined @{$rha->{'sim'}}[0]->{'status'}) {
      #   my $st = @{$rha->{'sim'}}[0]->{'status'}[0];
      #   prt( "Status = $st\n" );
      #}
   }
}
sub load_xml_file($) {
   my ($in_xml_file) = @_;
   my (@lines,$txt);
   # view XML data
   prt( "Loading [$in_xml_file] ...\n" );
   if (open INF, "<$in_xml_file") {
      @lines = <INF>;
      close INF;
      prt("Display of source lines...\n");
      foreach $txt (@lines) {
         if ($out_trimmed_lines) {
            $txt = trim_all($txt);
            next if (length($txt) == 0);
            prt("$txt\n");
         } else {
            prt($txt);
         }
      }
      prt("End display of source lines of [$in_xml_file]...\n");
   } else {
      prt("ERROR: Can NOT open file [$in_xml_file]...Aborting...\n");
      pgm_exit(1,"FAILED FILE OPEN");
   }
   my $xml = new XML::Simple (ForceArray => 0, suppressempty => '');
   my $data1 = $xml->XMLin($in_xml_file);
   prt( "Dump of [$in_xml_file]...\nNOT using (ForceArray => 1) ...\n" );
   my $txt1 = Dumper($data1);
   my $stxt1 = $txt1;
   if ($maxtxt && (length($txt1) > $maxtxt)) {
      $stxt1 = substr($txt1,0,$maxtxt);
   }
   prt( "$stxt1\n");
   prt( "End dump of [$in_xml_file], not using (ForceArray => 1) ...\n" );
   if ($add_force_array) {
      my $xml2 = new XML::Simple (ForceArray => 1, suppressempty => '');
      # my $xml2 = new XML::Simple (ForceArray => 1, KeepRoot => 1 );
      my $data2 = $xml2->XMLin($in_xml_file);
      my $txt2 = Dumper($data2);
      prt( "Dump of [$in_xml_file]...\nUsing (ForceArray => 1, suppressempty => '') ...\n" );
      my $stxt2 = $txt2;
      if ($maxtxt && (length($txt2) > $maxtxt)) {
          $stxt2 = substr($txt2,0,$maxtxt);
      }
      prt( "$stxt2\n");
      prt( "End dump of [$in_xml_file], Using (ForceArray => 1) ...\n" );
      if ($txt1 eq $txt2) {
         prt( "Two DUMPS are exactly the SAME!\n" );
      } else {
         prt( "Two DUMPS are DIFFERENT!\n" );
      }
      show_fg_xml_data_fa($data2);
   }
   show_fg_xml_data($data1);
}
my $camelids = <<EOF;
<?xml version="1.0"?>
<dromedaries>
  <species name="Camel">
    <humps>1 or 2</humps>
    <disposition>Cranky</disposition>
  </species>
  <species name="Llama">
    <humps>1</humps>
    <disposition>Aloof</disposition>
  </species>
  <species name="Alpaca">
    <humps>(see Llama)</humps>
    <disposition>Friendly</disposition>
  </species>
</dromedaries>
EOF
my $camelids2 = <<EOF;
<?xml version="1.0"?>
<camelids>
  <species name="Camelus dromedarius">
    <common-name>Dromedary, or Arabian Camel</common-name>
    <physical-characteristics>
      <mass>300 to 690 kg.</mass>
      <appearance>
        The dromedary camel is characterized by a long-curved 
        neck, deep-narrow chest, and a single hump.
      </appearance>
    </physical-characteristics>
    <natural-history>
       <food-habits>
         The dromedary camel is an herbivore.
       </food-habits>
       <reproduction>
         The dromedary camel has a lifespan of about 40-50 years
       </reproduction>
       <behavior>
         With the exception of rutting males, dromedaries show
         very little aggressive behavior.
       </behavior>
       <habitat>
         The camels prefer desert conditions characterized by a
         long dry season and a short rainy season.
       </habitat>
    </natural-history>
    <conservation status="no special status">
      <detail>
        Since the dromedary camel is domesticated, the camel has
        no special status in conservation.
      </detail>
    </conservation>
  </species>
  <species name="Llama">
    <common-name>Llama</common-name>
    <physical-characteristics>
      <mass>200 to 400 kg.</mass>
      <humps>1</humps>
      <appearance>
        The Llama is characterized by
        blah blah blah
      </appearance>
    </physical-characteristics>
    <natural-history>
      <behavior>
          <disposition>Aloof</disposition>
      </behavior>
    </natural-history>
    <conservation status="no special status">
      <detail>
        Since the Llama's are now 'farmed' it has no 
        special status
      </detail>
    </conservation>
  </species>
  <species name="Alpaca">
    <common-name>Alpaca</common-name>
    <humps>(see Llama)</humps>
    <disposition>Friendly</disposition>
    <conservation status="no special status">
      <detail>
        Since the Alpaca is domesticated, and 'farmed' it has no 
        special status
      </detail>
    </conservation>
  </species>
</camelids>
EOF
#if ($stxt1 eq $stxt2) {
#   prt( "SAME, with forced array ...\n" );
#} else {
#   prt( "$stxt2\n" );
#}
# ref($something) gives -
# a scalar value undef 
# a reference to a scalar "SCALAR" 
# a reference to an array "ARRAY" 
# a reference to a hash "HASH" 
# a reference to a subroutine "CODE" 
# a reference to a filehandle "IO" or "IO::Handle" 
# a reference to a typeglob "GLOB" 
# a reference to a precompiled pattern "Regexp" 
# a reference to another reference "REF" 
sub is_scalar_type($) {
    my ($t) = shift;
    return 0 if (defined $t && length($t));
    return 1;
}
sub show_hash_data($$$) {
    my ($rh,$lev,$num) = @_;
    my ($key,$val,$typ,$typ2,$cnt);
    $key = $lev;
    my $indent = '';
    while ($key) {
        $indent .= '  ';
        $key--;
    }
    foreach $key (keys %{$rh}) {
        $val = ${$rh}{$key};
        $typ = ref($val);
        if (is_scalar_type($typ)) {
            prt( $indent."$num: key=[$key] val=[$val] ($lev)\n" );
        } else {
            if ($typ eq 'ARRAY') {
                my ($v2, $k3, $v3);
                $v3 = scalar @{$val};
                prt( $indent."$num: key=[$key] type=[$typ] count $v3 ($lev)\n" );
                $cnt = 0;
                foreach $v2 (@{$val}) {
                    $cnt++;
                    $typ2 = ref($v2);
                    if (is_scalar_type($typ2)) {
                        prt( $indent."scalar $v2\n" );
                    } else {
                        if ($typ2 eq 'HASH') {
                            show_hash_data($v2,($lev + 1),$cnt);
                        } else {
                            prt( $indent."TYPE NOT HANDLED ($lev)\n" );
                        }
                    }
                }
                prt( $indent."DONE key=[$key] type=[$typ] count $v3 ($lev)\n" );
            } else {
                prt( $indent."TYPE NOT HANDLED ($lev}\n" );
            }
        }
    }
}
# access XML data
sub show_array_values($$$$) {
    my ($nam, $num,$ar,$lev) = @_;
    my $kcnt = scalar @{$ar};
    my ($v1,$ind,$typ);
    $v1 = $lev;
    $ind = '';
    while ($v1--) {
        $ind .= ' ';
    }
    prt( $ind."The $nam $num array has $kcnt items...\n" );
    foreach $v1 (@{$ar}) {
        $typ = ref($v1);
        if (is_scalar_type($typ)) {
            prt( $ind." val [$v1] scalar" );
        } elsif ($typ eq 'HASH') {
            show_hash_keys($nam, $num, $v1, $lev + 1);
        } elsif ($typ eq 'ARRAY') {
            show_array_values($nam, $num, $v1, $lev + 1);
        }
    }
}
sub show_hash_keys($$$$) {
    my ($nam,$num,$hr,$lev) = @_;
    my @hashkeys = keys %{$hr};
    my $kcnt = scalar @hashkeys;
    my ($ky,$v1,$typ,$ind);
    $ind = '';
    $v1 = $lev;
    while ($v1--) {
        $ind .= ' ';
    }
    prt( $ind."The $nam $num hash has $kcnt keys...\n" );
    foreach $ky (keys %{$hr}) {
        $v1 = ${$hr}{$ky};
        $typ = ref($v1);
        if (is_scalar_type($typ)) {
            $typ = "[$v1] scalar";
        }
        prt( $ind."{$nam}{$ky} ($typ)\n" );
        if ($typ eq 'HASH') {
            show_hash_keys($ky, $num, $v1, $lev + 1);
        } elsif ($typ eq 'ARRAY') {
            show_array_values($ky, $num, $v1, $lev + 1);
        }
    }
}
sub get_type_name($) {
    my ($itm) = @_;
    my $t = ref($itm);
    my $nm = $t;
    $nm = 'scalar' if (is_scalar_type($t));
    return $nm;
}
#          'Files' => {
#                     'Filter' => [
sub test_files($) {
    my ($data) = @_;
    my ($val,$m1,$c1);
    if (defined $data->{Files}->{Filter}) {
        $val = $data->{Files}->{Filter};
        $m1 = get_type_name($val);
        if ($m1 eq 'scalar') {
            prt( "{Files}->{Filter} value $val\n" );
        } else {
            if ($m1 eq 'ARRAY') {
                $c1 = scalar @{$val};
                prt( "{Files}->{Filter} type $m1, count $c1\n" );
            } else {
                prt( "{Files}->{Filter} type $m1\n" );
            }
        }
    } else {
        prt( "NOT DEFINED\n" );
    }
}
sub test_configuration($) {
    my ($data) = @_;
    my ($val,$typ,$cnt,$v2,$t2,$num,$i);
    my (@keys,$c2,$j,$k2,$v3,$m1);
    my ($c3,$k,$v4,$m4,$k4);
    my ($ind);
    if (defined $data->{Configurations}->{Configuration}) {
        $val = $data->{Configurations}->{Configuration};
        $typ = ref($val);
        if (is_scalar_type($typ)) {
            prt( "Defined with value $val\n" );
        } else {
            if ($typ eq 'ARRAY') {
                $cnt = scalar @{$val};
                prt( "Defined $typ, with count $cnt\n" );
                for ($i = 0; $i < $cnt; $i++) {
                    $num = $i + 1;
                    $v2 = ${$val}[$i];
                    $t2 = ref($v2);
                    if (is_scalar_type($t2)) {
                        prt( "$num: value [$v2]\n" );
                    } else {
                        if ($t2 eq 'HASH') {
                            @keys = keys( %{$v2} );
                            $c2 = scalar @keys;
                            prt( "$num: type [$t2], with $c2 keys\n" );
                            for ($j = 0; $j < $c2; $j++) {
                                $k2 = $keys[$j];
                                $v3 = ${$v2}{$k2};
                                $m1 = get_type_name($v3);
                                if ($m1 eq 'scalar') {
                                    prt( "   [$k2] value [$v3]\n" );
                                } else {
                                    if ($m1 eq 'ARRAY') {
                                        $c3 = scalar @{$v3};
                                        $ind = "       "; 
                                        prt( $ind."[$k2] type $m1, count $c3\n" );
                                        for ($k = 0; $k < $c3; $k++) {
                                            $k4 = $k+1;
                                            $v4 = ${$v3}[$k];
                                            $m4 = get_type_name($v4);
                                            if ($m4 eq 'scalar') {
                                                prt($ind."$k4: value [$v4]\n");
                                            } else {
                                                prt($ind."$k4: type $m4\n");
                                            }
                                        }
                                    } else {
                                        prt( "       [$k2] type $m1\n" );
                                    }
                                }
                            }
                        } else {
                            prt( "$num: type [$t2]\n" );
                        }
                    }
                }
            } else {
                prt( "Defined $typ\n" );
            }
        }
    } else {
        prt( "NOT Defined\n" );
    }
}
# ######################################
# ### MAIN ###
load_xml_file($inp_xml_file);
if ($test_camelids) {
    my $tfile = 'tempcamel.xml';
    write2file($camelids2,$tfile);
    prt( "Written xml to [$tfile]\n" );
    prt( "Note, this information is not necessarily correct or accurate!\nIt is just SAMPLE data\n" );
    my $xs1 = XML::Simple->new();
    my $doc = $xs1->XMLin($tfile);
    foreach my $key (keys (%{$doc->{species}})){
        prt( $doc->{species}->{$key}->{'common-name'} . ' (' . $key . ') ' );
        prt( $doc->{species}->{$key}->{conservation}->{detail} . " " );
        prt( "\n" );
    }
} else {
    #show_hash_data($data2, 0, 0);
    #show_hash_keys('root', 1, $data1, 0);
    #show_hash_keys('root', 2, $data2, 0);
    #test_configuration($data1);
    #test_files($data1);
}
pgm_exit(0,"Normal exit.");
# ######################################
# eof - xmlsimple.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional