Update of /cvsroot/perl-xml/xml-simple/lib/XML
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29761/lib/XML
Modified Files:
Simple.pm
Log Message:
- integrate ValueAttr patch from Anton Berezin (XMLout() support still pending)
Index: Simple.pm
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/lib/XML/Simple.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- Simple.pm 2 Mar 2004 08:18:02 -0000 1.18
+++ Simple.pm 31 Mar 2004 10:07:46 -0000 1.19
@@ -53,7 +53,7 @@
@ISA = qw(Exporter);
@EXPORT = qw(XMLin XMLout);
@EXPORT_OK = qw(xml_in xml_out);
-$VERSION = '2.11';
+$VERSION = '2.12';
$PREFERRED_PARSER = undef;
my $StrictMode = 0;
@@ -66,7 +66,7 @@
my @KnownOptIn = qw(keyattr keeproot forcecontent contentkey noattr
searchpath forcearray cache suppressempty parseropts
grouptags nsexpand datahandler varattr variables
- normalisespace normalizespace);
+ normalisespace normalizespace valueattr);
my @KnownOptOut = qw(keyattr keeproot contentkey noattr
rootname xmldecl outputfile noescape suppressempty
@@ -763,6 +763,15 @@
}
+ # Special cleanup for {foldattr} which could be arrayref or hashref
+
+ if(exists($opt->{valueattr})) {
+ if(ref($opt->{valueattr}) eq 'ARRAY') {
+ $opt->{valueattrlist} = {};
+ $opt->{valueattrlist}->{$_} = 1 foreach(@{ delete $opt->{valueattr} });
+ }
+ }
+
# make sure there's nothing weird in {grouptags}
if($opt->{grouptags} and !UNIVERSAL::isa($opt->{grouptags}, 'HASH')) {
@@ -880,6 +889,16 @@
}
+ # Roll up 'value' attributes (but only if no nested elements)
+
+ if(!@_ and keys %$attr == 1) {
+ my($k) = keys %$attr;
+ if($self->{opt}->{valueattrlist} and $self->{opt}->{valueattrlist}->{$k}) {
+ return $attr->{$k};
+ }
+ }
+
+
# Add any nested elements
my($key, $val);
@@ -1008,6 +1027,19 @@
return(undef);
}
+
+ # Roll up named elements with named nested 'value' attributes
+
+ if($self->{opt}->{valueattr}) {
+ while(my($key, $val) = each(%$attr)) {
+ next unless($self->{opt}->{valueattr}->{$key});
+ next unless(UNIVERSAL::isa($val, 'HASH') and (keys %$val == 1));
+ my($k) = keys %$val;
+ next unless($k eq $self->{opt}->{valueattr}->{$key});
+ $attr->{$key} = $val->{$k};
+ }
+ }
+
return($attr)
}
@@ -2396,6 +2428,40 @@
supplied hashref, C<${name}> will be replaced with the corresponding value from
the hashref. If no matching key is found, the variable will not be replaced.
+=head2 ValueAttr => [ names ] I<# in - handy>
+
+Use this option to deal elements which always have a single attribute and no
+content. Eg:
+
+ <opt>
+ <colour value="red" />
+ <size value="XXL" />
+ </opt>
+
+Setting C<< ValueAttr => [ 'value' ] >> will cause the above XML to parse to:
+
+ {
+ colour => 'red',
+ size => 'XXL'
+ }
+
+instead of this (the default):
+
+ {
+ colour => { value => 'red' },
+ size => { value => 'XXL' }
+ }
+
+Note: This form of the ValueAttr option is not compatible with C<XMLout()> -
+since the attribute name is discarded at parse time, the original XML cannot be
+reconstructed.
+
+=head2 ValueAttr => { element => attribute, ... } I<# in+out - handy>
+
+This (preferred) form of the ValueAttr option requires you to specify both
+the element and the attribute names. This is not only safer, it also allows
+the original XML to be reconstructed by C<XMLout()>.
+
=head2 VarAttr => 'attr_name' I<# in - handy>
In addition to the variables defined using C<Variables>, this option allows
|
