commit perl-XML-Simple

14 Dec 2006

Hello community,

here is the log from the commit of package perl-XML-Simple
checked in at Thu Dec 14 02:05:35 CET 2006.

--------

--- perl-XML-Simple/perl-XML-Simple.changes	2006-10-05 12:23:06.000000000 +0200
+++ /mounts/work_src_done/STABLE/perl-XML-Simple/perl-XML-Simple.changes	2006-12-13 13:32:05.000000000 +0100
@@ -1,0 +2,8 @@
+Wed Dec 13 12:20:35 CET 2006 - anicka@suse.cz
+
+- update to 2.16
+ * Added test/fix for bad GroupTags option
+ * Added new_hashref() hook method
+ * refactored cache save/restore methods for easier overriding
+
+-------------------------------------------------------------------

Old:
----
  XML-Simple-2.15-test.diff
  XML-Simple-2.15.tar.bz2

New:
----
  XML-Simple-2.16-test.diff
  XML-Simple-2.16.tar.bz2

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Other differences:
------------------
++++++ perl-XML-Simple.spec ++++++
--- /var/tmp/diff_new_pack.TV9kPR/_old	2006-12-14 02:05:27.000000000 +0100
+++ /var/tmp/diff_new_pack.TV9kPR/_new	2006-12-14 02:05:27.000000000 +0100
@@ -1,5 +1,5 @@
 #
-# spec file for package perl-XML-Simple (Version 2.15)
+# spec file for package perl-XML-Simple (Version 2.16)
 #
 # Copyright (c) 2006 SUSE LINUX Products GmbH, Nuernberg, Germany.
 # This file and all modifications and additions to the pristine
@@ -12,7 +12,7 @@
 
 Name:           perl-XML-Simple
 BuildRequires:  perl-XML-Parser
-Version:        2.15
+Version:        2.16
 Release:        1
 Requires:       expat perl-XML-Parser
 Requires:       perl = %{perl_version}
@@ -59,6 +59,11 @@
 /var/adm/perl-modules/%{name}
 
 %changelog -n perl-XML-Simple
+* Wed Dec 13 2006 - anicka@suse.cz
+- update to 2.16
+  * Added test/fix for bad GroupTags option
+  * Added new_hashref() hook method
+  * refactored cache save/restore methods for easier overriding
 * Thu Oct 05 2006 - anicka@suse.cz
 - update to 2.15
   * Makefile.PL changes: reject known-bad PurePerl and RTF parser

++++++ XML-Simple-2.15-test.diff -> XML-Simple-2.16-test.diff ++++++

++++++ XML-Simple-2.15.tar.bz2 -> XML-Simple-2.16.tar.bz2 ++++++
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/XML-Simple-2.15/Changes new/XML-Simple-2.16/Changes
--- old/XML-Simple-2.15/Changes	2006-10-03 03:05:14.000000000 +0200
+++ new/XML-Simple-2.16/Changes	2006-10-30 09:21:59.000000000 +0100
@@ -1,5 +1,10 @@
 Revision history for Perl module XML::Simple
 
+2.16  Oct 30 2006
+      - Added test/fix for bad GroupTags option (report from Lee Goddard)
+      - Added new_hashref() hook method
+      - refactored cache save/restore methods for easier overriding
+
 2.15  Oct 03 2006
       - Makefile.PL changes: reject known-bad PurePerl and RTF parser modules;
         default to XML::SAX::Expat if no parser installed
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/XML-Simple-2.15/MANIFEST new/XML-Simple-2.16/MANIFEST
--- old/XML-Simple-2.15/MANIFEST	2005-01-29 06:18:41.000000000 +0100
+++ new/XML-Simple-2.16/MANIFEST	2006-10-08 09:38:24.000000000 +0200
@@ -18,6 +18,7 @@
 t/8_Namespaces.t
 t/9_Strict.t
 t/A_XMLParser.t
+t/B_Hooks.t
 t/desertnet.src
 t/lib/TagsToUpper.pm
 t/srt.xml
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/XML-Simple-2.15/META.yml new/XML-Simple-2.16/META.yml
--- old/XML-Simple-2.15/META.yml	2006-10-03 03:28:23.000000000 +0200
+++ new/XML-Simple-2.16/META.yml	2006-10-30 09:28:27.000000000 +0100
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         XML-Simple
-version:      2.15
+version:      2.16
 abstract:     Easy API to maintain XML (esp config files)
 license:      perl
 author:       Grant McLean <grantm@cpan.org>
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/XML-Simple-2.15/README new/XML-Simple-2.16/README
--- old/XML-Simple-2.15/README	2006-10-02 11:20:02.000000000 +0200
+++ new/XML-Simple-2.16/README	2006-10-30 09:20:19.000000000 +0100
@@ -56,7 +56,7 @@
 
 STATUS
 
-  This version (2.15) is the current stable release.
+  This version (2.16) is the current stable release.
 
   Please send any feedback to the author: grantm@cpan.org
 
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/XML-Simple-2.15/lib/XML/Simple.pm new/XML-Simple-2.16/lib/XML/Simple.pm
--- old/XML-Simple-2.15/lib/XML/Simple.pm	2006-10-03 03:07:48.000000000 +0200
+++ new/XML-Simple-2.16/lib/XML/Simple.pm	2006-10-30 09:28:13.000000000 +0100
@@ -1,4 +1,4 @@
-# $Id: Simple.pm,v 1.28 2006/10/03 01:07:48 grantm Exp $
+# $Id: Simple.pm,v 1.34 2006/10/30 08:28:13 grantm Exp $
 
 package XML::Simple;
 
@@ -18,7 +18,7 @@
 
     require XML::Simple;
 
-    my $xs = new XML::Simple(options);
+    my $xs = XML::Simple->new(options);
 
     my $ref = $xs->XMLin([<xml file or string>] [, <options>]);
 
@@ -53,15 +53,10 @@
 @ISA               = qw(Exporter);
 @EXPORT            = qw(XMLin XMLout);
 @EXPORT_OK         = qw(xml_in xml_out);
-$VERSION           = '2.15';
+$VERSION           = '2.16';
 $PREFERRED_PARSER  = undef;
 
 my $StrictMode     = 0;
-my %CacheScheme    = (
-                       storable => [ \&StorableSave, \&StorableRestore ],
-                       memshare => [ \&MemShareSave, \&MemShareRestore ],
-                       memcopy  => [ \&MemCopySave,  \&MemCopyRestore  ]
-                     );
 
 my @KnownOptIn     = qw(keyattr keeproot forcecontent contentkey noattr
                         searchpath forcearray cache suppressempty parseropts
@@ -135,6 +130,25 @@
 
 
 ##############################################################################
+# Sub: _get_object()
+#
+# Helper routine called from XMLin() and XMLout() to create an object if none
+# was provided.  Note, this routine does mess with the caller's @_ array.
+#
+
+sub _get_object {
+  my $self;
+  if($_[0]  and  UNIVERSAL::isa($_[0], 'XML::Simple')) {
+    $self = shift;
+  }
+  else {
+    $self = XML::Simple->new();
+  }
+  
+  return $self;
+}
+
+##############################################################################
 # Sub/Method: XMLin()
 #
 # Exported routine for slurping XML into a hashref - see pod for info.
@@ -146,17 +160,7 @@
 #
 
 sub XMLin {
-
-  # If this is not a method call, create an object
-
-  my $self;
-  if($_[0]  and  UNIVERSAL::isa($_[0], 'XML::Simple')) {
-    $self = shift;
-  }
-  else {
-    $self = new XML::Simple();
-  }
-
+  my $self = &_get_object;      # note, @_ is passed implicitly
 
   my $string = shift;
 
@@ -197,10 +201,8 @@
 
     if($self->{opt}->{cache}) {
       foreach $scheme (@{$self->{opt}->{cache}}) {
-        croak "Unsupported caching scheme: $scheme"
-          unless($CacheScheme{$scheme});
-
-        my $opt = $CacheScheme{$scheme}->[1]->($filename);
+        my $method = 'cache_read_' . $scheme;
+        my $opt = $self->$method($filename);
         return($opt) if($opt);
       }
     }
@@ -232,7 +234,8 @@
   }
 
   if($self->{opt}->{cache}) {
-    $CacheScheme{$self->{opt}->{cache}->[0]}->[0]->($ref, $filename);
+    my $method = 'cache_write_' . $self->{opt}->{cache}->[0];
+    $self->$method($ref, $filename);
   }
 
   return($ref);
@@ -327,7 +330,7 @@
     carp "'nsexpand' option requires XML::SAX";
   }
 
-  my $xp = new XML::Parser(Style => 'Tree', @{$self->{opt}->{parseropts}});
+  my $xp = XML::Parser->new(Style => 'Tree', @{$self->{opt}->{parseropts}});
   my($tree);
   if($filename) {
     # $tree = $xp->parsefile($filename);  # Changed due to prob w/mod_perl
@@ -345,17 +348,16 @@
 
 
 ##############################################################################
-# Sub: StorableSave()
+# Method: cache_write_storable()
 #
 # Wrapper routine for invoking Storable::nstore() to cache a parsed data
 # structure.
 #
 
-sub StorableSave {
-  my($data, $filename) = @_;
+sub cache_write_storable {
+  my($self, $data, $filename) = @_;
 
-  my $cachefile = $filename;
-  $cachefile =~ s{(\.xml)?$}{.stor};
+  my $cachefile = $self->storable_filename($filename);
 
   require Storable;           # We didn't need it until now
 
@@ -371,18 +373,17 @@
 
 
 ##############################################################################
-# Sub: StorableRestore()
+# Method: cache_read_storable()
 #
 # Wrapper routine for invoking Storable::retrieve() to read a cached parsed
 # data structure.  Only returns cached data if the cache file exists and is
 # newer than the source XML file.
 #
 
-sub StorableRestore {
-  my($filename) = @_;
+sub cache_read_storable {
+  my($self, $filename) = @_;
   
-  my $cachefile = $filename;
-  $cachefile =~ s{(\.xml)?$}{.stor};
+  my $cachefile = $self->storable_filename($filename);
 
   return unless(-r $cachefile);
   return unless((stat($cachefile))[9] > (stat($filename))[9]);
@@ -400,27 +401,43 @@
 
 
 ##############################################################################
-# Sub: MemShareSave()
+# Method: storable_filename()
+#
+# Translates the supplied source XML filename into a filename for the storable
+# cached data.  A '.stor' suffix is added after stripping an optional '.xml'
+# suffix.
+#
+
+sub storable_filename {
+  my($self, $cachefile) = @_;
+
+  $cachefile =~ s{(\.xml)?$}{.stor};
+  return $cachefile;
+}
+
+
+##############################################################################
+# Method: cache_write_memshare()
 #
 # Takes the supplied data structure reference and stores it away in a global
 # hash structure.
 #
 
-sub MemShareSave {
-  my($data, $filename) = @_;
+sub cache_write_memshare {
+  my($self, $data, $filename) = @_;
 
   $MemShareCache{$filename} = [time(), $data];
 }
 
 
 ##############################################################################
-# Sub: MemShareRestore()
+# Method: cache_read_memshare()
 #
 # Takes a filename and looks in a global hash for a cached parsed version.
 #
 
-sub MemShareRestore {
-  my($filename) = @_;
+sub cache_read_memshare {
+  my($self, $filename) = @_;
   
   return unless($MemShareCache{$filename});
   return unless($MemShareCache{$filename}->[0] > (stat($filename))[9]);
@@ -431,14 +448,14 @@
 
 
 ##############################################################################
-# Sub: MemCopySave()
+# Method: cache_write_memcopy()
 #
 # Takes the supplied data structure and stores a copy of it in a global hash
 # structure.
 #
 
-sub MemCopySave {
-  my($data, $filename) = @_;
+sub cache_write_memcopy {
+  my($self, $data, $filename) = @_;
 
   require Storable;           # We didn't need it until now
   
@@ -447,14 +464,14 @@
 
 
 ##############################################################################
-# Sub: MemCopyRestore()
+# Method: cache_read_memcopy()
 #
 # Takes a filename and looks in a global hash for a cached parsed version.
 # Returns a reference to a copy of that data structure.
 #
 
-sub MemCopyRestore {
-  my($filename) = @_;
+sub cache_read_memcopy {
+  my($self, $filename) = @_;
   
   return unless($MemCopyCache{$filename});
   return unless($MemCopyCache{$filename}->[0] > (stat($filename))[9]);
@@ -474,16 +491,7 @@
 #
 
 sub XMLout {
-
-  # If this is not a method call, create an object
-
-  my $self;
-  if($_[0]  and  UNIVERSAL::isa($_[0], 'XML::Simple')) {
-    $self = shift;
-  }
-  else {
-    $self = new XML::Simple();
-  }
+  my $self = &_get_object;      # note, @_ is passed implicitly
 
   croak "XMLout() requires at least one argument" unless(@_);
   my $ref = shift;
@@ -682,6 +690,11 @@
   }
   if($opt->{cache}) {
     $_ = lc($_) foreach (@{$opt->{cache}});
+    foreach my $scheme (@{$opt->{cache}}) {
+      my $method = 'cache_read_' . $scheme;
+      croak "Unsupported caching scheme: $scheme"
+        unless($self->can($method));
+    }
   }
   
   if(exists($opt->{parseropts})) {
@@ -791,8 +804,14 @@
 
   # make sure there's nothing weird in {grouptags}
 
-  if($opt->{grouptags} and !UNIVERSAL::isa($opt->{grouptags}, 'HASH')) {
-    croak "Illegal value for 'GroupTags' option - expected a hashref";
+  if($opt->{grouptags}) {
+    croak "Illegal value for 'GroupTags' option - expected a hashref"
+      unless UNIVERSAL::isa($opt->{grouptags}, 'HASH');
+
+    while(my($key, $val) = each %{$opt->{grouptags}}) {
+      next if $key ne $val;
+      croak "Bad value in GroupTags: '$key' => '$val'";
+    }
   }
 
 
@@ -1125,7 +1144,7 @@
   my $name     = shift;
   my $arrayref = shift;
 
-  my $hashref  = {};
+  my $hashref  = $self->new_hashref;
 
   my($i, $key, $val, $flag);
 
@@ -1197,6 +1216,20 @@
 
 
 ##############################################################################
+# Method: new_hashref()
+#
+# This is a hook routine for overriding in a sub-class.  Some people believe
+# that using Tie::IxHash here will solve order-loss problems.
+# 
+
+sub new_hashref {
+  my $self = shift;
+
+  return { @_ };
+}
+
+
+##############################################################################
 # Method: collapse_content()
 #
 # Helper routine for array_to_hash
@@ -1867,7 +1900,7 @@
 
 An IO::Handle object will be read to EOF and its contents parsed. eg:
 
-  $fh = new IO::File('/etc/params.xml');
+  $fh = IO::File->new('/etc/params.xml');
   $ref = XMLin($fh);
 
 =back
@@ -2618,7 +2651,7 @@
 
 First create an XML::Simple parser object with your preferred defaults:
 
-  my $xs = new XML::Simple(ForceArray => 1, KeepRoot => 1);
+  my $xs = XML::Simple->new(ForceArray => 1, KeepRoot => 1);
 
 then call C<XMLin()> or C<XMLout()> as a method of that object:
 
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/XML-Simple-2.15/t/1_XMLin.t new/XML-Simple-2.16/t/1_XMLin.t
--- old/XML-Simple-2.15/t/1_XMLin.t	2006-10-03 03:07:48.000000000 +0200
+++ new/XML-Simple-2.16/t/1_XMLin.t	2006-10-30 09:28:13.000000000 +0100
@@ -1,4 +1,4 @@
-# $Id: 1_XMLin.t,v 1.24 2006/10/03 01:07:48 grantm Exp $
+# $Id: 1_XMLin.t,v 1.25 2006/10/30 08:28:13 grantm Exp $
 # vim: syntax=perl
 
 use strict;
@@ -25,8 +25,9 @@
 $@ = '';
 eval "use XML::Simple;";
 is($@, '', 'Module compiled OK');
-unless($XML::Simple::VERSION eq '2.15') {
-  diag("Warning: XML::Simple::VERSION = $XML::Simple::VERSION (expected 2.15)");
+my $version = '2.16';
+unless($XML::Simple::VERSION eq $version) {
+  diag("Warning: XML::Simple::VERSION = $XML::Simple::VERSION (expected $version)");
 }
 
 
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/XML-Simple-2.15/t/2_XMLout.t new/XML-Simple-2.16/t/2_XMLout.t
--- old/XML-Simple-2.15/t/2_XMLout.t	2006-09-19 11:52:34.000000000 +0200
+++ new/XML-Simple-2.16/t/2_XMLout.t	2006-10-05 10:28:05.000000000 +0200
@@ -1,4 +1,4 @@
-# $Id: 2_XMLout.t,v 1.16 2006/09/19 09:52:34 grantm Exp $
+# $Id: 2_XMLout.t,v 1.17 2006/10/05 08:28:05 grantm Exp $
 # vim: syntax=perl
 
 use strict;
@@ -6,7 +6,7 @@
 
 $^W = 1;
 
-plan tests => 198;
+plan tests => 201;
 
 
 ##############################################################################
@@ -869,7 +869,15 @@
 # </opt>
 #
 
-$_ = XMLout($ref, grouptags => {dirs => 'dir'}, noattr => 1);
+$@ = '';
+$_ = eval { XMLout($ref, grouptags => {dirs => 'dirs'}, noattr => 1); };
+ok($@, 'bad GroupTags value was caught');
+like("$@", qr{Bad value in GroupTags: 'dirs' => 'dirs'},
+  'error message looks good');
+
+$@ = '';
+$_ = eval { XMLout($ref, grouptags => {dirs => 'dir'}, noattr => 1); };
+ok(!$@, 'good GroupTags value caused no error');
 
 ok(s{\s*<(prefix)>before</\1>\s*}{ELEM}s, 'prefix OK');
 ok(s{\s*<(suffix)>after</\1>\s*}{ELEM}s,  'suffix OK');
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/XML-Simple-2.15/t/B_Hooks.t new/XML-Simple-2.16/t/B_Hooks.t
--- old/XML-Simple-2.15/t/B_Hooks.t	1970-01-01 01:00:00.000000000 +0100
+++ new/XML-Simple-2.16/t/B_Hooks.t	2006-10-12 10:57:52.000000000 +0200
@@ -0,0 +1,136 @@
+# $Id: B_Hooks.t,v 1.2 2006/10/12 08:57:52 grantm Exp $
+# vim: syntax=perl
+
+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' };
+}


++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++



Remember to have fun...

---------------------------------------------------------------------
To unsubscribe, e-mail: opensuse-commit+unsubscribe@opensuse.org
For additional commands, e-mail: opensuse-commit+help@opensuse.org

    

root＠suse.de

tags

participants (1)