From: Grant M. <gr...@us...> - 2002-02-05 22:12:10
|
Update of /cvsroot/perl-xml/xml-simple/t In directory usw-pr-cvs1:/tmp/cvs-serv2952/t Added Files: 7_SaxStuff.t Log Message: New test script for SAX handling, driving and 'filtering' --- NEW FILE: 7_SaxStuff.t --- # $Id: 7_SaxStuff.t,v 1.1 2002/02/05 22:12:05 grantm Exp $ use strict; use File::Spec; use IO::File; BEGIN { unshift @INC, File::Spec->catfile('t', 'lib'); eval { require XML::SAX; }; if($@) { print STDERR "no XML::SAX..."; print "1..0\n"; exit 0; } } use TagsToUpper; # Initialise filenames and check they're there my $SrcFile = File::Spec->catfile('t', 'desertnet.src'); my $XMLFile = File::Spec->catfile('t', 'desertnet.xml'); my $CacheFile = File::Spec->catfile('t', 'desertnet.stor'); unless(-e $SrcFile) { print STDERR "test data missing..."; print "1..0\n"; exit 0; } print "1..13\n"; my $t = 1; ############################################################################## # S U P P O R T R O U T I N E S ############################################################################## ############################################################################## # Print out 'n ok' or 'n not ok' as expected by test harness. # First arg is test number (n). If only one following arg, it is interpreted # as true/false value. If two args, equality = true. # sub ok { my($n, $x, $y) = @_; die "Sequence error got $n expected $t" if($n != $t); $x = 0 if(@_ > 2 and $x ne $y); print(($x ? '' : 'not '), 'ok ', $t++, "\n"); } ############################################################################## # Take two scalar values (may be references) and compare them (recursively # if necessary) returning 1 if same, 0 if different. # sub DataCompare { my($x, $y) = @_; my($i); if(!ref($x)) { return(1) if($x eq $y); print STDERR "$t:DataCompare: $x != $y\n"; return(0); } if(ref($x) eq 'ARRAY') { unless(ref($y) eq 'ARRAY') { print STDERR "$t:DataCompare: expected arrayref, got: $y\n"; return(0); } if(scalar(@$x) != scalar(@$y)) { print STDERR "$t:DataCompare: expected ", scalar(@$x), " element(s), got: ", scalar(@$y), "\n"; return(0); } for($i = 0; $i < scalar(@$x); $i++) { DataCompare($x->[$i], $y->[$i]) || return(0); } return(1); } if(ref($x) eq 'HASH') { unless(ref($y) eq 'HASH') { print STDERR "$t:DataCompare: expected hashref, got: $y\n"; return(0); } if(scalar(keys(%$x)) != scalar(keys(%$y))) { print STDERR "$t:DataCompare: expected ", scalar(keys(%$x)), " key(s) (", join(', ', keys(%$x)), "), got: ", scalar(keys(%$y)), " (", join(', ', keys(%$y)), ")\n"; return(0); } foreach $i (keys(%$x)) { unless(exists($y->{$i})) { print STDERR "$t:DataCompare: missing hash key - {$i}\n"; return(0); } DataCompare($x->{$i}, $y->{$i}) || return(0); } return(1); } print STDERR "Don't know how to compare: " . ref($x) . "\n"; return(0); } ############################################################################## # Copy a file # sub CopyFile { my($Src, $Dst) = @_; open(IN, $Src) || return(undef); local($/) = undef; my $Data = <IN>; close(IN); open(OUT, ">$Dst") || return(undef); print OUT $Data; close(OUT); return(1); } ############################################################################## # T E S T R O U T I N E S ############################################################################## use XML::Simple; # Initialise test data my $Expected = { 'server' => { 'sahara' => { 'osversion' => '2.6', 'osname' => 'solaris', 'address' => [ '10.0.0.101', '10.0.1.101' ] }, 'gobi' => { 'osversion' => '6.5', 'osname' => 'irix', 'address' => '10.0.0.102' }, 'kalahari' => { 'osversion' => '2.0.34', 'osname' => 'linux', 'address' => [ '10.0.0.103', '10.0.1.103' ] } } }; my $xml = ''; # Force default behaviour of using SAX parser if it is available (which it # is or we wouldn't be here). $XML::Simple::PREFERRED_PARSER = ''; ok(1, CopyFile($SrcFile, $XMLFile)); # Start with known source file unlink($CacheFile); # Ensure there are ... ok(2, ! -e $CacheFile); # ... no cache files lying around # Pass in a filename to check parse_uri() my $opt = XMLin($XMLFile); ok(3, DataCompare($opt, $Expected)); # Got what we expected # Pass in an IO::File object to test parse_file() my $fh = IO::File->new("<$XMLFile"); ok(4, ref($fh)); $opt = XMLin($fh); ok(5, DataCompare($opt, $Expected)); # Got what we expected $fh->close(); # Pass in a string to test parse_string() if(open(XMLFILE, "<$XMLFile")) { local($/) = undef; $xml = <XMLFILE>; close(XMLFILE); } $opt = XMLin($xml); ok(6, DataCompare($opt, $Expected)); # Got what we expected # Pass in '-' for STDIN open(OLDSTDIN, "<&STDIN"); close(STDIN); open(STDIN, "<$XMLFile"); $opt = XMLin('-'); ok(7, DataCompare($opt, $Expected)); # Got what we expected open(STDIN, "<&OLDSTDIN"); close(OLDSTDIN); # Try using XML:Simple object as a SAX handler my $simple = XML::Simple->new(); my $parser = XML::SAX::ParserFactory->parser(Handler => $simple); $opt = $parser->parse_uri($XMLFile); ok(8, DataCompare($opt, $Expected)); # Got what we expected # Try again but make sure options from the constructor are being used $simple = XML::Simple->new( keyattr => { server => 'osname' }, forcearray => ['address'], ); $parser = XML::SAX::ParserFactory->parser(Handler => $simple); $opt = $parser->parse_uri($XMLFile); my $Expected2 = { 'server' => { 'irix' => { 'address' => [ '10.0.0.102' ], 'osversion' => '6.5', 'name' => 'gobi' }, 'solaris' => { 'address' => [ '10.0.0.101', '10.0.1.101' ], 'osversion' => '2.6', 'name' => 'sahara' }, 'linux' => { 'address' => [ '10.0.0.103', '10.0.1.103' ], 'osversion' => '2.0.34', 'name' => 'kalahari' } } }; ok(9, DataCompare($opt, $Expected2)); # Got what we expected # Try using XML::Simple to drive a SAX pipeline my $Expected3 = { 'SERVER' => { 'sahara' => { 'OSVERSION' => '2.6', 'OSNAME' => 'solaris', 'ADDRESS' => [ '10.0.0.101', '10.0.1.101' ] }, 'gobi' => { 'OSVERSION' => '6.5', 'OSNAME' => 'irix', 'ADDRESS' => '10.0.0.102' }, 'kalahari' => { 'OSVERSION' => '2.0.34', 'OSNAME' => 'linux', 'ADDRESS' => [ '10.0.0.103', '10.0.1.103' ] } } }; my $simple2 = XML::Simple->new(keyattr => [qw(NAME)]); my $filter = TagsToUpper->new(Handler => $simple2); my $opt2 = XMLout($opt, keyattr => { server => 'osname' }, Handler => $filter, ); ok(10, DataCompare($opt2, $Expected3)); # Got what we expected # Confirm that 'handler' is a synonym for 'Handler' $simple2 = XML::Simple->new(keyattr => [qw(NAME)]); $filter = TagsToUpper->new(Handler => $simple2); $opt2 = XMLout($opt, keyattr => { server => 'osname' }, handler => $filter, ); ok(11, DataCompare($opt2, $Expected3)); # Got what we expected # Confirm that DataHandler routine gets called $xml = q(<opt><anon>one</anon><anon>two</anon><anon>three</anon></opt>); $simple = XML::Simple->new( DataHandler => sub { my $xs = shift; my $data = shift; return(join(',', @$data)); } ); $parser = XML::SAX::ParserFactory->parser(Handler => $simple); my $result = $parser->parse_string($xml); ok(12, $result, 'one,two,three'); # Confirm that 'datahandler' is a synonym for 'DataHandler' $simple = XML::Simple->new( datahandler => sub { my $xs = shift; my $data = shift; return(join(',', reverse(@$data))); } ); $parser = XML::SAX::ParserFactory->parser(Handler => $simple); $result = $parser->parse_string($xml); ok(13, $result, 'three,two,one'); # Clean up and go unlink($CacheFile); unlink($XMLFile); exit(0); |