#!/perl -w
# NAME: xmlwin32.pl
# AIM: Parse an XML document using Win32::OLE ...
# references : http://msdn2.microsoft.com/en-us/library/ms753759.aspx
# http://www.perl.com/pub/a/2001/04/17/msxml.html
# 02/06/2007 - geoff mclane - geoffair.com/mperl/index.htm
use strict;
use warnings;
use Win32::OLE qw(in with);
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $outfile = 'temp.'.$0.'.txt';
if ($0 =~ /\w{1}:\\.*/) {
	my @tmpsp = split(/\\/,$0);
	$outfile = 'temp.'.($tmpsp[-1]).'.txt';
}
open_log($outfile);
prt( "$0 ... Hello, World ...\n" );

my $do_vcproj = 1;	# load and show a VCPROJ file 
my $show_value = 0;
my $in_proj = 'c:\FG\18\flightgear\projects\VC8\flightgear.vcproj';
my $xml_file  = 'tempbooks.xml';
#my $node_name = 'book';
my $node_name = 'author';
# create XML document
my $raw = <<EOF;
<?xml version="1.0"?>
<catalog>
   <book id="bk101">
      <author>Gambardella, Matthew</author>
      <title>XML Developer's Guide</title>
      <genre>Computer</genre>
      <price>44.95</price>
      <publish_date>2000-10-01</publish_date>
      <description>An in-depth look at creating applications 
      with XML.</description>
   </book>
   <book id="bk102">
      <author>Ralls, Kim</author>
      <title>Midnight Rain</title>
      <genre>Fantasy</genre>
      <price>5.95</price>
      <publish_date>2000-12-16</publish_date>
      <description>A former architect battles corporate zombies, 
      an evil sorceress, and her own childhood to become queen 
      of the world.</description>
   </book>
   <book id="bk103">
      <author>Corets, Eva</author>
      <title>Maeve Ascendant</title>
      <genre>Fantasy</genre>
      <price>5.95</price>
      <publish_date>2000-11-17</publish_date>
      <description>After the collapse of a nanotechnology 
      society in England, the young survivors lay the 
      foundation for a new society.</description>
   </book>
   <book id="bk104">
      <author>Corets, Eva</author>
      <title>Oberon's Legacy</title>
      <genre>Fantasy</genre>
      <price>5.95</price>
      <publish_date>2001-03-10</publish_date>
      <description>In post-apocalypse England, the mysterious 
      agent known only as Oberon helps to create a new life 
      for the inhabitants of London. Sequel to Maeve 
      Ascendant.</description>
   </book>
   <book id="bk105">
      <author>Corets, Eva</author>
      <title>The Sundered Grail</title>
      <genre>Fantasy</genre>
      <price>5.95</price>
      <publish_date>2001-09-10</publish_date>
      <description>The two daughters of Maeve, half-sisters, 
      battle one another for control of England. Sequel to 
      Oberon's Legacy.</description>
   </book>
   <book id="bk106">
      <author>Randall, Cynthia</author>
      <title>Lover Birds</title>
      <genre>Romance</genre>
      <price>4.95</price>
      <publish_date>2000-09-02</publish_date>
      <description>When Carla meets Paul at an ornithology 
      conference, tempers fly as feathers get ruffled.</description>
   </book>
   <book id="bk107">
      <author>Thurman, Paula</author>
      <title>Splish Splash</title>
      <genre>Romance</genre>
      <price>4.95</price>
      <publish_date>2000-11-02</publish_date>
      <description>A deep sea diver finds true love twenty 
      thousand leagues beneath the sea.</description>
   </book>
   <book id="bk108">
      <author>Knorr, Stefan</author>
      <title>Creepy Crawlies</title>
      <genre>Horror</genre>
      <price>4.95</price>
      <publish_date>2000-12-06</publish_date>
      <description>An anthology of horror stories about roaches,
      centipedes, scorpions  and other insects.</description>
   </book>
   <book id="bk109">
      <author>Kress, Peter</author>
      <title>Paradox Lost</title>
      <genre>Science Fiction</genre>
      <price>6.95</price>
      <publish_date>2000-11-02</publish_date>
      <description>After an inadvertant trip through a Heisenberg
      Uncertainty Device, James Salway discovers the problems 
      of being quantum.</description>
   </book>
   <book id="bk110">
      <author>O'Brien, Tim</author>
      <title>Microsoft .NET: The Programming Bible</title>
      <genre>Computer</genre>
      <price>36.95</price>
      <publish_date>2000-12-09</publish_date>
      <description>Microsoft's .NET initiative is explored in 
      detail in this deep programmer's reference.</description>
   </book>
   <book id="bk111">
      <author>O'Brien, Tim</author>
      <title>MSXML3: A Comprehensive Guide</title>
      <genre>Computer</genre>
      <price>36.95</price>
      <publish_date>2000-12-01</publish_date>
      <description>The Microsoft MSXML3 parser is covered in 
      detail, with attention to XML DOM interfaces, XSLT processing, 
      SAX and more.</description>
   </book>
   <book id="bk112">
      <author>Galos, Mike</author>
      <title>Visual Studio 7: A Comprehensive Guide</title>
      <genre>Computer</genre>
      <price>49.95</price>
      <publish_date>2001-04-16</publish_date>
      <description>Microsoft Visual Studio 7 is explored in depth,
      looking at how Visual Basic, Visual C++, C#, and ASP+ are 
      integrated into a comprehensive development 
      environment.</description>
   </book>
</catalog>
EOF

if ($do_vcproj) {
	$xml_file = $in_proj;
} else {
	prt( "Creating XML file $xml_file, from above \$raw data ...\n" );
	write2file( $raw, $xml_file );
}
prt( "Creating Win32::OLE MSXML2.DOMDocument.3.0 objects ...\n" );
my $dom = Win32::OLE->new('MSXML2.DOMDocument.3.0') or mydie( "new() failed" );
prt( "Loading $xml_file into DOM object ...\n" );
$dom->{async} = "False";
$dom->{validateOnParse} = "False";
$dom->Load($xml_file) or mydie( "Parse failed" );

# from : http://msdn2.microsoft.com/en-us/library/ms753759.aspx
# http://www.perl.com/pub/a/2001/04/17/msxml.html
my $ind1 = "   ";
my $ind2 = "        ";
prt( "Reconstruct the XML data from the loaded DOM ...\n" );
# my $dt = $dom->{doctype}; # hmmm, did not work
my $root = $dom->DocumentElement();
my $books = $root->childNodes();
my $rnam = $root->{nodeName};
prt( "<?xml version=\"1.0\"?>\n" );
prt( "<$rnam>\n" );
if ($do_vcproj) {
	foreach my $book (in $books) { # make sure you include the 'in'
		my $typ = show_type( $book, "node", 1 );
		#prt( "$book\n" );
		last;
	}
} else {
	# do the books
	foreach my $book (in $books) { # make sure you include the 'in'
		my $nam1 = $book->{nodeName};
		my $txt1 = $book->Attributes->getNamedItem("id")->{Text};
		prt( "$ind1<$nam1 id=\"$txt1\">\n" );
		my $children = $book->childNodes();
		foreach my $child (in $children) {
			my $nam2 = $child->{nodeName};
			my $txt2 = $child->{nodeTypedValue};
			prt( "$ind2<$nam2>$txt2</$nam2>\n" );
		}
		prt( "$ind1</$nam1>\n" );
	}
}
prt( "</$rnam>\n" );

# this does NOT seem to work!!!
my $node_list = $dom->selectNodes($node_name);
foreach my $node (in $node_list) {
	my @txt = $node->{Text}; 
	prt( "@txt\n" );
}

prt( "List of $node_name ...\n" );
my @authors = get_node_text( $node_name, $books );
prt( join( "\n", @authors ) );
prt( "\nList of ".scalar @authors." $node_name ...\n" );

close_log($outfile,1);
exit(0);

sub get_node_text {
	my ( $name, $bks ) = @_;
	my @auths = ();
	foreach my $bk (in $bks) {
		my $cn = $bk->childNodes();
		foreach my $c (in $cn) {
			my $nm = $c->{nodeName};
			if ($nm eq $name) {
				my $tx = $c->{nodeTypedValue};
				push(@auths, $tx);
			}
		}
	}
	return @auths;
}

sub show_type {
	my ($k, $name, $out) = @_;
	my $type = ref($k);
	my $msg = "$name ";
	if ($type) {
		if (($type eq 'HASH' )||($k =~ /=HASH/)) {
			my $hcnt = scalar keys %$k;
			$msg .= "(HASH) hcnt=$hcnt ";
			my $knum = 0;
			for my $k1 (keys %$k) {
				$knum++;
				$msg .= "[$knum: $k1] ";
				#if (defined %{$k{$k1}} ) {
				#	my $v = %{$k{$k1}};
				if ($show_value) {
					###if (defined $$k{$k1} ) {
					if (defined ${%$k}{$k1} ) {
						my $v = $$k{$k1};
						my $t2 = ref($v);
						if ($t2) {
							$msg .= "\n{".show_type($v, "$k1 => ", 0).'}';
						} else {
							$msg .= "val=$v ";
						}
					} else {
						$msg .= 'v=undef ';
					}
				}
			}
		} elsif (($type eq 'ARRAY')||($k =~ /=ARRAY/)) {
			my $cnt = scalar @$k;
			$msg .= "(ARRAY) acnt=$cnt ";
			foreach my $t (@$k) {
				my $t2 = ref($t);
				if ($t2) {
					$msg .= "\n{".show_type($t, 'sta => ', 0).'}';
				} 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;
}

# eof - xmlwin32.pl
