#!/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
