Generated: Tue Feb 2 17:55:01 2010 from xmlwrapper.pl 2009/10/16 9 KB.
#!/perl -w # NAME: xmlwrapper.pl # AIM: Test the XML::Parser::Wrapper interface ... # 2009/10/16 - Installed via PPM, XML-Parser-Wrapper, in DELL02... # and test on a VCPROJ file # 07/28/2008 - geoff mclane - http://geoffair.net/mperl/ use strict; use warnings; use XML::Parser::Wrapper; 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 ... exploring XML::Parser::Wrapper\n" ); prt( "from: http://search.cpan.org/~dowens/XML-Parser-Wrapper-0.08/lib/XML/Parser/Wrapper.pm\n" ); my $load_from_file = 1; # try to LOAD the following file my $in_xml_file = 'C:\Projects\hb\lame\vc_solution\vc9_libmp3lame.vcproj'; my $loaded_vcproj = 0; # without line endings ... ##my $xml = qq{<foo><head id="a">Hello World!</head><head2><test_tag id="b"/></head2></foo>}; # with line endings my $xml = <<EOF; <foo> <head id="a">Hello World!</head> <head2> <test_tag id="b"/> </head2> </foo> EOF sub load_in_file($) { my ($inf) = @_; if (open INF, "<$inf") { my @lines = <INF>; close INF; $xml = join("\n",@lines); $xml .= "\n"; prt( "Set XML text from [$inf]...\n" ); $loaded_vcproj = 1; } else { prt("ERROR: Can NOT open [$inf]\n"); } } sub enumerate_elements($) { my ($root) = @_; my $xcnt = 0; my ($tag, $element, $type); my $root_tag_name = $root->name; my $roots_children = $root->elements; prt( "root tag name = $root_tag_name ...\n" ); foreach $element (@$roots_children) { $xcnt++; if ($element->is_text()) { $tag = trim_all($element->text()); $type = 'TEXT'; } else { $tag = $element->name(); $type = 'element name'; } if (length($tag)) { prt( "$xcnt: $type = $tag\n" ); } else { prt( "$xcnt: $type = <all spacey>\n" ); } if ($element->name eq 'head') { my $id = $element->attr('id'); my $hello_world_text = $element->text; # eq "Hello World!" prt( " head element has id attr = [$id], and text = [".trim_all($hello_world_text)."] ...\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 get_type_name($) { my ($itm) = @_; my $t = ref($itm); my $nm = $t; $nm = 'scalar' if (is_scalar_type($t)); return $nm; } # first_element_if($element_name) # Like first_element(), except if there is no corresponding child, # return an object that will work instead of undef. This allows for reliable chaining, e.g. # my $class = $root->kid_if('field')->kid_if('field')->kid_if('element') # ->kid_if('field')->attribute('class'); # Aliases: getFirstElementIf(), kidIf(), first_kid_if() sub enumerate_vcproj($$) { my ($root,$fil) = @_; my $root_children = $root->elements; my $ecnt = scalar @{$root_children}; my ($tag,$element); my ($item,$type,$cnt2,$tag2,$elem2,$msg); my ($cnt3, $cntl, $tn); my ($itm2,$tn2,$itmc); my ($txt1); my $shw_arr = 0; prt( "\nEnumeration of VCPROJ XML file [$fil]...\n" ); $cnt3 = 0; foreach $element (@{$root_children}) { $tag = $element->name; if (defined $tag && length($tag)) { $cnt3++; } } prt( "The root_children array has $ecnt elements, but only $cnt3 have length...\n" ); $ecnt = 0; foreach $element (@{$root_children}) { $tag = $element->name; if (defined $tag && length($tag)) { $ecnt++; #$type = get_type_name($element); #$item = $element->{$tag}; $item = $root->kid($tag); $cnt2 = scalar @{$item}; $type = get_type_name($item); $msg = ''; $cntl = 0; foreach $elem2 (@{$item}) { if (defined $elem2 && length($elem2)) { $cntl++; } } foreach $elem2 (@{$item}) { if (defined $elem2 && length($elem2)) { $tn = get_type_name($elem2); if ($shw_arr && ($tn eq 'ARRAY')) { $cnt3 = scalar @{$elem2}; $msg .= ' ' if (length($msg)); $msg .= "[ARRAY($cnt3)]"; if ($cnt3) { $itmc = 0; foreach $itm2 (@{$elem2}) { $tn2 = get_type_name($itm2); $itmc++; if ($tn2 eq 'scalar') { $tn2 = trim_all($itm2); $msg .= "\n $itmc:[$tn2]" if (length($tn2)); } else { $msg .= "\n $itmc:type [$tn2]"; } } } } elsif ($tn eq 'scalar') { if ($elem2 ne $tag) { $msg .= ' ' if (length($msg)); $msg .= "[$elem2]"; } } else { $msg .= ' ' if (length($msg)); $msg .= "[$tn]"; } } } prt( " $ecnt: $tag $cntl($cnt2) $msg\n" ); # $type\n" ); } } $tag = 'Files'; $tag2 = 'Filter'; $elem2 = $root->kid_if($tag)->kid_if($tag2); prt( "root->kid_if($tag)->kid_if($tag2) = $elem2\n" ); foreach $element (@{$elem2}) { #$tag = $element->name; $tn2 = get_type_name($element); if ($tn2 eq 'scalar') { prt( "$element\n"); } else { if ($tn2 eq 'ARRAY') { $cnt2 = scalar @{$element}; prt(" $tn2($cnt2)\n"); #$txt1 = Dumper($element); #prt($txt1); # foreach $itm2 (@{$element}) { # $tn2 = get_type_name($itm2); # if ($tn2 eq 'scalar') { # prt(" $itm2\n"); # } else { # prt(" $tn2\n"); # } # } } else { prt( "$tn2\n"); } } } } sub xml_add_lines($) { my ($txt) = shift; my $ntxt = ''; my ($ch, $i, $len, $pch, $i2, $nch); $len = length($txt); $pch = ''; for ($i = 0; $i < $len; $i++) { $i2 = $i + 1; $ch = substr($txt,$i,1); $nch = (($i2 < $len) ? substr($txt,$i2,1) : ''); if (($ch eq '<')&&($pch ne "\n")&&($nch ne '/')) { $ntxt .= "\n"; } elsif (($ch eq '>')&&($nch eq '<')) { $ntxt .= $ch; $ch = "\n"; } $pch = $ch if (($ch ne ' ')&&($ch ne "\t")); $ntxt .= $ch; } $ntxt .= "\n" if ($ch ne "\n"); return $ntxt; } sub modify_xml($) { my ($root) = @_; my $xcnt = 0; my ($tag, $element, $type); ##my $head_element = $root->element('head2'); my $head_elements = $root->elements('head2'); ##my $test = $root->element('head2')->element('test_tag'); my $new_element = $root->add_child('test4', { attr1 => 'val1' }); my $kid = $root->update_kid('root_child', { attr2 => 'stuff2' }, 'blah'); $kid->update_node({ new_attr => 'new_stuff' }); $new_element->add_child('child_of_test4', { myattr => 'stuff' }, 'bleh'); my $new_xml = $root->to_xml; write2file(xml_add_lines($new_xml), "tempnew.xml"); prt( "Modified XML written to tempnew.xml ...\n" ); $xcnt = 0; prt( "List of modified element names ...\n" ); my $roots_children = $root->elements; foreach $element (@$roots_children) { $xcnt++; $tag = $element->name(); if ((defined $tag)&&(length($tag))) { prt( "$xcnt: element name = ".$element->name."\n" ); } } } # ========================================= # MAIN load_in_file($in_xml_file) if ($load_from_file); my $xml_root = XML::Parser::Wrapper->new($xml); enumerate_elements($xml_root); if ($loaded_vcproj) { enumerate_vcproj($xml_root,$in_xml_file); } else { modify_xml($xml_root); } close_log($outfile,1); exit(0); ###################################### # eof - xmlwrapper.pl