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);