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