[perl-xml-cvs] CVS: xml-simple/lib/XML Simple.pm,1.39,1.40

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

Update of /cvsroot/perl-xml/xml-simple/lib/XML
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23871/lib/XML

Modified Files:
	Simple.pm 
Log Message:
- add die_or_warn handling for non-unique key attributes values during array folding

Index: Simple.pm
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/lib/XML/Simple.pm,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -d -r1.39 -r1.40
--- Simple.pm	2 Aug 2007 10:40:16 -0000	1.39
+++ Simple.pm	15 Aug 2007 10:36:48 -0000	1.40
@@ -53,7 +53,7 @@
 @ISA               = qw(Exporter);
 @EXPORT            = qw(XMLin XMLout);
 @EXPORT_OK         = qw(xml_in xml_out);
-$VERSION           = '2.17';
+$VERSION           = '2.18';
 $PREFERRED_PARSER  = undef;
 
 my $StrictMode     = 0;
@@ -1233,23 +1233,19 @@
       ) {
         $val = $arrayref->[$i]->{$key};
         if(ref($val)) {
-          if($StrictMode) {
-            croak "<$name> element has non-scalar '$key' key attribute";
-          }
-          if($^W) {
-            carp "Warning: <$name> element has non-scalar '$key' key attribute";
-          }
+          $self->die_or_warn("<$name> element has non-scalar '$key' key attribute");
           return($arrayref);
         }
         $val = $self->normalise_space($val)
           if($self->{opt}->{normalisespace} == 1);
+        $self->die_or_warn("<$name> element has non-unique value in '$key' key attribute: $val")
+          if(exists($hashref->{$val}));
         $hashref->{$val} = { %{$arrayref->[$i]} };
         $hashref->{$val}->{"-$key"} = $hashref->{$val}->{$key} if($flag eq '-');
         delete $hashref->{$val}->{$key} unless($flag eq '+');
       }
       else {
-        croak "<$name> element has no '$key' key attribute" if($StrictMode);
-        carp "Warning: <$name> element has no '$key' key attribute" if($^W);
+        $self->die_or_warn("<$name> element has no '$key' key attribute");
         return($arrayref);
       }
     }
@@ -1259,15 +1255,24 @@
   # Or assume keyattr => [ .... ]
 
   else {
+    my $default_keys =
+      join(',', @DefKeyAttr) eq join(',', @{$self->{opt}->{keyattr}});
+
     ELEMENT: for($i = 0; $i < @$arrayref; $i++)  {
       return($arrayref) unless(UNIVERSAL::isa($arrayref->[$i], 'HASH'));
 
       foreach $key (@{$self->{opt}->{keyattr}}) {
         if(defined($arrayref->[$i]->{$key}))  {
           $val = $arrayref->[$i]->{$key};
-          return($arrayref) if(ref($val));
+          if(ref($val)) {
+            $self->die_or_warn("<$name> element has non-scalar '$key' key attribute")
+              if not $default_keys;
+            return($arrayref);
+          }
           $val = $self->normalise_space($val)
             if($self->{opt}->{normalisespace} == 1);
+          $self->die_or_warn("<$name> element has non-unique value in '$key' key attribute: $val")
+            if(exists($hashref->{$val}));
           $hashref->{$val} = { %{$arrayref->[$i]} };
           delete $hashref->{$val}->{$key};
           next ELEMENT;
@@ -1289,6 +1294,25 @@
 
 
 ##############################################################################
+# Method: die_or_warn()
+#
+# Takes a diagnostic message and does one of three things:
+# 1. dies if strict mode is enabled
+# 2. warns if warnings are enabled but strict mode is not
+# 3. ignores message and resturns silently if neither strict mode nor warnings
+#    are enabled
+# 
+
+sub die_or_warn {
+  my $self = shift;
+  my $msg  = shift;
+
+  croak $msg if($StrictMode);
+  carp "Warning: $msg" if($^W);
+}
+
+
+##############################################################################
 # Method: new_hashref()
 #
 # This is a hook routine for overriding in a sub-class.  Some people believe
@@ -2872,6 +2896,12 @@
 
 =item * 
 
+Data error - as above, but non-unique values are present in the key attribute
+(eg: more than one E<lt>partE<gt> element with the same partnum).  This will
+also trigger a warning if strict mode is not enabled.
+
+=item * 
+
 Data error - as above, but value of key attribute (eg: partnum) is not a 
 scalar string (due to nested elements etc).  This will also trigger a warning
 if strict mode is not enabled.