[perl-xml-cvs] CVS: xml-simple/t 1_XMLin.t,1.10,1.11 2_XMLout.t,1.5,1.6 3_Storable.t,1.5,1.6 6_ObjIntf.t,1.4,1.5 9_Strict.t,1.3,1.4

[Grant M. <gr...@us...>]

Update of /cvsroot/perl-xml/xml-simple/t
In directory sc8-pr-cvs1:/tmp/cvs-serv18853

Modified Files:
	1_XMLin.t 2_XMLout.t 3_Storable.t 6_ObjIntf.t 9_Strict.t 
Log Message:
- tests for new features in release 2.04

Index: 1_XMLin.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/1_XMLin.t,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- 1_XMLin.t	20 Jan 2003 07:48:59 -0000	1.10
+++ 1_XMLin.t	10 Apr 2003 10:20:06 -0000	1.11
@@ -15,14 +15,14 @@
   plan skip_all => 'Test data missing';
 }
 
-plan tests => 66;
+plan tests => 93;
 
 
 $@ = '';
 eval "use XML::Simple;";
 is($@, '', 'Module compiled OK');
-unless($XML::Simple::VERSION eq '2.03') {
-  diag("Warning: XML::Simple::VERSION = $XML::Simple::VERSION (expected 2.03)");
+unless($XML::Simple::VERSION eq '2.04') {
+  diag("Warning: XML::Simple::VERSION = $XML::Simple::VERSION (expected 2.04)");
 }
 
 
@@ -134,13 +134,14 @@
             {name => 'item2', attr1 => 'value3', attr2 => 'value4' }
 	  ]
 };
-$opt = XMLin($string, keyattr => [] );
+my @cont_key = (contentkey => '-content');
+$opt = XMLin($string, keyattr => [], @cont_key);
 is_deeply($opt, $target, 'not folded when keyattr turned off');
 
 
 # Same again with alternative key suppression
 
-$opt = XMLin($string, keyattr => {} );
+$opt = XMLin($string, keyattr => {}, @cont_key);
 is_deeply($opt, $target, 'still works when keyattr is empty hash');
 
 
@@ -151,7 +152,7 @@
     <item key="item1" attr1="value1" attr2="value2" />
     <item key="item2" attr1="value3" attr2="value4" />
   </opt>
-));
+), @cont_key);
 is_deeply($opt, {
   item => {
             item1 => { attr1 => 'value1', attr2 => 'value2' },
@@ -165,7 +166,7 @@
     <item id="item1" attr1="value1" attr2="value2" />
     <item id="item2" attr1="value3" attr2="value4" />
   </opt>
-));
+), @cont_key);
 is_deeply($opt, {
   item => {
             item1 => { attr1 => 'value1', attr2 => 'value2' },
@@ -189,28 +190,40 @@
 	  }
 };
 
-$opt = XMLin($xml, keyattr => [qw(xname)]);
+$opt = XMLin($xml, keyattr => [qw(xname)], @cont_key);
 is_deeply($opt, $target, "folded on non-default key 'xname'");
 
 
 # And with precise element/key specification
 
-$opt = XMLin($xml, keyattr => { 'item' => 'xname' });
+$opt = XMLin($xml, keyattr => { 'item' => 'xname' }, @cont_key);
 is_deeply($opt, $target, 'same again but keyattr set with hash');
 
 
 # Same again but with key field further down the list
 
-$opt = XMLin($xml, keyattr => [qw(wibble xname)]);
+$opt = XMLin($xml, keyattr => [qw(wibble xname)], @cont_key);
 is_deeply($opt, $target, 'keyattr as array with value in second position');
 
 
 # Same again but with key field supplied as scalar
 
-$opt = XMLin($xml, keyattr => qw(xname));
+$opt = XMLin($xml, keyattr => qw(xname), @cont_key);
 is_deeply($opt, $target, 'keyattr as scalar');
 
 
+# Same again but with mixed-case option name
+
+$opt = XMLin($xml, KeyAttr => qw(xname), @cont_key);
+is_deeply($opt, $target, 'KeyAttr as scalar');
+
+
+# Same again but with underscores in option name
+
+$opt = XMLin($xml, key_attr => qw(xname), @cont_key);
+is_deeply($opt, $target, 'key_attr as scalar');
+
+
 # Weird variation, not exactly what we wanted but it is what we expected 
 # given the current implementation and we don't want to break it accidently
 
@@ -229,7 +242,7 @@
   }
 };
 
-$opt = XMLin($xml);
+$opt = XMLin($xml, @cont_key);
 is_deeply($opt, $target, 'fold same array on two different keys');
 
 
@@ -241,7 +254,7 @@
     'three' => { 'value' => '3' },
   }
 };
-$opt = XMLin($xml, keyattr => { 'item' => 'id' });
+$opt = XMLin($xml, keyattr => { 'item' => 'id' }, @cont_key);
 is_deeply($opt, $target, 'same again but with priority switch');
 
 
@@ -281,7 +294,8 @@
   }
 };
 
-$opt = XMLin($xml, forcearray => 1, keyattr => { 'car' => 'license', 'option' => 'pn' });
+$opt = XMLin($xml, forcearray => 1,
+  keyattr => { 'car' => 'license', 'option' => 'pn' }, @cont_key);
 is_deeply($opt, $target, 'folded on multi-key keyattr hash');
 
 
@@ -313,7 +327,7 @@
     }
   }
 };
-$opt = XMLin($xml, forcearray => 1, keyattr => { 'car' => '+license', 'option' => '-pn' });
+$opt = XMLin($xml, forcearray => 1, keyattr => { 'car' => '+license', 'option' => '-pn' }, @cont_key);
 is_deeply($opt, $target, "same again but with '+' prefix to copy keys");
 
 
@@ -338,20 +352,22 @@
   ]
 };
 
-$opt = XMLin($xml);
+$opt = XMLin($xml, @cont_key);
 is_deeply($opt, $target, "did not fold on default key with non-scalar value");
 
-$opt = XMLin($xml, keyattr => { item => 'name' });
+$opt = XMLin($xml, keyattr => { item => 'name' }, @cont_key);
 is_deeply($opt, $target, "did not fold on specific key with non-scalar value");
 
 
 # Make sure that the root element name is preserved if we ask for it
 
 $target = XMLin("<opt>$xml</opt>", forcearray => 1,
-                keyattr => { 'car' => '+license', 'option' => '-pn' });
+                keyattr => { 'car' => '+license', 'option' => '-pn' },
+                @cont_key);
 
 $opt    = XMLin(      $xml,        forcearray => 1, keeproot => 1,
-                keyattr => { 'car' => '+license', 'option' => '-pn' });
+                keyattr => { 'car' => '+license', 'option' => '-pn' }, 
+                @cont_key);
 
 is_deeply($opt, $target, 'keeproot option works');
 
@@ -359,13 +375,13 @@
 # confirm that CDATA sections parse correctly
 
 $xml = q{<opt><cdata><![CDATA[<greeting>Hello, world!</greeting>]]></cdata></opt>};
-$opt = XMLin($xml);
+$opt = XMLin($xml, @cont_key);
 is_deeply($opt, {
   'cdata' => '<greeting>Hello, world!</greeting>'
 }, 'CDATA section parsed correctly');
 
 $xml = q{<opt><x><![CDATA[<y>one</y>]]><![CDATA[<y>two</y>]]></x></opt>};
-$opt = XMLin($xml);
+$opt = XMLin($xml, @cont_key);
 is_deeply($opt, {
   'x' => '<y>one</y><y>two</y>'
 }, 'CDATA section containing markup characters parsed correctly');
@@ -396,7 +412,7 @@
 $@ = '';
 $opt = eval {
   XMLin('test2.xml', searchpath => [
-    'dir1', 'dir2', File::Spec->catdir('t', 'subdir')
+    'dir1', 'dir2', File::Spec->catdir('t', 'subdir'), @cont_key
   ] );
 
 };
@@ -424,7 +440,7 @@
 $XMLFile = File::Spec->catfile('t', '1_XMLin.xml');  # t/1_XMLin.xml
 eval {
   $fh->open($XMLFile) || die "$!";
-  $opt = XMLin($fh);
+  $opt = XMLin($fh, @cont_key);
 };
 is($@, '', "XMLin didn't choke on an IO::File object");
 is($opt->{location}, 't/1_XMLin.xml', 'and it parsed the right file');
@@ -456,7 +472,7 @@
       <anon>2.0</anon><anon>2.1</anon><anon>2.2</anon>
     </row>
   </opt>
-));
+), @cont_key);
 is_deeply($opt, {
   row => [
 	   [ '0.0', '0.1', '0.2' ],
@@ -474,7 +490,7 @@
     <anon>two</anon>
     <anon>three</anon>
   </opt>
-});
+}, @cont_key);
 is_deeply($opt, [
   qw(one two three)
 ], 'top level anonymous array returned arrayref');
@@ -491,7 +507,7 @@
       </anon>
     </anon>
   </opt>
-));
+), @cont_key);
 is_deeply($opt, [
   1,
   [
@@ -558,11 +574,37 @@
 }, "even when we change it's name to 'text'");
 
 
+# Confirm that spurious 'content' keys are *not* eliminated after array folding
+
+$xml = q(<opt><x y="one">First</x><x y="two">Second</x></opt>);
+$opt = XMLin($xml, forcearray => [ 'x' ], keyattr => {x => 'y'});
+is_deeply($opt, { 
+  x => {
+    one => { content => 'First'  },
+    two => { content => 'Second' },
+  }
+}, "spurious content keys not eliminated after folding");
+
+
+# unless we ask nicely
+
+$xml = q(<opt><x y="one">First</x><x y="two">Second</x></opt>);
+$opt = XMLin(
+  $xml, forcearray => [ 'x' ], keyattr => {x => 'y'}, contentkey => '-content'
+);
+is_deeply($opt, { 
+  x => {
+    one => 'First',
+    two => 'Second',
+  }
+}, "spurious content keys not eliminated after folding");
+
+
 # Check that mixed content parses in the weird way we expect
 
 $xml = q(<p class="mixed">Text with a <b>bold</b> word</p>);
 
-is_deeply(XMLin($xml), {
+is_deeply(XMLin($xml, @cont_key), {
   'class'   => 'mixed',
   'content' => [ 'Text with a ', ' word' ],
   'b'       => 'bold'
@@ -584,7 +626,7 @@
 
 # Unless 'forcearray' option is specified
 
-$opt = XMLin($string, forcearray => 1);
+$opt = XMLin($string, forcearray => 1, @cont_key);
 is_deeply($opt, {
   name => [ 'value' ]
 }, 'except when forcearray is enabled');
@@ -596,7 +638,7 @@
   <inner name="one" value="1" />
 </opt>);
 
-$opt = XMLin($string, forcearray => 1);
+$opt = XMLin($string, forcearray => 1, @cont_key);
 is_deeply($opt, {
   'inner' => { 'one' => { 'value' => 1 } }
 }, 'array folding works with single nested hash');
@@ -604,7 +646,7 @@
 
 # But not without forcearray option specified
 
-$opt = XMLin($string, forcearray => 0);
+$opt = XMLin($string, forcearray => 0, @cont_key);
 is_deeply($opt, {
   'inner' => { 'name' => 'one', 'value' => 1 } 
 }, 'but not if forcearray is turned off');
@@ -621,7 +663,7 @@
 </opt>
 );
 
-$opt = XMLin($xml, forcearray => [ 'two' ]);
+$opt = XMLin($xml, forcearray => [ 'two' ], @cont_key);
 is_deeply($opt, {
   'zero' => '0',
   'one' => 'i',
@@ -637,7 +679,7 @@
 </opt>
 );
 
-$opt = XMLin($xml, noattr => 1);
+$opt = XMLin($xml, noattr => 1, @cont_key);
 is_deeply($opt, { nest => 'text' }, 'attributes successfully skipped');
 
 
@@ -651,7 +693,7 @@
 };
 
 
-$opt = XMLin($xml, noattr => 1);
+$opt = XMLin($xml, noattr => 1, @cont_key);
 is_deeply($opt, {
  'item' => {
     'a' => { 'value' => 'alpha' },
@@ -671,7 +713,7 @@
   </outer>
 </body>);
 
-$opt = XMLin($xml, noattr => 1);
+$opt = XMLin($xml, noattr => 1, @cont_key);
 is_deeply($opt, {
   'name' => 'bob',
   'outer' => {
@@ -683,13 +725,13 @@
 
 # Unless 'suppressempty' is enabled
 
-$opt = XMLin($xml, noattr => 1, suppressempty => 1);
+$opt = XMLin($xml, noattr => 1, suppressempty => 1, @cont_key);
 is_deeply($opt, { 'name' => 'bob', }, 'or are suppressed');
 
 
 # Check behaviour when 'suppressempty' is set to to undef;
 
-$opt = XMLin($xml, noattr => 1, suppressempty => undef);
+$opt = XMLin($xml, noattr => 1, suppressempty => undef, @cont_key);
 is_deeply($opt, {
   'name' => 'bob',
   'outer' => {
@@ -700,7 +742,7 @@
 
 # Check behaviour when 'suppressempty' is set to to empty string;
 
-$opt = XMLin($xml, noattr => 1, suppressempty => '');
+$opt = XMLin($xml, noattr => 1, suppressempty => '', @cont_key);
 is_deeply($opt, {
   'name' => 'bob',
   'outer' => {
@@ -718,10 +760,274 @@
   </outer>
 </body>);
 
-$opt = XMLin($xml, noattr => 1, suppressempty => 1);
+$opt = XMLin($xml, noattr => 1, suppressempty => 1, @cont_key);
 is($opt, undef, 'empty document parses to undef');
 
 
+# Confirm nothing magical happens with grouped elements
+
+$xml = q(<opt>
+  <prefix>before</prefix>
+  <dirs>
+    <dir>/usr/bin</dir>
+    <dir>/usr/local/bin</dir>
+  </dirs>
+  <suffix>after</suffix>
+</opt>);
+
+$opt = XMLin($xml);
+is_deeply($opt, {
+  prefix => 'before',
+  dirs   => {
+              dir => [ '/usr/bin', '/usr/local/bin' ]
+            },
+  suffix => 'after',
+}, 'grouped tags parse normally');
+
+
+# unless we specify how the grouping works
+
+$xml = q(<opt>
+  <prefix>before</prefix>
+  <dirs>
+    <dir>/usr/bin</dir>
+    <dir>/usr/local/bin</dir>
+  </dirs>
+  <suffix>after</suffix>
+</opt>);
+
+$opt = XMLin($xml, grouptags => {dirs => 'dir'} );
+is_deeply($opt, {
+  prefix => 'before',
+  dirs   => [ '/usr/bin', '/usr/local/bin' ],
+  suffix => 'after',
+}, 'disintermediation of grouped tags works');
+
+
+# try again with multiple groupings
+
+$xml = q(<opt>
+  <prefix>before</prefix>
+  <dirs>
+    <dir>/usr/bin</dir>
+    <dir>/usr/local/bin</dir>
+  </dirs>
+  <infix>between</infix>
+  <terms>
+    <term>vt100</term>
+    <term>xterm</term>
+  </terms>
+  <suffix>after</suffix>
+</opt>);
+
+$opt = XMLin($xml, grouptags => {dirs => 'dir', terms => 'term'} );
+is_deeply($opt, {
+  prefix => 'before',
+  dirs   => [ '/usr/bin', '/usr/local/bin' ],
+  infix  => 'between',
+  terms  => [ 'vt100', 'xterm' ],
+  suffix => 'after',
+}, 'disintermediation works with multiple groups');
+
+
+# confirm folding and ungrouping work together
+
+$xml = q(<opt>
+  <prefix>before</prefix>
+  <dirs>
+    <dir name="first">/usr/bin</dir>
+    <dir name="second">/usr/local/bin</dir>
+  </dirs>
+  <suffix>after</suffix>
+</opt>);
+
+$opt = XMLin($xml, keyattr => {dir => 'name'}, grouptags => {dirs => 'dir'} );
+is_deeply($opt, {
+  prefix => 'before',
+  dirs   => {
+              first  => { content => '/usr/bin' }, 
+              second => { content => '/usr/local/bin' }, 
+            },
+  suffix => 'after',
+}, 'folding and ungrouping work together');
+
+
+# confirm folding, ungrouping and content stripping work together
+
+$xml = q(<opt>
+  <prefix>before</prefix>
+  <dirs>
+    <dir name="first">/usr/bin</dir>
+    <dir name="second">/usr/local/bin</dir>
+  </dirs>
+  <suffix>after</suffix>
+</opt>);
+
+$opt = XMLin($xml,
+  contentkey => '-text', 
+  keyattr    => {dir => 'name'}, 
+  grouptags  => {dirs => 'dir'} 
+);
+is_deeply($opt, {
+  prefix => 'before',
+  dirs   => {
+              first  => '/usr/bin', 
+              second => '/usr/local/bin', 
+            },
+  suffix => 'after',
+}, 'folding, ungrouping and content stripping work together');
+
+
+# confirm folding fails as expected even with ungrouping but (no forcearray)
+
+$xml = q(<opt>
+  <prefix>before</prefix>
+  <dirs>
+    <dir name="first">/usr/bin</dir>
+  </dirs>
+  <suffix>after</suffix>
+</opt>);
+
+$opt = XMLin($xml,
+  contentkey => '-text', 
+  keyattr    => {dir => 'name'}, 
+  grouptags  => {dirs => 'dir'} 
+);
+is_deeply($opt, {
+  prefix => 'before',
+  dirs   => { name => 'first', text => '/usr/bin'}, 
+  suffix => 'after',
+}, 'folding without forcearray but with ungrouping fails as expected');
+
+
+# but works with forcearray enabled
+
+$xml = q(<opt>
+  <prefix>before</prefix>
+  <dirs>
+    <dir name="first">/usr/bin</dir>
+  </dirs>
+  <suffix>after</suffix>
+</opt>);
+
+$opt = XMLin($xml,
+  contentkey => '-text', 
+  forcearray => [ 'dir' ],
+  keyattr    => {dir => 'name'}, 
+  grouptags  => {dirs => 'dir'} 
+);
+is_deeply($opt, {
+  prefix => 'before',
+  dirs   => {'first' => '/usr/bin'}, 
+  suffix => 'after',
+}, 'folding with forcearray and ungrouping works');
+
+
+# Test variable expansion - when no variables are defined
+
+$xml = q(<opt>
+  <file name="config_file">${conf_dir}/appname.conf</file>
+  <file name="log_file">${log_dir}/appname.log</file>
+  <file name="debug_file">${log_dir}/appname.dbg</file>
+</opt>);
+
+$opt = XMLin($xml, contentkey => '-content');
+is_deeply($opt, {
+  file => {
+    config_file => '${conf_dir}/appname.conf',
+    log_file    => '${log_dir}/appname.log',
+    debug_file  => '${log_dir}/appname.dbg',
+  }
+}, 'undefined variables are left untouched');
+
+
+# try again but with variables defined in advance
+
+$opt = XMLin($xml,
+  contentkey => '-content',
+  variables  => { conf_dir => '/etc', log_dir => '/var/log' }
+);
+is_deeply($opt, {
+  file => {
+    config_file => '/etc/appname.conf',
+    log_file    => '/var/log/appname.log',
+    debug_file  => '/var/log/appname.dbg',
+  }
+}, 'substitution of pre-defined variables works');
+
+
+# now try defining them in the XML
+
+$xml = q(<opt>
+  <dir xsvar="conf_dir">/etc</dir>
+  <dir xsvar="log_dir">/var/log</dir>
+  <file name="config_file">${conf_dir}/appname.conf</file>
+  <file name="log_file">${log_dir}/appname.log</file>
+  <file name="debug_file">${log_dir}/appname.dbg</file>
+</opt>);
+
+$opt = XMLin($xml, contentkey => '-content', varattr => 'xsvar');
+is_deeply($opt, {
+  file => {
+    config_file => '/etc/appname.conf',
+    log_file    => '/var/log/appname.log',
+    debug_file  => '/var/log/appname.dbg',
+  },
+  dir           => [
+                     { xsvar => 'conf_dir', content => '/etc'     },
+                     { xsvar => 'log_dir',  content => '/var/log' },
+                   ]
+}, 'variables defined in XML work');
+
+
+# confirm that variables in XML are merged with pre-defined ones
+
+$xml = q(<opt>
+  <dir xsvar="log_dir">/var/log</dir>
+  <file name="config_file">${conf_dir}/appname.conf</file>
+  <file name="log_file">${log_dir}/appname.log</file>
+  <file name="debug_file">${log_dir}/appname.dbg</file>
+</opt>);
+
+$opt = XMLin($xml,
+  contentkey => '-content', 
+  varattr    => 'xsvar',
+  variables  => { conf_dir => '/etc', log_dir => '/tmp' }
+);
+is_deeply($opt, {
+  file => {
+    config_file => '/etc/appname.conf',
+    log_file    => '/var/log/appname.log',
+    debug_file  => '/var/log/appname.dbg',
+  },
+  dir           => { xsvar => 'log_dir',  content => '/var/log' },
+}, 'variables defined in XML merged successfully with predefined vars');
+
+
+# confirm that a variables are expanded in variable definitions
+
+$xml = q(<opt>
+  <dirs>
+    <dir name="prefix">/usr/local/apache</dir>
+    <dir name="exec_prefix">${prefix}</dir>
+    <dir name="bin_dir">${exec_prefix}/bin</dir>
+  </dirs>
+</opt>);
+
+$opt = XMLin($xml,
+  contentkey => '-content',
+  varattr    => 'name',
+  grouptags  => { dirs => 'dir' },
+);
+is_deeply($opt, {
+  dirs => {
+    prefix      => '/usr/local/apache',
+    exec_prefix => '/usr/local/apache',
+    bin_dir     => '/usr/local/apache/bin',
+  }
+}, 'variables are expanded in later variable definitions');
+
+
 # Test option error handling
 
 $@='';
@@ -736,9 +1042,59 @@
 'with correct error message');
 
 
+# Test the NormaliseSpace option
+
+$xml = q(<opt>
+  <user name="  Joe
+  Bloggs  " id="  one  two "/>
+  <user>
+    <name>  Jane
+    Doe </name>
+    <id>
+    three
+    four
+    </id>
+  </user>
+</opt>);
+
+$opt = XMLin($xml, KeyAttr => [ 'name' ], NormaliseSpace => 1);
+ok(ref($opt->{user}) eq 'HASH', "NS-1: folding OK");
+ok(exists($opt->{user}->{'Joe Bloggs'}), "NS-2: space normalised in hash key");
+ok(exists($opt->{user}->{'Jane Doe'}), "NS-3: space normalised in hash key");
+like($opt->{user}->{'Jane Doe'}->{id}, qr{^\s\s+three\s\s+four\s\s+$}s,
+  "NS-4: space not normalised in hash value");
+
+$opt = XMLin($xml, KeyAttr => [ 'name' ], NormaliseSpace => 2);
+ok(ref($opt->{user}) eq 'HASH', "NS-5: folding OK");
+ok(exists($opt->{user}->{'Joe Bloggs'}), "NS-6: space normalised in hash key");
+like($opt->{user}->{'Joe Bloggs'}->{id}, qr{^one\stwo$}s,
+  "NS-7: space normalised in attribute value");
+ok(exists($opt->{user}->{'Jane Doe'}), "NS-8: space normalised in hash key");
+like($opt->{user}->{'Jane Doe'}->{id}, qr{^three\sfour$}s,
+  "NS-9: space normalised in element text content");
+
+# confirm NormaliseSpace works in anonymous arrays too
+
+$xml = q(<opt>
+  <anon>  one  two </anon><anon> three
+  four  five </anon><anon> six </anon><anon> seveneightnine </anon>
+</opt>);
+
+$opt = XMLin($xml, NormaliseSpace => 2);
+is_deeply($opt, [   'one two', 'three four five', 'six', 'seveneightnine' ],
+  "NS-10: space normalised in anonymous array");
+
+# Check that American speeling works too
+
+$opt = XMLin($xml, NormalizeSpace => 2);
+is_deeply($opt, [   'one two', 'three four five', 'six', 'seveneightnine' ],
+  "NS-11: space normalized in anonymous array");
+
 # Now for a 'real world' test, try slurping in an SRT config file
 
-$opt = XMLin(File::Spec->catfile('t', 'srt.xml'), forcearray => 1);
+$opt = XMLin(File::Spec->catfile('t', 'srt.xml'),
+  forcearray => 1, @cont_key
+);
 $target = {
   'global' => [
     {

Index: 2_XMLout.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/2_XMLout.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- 2_XMLout.t	20 Jan 2003 07:48:10 -0000	1.5
+++ 2_XMLout.t	10 Apr 2003 10:20:07 -0000	1.6
@@ -5,7 +5,7 @@
 use Test::More;
 use IO::File;
 
-plan tests => 174;
+plan tests => 190;
 
 ##############################################################################
 #                   S U P P O R T   R O U T I N E S
@@ -681,6 +681,13 @@
 like($_, qr{^\s*<opt\s+one="1">text</opt>\s*$}s, 'even when name changed');
 
 
+# and also if we add the '-' prefix
+
+$_ = XMLout($ref, contentkey => '-text_content');
+
+like($_, qr{^\s*<opt\s+one="1">text</opt>\s*$}s, 'even with "-" prefix');
+
+
 # Check 'noattr' option
 
 $ref = {
@@ -748,6 +755,129 @@
 ok(s{\s*<(word)>thirty two</\1>\s*}{32}s, 'scalar 2.1 mapped OK');
 ok(s{\s*<(number)>323232</\1>\s*}{NUM}s, 'element 2 OK');
 like($_, qr{^<(\w+)\s*>NUMNUM</\1>$}, 'document OK');
+
+
+# Check grouped tags get ungrouped correctly
+
+$ref = {
+  prefix => 'before',
+  dirs   => [ '/usr/bin', '/usr/local/bin' ],
+  suffix => 'after',
+};
+
+# Expect:
+#
+# <opt>
+#   <prefix>before</prefix>
+#   <dirs>
+#     <dir>/usr/bin</dir>
+#     <dir>/usr/local/bin</dir>
+#   </dirs>
+#   <suffix>after</suffix>
+# </opt>
+#
+
+$_ = XMLout($ref, grouptags => {dirs => 'dir'}, noattr => 1);
+
+ok(s{\s*<(prefix)>before</\1>\s*}{ELEM}s, 'prefix OK');
+ok(s{\s*<(suffix)>after</\1>\s*}{ELEM}s,  'suffix OK');
+ok(s{\s*<dir>/usr/bin</dir>\s*<dir>/usr/local/bin</dir>\s*}{LIST}s,  'list OK');
+ok(s{\s*<dirs>LIST</dirs>\s*}{ELEM}s,  'group OK');
+like($_, qr{^<(\w+)\s*>ELEMELEMELEM</\1>$}, 'document OK');
+
+
+# Try again with multiple groupings
+
+$ref = {
+  dirs   => [ '/usr/bin', '/usr/local/bin' ],
+  terms  => [ 'vt100', 'xterm' ],
+};
+
+# Expect:
+#
+# <opt>
+#   <dirs>
+#     <dir>/usr/bin</dir>
+#     <dir>/usr/local/bin</dir>
+#   </dirs>
+#   <terms>
+#     <term>vt100</term>
+#     <term>xterm</term>
+#   </terms>
+# </opt>
+#
+
+$_ = XMLout($ref, grouptags => {dirs => 'dir', terms => 'term'}, noattr => 1);
+
+ok(s{\s*<dir>/usr/bin</dir>\s*<dir>/usr/local/bin</dir>\s*}{LIST}s,  'list 1 OK');
+ok(s{\s*<dirs>LIST</dirs>\s*}{ELEM}s,  'group 1 OK');
+ok(s{\s*<term>vt100</term>\s*<term>xterm</term>\s*}{LIST}s,  'list 2 OK');
+ok(s{\s*<terms>LIST</terms>\s*}{ELEM}s,  'group 2 OK');
+like($_, qr{^<(\w+)\s*>ELEMELEM</\1>$}, 'document OK');
+
+
+# Confirm unfolding and grouping work together
+
+$ref = {
+  dirs   => {
+              first   => { content => '/usr/bin'       }, 
+              second  => { content => '/usr/local/bin' },
+            },
+};
+
+# Expect:
+#
+# <opt>
+#   <dirs>
+#     <dir name="first">/usr/bin</dir>
+#     <dir name="second">/usr/local/bin</dir>
+#   </dirs>
+# </opt>
+#
+
+$_ = XMLout($ref, 
+  grouptags => {dirs => 'dir'}, keyattr => {dir => 'name'},
+);
+
+ok(s{\s*<dir\s+name="first">/usr/bin</dir>\s*}{ITEM}s, 'item 1 OK');
+ok(s{\s*<dir\s+name="second">/usr/local/bin</dir>\s*}{ITEM}s, 'item 2 OK');
+ok(s{\s*<dirs>ITEMITEM</dirs>\s*}{GROUP}s,  'group OK');
+like($_, qr{^<(\w+)\s*>GROUP</\1>$}, 'document OK');
+
+
+# Combine unfolding, grouping and stripped content - watch it fail :-(
+
+$ref = {
+  dirs   => {
+              first   => '/usr/bin',
+              second  => '/usr/local/bin'
+            },
+};
+
+# Expect:
+#
+# <opt>
+#   <dirs first="/usr/bin" second="/usr/local/bin" />
+# </opt>
+#
+
+$_ = XMLout($ref, 
+  grouptags => {dirs => 'dir'}, keyattr => {dir => 'name'}, 
+  contentkey => '-content'
+);
+
+like($_, qr{
+  ^<(\w+)>\s*
+    <dirs>\s*
+      <dir
+        (?:
+          \s+first="/usr/bin"
+         |\s+second="/usr/local/bin"
+        ){2}\s*
+      />\s*
+    </dirs>\s*
+  </\1>$
+}x, 'Failed to unwrap/group stripped content - as expected');
 
 
 # 'Stress test' with a data structure that maps to several thousand elements.

Index: 3_Storable.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/3_Storable.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- 3_Storable.t	16 Oct 2002 09:43:35 -0000	1.5
+++ 3_Storable.t	10 Apr 2003 10:20:08 -0000	1.6
@@ -36,7 +36,7 @@
 }
 
 
-plan tests => 20;
+plan tests => 21;
 
 ##############################################################################
 #                   S U P P O R T   R O U T I N E S
@@ -175,6 +175,11 @@
 PassTime($t1);
 $opt = XMLin($XMLFile, cache => 'storable');
 is_deeply($opt, $Expected, 'parsed expected data in through cache');
+
+# Make sure scheme name is case-insensitive
+
+$opt = XMLin($XMLFile, cache => 'Storable');
+is_deeply($opt, $Expected, 'scheme name is case-insensitive');
 
 # Clean up and go
 

Index: 6_ObjIntf.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/6_ObjIntf.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- 6_ObjIntf.t	16 Oct 2002 09:43:35 -0000	1.4
+++ 6_ObjIntf.t	10 Apr 2003 10:20:08 -0000	1.5
@@ -2,7 +2,7 @@
 # vim: syntax=perl
 
 use strict;
-use Test::More tests => 27;
+use Test::More tests => 33;
 
 ##############################################################################
 # Derived version of XML::Simple that returns everything in upper case
@@ -101,10 +101,19 @@
   keyattr => { }
 );
 
+my %opts3 = (
+  keyattr => { disc => 'cddbid', track => 'number' },
+  keeproot => 1, 
+  contentkey => '-title',
+  forcearray => [ qw(disc album) ] 
+);
+
 my $xs1 = new XML::Simple( %opts1 );
 my $xs2 = new XML::Simple( %opts2 );
+my $xs3 = new XML::Simple( %opts3 );
 isa_ok($xs1, 'XML::Simple', 'object one');
 isa_ok($xs2, 'XML::Simple', 'object two');
+isa_ok($xs3, 'XML::Simple', 'object three');
 is_deeply(\%opts1, {
   keyattr => { disc => 'cddbid', track => 'number' },
   keeproot => 1, 
@@ -171,6 +180,38 @@
 is_deeply($ref2, $exp2, 'parsed expected data via object 2');
 
 
+# Try using the third object
+
+my $exp3 = {
+  'cddatabase' => {
+    'disc' => {
+      '960b750c' => {
+        'id' => '9362-45055-2',
+        'album' => [ 'Automatic For The People' ],
+        'artist' => 'R.E.M.',
+        'track' => {
+          1  => 'Drive',
+          2  => 'Try Not To Breathe',
+          3  => 'The Sidewinder Sleeps Tonite',
+          4  => 'Everybody Hurts',
+          5  => 'New Orleans Instrumental No. 1',
+          6  => 'Sweetness Follows',
+          7  => 'Monty Got A Raw Deal',
+          8  => 'Ignoreland',
+          9  => 'Star Me Kitten',
+          10 => 'Man On The Moon',
+          11 => 'Nightswimming',
+          12 => 'Find The River'
+        }
+      }
+    }
+  }
+};
+
+my $ref3 = $xs3->XMLin($xml);
+is_deeply($ref3, $exp3, 'parsed expected data via object 3');
+
+
 # Confirm default options in object merge correctly with options as args
 
 $ref1 = $xs1->XMLin($xml, keyattr => [], forcearray => 0);
@@ -266,3 +307,53 @@
 like($_, qr{<opt>\s*
  <server\s+address="<!\[CDATA\[12->14\s+"Puf&Stuf"\s+Drive\]\]>"\s*/>\s*
 </opt>}xs, 'inheritance works with escape_value() overridden');
+
+
+# Check variables defined in the constructor don't get trounced for
+# subsequent parses
+
+$xs1 = XML::Simple->new(
+  contentkey => '-content', 
+  varattr    => 'xsvar',
+  variables  => { conf_dir => '/etc', log_dir => '/tmp' }
+);
+
+$xml = q(<opt>
+  <dir xsvar="log_dir">/var/log</dir>
+  <file name="config_file">${conf_dir}/appname.conf</file>
+  <file name="log_file">${log_dir}/appname.log</file>
+  <file name="debug_file">${log_dir}/appname.dbg</file>
+</opt>);
+
+my $opt = $xs1->XMLin($xml);
+is_deeply($opt, {
+  file => {
+    config_file => '/etc/appname.conf',
+    log_file    => '/var/log/appname.log',
+    debug_file  => '/var/log/appname.dbg',
+  },
+  dir           => { xsvar => 'log_dir',  content => '/var/log' },
+}, 'variables from XML merged with predefined variables');
+
+$xml = q(<opt>
+  <file name="config_file">${conf_dir}/appname.conf</file>
+  <file name="log_file">${log_dir}/appname.log</file>
+  <file name="debug_file">${log_dir}/appname.dbg</file>
+</opt>);
+
+my $opt = $xs1->XMLin($xml);
+is_deeply($opt, {
+  file => {
+    config_file => '/etc/appname.conf',
+    log_file    => '/tmp/appname.log',
+    debug_file  => '/tmp/appname.dbg',
+  },
+}, 'variables from XML merged with predefined variables');
+
+# check that unknown options passed to the constructor are rejected
+
+$@ = undef;
+eval { $xs1 = XML::Simple->new(KeyAttr => {}, WibbleFlibble => 1) };
+ok(defined($@), "unrecognised option caught by constructor");
+like($@, qr/^Unrecognised option: WibbleFlibble at/,
+  "correct message in exception");

Index: 9_Strict.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/9_Strict.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- 9_Strict.t	11 Dec 2002 01:48:28 -0000	1.3
+++ 9_Strict.t	10 Apr 2003 10:20:10 -0000	1.4
@@ -36,7 +36,7 @@
 };
 
 isnt($@, '', 'omitting forcearray was a fatal error');
-like($@, qr/No value specified for 'forcearray'/, 
+like($@, qr/(?i)No value specified for 'forcearray'/, 
   'with the correct error message');
 
 
@@ -47,7 +47,7 @@
 };
 
 isnt($@, '', 'omitting keyattr was a fatal error');
-like($@, qr/No value specified for 'keyattr'/,
+like($@, qr/(?i)No value specified for 'keyattr'/,
   'with the correct error message');
 
 
@@ -58,7 +58,7 @@
 };
 
 isnt($@, '', 'omitting forcearray for elements in keyattr was a fatal error');
-like($@, qr/<part> set in keyattr but not in forcearray/,
+like($@, qr/(?i)<part> set in keyattr but not in forcearray/,
   'with the correct error message');
 
 
@@ -67,7 +67,7 @@
 };
 
 isnt($@, '', 'omitting keyattr elements from forcearray was a fatal error');
-like($@, qr/<part> set in keyattr but not in forcearray/,
+like($@, qr/(?i)<part> set in keyattr but not in forcearray/,
   'with the correct error message');
 
 
@@ -86,7 +86,7 @@
 };
 
 isnt($@, '', 'key attribute missing from names element was a fatal error');
-like($@, qr/<part> element has no 'partnum' key attribute/,
+like($@, qr/(?i)<part> element has no 'partnum' key attribute/,
   'with the correct error message');
 
 
@@ -106,7 +106,7 @@
 };
 
 isnt($@, '', 'key attribute not a scalar was a fatal error');
-like($@, qr/<item> element has non-scalar 'name' key attribute/,
+like($@, qr/(?i)<item> element has non-scalar 'name' key attribute/,
   'with the correct error message');
 
 
@@ -145,7 +145,7 @@
 };
 
 isnt($@, '', 'omitting keyattr was a fatal error');
-like($@, qr/No value specified for 'keyattr'/,
+like($@, qr/(?i)No value specified for 'keyattr'/,
   'with the correct error message');
 
 
@@ -179,7 +179,7 @@
 };
 
 isnt($@, '', 'omitting forcearray was a fatal error');
-like($@, qr/No value specified for 'forcearray'/, 
+like($@, qr/(?i)No value specified for 'forcearray'/, 
   'with the correct error message');
 
 
@@ -192,7 +192,7 @@
 };
 
 isnt($@, '', 'omitting keyattr was a fatal error');
-like($@, qr/No value specified for 'keyattr'/,
+like($@, qr/(?i)No value specified for 'keyattr'/,
   'with the correct error message');
 
 
@@ -205,7 +205,7 @@
 };
 
 isnt($@, '', 'omitting forcearray for elements in keyattr was a fatal error');
-like($@, qr/<part> set in keyattr but not in forcearray/,
+like($@, qr/(?i)<part> set in keyattr but not in forcearray/,
   'with the correct error message');
 
 
@@ -216,7 +216,7 @@
 };
 
 isnt($@, '', 'omitting keyattr elements from forcearray was a fatal error');
-like($@, qr/<part> set in keyattr but not in forcearray/,
+like($@, qr/(?i)<part> set in keyattr but not in forcearray/,
   'with the correct error message');
 
 
@@ -236,7 +236,7 @@
 };
 
 isnt($@, '', 'key attribute missing from names element was a fatal error');
-like($@, qr/<part> element has no 'partnum' key attribute/,
+like($@, qr/(?i)<part> element has no 'partnum' key attribute/,
   'with the correct error message');
 
 
@@ -258,7 +258,7 @@
 };
 
 isnt($@, '', 'key attribute not a scalar was a fatal error');
-like($@, qr/<item> element has non-scalar 'name' key attribute/,
+like($@, qr/(?i)<item> element has non-scalar 'name' key attribute/,
   'with the correct error message');
 
 
@@ -301,7 +301,7 @@
 };
 
 isnt($@, '', 'omitting keyattr was a fatal error');
-like($@, qr/No value specified for 'keyattr'/,
+like($@, qr/(?i)No value specified for 'keyattr'/,
   'with the correct error message');