1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133
|
use strict;
use Test::More;
use File::Spec;
plan tests => 12;
use_ok('XML::Simple');
SKIP: {
eval { require Tie::IxHash };
skip "Tie::IxHash not installed", 3 if $@;
eval <<'EOF';
package SimpleOrder;
use base qw(XML::Simple);
use Tie::IxHash;
sub new_hashref {
my $self = shift;
my %hash;
tie %hash, 'Tie::IxHash', @_;
return \%hash;
}
EOF
ok(!$@, 'no errors processing SimpleOrder');
my $xs = SimpleOrder->new;
my $xml = q{
<nums>
<num id="one">I</num>
<num id="two">II</num>
<num id="three">III</num>
<num id="four">IV</num>
<num id="five">V</num>
<num id="six">VI</num>
<num id="seven">VII</num>
</nums>
};
my $expected = {
'one' => { 'content' => 'I' },
'two' => { 'content' => 'II' },
'three' => { 'content' => 'III' },
'four' => { 'content' => 'IV' },
'five' => { 'content' => 'V' },
'six' => { 'content' => 'VI' },
'seven' => { 'content' => 'VII' },
};
my $data = $xs->xml_in($xml);
is_deeply($data->{num}, $expected, 'hash content looks good');
is_deeply(
[ keys %{$data->{num}} ],
[ qw(one two three four five six seven) ],
'order of the hash keys looks good too'
);
}
my $xs = XML::Simple->new(cache => 'storable');
my $sx = ElbarotsXS->new(cache => 'storable');
isa_ok($sx, 'XML::Simple', 'object of class ElbarotsXS');
my $src_file = File::Spec->catfile('t', 'test1.xml');
is(
$xs->storable_filename($src_file),
File::Spec->catfile('t', 'test1.stor'),
'default storable cache filename looks good'
);
my $cache_file = File::Spec->catfile('t', '1tset.stor'),;
is(
$sx->storable_filename($src_file),
$cache_file,
'overridden storable cache filename looks good'
);
SKIP: {
eval { require Storable };
skip "Storable not installed", 2 if $@;
unlink($cache_file),
ok(! -e $cache_file, 'overridden cache file does not exist before parse');
my $data = $sx->xml_in($src_file);
ok(-e $cache_file, 'overridden cache file does exist after parse');
unlink($cache_file),
}
my $data = eval {
$xs = XML::Simple->new(cache => 'floogle');
$xs->xml_in($src_file);
};
ok($@, 'bad cache scheme was rejected');
$data = eval {
$sx = ElbarotsXS->new(cache => 'floogle');
$sx->xml_in($src_file);
};
ok(! $@, 'custom cache scheme was not rejected');
is_deeply(
$data,
{ data => 'floogle' },
'custom cache reading method delivered the goods'
);
exit 0;
package ElbarotsXS;
use base 'XML::Simple';
sub storable_filename {
my($self, $path) = @_;
my($vol, $dir, $file) = File::Spec->splitpath( $path );
$file =~ s{\.xml$}{};
return File::Spec->catpath($vol, $dir, reverse($file) . '.stor');
}
sub cache_read_floogle {
return { data => 'floogle' };
}
|