Generated: Sun Apr 15 11:46:52 2012 from xml08.pl 2011/12/22 10.1 KB.
#!/usr/bin/perl # xml08.pl # AIM: To explore the XML:Simple interface ... # use module # 22/12/2011 - A fresh look, and seem to have got the jist now... the load is quite SLOW, # but each item can be enumerated. Seems ForceArray does quite little, except force each # indent level to begin with an ARRAY use strict; use warnings; use XML::Simple; use Data::Dumper; require "logfile.pl" or die "Missing logfile.pl ...\n"; # my simple log file # log file stuff my ($LF); my $outfile = 'temp.'.$0.'.txt'; open_log($outfile); my $enumd3 = 0; my $load_log = 1; my $dump_data = 0; my $show_type_text = 1; my $use_force_array = 0; # create object my ($xml2, $data2); # file load my $in_proj = 'C:\FGCVS\flightgear\data\materials.xml'; ###my $in_proj = 'C:\FGCVS\flightgear\data\materials-dds.xml'; ###my $in_proj = 'C:\DTEMP\osm-1153716.gpx'; ###my $in_proj = 'C:\FG\27\FlightGear\flightgear.vcproj'; ###my $in_proj = 'C:\Documents and Settings\Geoff McLane.PRO-1\My Documents\My Photo Albums\Photo Album 2006-11-24.album\studio.data\studio.plist'; my @xmlkeys = (); my @srcfls = (); my @hdrfls = (); my $key_cnt = 0; # read XML file my $TYP_HASH = 1; my $TYP_ARRAY = 2; my $TYP_CODE = 3; my $TYP_GLOB = 4; my $TYP_OTHER = 5; my $TYP_UNDEF = 6; my %type_text = ( $TYP_HASH => 'HASH', $TYP_ARRAY => 'ARRAY', $TYP_CODE => 'CODE', $TYP_GLOB => 'GLOB', $TYP_OTHER => 'OTHER', $TYP_UNDEF => 'TEXT' ); sub get_type_number($) { my ($k) = shift; my $type = ref($k); if ($type) { if ($type eq 'HASH' ) { return $TYP_HASH; } elsif ($type eq 'ARRAY') { return $TYP_ARRAY; } elsif ($type eq 'CODE') { return $TYP_CODE; } elsif ($type eq 'GLOB') { return $TYP_GLOB; } else { return $TYP_OTHER; } } return $TYP_UNDEF; } sub get_type_text($) { my $num = shift; if (defined $type_text{$num}) { return $type_text{$num}; } return 'Undefined $num'; } sub is_text_type($) { my ($k) = shift; my $n = get_type_number($k); return 1 if ($n == $TYP_UNDEF); return 0; } sub show_hash_type($$$); sub show_array_type($$$); sub show_hash_type($$$) { my ($data,$dep,$path) = @_; my $cnt = 0; my $indent = ' ' x $dep; my ($key,$val,$num,$text,$icnt,$npath); foreach $key (keys %{$data}) { $val = ${$data}{$key}; $num = get_type_number($val); $text = ($show_type_text ? get_type_text($num) : ""); $cnt++; ###$npath = $path.'->'.'{"'.$key.'"}'; $npath = $path.'{"'.$key.'"}'; if ($num == $TYP_UNDEF) { prt( $indent."$cnt: $key = ".$val." $text $npath\n" ); } elsif ($num == $TYP_HASH) { $icnt = scalar keys(%{$val}); prt($indent."$cnt: $key $text $icnt $npath\n" ); show_hash_type($val,($dep+1),$npath); } elsif ($num == $TYP_ARRAY) { $icnt = scalar @{$val}; prt($indent."$cnt: $key $text $icnt $npath\n" ); show_array_type($val,($dep+1),$npath); } else { prt($indent."$cnt: $key $text MISSED - CHECK ME!\n" ); } } } sub show_array_type($$$) { my ($data,$dep,$path) = @_; my $cnt = 0; my $indent = ' ' x $dep; my ($key,$num,$text,$icnt,$npath); foreach $key (@{$data}) { $num = get_type_number($key); $text = ($show_type_text ? get_type_text($num) : ""); $npath = $path.'['.$cnt.']'; $cnt++; if ($num == $TYP_UNDEF) { prt( $indent."$cnt: $key $text $npath\n" ); } elsif ($num == $TYP_HASH) { $icnt = scalar keys(%{$key}); prt($indent."$cnt: HASH, with $icnt keys $npath\n" ); show_hash_type($key,($dep+1),$npath); } elsif ($num == $TYP_ARRAY) { $icnt = scalar @{$key}; prt($indent."$cnt: ARRAY, with $icnt items $npath\n" ); show_array_type($key,($dep+1),$npath); } else { prt($indent."$cnt: $text MISSED - CHECK ME!\n" ); } } } sub show_xml_keys($) { my ($path) = shift; my $cnt1 = 0; my (@arr,$cnt,$msg,$key,$val); foreach my $k (@xmlkeys) { $cnt1++; my $data = $data2->{$k}; #my $npath = $path.'->'.'{"'.$k.'"}'; my $npath = $path.'{"'.$k.'"}'; my $num = get_type_number($data); my $text = get_type_text($num); if ($dump_data) { prt( "$cnt1 $k $text ($num)\n" ); prt("=================================================\n"); prt( Dumper($data) ); prt("=================================================\n"); } if ($num == $TYP_UNDEF) { # not scalar == TEXT prt( "$cnt1: $k = ".$data." $text $npath\n" ); } elsif ($num == $TYP_HASH) { $cnt = scalar keys(%{$data}); prt( "$cnt1: $k $text, with $cnt keys $npath\n" ); show_hash_type($data,1,$npath); } elsif ($num == $TYP_ARRAY) { $cnt = scalar @{$data}; prt( "$cnt1 $k $text, with $cnt items $npath\n" ); show_array_type($data,1,$npath); } else { prt( "$cnt1 $k $text CHECK ME\n" ); } } } sub test_path($) { my ($dat) = @_; my ($h,$n,$t,$cnt,$msg,$i,$i2,$lat,$lon,$ele); #$h = ${$dat}->{"trk"}->{"trkseg"}->{"trkpt"}; $h = ${$dat}{"trk"}{"trkseg"}{"trkpt"}; $n = get_type_number($h); $t = get_type_text($n); if ($n == $TYP_UNDEF) { $msg = "TEXT [$h]"; } elsif ($n == $TYP_HASH) { $cnt = scalar keys(%{$h}); $msg = "with $cnt keys"; } elsif ($n == $TYP_ARRAY) { $cnt = scalar @{$h}; $msg = "with $cnt items"; for ($i = 0; $i < $cnt; $i++) { $lat = ${$dat}{"trk"}{"trkseg"}{"trkpt"}[$i]{"lat"}; $lon = ${$dat}{"trk"}{"trkseg"}{"trkpt"}[$i]{"lon"}; $ele = ${$dat}{"trk"}{"trkseg"}{"trkpt"}[$i]{"ele"}; $i2 = $i + 1; prt("$i2: $lat,$lon,$ele\n"); } } else { $msg = "CHECK ME!"; } prt("test_path $t $msg\n"); } sub test_path2() { # 2 material ARRAY, with 188 items ${$data2}{"material"} my ($n,$t,$i,$cnt,$i2,$name,$j,$txtr); my ($acnt,$tmp,$val); my $array = ${$data2}{"material"}; $n = get_type_number($array); $t = get_type_text($n); if ($n == $TYP_ARRAY) { $cnt = scalar @{$array}; prt("test_path $t, with $cnt elements\n"); for ($i = 0; $i < $cnt; $i++) { $i2 = $i + 1; # 1: HASH, with 9 keys ${$data2}{"material"}[0] my $hash = ${$array}[$i]; $n = get_type_number($hash); $t = get_type_text($n); if ($n == $TYP_HASH) { my $hcnt = scalar keys(%{$hash}); #prt("test_path $t, with $hcnt keys.\n"); # 4: name = grass_rwy TEXT ${$data2}{"material"}[0]{"name"} $name = "'name' NOT found"; if (defined ${$hash}{"name"}) { $name = ${$hash}{"name"}; $n = get_type_number($name); $t = get_type_text($n); if ($n == $TYP_ARRAY) { $acnt = scalar @{$name}; $tmp = ''; for ($j = 0; $j < $acnt; $j++) { $val = ${$name}[$j]; $tmp .= ' ' if (length($tmp)); if (is_text_type($val)) { $tmp .= "$val"; } else { $tmp .= "NTT ".get_type_text(get_type_number($val)); } } $name = $tmp; } elsif ($n != $TYP_UNDEF) { $name = "Is type $t"; } } $txtr = "'texture' NOT defined"; if (defined ${$hash}{"texture"}) { $txtr = ${$hash}{"texture"}; $n = get_type_number($txtr); $t = get_type_text($n); if ($n == $TYP_ARRAY) { $acnt = scalar @{$txtr}; $tmp = ''; for ($j = 0; $j < $acnt; $j++) { $val = ${$txtr}[$j]; $tmp .= ' ' if (length($tmp)); if (is_text_type($val)) { $tmp .= "$val"; } else { $tmp .= "NTT ".get_type_text(get_type_number($val)); } } $txtr = $tmp; } elsif ($n != $TYP_UNDEF) { $txtr = "Is type $t"; } } prt("$i2:, name = [$name], texture [$txtr]\n"); } else { prt("test_path $t NOT HASH\n"); last; } } } else { prt("test_path $t NOT ARRAY\n"); } } #### MAIN #### ############################# if (! -f $in_proj) { mydie( "ERROR: Can NOT locate [$in_proj] ...\n" ); } prt( "Loading [$in_proj] ...\n" ); if ($use_force_array) { $xml2 = new XML::Simple (ForceArray => 1); prt("Using (ForceArray => 1) ...\n"); } else { $xml2 = new XML::Simple; prt("NOT using (ForceArray => 1) ...\n"); } #$data2 = $xml2->XMLin($raw2); $data2 = $xml2->XMLin($in_proj); # access XML data # prt( "Output of [$in_proj]...\nNOT using (ForceArray => 1) ...\n" ); prt( "Output of [$in_proj]...\n"); ###prt( Dumper($data2) ); $key_cnt = 0; foreach my $key (keys %{$data2}) { $key_cnt++; ##prt( "$key_cnt $key\n" ); push(@xmlkeys, $key); } #test_path($data2); #'${data2}->{"trk"}->{"trkseg"}->{"trkpt"} test_path2(); prt("Got $key_cnt primary keys...\n"); show_xml_keys("\${\$data2}"); close_log($outfile,$load_log); exit(0); # eof -