use strict;
use Data::DumpXML qw(dump_xml);
use Data::DumpXML::Parser;
my $obj = bless { foo => 33, bar => "<>" }, "Obj";
my @tests = (
[1..10],
[\1],
[\\\\\\1],
[undef],
[bless[], "Foo"],
[$obj, $obj, \$obj, [$obj, $obj]],
[\$obj->{foo}, $obj, $obj],
[{"\0" => "\1"}],
[bless [], 'Class&<>"'], # funny class name
[join("", map chr, 0.255)],
["ære våre børn"],
#[bless["ære våre børn"], "fårepølse"], # high-bit class names are mangled
);
print "1.." . (@tests + 3) . "\n";
my $testno = 1;
for (@tests) {
my $xml1 = dump_xml(@$_);
#print $xml1;
my $restore = Data::DumpXML::Parser->new->parse($xml1);
my $xml2 = dump_xml(@$restore);
unless ($xml1 eq $xml2) {
print $xml1;
print $xml2;
print "not ";
}
print "ok " . $testno++ . "\n";
}
#print $xml;
print "Testing Blesser...\n";
my $xml = dump_xml($obj);
my $thistest = $testno++;
my $p = Data::DumpXML::Parser->new(Blesser => sub {
my($o, $c) = @_;
print "not " unless ref($o) eq "HASH"
and $o->{foo} == 33
and $c eq "Obj";
print "ok $thistest\n";
bless $o, $c . "::Bar";
});
my $res = $p->parse($xml);
print "not " unless ref($res->[0]) eq "Obj::Bar";
print "ok " . $testno++ . "\n";
# Test with namespace prefixes
$xml = do { local $Data::DumpXML::NS_PREFIX="dump"; dump_xml($obj) };
#print $xml;
$p = Data::DumpXML::Parser->new();
$res = $p->parse($xml);
print "not " unless ref($res->[0]) eq "Obj" && $res->[0]{foo} eq 33;
print "ok " . $testno++ . "\n";