Generated: Tue Feb 2 17:55:00 2010 from xml05.pl 2006/04/17 2.7 KB.
#!/Perl # XML - Walking the xml document tree, using XML::Simple - 17 April, 2006 use Data::Dumper; use XML::Simple; my $outfil = 'tempxout.txt'; my ($OF); my $file = 'c:\\FG0910-1\\source\\projects\\VC8\\FlightGear.vcproj'; open $OF, ">$outfil" or die "Can not create $outfil!\n"; my $xs1 = XML::Simple->new(); my $doc = $xs1->XMLin($file); prt( "Hello, World... loaded $file ... showing the document tree ...\n"); show_type($doc, 'doc', 1, 0); prt( "Dump of WHOLE document tree ...\n" ); prt( Data::Dumper->Dump([$doc], [qw(doc)]) ); prt( "End of show ;=))\n" ); close $OF; sub get_ind { my $l = shift; my $i = ($l + 1) * 3; return $i; } # show_type: parameters $variable $name $output # will effectively walk the document tree, # outputting all the elements, and their values. sub show_type { my ($k, $name, $out, $lev) = @_; my $type = ref($k); my $msg = "$name "; my $ind = get_ind($lev); if ($type) { if ($type eq 'HASH' ) { my $hcnt = scalar keys %$k; $msg .= "(HASH) hcnt=$hcnt "; for my $k1 (keys %$k) { $msg .= "\n"; $ind = get_ind($lev); while ($ind) { $msg .= ' '; $ind--; } $msg .= "key=$k1 "; #if (defined %{$k{$k1}} ) { # my $v = %{$k{$k1}}; if (defined $$k{$k1} ) { my $v = $$k{$k1}; my $t2 = ref($v); if ($t2) { $msg .= "\n"; $ind = get_ind($lev); while ($ind) { $msg .= ' '; $ind--; } $msg .= "{ ".show_type($v, "$k1 => ", 0, ($lev + 1)).' }'; } else { $msg .= "val=$v "; } } else { $msg .= 'v=undef '; } } } elsif ($type eq 'ARRAY') { my $cnt = scalar @$k; $msg .= "(ARRAY) acnt=$cnt "; foreach my $t (@$k) { my $t2 = ref($t); if ($t2) { $msg .= "\n"; $ind = get_ind($lev); while ($ind) { $msg .= ' '; $ind--; } $msg .= "{ ".show_type($t, 'sta => ', 0, ($lev + 1)).' }'; } else { $msg .= "$t "; } } } elsif ($type eq 'CODE') { $msg .= "is CODE ... "; } elsif ($type eq 'GLOB') { $msg .= "is GLOB ... "; } else { $msg .= "Type is $type ... "; $msg .= "[$k] not HASH, ARRAY, CODE. GLOB ... "; } } else { $msg .= "(SCALAR) no Type [$k] ..."; } prt( "$msg\n" ) if ($out); return $msg; } sub prt { print @_; print $OF @_; } #eof