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