← Back to branch summary

~ubuntu-branches/ubuntu/trusty/horae/trusty

« back to all changes in this revision

Viewing changes to 0CPAN/XML-Simple-2.14/t/6_ObjIntf.t

  • Committer: Bazaar Package Importer
  • Author(s): Carlo Segre
  • Date: 2008-02-23 23:13:02 UTC
  • mfrom: (2.1.2 hardy)
  • Revision ID: james.westby@ubuntu.com-20080223231302-mnyyxs3icvrus4ke
Tags: 066-3
Apply patch to athena_parts/misc.pl for compatibility with 
perl-tk 804.28.

Show diffs side-by-side

added added

removed removed

Lines of Context:
0CPAN/XML-Simple-2.14/t/6_ObjIntf.t
1
 
# $Id: 6_ObjIntf.t,v 1.8 2004/02/29 09:49:18 grantm Exp $
2
 
# vim: syntax=perl
3
 
 
4
 
use strict;
5
 
 
6
 
$^W = 1;
7
 
 
8
 
use Test::More tests => 37;
9
 
 
10
 
##############################################################################
11
 
# Derived version of XML::Simple that returns everything in upper case
12
 
##############################################################################
13
 
 
14
 
package XML::Simple::UC;
15
 
 
16
 
use vars qw(@ISA);
17
 
@ISA = qw(XML::Simple);
18
 
 
19
 
sub build_tree {
20
 
  my $self = shift;
21
 
 
22
 
  my $tree = $self->SUPER::build_tree(@_);
23
 
 
24
 
  ($tree) = uctree($tree);
25
 
 
26
 
  return($tree);
27
 
}
28
 
 
29
 
sub uctree {
30
 
  foreach my $i (0..$#_) {
31
 
    my $x = $_[$i];
32
 
    if(ref($x) eq 'ARRAY') {
33
 
      $_[$i] = [ uctree(@$x) ];
34
 
    }
35
 
    elsif(ref($x) eq 'HASH') {
36
 
      $_[$i] = { uctree(%$x) };
37
 
    }
38
 
    else {
39
 
      $_[$i] = uc($x);
40
 
    }
41
 
  }
42
 
  return(@_);
43
 
}
44
 
 
45
 
 
46
 
##############################################################################
47
 
# Derived version of XML::Simple that uses CDATA sections for escaping
48
 
##############################################################################
49
 
 
50
 
package XML::Simple::CDE;
51
 
 
52
 
use vars qw(@ISA);
53
 
@ISA = qw(XML::Simple);
54
 
 
55
 
sub escape_value {
56
 
  my $self = shift;
57
 
 
58
 
  my($data) = @_;
59
 
 
60
 
  if($data =~ /[&<>"]/) {
61
 
    $data = '<![CDATA[' . $data . ']]>';
62
 
  }
63
 
 
64
 
  return($data);
65
 
}
66
 
 
67
 
 
68
 
##############################################################################
69
 
# Start of the test script itself
70
 
##############################################################################
71
 
 
72
 
package main;
73
 
 
74
 
use XML::Simple;
75
 
 
76
 
# Check error handling in constructor
77
 
 
78
 
$@='';
79
 
$_ = eval { XML::Simple->new('searchpath') };
80
 
is($_, undef, 'invalid number of options are trapped');
81
 
like($@, qr/Default options must be name=>value pairs \(odd number supplied\)/,
82
 
'with correct error message');
83
 
 
84
 
 
85
 
my $xml = q(<cddatabase>
86
 
  <disc id="9362-45055-2" cddbid="960b750c">
87
 
    <artist>R.E.M.</artist>
88
 
    <album>Automatic For The People</album>
89
 
    <track number="1">Drive</track>
90
 
    <track number="2">Try Not To Breathe</track>
91
 
    <track number="3">The Sidewinder Sleeps Tonite</track>
92
 
    <track number="4">Everybody Hurts</track>
93
 
    <track number="5">New Orleans Instrumental No. 1</track>
94
 
    <track number="6">Sweetness Follows</track>
95
 
    <track number="7">Monty Got A Raw Deal</track>
96
 
    <track number="8">Ignoreland</track>
97
 
    <track number="9">Star Me Kitten</track>
98
 
    <track number="10">Man On The Moon</track>
99
 
    <track number="11">Nightswimming</track>
100
 
    <track number="12">Find The River</track>
101
 
  </disc>
102
 
</cddatabase>
103
 
);
104
 
 
105
 
my %opts1 = (
106
 
  keyattr => { disc => 'cddbid', track => 'number' },
107
 
  keeproot => 1, 
108
 
  contentkey => 'title',
109
 
  forcearray => [ qw(disc album) ] 
110
 
);
111
 
 
112
 
my %opts2 = (
113
 
  keyattr => { }
114
 
);
115
 
 
116
 
my %opts3 = (
117
 
  keyattr => { disc => 'cddbid', track => 'number' },
118
 
  keeproot => 1, 
119
 
  contentkey => '-title',
120
 
  forcearray => [ qw(disc album) ] 
121
 
);
122
 
 
123
 
my $xs1 = new XML::Simple( %opts1 );
124
 
my $xs2 = new XML::Simple( %opts2 );
125
 
my $xs3 = new XML::Simple( %opts3 );
126
 
isa_ok($xs1, 'XML::Simple', 'object one');
127
 
isa_ok($xs2, 'XML::Simple', 'object two');
128
 
isa_ok($xs3, 'XML::Simple', 'object three');
129
 
is_deeply(\%opts1, {
130
 
  keyattr => { disc => 'cddbid', track => 'number' },
131
 
  keeproot => 1, 
132
 
  contentkey => 'title',
133
 
  forcearray => [ qw(disc album) ] 
134
 
}, 'options hash was not corrupted');
135
 
 
136
 
my $exp1 = {
137
 
  'cddatabase' => {
138
 
    'disc' => {
139
 
      '960b750c' => {
140
 
        'id' => '9362-45055-2',
141
 
        'album' => [ 'Automatic For The People' ],
142
 
        'artist' => 'R.E.M.',
143
 
        'track' => {
144
 
          1  => { 'title' => 'Drive' },
145
 
          2  => { 'title' => 'Try Not To Breathe' },
146
 
          3  => { 'title' => 'The Sidewinder Sleeps Tonite' },
147
 
          4  => { 'title' => 'Everybody Hurts' },
148
 
          5  => { 'title' => 'New Orleans Instrumental No. 1' },
149
 
          6  => { 'title' => 'Sweetness Follows' },
150
 
          7  => { 'title' => 'Monty Got A Raw Deal' },
151
 
          8  => { 'title' => 'Ignoreland' },
152
 
          9  => { 'title' => 'Star Me Kitten' },
153
 
          10 => { 'title' => 'Man On The Moon' },
154
 
          11 => { 'title' => 'Nightswimming' },
155
 
          12 => { 'title' => 'Find The River' }
156
 
        }
157
 
      }
158
 
    }
159
 
  }
160
 
};
161
 
 
162
 
my $ref1 = $xs1->XMLin($xml);
163
 
is_deeply($ref1, $exp1, 'parsed expected data via object 1');
164
 
 
165
 
 
166
 
# Try using the other object
167
 
 
168
 
my $exp2 = {
169
 
  'disc' => {
170
 
    'album' => 'Automatic For The People',
171
 
    'artist' => 'R.E.M.',
172
 
    'cddbid' => '960b750c',
173
 
    'id' => '9362-45055-2',
174
 
    'track' => [
175
 
      { 'number' => 1,  'content' => 'Drive' },
176
 
      { 'number' => 2,  'content' => 'Try Not To Breathe' },
177
 
      { 'number' => 3,  'content' => 'The Sidewinder Sleeps Tonite' },
178
 
      { 'number' => 4,  'content' => 'Everybody Hurts' },
179
 
      { 'number' => 5,  'content' => 'New Orleans Instrumental No. 1' },
180
 
      { 'number' => 6,  'content' => 'Sweetness Follows' },
181
 
      { 'number' => 7,  'content' => 'Monty Got A Raw Deal' },
182
 
      { 'number' => 8,  'content' => 'Ignoreland' },
183
 
      { 'number' => 9,  'content' => 'Star Me Kitten' },
184
 
      { 'number' => 10, 'content' => 'Man On The Moon' },
185
 
      { 'number' => 11, 'content' => 'Nightswimming' },
186
 
      { 'number' => 12, 'content' => 'Find The River' }
187
 
    ]
188
 
  }
189
 
};
190
 
 
191
 
my $ref2 = $xs2->XMLin($xml);
192
 
is_deeply($ref2, $exp2, 'parsed expected data via object 2');
193
 
 
194
 
 
195
 
# Try using the third object
196
 
 
197
 
my $exp3 = {
198
 
  'cddatabase' => {
199
 
    'disc' => {
200
 
      '960b750c' => {
201
 
        'id' => '9362-45055-2',
202
 
        'album' => [ 'Automatic For The People' ],
203
 
        'artist' => 'R.E.M.',
204
 
        'track' => {
205
 
          1  => 'Drive',
206
 
          2  => 'Try Not To Breathe',
207
 
          3  => 'The Sidewinder Sleeps Tonite',
208
 
          4  => 'Everybody Hurts',
209
 
          5  => 'New Orleans Instrumental No. 1',
210
 
          6  => 'Sweetness Follows',
211
 
          7  => 'Monty Got A Raw Deal',
212
 
          8  => 'Ignoreland',
213
 
          9  => 'Star Me Kitten',
214
 
          10 => 'Man On The Moon',
215
 
          11 => 'Nightswimming',
216
 
          12 => 'Find The River'
217
 
        }
218
 
      }
219
 
    }
220
 
  }
221
 
};
222
 
 
223
 
my $ref3 = $xs3->XMLin($xml);
224
 
is_deeply($ref3, $exp3, 'parsed expected data via object 3');
225
 
 
226
 
 
227
 
# Confirm default options in object merge correctly with options as args
228
 
 
229
 
$ref1 = $xs1->XMLin($xml, keyattr => [], forcearray => 0);
230
 
 
231
 
is_deeply($ref1, {              # Parsed to what we expected
232
 
  'cddatabase' => {
233
 
    'disc' => {
234
 
      'album' => 'Automatic For The People',
235
 
      'id' => '9362-45055-2',
236
 
      'artist' => 'R.E.M.',
237
 
      'cddbid' => '960b750c',
238
 
      'track' => [
239
 
        { 'number' => 1,  'title' => 'Drive' },
240
 
        { 'number' => 2,  'title' => 'Try Not To Breathe' },
241
 
        { 'number' => 3,  'title' => 'The Sidewinder Sleeps Tonite' },
242
 
        { 'number' => 4,  'title' => 'Everybody Hurts' },
243
 
        { 'number' => 5,  'title' => 'New Orleans Instrumental No. 1' },
244
 
        { 'number' => 6,  'title' => 'Sweetness Follows' },
245
 
        { 'number' => 7,  'title' => 'Monty Got A Raw Deal' },
246
 
        { 'number' => 8,  'title' => 'Ignoreland' },
247
 
        { 'number' => 9,  'title' => 'Star Me Kitten' },
248
 
        { 'number' => 10, 'title' => 'Man On The Moon' },
249
 
        { 'number' => 11, 'title' => 'Nightswimming' },
250
 
        { 'number' => 12, 'title' => 'Find The River' }
251
 
      ]
252
 
    }
253
 
  }
254
 
}, 'successfully merged options');
255
 
 
256
 
 
257
 
# Confirm that default options in object still work as expected
258
 
 
259
 
$ref1 = $xs1->XMLin($xml);
260
 
is_deeply($ref1, $exp1, 'defaults were not affected by merge');
261
 
 
262
 
 
263
 
# Confirm they work for output too
264
 
 
265
 
$_ = $xs1->XMLout($ref1);
266
 
 
267
 
ok(s{<track number="1">Drive</track>}                         {<NEST/>}, 't1');
268
 
ok(s{<track number="2">Try Not To Breathe</track>}            {<NEST/>}, 't2');
269
 
ok(s{<track number="3">The Sidewinder Sleeps Tonite</track>}  {<NEST/>}, 't3');
270
 
ok(s{<track number="4">Everybody Hurts</track>}               {<NEST/>}, 't4');
271
 
ok(s{<track number="5">New Orleans Instrumental No. 1</track>}{<NEST/>}, 't5');
272
 
ok(s{<track number="6">Sweetness Follows</track>}             {<NEST/>}, 't6');
273
 
ok(s{<track number="7">Monty Got A Raw Deal</track>}          {<NEST/>}, 't7');
274
 
ok(s{<track number="8">Ignoreland</track>}                    {<NEST/>}, 't8');
275
 
ok(s{<track number="9">Star Me Kitten</track>}                {<NEST/>}, 't9');
276
 
ok(s{<track number="10">Man On The Moon</track>}              {<NEST/>}, 't10');
277
 
ok(s{<track number="11">Nightswimming</track>}                {<NEST/>}, 't11');
278
 
ok(s{<track number="12">Find The River</track>}               {<NEST/>}, 't12');
279
 
ok(s{<album>Automatic For The People</album>}                 {<NEST/>}, 'ttl');
280
 
ok(s{cddbid="960b750c"}{ATTR}, 'cddbid');
281
 
ok(s{id="9362-45055-2"}{ATTR}, 'id');
282
 
ok(s{artist="R.E.M."}  {ATTR}, 'artist');
283
 
ok(s{<disc(\s+ATTR){3}\s*>(\s*<NEST/>){13}\s*</disc>}{<DISC/>}s, 'disc');
284
 
ok(m{^\s*<(cddatabase)>\s*<DISC/>\s*</\1>\s*$}, 'database');
285
 
 
286
 
 
287
 
# Confirm error when mandatory parameter missing
288
 
 
289
 
$_ = eval {
290
 
  $xs1->XMLout();
291
 
};
292
 
ok(!defined($_), 'XMLout() method call with no args proves fatal');
293
 
like($@, qr/XMLout\(\) requires at least one argument/, 
294
 
'with correct error message');
295
 
 
296
 
 
297
 
# Check that overriding build_tree() method works
298
 
 
299
 
$xml = q(<opt>
300
 
  <server>
301
 
    <name>Apollo</name>
302
 
    <address>10 Downing Street</address>
303
 
  </server>
304
 
</opt>
305
 
);
306
 
 
307
 
my $xsp = new XML::Simple::UC();
308
 
$ref1 = $xsp->XMLin($xml);
309
 
is_deeply($ref1, {
310
 
  'SERVER' => {
311
 
    'NAME' => 'APOLLO',
312
 
    'ADDRESS' => '10 DOWNING STREET'
313
 
  }
314
 
}, 'inheritance works with build_tree() overridden');
315
 
 
316
 
 
317
 
# Check that overriding escape_value() method works
318
 
 
319
 
my $ref = {
320
 
  'server' => {
321
 
    'address' => '12->14 "Puf&Stuf" Drive'
322
 
  }
323
 
};
324
 
 
325
 
$xsp = new XML::Simple::CDE();
326
 
 
327
 
$_ = $xsp->XMLout($ref);
328
 
 
329
 
like($_, qr{<opt>\s*
330
 
 <server\s+address="<!\[CDATA\[12->14\s+"Puf&Stuf"\s+Drive\]\]>"\s*/>\s*
331
 
</opt>}xs, 'inheritance works with escape_value() overridden');
332
 
 
333
 
 
334
 
# Check variables defined in the constructor don't get trounced for
335
 
# subsequent parses
336
 
 
337
 
$xs1 = XML::Simple->new(
338
 
  contentkey => '-content', 
339
 
  varattr    => 'xsvar',
340
 
  variables  => { conf_dir => '/etc', log_dir => '/tmp' }
341
 
);
342
 
 
343
 
$xml = q(<opt>
344
 
  <dir xsvar="log_dir">/var/log</dir>
345
 
  <file name="config_file">${conf_dir}/appname.conf</file>
346
 
  <file name="log_file">${log_dir}/appname.log</file>
347
 
  <file name="debug_file">${log_dir}/appname.dbg</file>
348
 
</opt>);
349
 
 
350
 
my $opt = $xs1->XMLin($xml);
351
 
is_deeply($opt, {
352
 
  file => {
353
 
    config_file => '/etc/appname.conf',
354
 
    log_file    => '/var/log/appname.log',
355
 
    debug_file  => '/var/log/appname.dbg',
356
 
  },
357
 
  dir           => { xsvar => 'log_dir',  content => '/var/log' },
358
 
}, 'variables from XML merged with predefined variables');
359
 
 
360
 
$xml = q(<opt>
361
 
  <file name="config_file">${conf_dir}/appname.conf</file>
362
 
  <file name="log_file">${log_dir}/appname.log</file>
363
 
  <file name="debug_file">${log_dir}/appname.dbg</file>
364
 
</opt>);
365
 
 
366
 
$opt = $xs1->XMLin($xml);
367
 
is_deeply($opt, {
368
 
  file => {
369
 
    config_file => '/etc/appname.conf',
370
 
    log_file    => '/tmp/appname.log',
371
 
    debug_file  => '/tmp/appname.dbg',
372
 
  },
373
 
}, 'variables from XML merged with predefined variables');
374
 
 
375
 
# check that unknown options passed to the constructor are rejected
376
 
 
377
 
$@ = undef;
378
 
eval { $xs1 = XML::Simple->new(KeyAttr => {}, WibbleFlibble => 1) };
379
 
ok(defined($@), "unrecognised option caught by constructor");
380
 
like($@, qr/^Unrecognised option: WibbleFlibble at/,
381
 
  "correct message in exception");
382
 
 
383
 
exit(0);