Menu
▾
▴
perl-xml-commits — the list to which CVS commits go
You can subscribe to this list here.
| 2002 |
Jan
(8) |
Feb
(22) |
Mar
(3) |
Apr
(13) |
May
(1) |
Jun
(4) |
Jul
|
Aug
(5) |
Sep
(9) |
Oct
(36) |
Nov
(7) |
Dec
(15) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2003 |
Jan
(4) |
Feb
(1) |
Mar
(55) |
Apr
(25) |
May
(25) |
Jun
(4) |
Jul
(2) |
Aug
|
Sep
(12) |
Oct
(6) |
Nov
(14) |
Dec
(1) |
| 2004 |
Jan
(1) |
Feb
(8) |
Mar
(6) |
Apr
(5) |
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
(1) |
Oct
(3) |
Nov
(11) |
Dec
|
| 2005 |
Jan
(14) |
Feb
(3) |
Mar
(4) |
Apr
(14) |
May
(1) |
Jun
|
Jul
(1) |
Aug
|
Sep
(1) |
Oct
(2) |
Nov
(2) |
Dec
(1) |
| 2006 |
Jan
|
Feb
|
Mar
|
Apr
(3) |
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
(8) |
Oct
(19) |
Nov
(5) |
Dec
|
| 2007 |
Jan
(5) |
Feb
(1) |
Mar
|
Apr
(4) |
May
|
Jun
|
Jul
|
Aug
(8) |
Sep
|
Oct
|
Nov
|
Dec
|
| 2008 |
Jan
|
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
|
Jul
(1) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Christian G. <phi...@us...> - 2002-11-12 10:41:32
|
Update of /cvsroot/perl-xml/XML-LibXML-Common
In directory usw-pr-cvs1:/tmp/cvs-serv10650
Modified Files:
Common.xs Changes
Log Message:
Modified Files:
Common.xs Changes
added daisukes encoding patch
Index: Common.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-Common/Common.xs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- Common.xs 21 Oct 2002 16:43:16 -0000 1.3
+++ Common.xs 12 Nov 2002 10:41:29 -0000 1.4
@@ -58,55 +58,64 @@
realstring = SvPV(string, len);
if ( realstring != NULL ) {
/* warn("encode %s", realstring ); */
- enc = xmlParseCharEncoding( encoding );
-
- if ( enc == 0 ) {
- /* this happens if the encoding is "" or NULL */
- enc = XML_CHAR_ENCODING_UTF8;
- }
-
- if ( enc == XML_CHAR_ENCODING_UTF8 ) {
- /* copy the string */
- /* warn( "simply copy the string" ); */
- tstr = xmlStrdup( realstring );
- }
- else {
- LibXML_COMMON_error = NEWSV(0, 512);
- xmlSetGenericErrorFunc(PerlIO_stderr(),
- (xmlGenericErrorFunc)LIBXML_COMMON_error_handler);
-
-
- if ( enc > 1 ) {
- coder= xmlGetCharEncodingHandler( enc );
+#ifdef HAVE_UTF8
+ if ( !DO_UTF8(string) && encoding != NULL ) {
+#else
+ if ( encoding != NULL ) {
+#endif
+ enc = xmlParseCharEncoding( encoding );
+
+ if ( enc == 0 ) {
+ /* this happens if the encoding is "" or NULL */
+ enc = XML_CHAR_ENCODING_UTF8;
}
- else if ( enc == XML_CHAR_ENCODING_ERROR ){
- coder =xmlFindCharEncodingHandler( encoding );
+
+ if ( enc == XML_CHAR_ENCODING_UTF8 ) {
+ /* copy the string */
+ /* warn( "simply copy the string" ); */
+ tstr = xmlStrdup( realstring );
}
else {
- croak("no encoder found\n");
- }
+ LibXML_COMMON_error = NEWSV(0, 512);
+ xmlSetGenericErrorFunc(PerlIO_stderr(),
+ (xmlGenericErrorFunc)LIBXML_COMMON_error_handler);
- if ( coder == NULL ) {
- croak( "cannot encode string" );
- }
+
+ if ( enc > 1 ) {
+ coder= xmlGetCharEncodingHandler( enc );
+ }
+ else if ( enc == XML_CHAR_ENCODING_ERROR ){
+ coder =xmlFindCharEncodingHandler( encoding );
+ }
+ else {
+ croak("no encoder found\n");
+ }
+
+ if ( coder == NULL ) {
+ croak( "cannot encode string" );
+ }
- in = xmlBufferCreate();
- out = xmlBufferCreate();
- xmlBufferCCat( in, realstring );
- if ( xmlCharEncInFunc( coder, out, in ) >= 0 ) {
- tstr = xmlStrdup( out->content );
- }
+ in = xmlBufferCreate();
+ out = xmlBufferCreate();
+ xmlBufferCCat( in, realstring );
+ if ( xmlCharEncInFunc( coder, out, in ) >= 0 ) {
+ tstr = xmlStrdup( out->content );
+ }
- xmlBufferFree( in );
- xmlBufferFree( out );
- xmlCharEncCloseFunc( coder );
+ xmlBufferFree( in );
+ xmlBufferFree( out );
+ xmlCharEncCloseFunc( coder );
- sv_2mortal(LibXML_COMMON_error);
+ sv_2mortal(LibXML_COMMON_error);
- if ( SvCUR( LibXML_COMMON_error ) > 0 ) {
- croak(SvPV(LibXML_COMMON_error, len));
+ if ( SvCUR( LibXML_COMMON_error ) > 0 ) {
+ croak(SvPV(LibXML_COMMON_error, len));
+ }
}
}
+ else {
+ tstr = xmlStrdup( realstring );
+ }
if ( !tstr ) {
croak( "return value missing!" );
@@ -162,11 +171,13 @@
xmlSetGenericErrorFunc(PerlIO_stderr(),
(xmlGenericErrorFunc)LIBXML_COMMON_error_handler);
+ sv_2mortal(LibXML_COMMON_error);
+
if ( enc > 1 ) {
coder= xmlGetCharEncodingHandler( enc );
}
else if ( enc == XML_CHAR_ENCODING_ERROR ){
- coder =xmlFindCharEncodingHandler( encoding );
+ coder = xmlFindCharEncodingHandler( encoding );
}
else {
croak("no encoder found\n");
@@ -186,8 +197,6 @@
xmlBufferFree( in );
xmlBufferFree( out );
xmlCharEncCloseFunc( coder );
-
- sv_2mortal(LibXML_COMMON_error);
if ( SvCUR( LibXML_COMMON_error ) > 0 ) {
croak(SvPV(LibXML_COMMON_error, len));
Index: Changes
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-Common/Changes,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- Changes 21 Oct 2002 16:43:16 -0000 1.4
+++ Changes 12 Nov 2002 10:41:29 -0000 1.5
@@ -1,12 +1,15 @@
Revision history for Perl extension XML::LibXML::Common.
+0.12 Tue Nov 12 12:00:00 2002
+ - Encoding fix provided by Daisuke Maki
+
0.11 Sat Okt 12 21:30:00 2002
- added a disclaimer note and the license statement
0.10 Sat Aug 31 20:00:00 2002
- - implemented encoding functions
- - libxml/ libgdome conform implementation
+ - implemented encoding functions
+ - libxml/ libgdome conform implementation
0.01 Sat Aug 31 18:29:05 2002
- - original version; created by h2xs 1.21 with options
+ - original version; created by h2xs 1.21 with options
|
|
From: Christian G. <phi...@us...> - 2002-11-11 09:20:04
|
Update of /cvsroot/perl-xml/XML-LibXML-Common In directory usw-pr-cvs1:/tmp/cvs-serv22467 Modified Files: README Log Message: Modified Files: README + note that libxml2 is required Index: README =================================================================== RCS file: /cvsroot/perl-xml/XML-LibXML-Common/README,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- README 21 Oct 2002 16:43:16 -0000 1.4 +++ README 11 Nov 2002 09:20:00 -0000 1.5 @@ -7,6 +7,13 @@ This package is required at least for XML::LibXML 1.53 or later to work properly. +Of course libxml2 2.4.20 needs to be installed, to compile this package. +you can get the latest libxml2 version from + ftp://xmlsoft.org + +If this library is not installed, don't expect any XML::LibXML module to +compile. + The latest cvs can be found at sourceforge: http://sourceforge.net/projects/perl-xml |
|
From: Christian G. <phi...@us...> - 2002-11-08 09:27:12
|
Update of /cvsroot/perl-xml/XML-NodeFilter In directory usw-pr-cvs1:/tmp/cvs-serv11636 Log Message: DOM Traversal Node Filter Status: Vendor Tag: phish108 Release Tags: CPAN_0_00 N XML-NodeFilter/README N XML-NodeFilter/NodeFilter.pm N XML-NodeFilter/Makefile.PL N XML-NodeFilter/Changes N XML-NodeFilter/MANIFEST N XML-NodeFilter/test.pl N XML-NodeFilter/t/01basic.t No conflicts created by this import ***** Bogus filespec: - Imported sources |
|
From: Grant M. <gr...@us...> - 2002-11-06 08:00:11
|
Update of /cvsroot/perl-xml/xml-simple
In directory usw-pr-cvs1:/tmp/cvs-serv11169
Modified Files:
Makefile.PL
Log Message:
- fixed path to Simple.pm
- fixed email address
Index: Makefile.PL
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/Makefile.PL,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- Makefile.PL 5 Feb 2002 22:19:18 -0000 1.3
+++ Makefile.PL 6 Nov 2002 08:00:07 -0000 1.4
@@ -61,11 +61,11 @@
WriteMakefile(
'NAME' => 'XML::Simple',
- 'VERSION_FROM' => 'Simple.pm',
+ 'VERSION_FROM' => 'lib/XML/Simple.pm',
'DISTNAME' => 'XML-Simple',
'dist' => { COMPRESS => 'gzip --best', SUFFIX => 'gz' },
($] >= 5.005 ? (
- 'AUTHOR' => 'Grant McLean <gr...@we...>',
- 'ABSTRACT_FROM' => 'Simple.pm',
+ 'AUTHOR' => 'Grant McLean <gr...@cp...>',
+ 'ABSTRACT_FROM' => 'lib/XML/Simple.pm',
) : () )
);
|
|
From: Grant M. <gr...@us...> - 2002-11-06 07:57:58
|
Update of /cvsroot/perl-xml/xml-simple/t
In directory usw-pr-cvs1:/tmp/cvs-serv10138/t
Modified Files:
0_Config.t
Log Message:
- minor formatting tweak
Index: 0_Config.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/0_Config.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- 0_Config.t 16 Oct 2002 09:43:35 -0000 1.3
+++ 0_Config.t 6 Nov 2002 07:57:53 -0000 1.4
@@ -51,7 +51,7 @@
# Print details of installed modules on STDERR
-diag(sprintf("\r%-30s %s\n", 'Package', 'Version'));
+diag(sprintf("\r# %-30s %s\n", 'Package', 'Version'));
foreach my $module (@mod_list) {
$version{$module} = 'Not Installed' unless(defined($version{$module}));
$version{$module} .= " (default parser)" if($module eq $default_parser);
|
|
From: Grant M. <gr...@us...> - 2002-11-06 07:57:32
|
Update of /cvsroot/perl-xml/xml-simple In directory usw-pr-cvs1:/tmp/cvs-serv9970 Modified Files: MANIFEST Log Message: - added t/9_Strict.t Index: MANIFEST =================================================================== RCS file: /cvsroot/perl-xml/xml-simple/MANIFEST,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- MANIFEST 13 Oct 2002 01:20:14 -0000 1.5 +++ MANIFEST 6 Nov 2002 07:57:28 -0000 1.6 @@ -15,6 +15,7 @@ t/6_ObjIntf.t t/7_SaxStuff.t t/8_Namespaces.t +t/9_Strict.t t/desertnet.src t/lib/TagsToUpper.pm t/subdir/test2.xml |
|
From: Christian G. <phi...@us...> - 2002-10-21 16:43:19
|
Update of /cvsroot/perl-xml/XML-LibXML-Common
In directory usw-pr-cvs1:/tmp/cvs-serv24889
Modified Files:
Changes Common.pm Common.xs README
Log Message:
Modified Files:
Changes
+ version notes
Common.pm
+ version number updates
+ license statement
Common.xs
- potential memory leak
Makefile.PL
timestamp
README
+ license statement
Index: Changes
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-Common/Changes,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- Changes 14 Oct 2002 10:34:53 -0000 1.3
+++ Changes 21 Oct 2002 16:43:16 -0000 1.4
@@ -1,11 +1,12 @@
Revision history for Perl extension XML::LibXML::Common.
-0.01 Sat Aug 31 18:29:05 2002
- - original version; created by h2xs 1.21 with options
+0.11 Sat Okt 12 21:30:00 2002
+ - added a disclaimer note and the license statement
0.10 Sat Aug 31 20:00:00 2002
- - implemented encoding functions
+ - implemented encoding functions
- libxml/ libgdome conform implementation
-0.11 Sat Okt 12 21:30:00 2002
- - added a disclaimer note and the license statement
\ No newline at end of file
+0.01 Sat Aug 31 18:29:05 2002
+ - original version; created by h2xs 1.21 with options
+
Index: Common.pm
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-Common/Common.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- Common.pm 14 Oct 2002 10:34:53 -0000 1.2
+++ Common.pm 21 Oct 2002 16:43:16 -0000 1.3
@@ -292,6 +292,13 @@
Christian Glahn, (chr...@ui...) Innsbruck University
+=head1 COPYRIGHT
+
+(c) 2002 Christian Glahn. All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
=head1 SEE ALSO
L<perl>, L<XML::LibXML>, L<XML::GDOME>
Index: Common.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-Common/Common.xs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- Common.xs 14 Oct 2002 20:12:37 -0000 1.2
+++ Common.xs 21 Oct 2002 16:43:16 -0000 1.3
@@ -9,7 +9,7 @@
#include "ppport.h"
#include <libxml/parser.h>
-#include <libxml/tree.h>
+/* #include <libxml/tree.h> */
#ifdef __cplusplus
}
@@ -108,7 +108,7 @@
}
}
- if ( !tstr ) {b
+ if ( !tstr ) {
croak( "return value missing!" );
}
Index: README
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-Common/README,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- README 14 Oct 2002 10:34:53 -0000 1.3
+++ README 21 Oct 2002 16:43:16 -0000 1.4
@@ -19,7 +19,13 @@
christian glahn ( christian.glahn at uibk.ac.at )
-Copyright 2001-2002 University of Innsbruck, All rights reserved.
+License
+=======
+
+This is free software, you may use it and distribute it under the same
+terms as Perl itself.
+
+Copyright (c) 2002 Christian Glahn, All rights reserved.
DISCLAIMER
==========
|
|
From: Grant M. <gr...@us...> - 2002-10-17 08:56:21
|
Update of /cvsroot/perl-xml/xml-simple/lib/XML In directory usw-pr-cvs1:/tmp/cvs-serv22354/lib/XML Modified Files: Simple.pm Log Message: - POD update for stringification error in strict more Index: Simple.pm =================================================================== RCS file: /cvsroot/perl-xml/xml-simple/lib/XML/Simple.pm,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- Simple.pm 17 Oct 2002 08:44:33 -0000 1.3 +++ Simple.pm 17 Oct 2002 08:56:18 -0000 1.4 @@ -2047,6 +2047,12 @@ element). Note: if strict mode is not set but -w is, this condition triggers a warning. +=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. + =back =head1 SAX SUPPORT |
|
From: Grant M. <gr...@us...> - 2002-10-17 08:44:36
|
Update of /cvsroot/perl-xml/xml-simple/t
In directory usw-pr-cvs1:/tmp/cvs-serv18573/t
Modified Files:
1_XMLin.t 9_Strict.t
Log Message:
- fixed stringification of keyattr values (reported by Trond Michelsen)
Index: 1_XMLin.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/1_XMLin.t,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- 1_XMLin.t 17 Oct 2002 07:29:44 -0000 1.6
+++ 1_XMLin.t 17 Oct 2002 08:44:33 -0000 1.7
@@ -15,7 +15,7 @@
plan skip_all => 'Test data missing';
}
-plan tests => 64;
+plan tests => 66;
$@ = '';
@@ -315,6 +315,34 @@
};
$opt = XMLin($xml, forcearray => 1, keyattr => { 'car' => '+license', 'option' => '-pn' });
is_deeply($opt, $target, "same again but with '+' prefix to copy keys");
+
+
+# Confirm the stringifying references bug is fixed
+
+my $xml = q(
+ <opt>
+ <item>
+ <name><firstname>Bob</firstname></name>
+ <age>21</age>
+ </item>
+ <item>
+ <name><firstname>Kate</firstname></name>
+ <age>22</age>
+ </item>
+ </opt>);
+
+$target = {
+ item => [
+ { age => '21', name => { firstname => 'Bob'} },
+ { age => '22', name => { firstname => 'Kate'} },
+ ]
+};
+
+$opt = XMLin($xml);
+is_deeply($opt, $target, "did not fold on default key with non-scalar value");
+
+$opt = XMLin($xml, keyattr => { item => 'name' });
+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
Index: 9_Strict.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/9_Strict.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- 9_Strict.t 17 Oct 2002 07:29:44 -0000 1.1
+++ 9_Strict.t 17 Oct 2002 08:44:33 -0000 1.2
@@ -4,7 +4,7 @@
use strict;
use Test::More;
-plan tests => 13;
+plan tests => 15;
##############################################################################
@@ -87,6 +87,26 @@
isnt($@, '', 'key attribute missing from names element was a fatal error');
like($@, qr/<part> element has no 'partnum' key attribute/,
+ 'with the correct error message');
+
+
+# Confirm that stringification of references is trapped
+
+$xml = q(
+<opt>
+ <item>
+ <name><firstname>Bob</firstname></name>
+ <age>21</age>
+ </item>
+</opt>
+);
+
+eval {
+ $opt = XMLin($xml, keyattr => { item => 'name' }, forcearray => ['item']);
+};
+
+isnt($@, '', 'key attribute not a scalar was a fatal error');
+like($@, qr/<item> element has non-scalar 'name' key attribute/,
'with the correct error message');
exit(0);
|
|
From: Grant M. <gr...@us...> - 2002-10-17 08:44:36
|
Update of /cvsroot/perl-xml/xml-simple/lib/XML
In directory usw-pr-cvs1:/tmp/cvs-serv18573/lib/XML
Modified Files:
Simple.pm
Log Message:
- fixed stringification of keyattr values (reported by Trond Michelsen)
Index: Simple.pm
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/lib/XML/Simple.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- Simple.pm 17 Oct 2002 07:29:45 -0000 1.2
+++ Simple.pm 17 Oct 2002 08:44:33 -0000 1.3
@@ -934,6 +934,15 @@
for($i = 0; $i < @$arrayref; $i++) {
if(ref($arrayref->[$i]) eq 'HASH' and exists($arrayref->[$i]->{$key})) {
$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";
+ }
+ return($arrayref);
+ }
$hashref->{$val} = { %{$arrayref->[$i]} };
$hashref->{$val}->{"-$key"} = $hashref->{$val}->{$key} if($flag eq '-');
delete $hashref->{$val}->{$key} unless($flag eq '+');
@@ -956,6 +965,7 @@
foreach $key (@{$self->{opt}->{keyattr}}) {
if(defined($arrayref->[$i]->{$key})) {
$val = $arrayref->[$i]->{$key};
+ return($arrayref) if(ref($val));
$hashref->{$val} = { %{$arrayref->[$i]} };
delete $hashref->{$val}->{$key};
next ELEMENT;
|
|
From: Grant M. <gr...@us...> - 2002-10-17 07:29:50
|
Update of /cvsroot/perl-xml/xml-simple/lib/XML
In directory usw-pr-cvs1:/tmp/cvs-serv26769/lib/XML
Modified Files:
Simple.pm
Log Message:
- added 'strict mode' and bumped version to 2.00
Index: Simple.pm
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/lib/XML/Simple.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- Simple.pm 13 Oct 2002 01:16:31 -0000 1.1
+++ Simple.pm 17 Oct 2002 07:29:45 -0000 1.2
@@ -24,6 +24,10 @@
my $xml = $xs->XMLout($hashref [, <options>]);
+Or to catch common errors:
+
+ use XML::Simple qw(:strict);
+
(or see L<"SAX SUPPORT"> for 'the SAX way').
=cut
@@ -46,9 +50,10 @@
@ISA = qw(Exporter);
@EXPORT = qw(XMLin XMLout);
-$VERSION = '1.08_01';
+$VERSION = '2.00';
$PREFERRED_PARSER = undef;
+my $StrictMode = 0;
my %CacheScheme = (
storable => [ \&StorableSave, \&StorableRestore ],
memshare => [ \&MemShareSave, \&MemShareRestore ],
@@ -79,6 +84,22 @@
##############################################################################
+# Wrapper for Exporter - handles ':strict'
+#
+
+sub import {
+
+ # Handle the :strict tag
+
+ $StrictMode = 1 if grep(/^:strict$/, @_);
+
+ # Pass everything else to Exporter.pm
+
+ __PACKAGE__->export_to_level(1, grep(!/^:strict$/, @_));
+}
+
+
+##############################################################################
# Constructor for optional object interface.
#
@@ -625,6 +646,32 @@
$opt->{parseropts} = [ ];
}
+
+ # Special cleanup for {forcearray} which could be arrayref or boolean
+ # or left to default to 0
+
+ if(exists($opt->{forcearray})) {
+ if(ref($opt->{forcearray}) eq 'ARRAY') {
+ if(@{$opt->{forcearray}}) {
+ $opt->{forcearray} = { (
+ map { $_ => 1 } @{$opt->{forcearray}}
+ ) };
+ }
+ else {
+ $opt->{forcearray} = 0;
+ }
+ }
+ else {
+ $opt->{forcearray} = ( $opt->{forcearray} ? 1 : 0 );
+ }
+ }
+ else {
+ if($StrictMode) {
+ croak "No value specified for 'forcearray' option in call to XML$dirn()";
+ }
+ $opt->{forcearray} = 0;
+ }
+
# Special cleanup for {keyattr} which could be arrayref or hashref or left
# to default to arrayref
@@ -641,12 +688,18 @@
# Convert keyattr => { elem => '+attr' }
# to keyattr => { elem => [ 'attr', '+' ] }
- foreach (keys(%{$opt->{keyattr}})) {
- if($opt->{keyattr}->{$_} =~ /^(\+|-)?(.*)$/) {
- $opt->{keyattr}->{$_} = [ $2, ($1 ? $1 : '') ];
+ foreach my $el (keys(%{$opt->{keyattr}})) {
+ if($opt->{keyattr}->{$el} =~ /^(\+|-)?(.*)$/) {
+ $opt->{keyattr}->{$el} = [ $2, ($1 ? $1 : '') ];
+ if($StrictMode) {
+ next if($opt->{forcearray} == 1);
+ next if(ref($opt->{forcearray}) eq 'HASH'
+ and $opt->{forcearray}->{$el});
+ croak "<$el> set in keyattr but not in forcearray";
+ }
}
else {
- delete($opt->{keyattr}->{$_}); # Never reached (famous last words?)
+ delete($opt->{keyattr}->{$el}); # Never reached (famous last words?)
}
}
}
@@ -661,30 +714,10 @@
}
}
else {
- $opt->{keyattr} = [ @DefKeyAttr ];
- }
-
-
- # Special cleanup for {forcearray} which could be arrayref or boolean
- # or left to default to 0
-
- if(exists($opt->{forcearray})) {
- if(ref($opt->{forcearray}) eq 'ARRAY') {
- if(@{$opt->{forcearray}}) {
- $opt->{forcearray} = { (
- map { $_ => 1 } @{$opt->{forcearray}}
- ) };
- }
- else {
- $opt->{forcearray} = 0;
- }
- }
- else {
- $opt->{forcearray} = ( $opt->{forcearray} ? 1 : 0 );
+ if($StrictMode) {
+ croak "No value specified for 'keyattr' option in call to XML$dirn()";
}
- }
- else {
- $opt->{forcearray} = 0;
+ $opt->{keyattr} = [ @DefKeyAttr ];
}
@@ -906,6 +939,7 @@
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);
return($arrayref);
}
@@ -1504,6 +1538,9 @@
the same options, you might like to investigate L<"OPTIONAL OO INTERFACE">
below.
+If you can't be bothered reading the documentation, refer to
+L<"STRICT MODE"> to automatically catch common mistakes.
+
Because there are so many options, it's hard for new users to know which ones
are important, so here are the two you really need to know about:
@@ -1778,10 +1815,10 @@
any package elements to be folded on the 'id' attribute. No other elements
which have an 'id' attribute will be folded at all.
-Note: C<XMLin()> will generate a warning if this syntax is used and an element
-which does not have the specified key attribute is encountered (eg: a 'package'
-element without an 'id' attribute, to use the example above). Warnings will
-only be generated if B<-w> is in force.
+Note: C<XMLin()> will generate a warning (or a fatal error in L<"STRICT MODE">)
+if this syntax is used and an element which does not have the specified key
+attribute is encountered (eg: a 'package' element without an 'id' attribute, to
+use the example above). Warnings will only be generated if B<-w> is in force.
Two further variations are made possible by prefixing a '+' or a '-' character
to the attribute name:
@@ -1968,6 +2005,40 @@
escape_value method) or for building the initial parse tree (the build_tree
method).
+=head1 STRICT MODE
+
+If you import the B<XML::Simple> routines like this:
+
+ use XML::Simple qw(:strict);
+
+the following common mistakes will be detected and treated as fatal errors
+
+=over 4
+
+=item *
+
+Failing to explicitly set the keyattr option - if you can't be bothered reading
+about this option, turn it off with: keyattr => []
+
+=item *
+
+Failing to explicitly set the forcearray option - if you can't be bothered
+reading about this option, set it to the safest mode with: forcearray => 1
+
+=item *
+
+Setting forcearray to an array, but failing to list all the elements from the
+keyattr hash.
+
+=item *
+
+Data error - keyattr is set to say { part => 'partnum' } but the XML contains
+one or more E<lt>partE<gt> elements without a 'partnum' attribute (or nested
+element). Note: if strict mode is not set but -w is, this condition triggers a
+warning.
+
+=back
+
=head1 SAX SUPPORT
From version 1.08_01, B<XML::Simple> includes support for SAX (the Simple API
@@ -2090,35 +2161,35 @@
=item *
If the 'preferred parser' is set to the string 'XML::Parser', then
-B<XML::Parser> will be used (or C<XMLin()> will die if B<XML::Parser> is not
+L<XML::Parser> will be used (or C<XMLin()> will die if L<XML::Parser> is not
installed).
=item *
If the 'preferred parser' is set to some other value, then it is assumed to be
-the name of a SAX parser module and is passed to B<XML::SAX::ParserFactory.>
-If B<XML::SAX> is not installed, or the requested parser module is not
+the name of a SAX parser module and is passed to L<XML::SAX::ParserFactory.>
+If L<XML::SAX> is not installed, or the requested parser module is not
installed, then C<XMLin()> will die.
=item *
If the 'preferred parser' is not defined at all (the normal default
-state), an attempt will be made to load B<XML::SAX>. If B<XML::SAX> is
+state), an attempt will be made to load L<XML::SAX>. If L<XML::SAX> is
installed, then a parser module will be selected according to
-B<XML::SAX::ParserFactory>'s normal rules (which typically means the last SAX
+L<XML::SAX::ParserFactory>'s normal rules (which typically means the last SAX
parser installed).
=item *
if the 'preferred parser' is not defined and B<XML::SAX> is not
installed, then B<XML::Parser> will be used. C<XMLin()> will die if
-B<XML::Parser> is not installed.
+L<XML::Parser> is not installed.
=back
Note: The B<XML::SAX> distribution includes an XML parser written entirely in
Perl. It is very portable but it is not very fast. You should consider
-installing B<XML::LibXML> or B<XML::SAX::Expat> if they are available for your
+installing L<XML::LibXML> or L<XML::SAX::Expat> if they are available for your
platform.
=head1 ERROR HANDLING
@@ -2315,21 +2386,21 @@
XML::Parser's handler API - it is obselete).
For tree-based parsing, you could choose between the 'Perlish' approach of
-XML::Twig and more standards based DOM implementations - preferably one with
+L<XML::Twig> and more standards based DOM implementations - preferably one with
XPath support.
=head1 STATUS
-This version (1.09) is the current stable version.
+This version (2.00) is the current stable version.
=head1 SEE ALSO
-B<XML::Simple> requires either B<XML::Parser> or B<XML::SAX>.
+B<XML::Simple> requires either L<XML::Parser> or L<XML::SAX>.
-To generate documents with namespaces, B<XML::NamespaceSupport> is required.
+To generate documents with namespaces, L<XML::NamespaceSupport> is required.
-The optional caching functions require B<Storable>.
+The optional caching functions require L<Storable>.
=head1 COPYRIGHT
|
|
From: Grant M. <gr...@us...> - 2002-10-17 07:29:50
|
Update of /cvsroot/perl-xml/xml-simple/t
In directory usw-pr-cvs1:/tmp/cvs-serv26769/t
Modified Files:
1_XMLin.t
Added Files:
9_Strict.t
Log Message:
- added 'strict mode' and bumped version to 2.00
--- NEW FILE: 9_Strict.t ---
# $Id: 9_Strict.t,v 1.1 2002/10/17 07:29:44 grantm Exp $
# vim: syntax=perl
use strict;
use Test::More;
plan tests => 13;
##############################################################################
# T E S T R O U T I N E S
##############################################################################
eval "use XML::Simple qw(:strict);";
ok(!$@, 'XML::Simple loads ok with qw(:strict)');
# Check that the basic functionality still works
my $xml = q(<opt name1="value1" name2="value2"></opt>);
$@ = '';
my $opt = eval {
XMLin($xml, forcearray => 1, keyattr => {});
};
is($@, '', 'XMLin() did not fail');
my $keys = join(' ', sort keys %$opt);
is($keys, 'name1 name2', 'and managed to produce the expected results');
# Confirm that forcearray cannot be omitted
eval {
$opt = XMLin($xml, keyattr => {});
};
isnt($@, '', 'omitting forcearray was a fatal error');
like($@, qr/No value specified for 'forcearray'/,
'with the correct error message');
# Confirm that keyattr cannot be omitted
eval {
$opt = XMLin($xml, forcearray => []);
};
isnt($@, '', 'omitting keyattr was a fatal error');
like($@, qr/No value specified for 'keyattr'/,
'with the correct error message');
# Confirm that element names from keyattr cannot be omitted from forcearray
eval {
$opt = XMLin($xml, keyattr => { part => 'partnum' }, forcearray => 0);
};
isnt($@, '', 'omitting forcearray for elements in keyattr was a fatal error');
like($@, qr/<part> set in keyattr but not in forcearray/,
'with the correct error message');
eval {
$opt = XMLin($xml, keyattr => { part => 'partnum' }, forcearray => ['x','y']);
};
isnt($@, '', 'omitting keyattr elements from forcearray was a fatal error');
like($@, qr/<part> set in keyattr but not in forcearray/,
'with the correct error message');
# Confirm that missing key attributes are detected
$xml = q(
<opt>
<part partnum="12345" desc="Thingy" />
<part partnum="67890" desc="Wotsit" />
<part desc="Fnurgle" />
</opt>
);
eval {
$opt = XMLin($xml, keyattr => { part => 'partnum' }, forcearray => 1);
};
isnt($@, '', 'key attribute missing from names element was a fatal error');
like($@, qr/<part> element has no 'partnum' key attribute/,
'with the correct error message');
exit(0);
Index: 1_XMLin.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/1_XMLin.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- 1_XMLin.t 16 Oct 2002 09:43:35 -0000 1.5
+++ 1_XMLin.t 17 Oct 2002 07:29:44 -0000 1.6
@@ -21,8 +21,8 @@
$@ = '';
eval "use XML::Simple;";
is($@, '', 'Module compiled OK');
-unless($XML::Simple::VERSION eq '1.08_01') {
- diag("Warning: XML::Simple::VERSION = $XML::Simple::VERSION (expected 1.08_01)");
+unless($XML::Simple::VERSION eq '2.00') {
+ diag("Warning: XML::Simple::VERSION = $XML::Simple::VERSION (expected 2.00)");
}
|
Update of /cvsroot/perl-xml/xml-simple/t
In directory usw-pr-cvs1:/tmp/cvs-serv21017/t
Modified Files:
0_Config.t 1_XMLin.t 2_XMLout.t 3_Storable.t 4_MemShare.t
5_MemCopy.t 6_ObjIntf.t 7_SaxStuff.t 8_Namespaces.t
Log Message:
- ported tests scripts to Test::More for improved diagnostics
Index: 0_Config.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/0_Config.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- 0_Config.t 5 Feb 2002 22:28:31 -0000 1.2
+++ 0_Config.t 16 Oct 2002 09:43:35 -0000 1.3
@@ -1,9 +1,8 @@
# $Id$
-
-BEGIN { print "1..1\n"; }
+# vim: syntax=perl
use strict;
-use File::Spec;
+use Test::More tests => 1;
# Build up a list of installed modules
@@ -52,14 +51,14 @@
# Print details of installed modules on STDERR
-printf STDERR "\r%-30s %s\n", 'Package', 'Version';
+diag(sprintf("\r%-30s %s\n", 'Package', 'Version'));
foreach my $module (@mod_list) {
$version{$module} = 'Not Installed' unless(defined($version{$module}));
$version{$module} .= " (default parser)" if($module eq $default_parser);
$version{$module} .= " (preferred parser)" if($module eq $preferred_parser);
- printf STDERR " %-30s %s\n", $module, $version{$module};
+ diag(sprintf(" %-30s %s\n", $module, $version{$module}));
}
# Housekeeping
-print "ok 1\n";
+ok(1, "Dumped config");
Index: 1_XMLin.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/1_XMLin.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- 1_XMLin.t 14 Feb 2002 21:37:05 -0000 1.4
+++ 1_XMLin.t 16 Oct 2002 09:43:35 -0000 1.5
@@ -1,116 +1,28 @@
# $Id$
+# vim: syntax=perl
use strict;
+use Test::More;
use IO::File;
use File::Spec;
+
# Initialise filenames and check they're there
my $XMLFile = File::Spec->catfile('t', 'test1.xml'); # t/test1.xml
unless(-e $XMLFile) {
- print STDERR "test data missing...";
- print "1..0\n";
- exit 0;
-}
-
-
-print "1..63\n";
-
-my $t = 1;
-
-##############################################################################
-# S U P P O R T R O U T I N E S
-##############################################################################
-
-##############################################################################
-# Print out 'n ok' or 'n not ok' as expected by test harness.
-# First arg is test number (n). If only one following arg, it is interpreted
-# as true/false value. If two args, equality = true.
-#
-
-sub ok {
- my($n, $x, $y) = @_;
- die "Sequence error got $n expected $t" if($n != $t);
- $x = 0 if(@_ > 2 and $x ne $y);
- print(($x ? '' : 'not '), 'ok ', $t++, "\n");
-}
-
-
-##############################################################################
-# Take two scalar values (may be references) and compare them (recursively
-# if necessary) returning 1 if same, 0 if different.
-#
-
-sub DataCompare {
- my($x, $y) = @_;
-
- my($i);
-
- if(!defined($x)) {
- return(1) if(!defined($y));
- print STDERR "$t:DataCompare: undef != $y\n";
- return(0);
- }
-
-
- if(!ref($x)) {
- return(1) if($x eq $y);
- print STDERR "$t:DataCompare: $x != $y\n";
- return(0);
- }
-
- if(ref($x) eq 'ARRAY') {
- unless(ref($y) eq 'ARRAY') {
- print STDERR "$t:DataCompare: expected arrayref, got: $y\n";
- return(0);
- }
- if(scalar(@$x) != scalar(@$y)) {
- print STDERR "$t:DataCompare: expected ", scalar(@$x),
- " element(s), got: ", scalar(@$y), "\n";
- return(0);
- }
- for($i = 0; $i < scalar(@$x); $i++) {
- DataCompare($x->[$i], $y->[$i]) || return(0);
- }
- return(1);
- }
-
- if(ref($x) eq 'HASH') {
- unless(ref($y) eq 'HASH') {
- print STDERR "$t:DataCompare: expected hashref, got: $y\n";
- return(0);
- }
- if(scalar(keys(%$x)) != scalar(keys(%$y))) {
- print STDERR "$t:DataCompare: expected ", scalar(keys(%$x)),
- " key(s), (", join(', ', keys(%$x)),
- ") got: ", scalar(keys(%$y)), " (", join(', ', keys(%$y)),
- ")\n";
- return(0);
- }
- foreach $i (keys(%$x)) {
- unless(exists($y->{$i})) {
- print STDERR "$t:DataCompare: missing hash key - {$i}\n";
- return(0);
- }
- DataCompare($x->{$i}, $y->{$i}) || return(0);
- }
- return(1);
- }
-
- print STDERR "Don't know how to compare: " . ref($x) . "\n";
- return(0);
+ plan skip_all => 'Test data missing';
}
+plan tests => 64;
-##############################################################################
-# T E S T R O U T I N E S
-##############################################################################
+$@ = '';
eval "use XML::Simple;";
-ok(1, !$@); # Module compiled OK
+is($@, '', 'Module compiled OK');
unless($XML::Simple::VERSION eq '1.08_01') {
- print STDERR "Warning: XML::Simple::VERSION = $XML::Simple::VERSION (expected 1.08_01)...";
+ diag("Warning: XML::Simple::VERSION = $XML::Simple::VERSION (expected 1.08_01)");
}
@@ -123,10 +35,10 @@
name2 => 'value2',
};
-ok(2, 1); # XMLin() didn't crash
-ok(3, defined($opt)); # and it returned a value
-ok(4, ref($opt) eq 'HASH'); # and a hasref at that
-ok(5, DataCompare($opt, $expected));
+ok(1, "XMLin() didn't crash");
+ok(defined($opt), 'and it returned a value');
+is(ref($opt), 'HASH', 'and a hasref at that');
+is_deeply($opt, $expected, 'matches expectations (attributes)');
# Now try a slightly more complex one that returns the same value
@@ -137,7 +49,7 @@
<name2>value2</name2>
</opt>
));
-ok(6, DataCompare($opt, $expected));
+is_deeply($opt, $expected, 'same again with nested elements');
# And something else that returns the same (line break included to pick up
@@ -145,7 +57,7 @@
$opt = XMLin(q(<opt name1="value1"
name2="value2" />));
-ok(7, DataCompare($opt, $expected));
+is_deeply($opt, $expected, 'attributes in empty element');
# Try something with two lists of nested values
@@ -161,10 +73,10 @@
</opt>)
);
-ok(8, DataCompare($opt, {
+is_deeply($opt, {
name1 => [ 'value1.1', 'value1.2', 'value1.3' ],
name2 => [ 'value2.1', 'value2.2', 'value2.3' ],
-}));
+}, 'repeated child elements give arrays of scalars');
# Now a simple nested hash
@@ -175,9 +87,9 @@
</opt>)
);
-ok(9, DataCompare($opt, {
+is_deeply($opt, {
item => { name1 => 'value1', name2 => 'value2' }
-}));
+}, 'nested element gives hash');
# Now a list of nested hashes
@@ -188,12 +100,12 @@
<item name1="value3" name2="value4" />
</opt>)
);
-ok(10, DataCompare($opt, {
+is_deeply($opt, {
item => [
{ name1 => 'value1', name2 => 'value2' },
{ name1 => 'value3', name2 => 'value4' }
]
-}));
+}, 'repeated child elements give list of hashes');
# Now a list of nested hashes transformed into a hash using default key names
@@ -211,7 +123,7 @@
}
};
$opt = XMLin($string);
-ok(11, DataCompare($opt, $target));
+is_deeply($opt, $target, "array folded on default key 'name'");
# Same thing left as an array by suppressing default key names
@@ -223,13 +135,13 @@
]
};
$opt = XMLin($string, keyattr => [] );
-ok(12, DataCompare($opt, $target));
+is_deeply($opt, $target, 'not folded when keyattr turned off');
# Same again with alternative key suppression
$opt = XMLin($string, keyattr => {} );
-ok(13, DataCompare($opt, $target));
+is_deeply($opt, $target, 'still works when keyattr is empty hash');
# Try the other two default key attribute names
@@ -240,12 +152,12 @@
<item key="item2" attr1="value3" attr2="value4" />
</opt>
));
-ok(14, DataCompare($opt, {
+is_deeply($opt, {
item => {
item1 => { attr1 => 'value1', attr2 => 'value2' },
item2 => { attr1 => 'value3', attr2 => 'value4' }
}
-}));
+}, "folded on default key 'key'");
$opt = XMLin(q(
@@ -254,12 +166,12 @@
<item id="item2" attr1="value3" attr2="value4" />
</opt>
));
-ok(15, DataCompare($opt, {
+is_deeply($opt, {
item => {
item1 => { attr1 => 'value1', attr2 => 'value2' },
item2 => { attr1 => 'value3', attr2 => 'value4' }
}
-}));
+}, "folded on default key 'id'");
# Similar thing using non-standard key names
@@ -278,25 +190,25 @@
};
$opt = XMLin($xml, keyattr => [qw(xname)]);
-ok(16, DataCompare($opt, $target));
+is_deeply($opt, $target, "folded on non-default key 'xname'");
# And with precise element/key specification
$opt = XMLin($xml, keyattr => { 'item' => 'xname' });
-ok(17, DataCompare($opt, $target));
+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)]);
-ok(18, DataCompare($opt, $target));
+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));
-ok(19, DataCompare($opt, $target));
+is_deeply($opt, $target, 'keyattr as scalar');
# Weird variation, not exactly what we wanted but it is what we expected
@@ -318,7 +230,7 @@
};
$opt = XMLin($xml);
-ok(20, DataCompare($opt, $target));
+is_deeply($opt, $target, 'fold same array on two different keys');
# Or somewhat more as one might expect
@@ -330,7 +242,7 @@
}
};
$opt = XMLin($xml, keyattr => { 'item' => 'id' });
-ok(21, DataCompare($opt, $target));
+is_deeply($opt, $target, 'same again but with priority switch');
# Now a somewhat more complex test of targetting folding
@@ -370,7 +282,7 @@
};
$opt = XMLin($xml, forcearray => 1, keyattr => { 'car' => 'license', 'option' => 'pn' });
-ok(22, DataCompare($opt, $target));
+is_deeply($opt, $target, 'folded on multi-key keyattr hash');
# Now try leaving the keys in place
@@ -402,7 +314,7 @@
}
};
$opt = XMLin($xml, forcearray => 1, keyattr => { 'car' => '+license', 'option' => '-pn' });
-ok(23, DataCompare($opt, $target));
+is_deeply($opt, $target, "same again but with '+' prefix to copy keys");
# Make sure that the root element name is preserved if we ask for it
@@ -413,85 +325,96 @@
$opt = XMLin( $xml, forcearray => 1, keeproot => 1,
keyattr => { 'car' => '+license', 'option' => '-pn' });
-ok(24, DataCompare($opt, $target));
+is_deeply($opt, $target, 'keeproot option works');
# confirm that CDATA sections parse correctly
$xml = q{<opt><cdata><![CDATA[<greeting>Hello, world!</greeting>]]></cdata></opt>};
$opt = XMLin($xml);
-ok(25, DataCompare($opt, {
+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);
-ok(26, DataCompare($opt, {
+is_deeply($opt, {
'x' => '<y>one</y><y>two</y>'
-}));
+}, 'CDATA section containing markup characters parsed correctly');
# Try parsing a named external file
+$@ = '';
$opt = eval{ XMLin($XMLFile); };
-ok(27, !$@); # XMLin didn't die
-print STDERR $@ if($@);
-ok(28, DataCompare($opt, {
+is($@, '', "XMLin didn't choke on named external file");
+is_deeply($opt, {
location => 't/test1.xml'
-}));
+}, 'and contents parsed as expected');
# Try parsing default external file (scriptname.xml in script directory)
+$@ = '';
$opt = eval { XMLin(); };
-print STDERR $@ if($@);
-ok(29, !$@); # XMLin didn't die
-ok(30, DataCompare($opt, {
+is($@, '', "XMLin didn't choke on un-named (default) external file");
+is_deeply($opt, {
location => 't/1_XMLin.xml'
-}));
+}, 'and contents parsed as expected');
# Try parsing named file in a directory in the searchpath
+$@ = '';
$opt = eval {
XMLin('test2.xml', searchpath => [
'dir1', 'dir2', File::Spec->catdir('t', 'subdir')
] );
};
-print STDERR $@ if($@);
-ok(31, !$@); # XMLin didn't die
-ok(32, DataCompare($opt, { location => 't/subdir/test2.xml' }));
+is($@, '', 'XMLin found file using searchpath');
+is_deeply($opt, {
+ location => 't/subdir/test2.xml'
+}, 'and contents parsed as expected');
# Ensure we get expected result if file does not exist
+$@ = '';
+$opt = undef;
$opt = eval {
XMLin('bogusfile.xml', searchpath => [qw(. ./t)] ); # should 'die'
};
-ok(33, !defined($opt)); # XMLin failed
-ok(34, $@ =~ /Could not find bogusfile.xml in/); # with the expected message
+is($opt, undef, 'XMLin choked on nonexistant file');
+like($@, qr/Could not find bogusfile.xml in/, 'with the expected message');
# Try parsing from an IO::Handle
+$@ = '';
my $fh = new IO::File;
$XMLFile = File::Spec->catfile('t', '1_XMLin.xml'); # t/1_XMLin.xml
-$fh->open($XMLFile) || die "$!";
-$opt = XMLin($fh);
-ok(35, 1); # XMLin didn't die
-ok(36, $opt->{location}, 't/1_XMLin.xml'); # and it parsed the right file
+eval {
+ $fh->open($XMLFile) || die "$!";
+ $opt = XMLin($fh);
+};
+is($@, '', "XMLin didn't choke on an IO::File object");
+is($opt->{location}, 't/1_XMLin.xml', 'and it parsed the right file');
# Try parsing from STDIN
close(STDIN);
-open(STDIN, $XMLFile) || die "$!";
-$opt = XMLin('-');
-ok(37, $opt->{location}, 't/1_XMLin.xml'); # parsed the right file
+$@ = '';
+eval {
+ open(STDIN, $XMLFile) || die "$!";
+ $opt = XMLin('-');
+};
+is($@, '', "XMLin didn't choke on STDIN ('-')");
+is($opt->{location}, 't/1_XMLin.xml', 'and data parsed correctly');
-# Confirm anonymous array folding works in general
+# Confirm anonymous array handling works in general
$opt = XMLin(q(
<opt>
@@ -506,16 +429,16 @@
</row>
</opt>
));
-ok(38, DataCompare($opt, {
+is_deeply($opt, {
row => [
[ '0.0', '0.1', '0.2' ],
[ '1.0', '1.1', '1.2' ],
[ '2.0', '2.1', '2.2' ]
]
-}));
+}, 'anonymous arrays parsed correctly');
-# Confirm anonymous array folding works in special top level case
+# Confirm anonymous array handling works in special top level case
$opt = XMLin(q{
<opt>
@@ -524,9 +447,9 @@
<anon>three</anon>
</opt>
});
-ok(39, DataCompare($opt, [
+is_deeply($opt, [
qw(one two three)
-]));
+], 'top level anonymous array returned arrayref');
$opt = XMLin(q(
@@ -541,12 +464,12 @@
</anon>
</opt>
));
-ok(40, DataCompare($opt, [
+is_deeply($opt, [
1,
[
'2.1', [ '2.2.1', '2.2.2']
]
-]));
+], 'nested anonymous arrays parsed correctly');
# Check for the dreaded 'content' attribute
@@ -558,23 +481,23 @@
);
$opt = XMLin($xml);
-ok(41, DataCompare($opt, {
+is_deeply($opt, {
item => {
content => 'text',
attr => 'value'
}
-}));
+}, "'content' key appears as expected");
# And check that we can change its name if required
$opt = XMLin($xml, contentkey => 'text_content');
-ok(42, DataCompare($opt, {
+is_deeply($opt, {
item => {
text_content => 'text',
attr => 'value'
}
-}));
+}, "'content' key successfully renamed to 'text'");
# Check that it doesn't get screwed up by forcearray option
@@ -582,40 +505,40 @@
$xml = q(<opt attr="value">text content</opt>);
$opt = XMLin($xml, forcearray => 1);
-ok(43, DataCompare($opt, {
- 'attr' => 'value',
+is_deeply($opt, {
+ 'attr' => 'value',
'content' => 'text content'
-}));
+}, "'content' key not munged by forcearray");
# Test that we can force all text content to parse to hash values
$xml = q(<opt><x>text1</x><y a="2">text2</y></opt>);
$opt = XMLin($xml, forcecontent => 1);
-ok(44, DataCompare($opt, {
+is_deeply($opt, {
'x' => { 'content' => 'text1' },
'y' => { 'a' => 2, 'content' => 'text2' }
-}));
+}, 'gratuitous use of content key works as expected');
# And that this is compatible with changing the key name
$opt = XMLin($xml, forcecontent => 1, contentkey => '0');
-ok(45, DataCompare($opt, {
+is_deeply($opt, {
'x' => { 0 => 'text1' },
'y' => { 'a' => 2, 0 => 'text2' }
-}));
+}, "even when we change it's name to 'text'");
# Check that mixed content parses in the weird way we expect
$xml = q(<p class="mixed">Text with a <b>bold</b> word</p>);
-ok(46, DataCompare(XMLin($xml), {
+is_deeply(XMLin($xml), {
'class' => 'mixed',
'content' => [ 'Text with a ', ' word' ],
'b' => 'bold'
-}));
+}, "mixed content doesn't work - no surprises there");
# Confirm single nested element rolls up into a scalar attribute value
@@ -626,17 +549,17 @@
</opt>
);
$opt = XMLin($string);
-ok(47, DataCompare($opt, {
+is_deeply($opt, {
name => 'value'
-}));
+}, 'nested element rolls up to scalar');
# Unless 'forcearray' option is specified
$opt = XMLin($string, forcearray => 1);
-ok(48, DataCompare($opt, {
+is_deeply($opt, {
name => [ 'value' ]
-}));
+}, 'except when forcearray is enabled');
# Confirm array folding of single nested hash
@@ -646,17 +569,17 @@
</opt>);
$opt = XMLin($string, forcearray => 1);
-ok(49, DataCompare($opt, {
+is_deeply($opt, {
'inner' => { 'one' => { 'value' => 1 } }
-}));
+}, 'array folding works with single nested hash');
# But not without forcearray option specified
$opt = XMLin($string, forcearray => 0);
-ok(50, DataCompare($opt, {
+is_deeply($opt, {
'inner' => { 'name' => 'one', 'value' => 1 }
-}));
+}, 'but not if forcearray is turned off');
# Test advanced features of forcearray
@@ -671,12 +594,12 @@
);
$opt = XMLin($xml, forcearray => [ 'two' ]);
-ok(51, DataCompare($opt, {
+is_deeply($opt, {
'zero' => '0',
'one' => 'i',
'two' => [ 'ii' ],
'three' => [ 'iii', 3, 'c' ]
-}));
+}, 'selective application of forcearray successful');
# Test 'noattr' option
@@ -687,7 +610,7 @@
);
$opt = XMLin($xml, noattr => 1);
-ok(52, DataCompare($opt, { nest => 'text' }));
+is_deeply($opt, { nest => 'text' }, 'attributes successfully skipped');
# And make sure it doesn't screw up array folding
@@ -701,13 +624,13 @@
$opt = XMLin($xml, noattr => 1);
-ok(53, DataCompare($opt, {
+is_deeply($opt, {
'item' => {
'a' => { 'value' => 'alpha' },
'b' => { 'value' => 'beta' },
'g' => { 'value' => 'gamma' }
}
-}));
+}, 'noattr does not intefere with array folding');
# Confirm empty elements parse to empty hashrefs
@@ -721,42 +644,42 @@
</body>);
$opt = XMLin($xml, noattr => 1);
-ok(54, DataCompare($opt, {
+is_deeply($opt, {
'name' => 'bob',
'outer' => {
'inner1' => {},
'inner2' => {}
}
-}));
+}, 'empty elements parse to hashrefs');
# Unless 'suppressempty' is enabled
$opt = XMLin($xml, noattr => 1, suppressempty => 1);
-ok(55, DataCompare($opt, { 'name' => 'bob', }));
+is_deeply($opt, { 'name' => 'bob', }, 'or are suppressed');
# Check behaviour when 'suppressempty' is set to to undef;
$opt = XMLin($xml, noattr => 1, suppressempty => undef);
-ok(56, DataCompare($opt, {
+is_deeply($opt, {
'name' => 'bob',
'outer' => {
'inner1' => undef,
'inner2' => undef
}
-}));
+}, "or parse to 'undef'");
# Check behaviour when 'suppressempty' is set to to empty string;
$opt = XMLin($xml, noattr => 1, suppressempty => '');
-ok(57, DataCompare($opt, {
+is_deeply($opt, {
'name' => 'bob',
'outer' => {
'inner1' => '',
'inner2' => ''
}
-}));
+}, 'or parse to an empty string');
# Confirm completely empty XML parses to undef with 'suppressempty'
@@ -768,18 +691,21 @@
</body>);
$opt = XMLin($xml, noattr => 1, suppressempty => 1);
-ok(58, DataCompare($opt, undef));
+is($opt, undef, 'empty document parses to undef');
# Test option error handling
+$@='';
$_ = eval { XMLin('<x y="z" />', rootname => 'fred') }; # not valid for XMLin()
-ok(59, !defined($_));
-ok(60, $@ =~ /Unrecognised option:/);
+is($_, undef, 'invalid options are trapped');
+like($@, qr/Unrecognised option:/, 'with correct error message');
+$@='';
$_ = eval { XMLin('<x y="z" />', 'searchpath') };
-ok(61, !defined($_));
-ok(62, $@ =~ /Options must be name=>value pairs .odd number supplied./);
+is($_, undef, 'invalid number of options are trapped');
+like($@, qr/Options must be name=>value pairs \(odd number supplied\)/,
+'with correct error message');
# Now for a 'real world' test, try slurping in an SRT config file
@@ -868,7 +794,7 @@
}
}
};
-ok(63, DataCompare($target, $opt));
+is_deeply($target, $opt, 'successfully read an SRT config file');
exit(0);
Index: 2_XMLout.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/2_XMLout.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- 2_XMLout.t 5 Feb 2002 22:28:31 -0000 1.3
+++ 2_XMLout.t 16 Oct 2002 09:43:35 -0000 1.4
@@ -1,89 +1,17 @@
# $Id$
+# vim: syntax=perl
use strict;
+use Test::More;
use IO::File;
-BEGIN { print "1..189\n"; }
-
-my $t = 1;
+plan tests => 172;
##############################################################################
# S U P P O R T R O U T I N E S
##############################################################################
##############################################################################
-# Print out 'n ok' or 'n not ok' as expected by test harness.
-# First arg is test number (n). If only one following arg, it is interpreted
-# as true/false value. If two args, equality = true.
-#
-
-sub ok {
- my($n, $x, $y) = @_;
- die "Sequence error got $n expected $t" if($n != $t);
- $x = 0 if(@_ > 2 and $x ne $y);
- print(($x ? '' : 'not '), 'ok ', $t++, "\n");
-}
-
-##############################################################################
-# Take two scalar values (may be references) and compare them (recursively
-# if necessary) returning 1 if same, 0 if different.
-#
-
-sub DataCompare {
- my($x, $y) = @_;
-
- my($i);
-
- if(!ref($x)) {
- return(1) if($x eq $y);
- print STDERR "$t:DataCompare: $x != $y\n";
- return(0);
- }
-
- if(ref($x) eq 'ARRAY') {
- unless(ref($y) eq 'ARRAY') {
- print STDERR "$t:DataCompare: expected arrayref, got: $y\n";
- return(0);
- }
- if(scalar(@$x) != scalar(@$y)) {
- print STDERR "$t:DataCompare: expected ", scalar(@$x),
- " element(s), got: ", scalar(@$y), "\n";
- return(0);
- }
- for($i = 0; $i < scalar(@$x); $i++) {
- DataCompare($x->[$i], $y->[$i]) || return(0);
- }
- return(1);
- }
-
- if(ref($x) eq 'HASH') {
- unless(ref($y) eq 'HASH') {
- print STDERR "$t:DataCompare: expected hashref, got: $y\n";
- return(0);
- }
- if(scalar(keys(%$x)) != scalar(keys(%$y))) {
- print STDERR "$t:DataCompare: expected ", scalar(keys(%$x)),
- " key(s) (", join(', ', keys(%$x)),
- "), got: ", scalar(keys(%$y)), " (", join(', ', keys(%$y)),
- ")\n";
- return(0);
- }
- foreach $i (keys(%$x)) {
- unless(exists($y->{$i})) {
- print STDERR "$t:DataCompare: missing hash key - {$i}\n";
- return(0);
- }
- DataCompare($x->{$i}, $y->{$i}) || return(0);
- }
- return(1);
- }
-
- print STDERR "Don't know how to compare: " . ref($x) . "\n";
- return(0);
-}
-
-
-##############################################################################
# Read file and return contents as a scalar.
#
@@ -101,9 +29,9 @@
# Try encoding a scalar value
my $xml = XMLout("scalar");
-ok(1, 1); # XMLout did not crash
-ok(2, defined($xml)); # and it returned an XML string
-ok(3, XMLin($xml), 'scalar'); # which parses back OK
+ok(1, 'XMLout did not crash');
+ok(defined($xml), 'and it returned an XML string');
+is(XMLin($xml), 'scalar', 'which parses back OK');
# Next try encoding a hash
@@ -114,13 +42,12 @@
# Expect:
# <opt one="1" two="II" three="..." />
-$_ = XMLout($hashref1); # Encode to $_ for convenience
- # Confirm it parses back OK
-ok(4, DataCompare($hashref1, XMLin($_)));
-ok(5, s/one="1"//); # first key encoded OK
-ok(6, s/two="II"//); # second key encoded OK
-ok(7, s/three="..."//); # third key encoded OK
-ok(8, /^<\w+\s+\/>/); # no other attributes encoded
+$_ = XMLout($hashref1);
+is_deeply(XMLin($_), $hashref1, 'encoded a hash');
+ok(s/one="1"//, 'first key encoded OK');
+ok(s/two="II"//, 'second key encoded OK');
+ok(s/three="..."//, 'third key encoded OK');
+like($_, qr/^<\w+\s+\/>/, 'no other attributes encoded');
# Now try encoding a hash with a nested array
@@ -133,12 +60,12 @@
# <array>three</array>
# </opt>
-$_ = XMLout($ref); # Encode to $_ for convenience
-ok(9, DataCompare($ref, XMLin($_)));
-ok(10, s{<array>one</array>\s*
+$_ = XMLout($ref);
+is_deeply(XMLin($_), $ref, 'encoded a hash with nested array');
+ok(s{<array>one</array>\s*
<array>two</array>\s*
- <array>three</array>}{}sx); # array elements encoded in correct order
-ok(11, /^<(\w+)\s*>\s*<\/\1>\s*$/s); # no other spurious encodings
+ <array>three</array>}{}sx, 'array elements encoded in correct order');
+like($_, qr/^<(\w+)\s*>\s*<\/\1>\s*$/s, 'no other spurious encodings');
# Now try encoding a nested hash
@@ -153,11 +80,11 @@
# </opt>
$_ = XMLout($ref);
-ok(12, DataCompare($ref, XMLin($_))); # Parses back OK
+is_deeply(XMLin($_), $ref, 'encoded nested hashes');
-ok(13, s{<hash1 one="1" />\s*}{}s);
-ok(14, s{<hash2 two="2" />\s*}{}s);
-ok(15, m{^<(\w+)\s+value="555 1234"\s*>\s*</\1>\s*$}s);
+ok(s{<hash1 one="1" />\s*}{}s, 'nested hash 1 ok');
+ok(s{<hash2 two="2" />\s*}{}s, 'nested hash 2 ok');
+like($_, qr{^<(\w+)\s+value="555 1234"\s*>\s*</\1>\s*$}s, 'whole OK');
# Now try encoding an anonymous array
@@ -171,12 +98,14 @@
# </opt>
$_ = XMLout($ref);
-ok(16, DataCompare($ref, XMLin($_))); # Parses back OK
+is_deeply(XMLin($_), $ref, 'encoded anonymous array');
-ok(17, s{<anon>1</anon>\s*}{}s);
-ok(18, s{<anon>two</anon>\s*}{}s);
-ok(19, s{<anon>III</anon>\s*}{}s);
-ok(20, m{^<(\w+)\s*>\s*</\1>\s*$}s);
+like($_, qr{
+ ^<(\w+)\s*>
+ \s*<anon>1</anon>
+ \s*<anon>two</anon>
+ \s*<anon>III</anon>
+ \s*</\1>\s*$}sx, 'output matches expectations');
# Now try encoding a nested anonymous array
@@ -195,15 +124,20 @@
# </opt>
$_ = XMLout($ref);
-ok(21, DataCompare($ref, XMLin($_))); # Parses back OK
+is_deeply(XMLin($_), $ref, 'encoded nested anonymous arrays');
-ok(22, s{<anon>1\.1</anon>\s*}{row}s);
-ok(23, s{<anon>1\.2</anon>\s*}{ one}s);
-ok(24, s{<anon>2\.1</anon>\s*}{row}s);
-ok(25, s{<anon>2\.2</anon>\s*}{ two}s);
-ok(26, s{<anon>\s*row one\s*</anon>\s*}{}s);
-ok(27, s{<anon>\s*row two\s*</anon>\s*}{}s);
-ok(28, m{^<(\w+)\s*>\s*</\1>\s*$}s);
+like($_, qr{
+ <(\w+)\s*>
+ \s*<anon\s*>
+ \s*<anon\s*>1\.1</anon\s*>
+ \s*<anon\s*>1\.2</anon\s*>
+ \s*</anon\s*>
+ \s*<anon\s*>
+ \s*<anon\s*>2\.1</anon\s*>
+ \s*<anon\s*>2\.2</anon\s*>
+ \s*</anon\s*>
+ \s*</\1\s*>
+}sx, 'output matches expectations');
# Now try encoding a hash of hashes with key folding disabled
@@ -224,12 +158,12 @@
# </opt>
$_ = XMLout($ref, keyattr => []);
-ok(29, DataCompare($ref, XMLin($_))); # Parses back OK
-ok(30, s{<England\s+capital="London"\s*/>\s*}{}s);
-ok(31, s{<France\s+capital="Paris"\s*/>\s*}{}s);
-ok(32, s{<Turkey\s+capital="Istanbul"\s*/>\s*}{}s);
-ok(33, s{<country\s*>\s*</country>}{}s);
-ok(34, s{^<(\w+)\s*>\s*</\1>$}{}s);
+is_deeply(XMLin($_), $ref, 'encoded hash of hashes with folding disabled');
+ok(s{<England\s+capital="London"\s*/>\s*}{}s, 'nested hash 1 ok');
+ok(s{<France\s+capital="Paris"\s*/>\s*}{}s, 'nested hash 2 ok');
+ok(s{<Turkey\s+capital="Istanbul"\s*/>\s*}{}s, 'nested hash 3 ok');
+ok(s{<country\s*>\s*</country>}{}s, 'container hash ok');
+ok(s{^<(\w+)\s*>\s*</\1>$}{}s, 'document ok');
# Try encoding same again with key folding set to non-standard value
@@ -243,41 +177,41 @@
$_ = XMLout($ref, keyattr => ['fullname']);
$xml = $_;
-ok(35, DataCompare($ref,
- XMLin($_, keyattr => ['fullname']))); # Parses back OK
-ok(36, s{\s*fullname="England"}{uk}s);
-ok(37, s{\s*capital="London"}{uk}s);
-ok(38, s{\s*fullname="France"}{fr}s);
-ok(39, s{\s*capital="Paris"}{fr}s);
-ok(40, s{\s*fullname="Turkey"}{tk}s);
-ok(41, s{\s*capital="Istanbul"}{tk}s);
-ok(42, s{<countryukuk\s*/>\s*}{}s);
-ok(43, s{<countryfrfr\s*/>\s*}{}s);
-ok(44, s{<countrytktk\s*/>\s*}{}s);
-ok(45, s{^<(\w+)\s*>\s*</\1>$}{}s);
+is_deeply(XMLin($_, keyattr => ['fullname']), $ref,
+'encoded hash of hashes with explicit folding enabled');
+ok(s{\s*fullname="England"}{uk}s, 'element 1 attr 1 ok');
+ok(s{\s*capital="London"}{uk}s, 'element 1 attr 2 ok');
+ok(s{\s*fullname="France"}{fr}s, 'element 2 attr 1 ok');
+ok(s{\s*capital="Paris"}{fr}s, 'element 2 attr 2 ok');
+ok(s{\s*fullname="Turkey"}{tk}s, 'element 3 attr 1 ok');
+ok(s{\s*capital="Istanbul"}{tk}s, 'element 3 attr 2 ok');
+ok(s{<countryukuk\s*/>\s*}{}s, 'element 1 ok');
+ok(s{<countryfrfr\s*/>\s*}{}s, 'element 2 ok');
+ok(s{<countrytktk\s*/>\s*}{}s, 'element 2 ok');
+ok(s{^<(\w+)\s*>\s*</\1>$}{}s, 'document ok');
# Same again but specify name as scalar rather than array
$_ = XMLout($ref, keyattr => 'fullname');
-ok(46, $_ eq $xml); # Same result as last time
+is($_, $xml, 'still works when keyattr is scalar');
# Same again but specify keyattr as hash rather than array
$_ = XMLout($ref, keyattr => { country => 'fullname' });
-ok(47, $_ eq $xml); # Same result as last time
+is($_, $xml, 'still works when keyattr is array');
# Same again but add leading '+'
$_ = XMLout($ref, keyattr => { country => '+fullname' });
-ok(48, $_ eq $xml); # Same result as last time
+is($_, $xml, "still works when keyattr is hash with leading '+'");
# and leading '-'
$_ = XMLout($ref, keyattr => { country => '-fullname' });
-ok(49, $_ eq $xml); # Same result as last time
+is($_, $xml, "still works when keyattr is hash with leading '-'");
# One more time but with default key folding values
@@ -290,17 +224,18 @@
# </opt>
$_ = XMLout($ref);
-ok(50, DataCompare($ref, XMLin($_))); # Parses back OK
-ok(51, s{\s*name="England"}{uk}s);
-ok(52, s{\s*capital="London"}{uk}s);
-ok(53, s{\s*name="France"}{fr}s);
-ok(54, s{\s*capital="Paris"}{fr}s);
-ok(55, s{\s*name="Turkey"}{tk}s);
-ok(56, s{\s*capital="Istanbul"}{tk}s);
-ok(57, s{<countryukuk\s*/>\s*}{}s);
-ok(58, s{<countryfrfr\s*/>\s*}{}s);
-ok(59, s{<countrytktk\s*/>\s*}{}s);
-ok(60, s{^<(\w+)\s*>\s*</\1>$}{}s);
+is_deeply(XMLin($_), $ref,
+'encoded hash of hashes with default folding enabled');
+ok(s{\s*name="England"}{uk}s, 'element 1 attr 1 ok');
+ok(s{\s*capital="London"}{uk}s, 'element 1 attr 2 ok');
+ok(s{\s*name="France"}{fr}s, 'element 2 attr 1 ok');
+ok(s{\s*capital="Paris"}{fr}s, 'element 2 attr 2 ok');
+ok(s{\s*name="Turkey"}{tk}s, 'element 3 attr 1 ok');
+ok(s{\s*capital="Istanbul"}{tk}s, 'element 3 attr 2 ok');
+ok(s{<countryukuk\s*/>\s*}{}s, 'element 1 ok');
+ok(s{<countryfrfr\s*/>\s*}{}s, 'element 2 ok');
+ok(s{<countrytktk\s*/>\s*}{}s, 'element 2 ok');
+ok(s{^<(\w+)\s*>\s*</\1>$}{}s, 'document ok');
# Finally, confirm folding still works with only one nested hash
@@ -312,12 +247,11 @@
$ref = { country => { England => { capital => 'London' } } };
$_ = XMLout($ref);
-ok(61, DataCompare($ref, XMLin($_, forcearray => 1))); # Parses back OK
-ok(62, s{\s*name="England"}{uk}s);
-ok(63, s{\s*capital="London"}{uk}s);
-ok(64, s{<countryukuk\s*/>\s*}{}s);
-#print STDERR "\n$_\n";
-ok(65, s{^<(\w+)\s*>\s*</\1>$}{}s);
+is_deeply(XMLin($_, forcearray => 1), $ref, 'single nested hash unfolded');
+ok(s{\s*name="England"}{uk}s, 'attr 1 ok');
+ok(s{\s*capital="London"}{uk}s, 'attr 2 ok');
+ok(s{<countryukuk\s*/>\s*}{}s, 'element ok');
+ok(s{^<(\w+)\s*>\s*</\1>$}{}s, 'document ok');
# Check that default XML declaration works
@@ -329,10 +263,9 @@
$ref = { one => 1 };
$_ = XMLout($ref, xmldecl => 1);
-ok(66, DataCompare($ref, XMLin($_))); # Parses back OK
-ok(67, s{^\Q<?xml version='1.0' standalone='yes'?>\E}{}s);
-ok(68, s{<opt one="1" />}{}s);
-ok(69, m{^\s*$}s);
+is_deeply(XMLin($_), $ref, 'generated doc with XML declaration');
+ok(s{^\Q<?xml version='1.0' standalone='yes'?>\E}{}s, 'XML declaration OK');
+like($_, qr{^\s*<opt\s+one="1"\s*/>}s, 'data OK too');
# Check that custom XML declaration works
@@ -342,48 +275,48 @@
# <opt one="1" />
$_ = XMLout($ref, xmldecl => "<?xml version='1.0' standalone='yes'?>");
-ok(70, DataCompare($ref, XMLin($_))); # Parses back OK
-ok(71, s{^\Q<?xml version='1.0' standalone='yes'?>\E}{}s);
-ok(72, s{<opt one="1" />}{}s);
-ok(73, m{^\s*$}s);
+is_deeply(XMLin($_), $ref, 'generated doc with custom XML declaration');
+ok(s{^\Q<?xml version='1.0' standalone='yes'?>\E}{}s, 'XML declaration OK');
+like($_, qr{^\s*<opt\s+one="1"\s*/>}s, 'data OK too');
# Check that special characters do get escaped
$ref = { a => '<A>', b => '"B"', c => '&C&' };
$_ = XMLout($ref);
-ok(74, DataCompare($ref, XMLin($_))); # Parses back OK
-ok(75, s{a="<A>"}{}s);
-ok(76, s{b=""B""}{}s);
-ok(77, s{c="&C&"}{}s);
-ok(78, s{^<(\w+)\s*/>$}{}s);
+is_deeply(XMLin($_), $ref, 'generated document with escaping');
+ok(s{a="<A>"}{}s, 'angle brackets escaped OK');
+ok(s{b=""B""}{}s, 'double quotes escaped OK');
+ok(s{c="&C&"}{}s, 'ampersands escaped OK');
+ok(s{^<(\w+)\s*/>$}{}s, 'data OK too');
# unless we turn escaping off
$_ = XMLout($ref, noescape => 1);
-ok(79, s{a="<A>"}{}s);
-ok(80, s{b=""B""}{}s);
-ok(81, s{c="&C&"}{}s);
-ok(82, s{^<(\w+)\s*/>$}{}s);
+ok(s{a="<A>"}{}s, 'generated unescaped angle brackets');
+ok(s{b=""B""}{}s, 'generated unescaped double quotes');
+ok(s{c="&C&"}{}s, 'generated unescaped ampersands');
+ok(s{^<(\w+)\s*/>$}{}s, 'data OK too');
-# Try encoding a recursive data structure and confirm that it fails
+# Try encoding a circular data structure and confirm that it fails
$_ = eval {
my $ref = { a => '1' };
$ref->{b} = $ref;
XMLout($ref);
};
-ok(83, !defined($_));
-ok(84, $@ =~ /recursive data structures not supported/);
+ok(!defined($_), 'caught circular data structure');
+like($@, qr/circular data structures not supported/,
+'with correct error message');
# Try encoding a blessed reference and confirm that it fails
$_ = eval { my $ref = new IO::File; XMLout($ref) };
-ok(85, !defined($_));
-ok(86, $@ =~ /Can't encode a value of type: /);
+ok(!defined($_), 'caught blessed reference in data structure');
+like($@, qr/Can't encode a value of type: /, 'with correct error message');
# Repeat some of the above tests with named root element
@@ -391,10 +324,9 @@
# Try encoding a scalar value
$xml = XMLout("scalar", rootname => 'TOM');
-ok(87, defined($xml)); # and it returned an XML string
-ok(88, XMLin($xml), 'scalar'); # which parses back OK
- # and contains the expected data
-ok(89, $xml =~ /^\s*<TOM>scalar<\/TOM>\s*$/si);
+ok(defined($xml), 'generated document with named root element');
+is(XMLin($xml), 'scalar', 'parsed it back correctly');
+like($xml, qr/^\s*<TOM>scalar<\/TOM>\s*$/si, 'XML as expected');
# Next try encoding a hash
@@ -403,12 +335,11 @@
# <DICK one="1" two="II" three="..." />
$_ = XMLout($hashref1, rootname => 'DICK');
- # Confirm it parses back OK
-ok(90, DataCompare($hashref1, XMLin($_)));
-ok(91, s/one="1"//); # first key encoded OK
-ok(92, s/two="II"//); # second key encoded OK
-ok(93, s/three="..."//); # third key encoded OK
-ok(94, /^<DICK\s+\/>/); # only expected root element left
+is_deeply(XMLin($_), $hashref1, 'same again but encoded a hash');
+ok(s/one="1"//, 'first key encoded OK');
+ok(s/two="II"//, 'second key encoded OK');
+ok(s/three="..."//, 'third key encoded OK');
+like($_, qr/^<DICK\s+\/>/, 'XML looks OK');
# Now try encoding a hash with a nested array
@@ -421,12 +352,12 @@
# <array>three</array>
# </LARRY>
-$_ = XMLout($ref, rootname => 'LARRY'); # Encode to $_ for convenience
-ok(95, DataCompare($ref, XMLin($_)));
-ok(96, s{<array>one</array>\s*
+$_ = XMLout($ref, rootname => 'LARRY');
+is_deeply(XMLin($_), $ref, 'same again but with array in hash');
+ok(s{<array>one</array>\s*
<array>two</array>\s*
- <array>three</array>}{}sx); # array encoded in correct order
-ok(97, /^<(LARRY)\s*>\s*<\/\1>\s*$/s); # only expected root element left
+ <array>three</array>}{}sx, 'array encoded in correct order');
+like($_, qr/^<(LARRY)\s*>\s*<\/\1>\s*$/s, 'only expected root element left');
# Now try encoding a nested hash
@@ -441,11 +372,11 @@
# </CURLY>
$_ = XMLout($ref, rootname => 'CURLY');
-ok(98, DataCompare($ref, XMLin($_))); # Parses back OK
+is_deeply(XMLin($_), $ref, 'same again but with nested hashes');
-ok(99, s{<hash1 one="1" />\s*}{}s);
-ok(100, s{<hash2 two="2" />\s*}{}s);
-ok(101, m{^<(CURLY)\s+value="555 1234"\s*>\s*</\1>\s*$}s);
+ok(s{<hash1 one="1" />\s*}{}s, 'hash 1 encoded OK');
+ok(s{<hash2 two="2" />\s*}{}s, 'hash 2 encoded OK');
+like($_, qr{^<(CURLY)\s+value="555 1234"\s*>\s*</\1>\s*$}s, 'document OK');
# Now try encoding an anonymous array
@@ -459,20 +390,23 @@
# </MOE>
$_ = XMLout($ref, rootname => 'MOE');
-ok(102, DataCompare($ref, XMLin($_))); # Parses back OK
-
-ok(103, s{<anon>1</anon>\s*}{}s);
-ok(104, s{<anon>two</anon>\s*}{}s);
-ok(105, s{<anon>III</anon>\s*}{}s);
-ok(106, m{^<(MOE)\s*>\s*</\1>\s*$}s);
+is_deeply(XMLin($_), $ref, 'same again but with nested anonymous array');
+like($_, qr{
+ ^<(MOE)\s*>
+ \s*<anon>1</anon>
+ \s*<anon>two</anon>
+ \s*<anon>III</anon>
+ \s*</\1>\s*$}sx, 'document OK');
# Test again, this time with no root element
# Try encoding a scalar value
-ok(107, XMLout("scalar", rootname => '') =~ /scalar\s+/s);
-ok(108, XMLout("scalar", rootname => undef) =~ /scalar\s+/s);
+like(XMLout("scalar", rootname => ''), qr/scalar\s+/s,
+ 'encoded scalar with no root element');
+like(XMLout("scalar", rootname => undef), qr/scalar\s+/s,
+ 'same again but with rootname = undef');
# Next try encoding a hash
@@ -483,12 +417,12 @@
# <three>...</three>
$_ = XMLout($hashref1, rootname => '');
- # Confirm it parses back OK
-ok(109, DataCompare($hashref1, XMLin("<opt>$_</opt>")));
-ok(110, s/<one>1<\/one>//); # first key encoded OK
-ok(111, s/<two>II<\/two>//); # second key encoded OK
-ok(112, s/<three>...<\/three>//); # third key encoded OK
-ok(113, /^\s*$/); # nothing else left
+is_deeply(XMLin("<opt>$_</opt>"), $hashref1,
+ 'generated doc with no root element from hash');
+ok(s/<one>1<\/one>//, 'first key encoded OK');
+ok(s/<two>II<\/two>//, 'second key encoded OK');
+ok(s/<three>...<\/three>//, 'third key encoded OK');
+like($_, qr/^\s*$/, 'document OK');
# Now try encoding a nested hash
@@ -502,11 +436,12 @@
# <hash2 two="2" />
$_ = XMLout($ref, rootname => '');
-ok(114, DataCompare($ref, XMLin("<opt>$_</opt>"))); # Parses back OK
-ok(115, s{<value>555 1234<\/value>\s*}{}s);
-ok(116, s{<hash1 one="1" />\s*}{}s);
-ok(117, s{<hash2 two="2" />\s*}{}s);
-ok(118, m{^\s*$}s);
+is_deeply(XMLin("<opt>$_</opt>"), $ref,
+ 'generated docucment with no root element from nested hashes');
+ok(s{<value>555 1234<\/value>\s*}{}s, 'first element OK');
+ok(s{<hash1 one="1" />\s*}{}s, 'second element OK');
+ok(s{<hash2 two="2" />\s*}{}s, 'third element OK');
+like($_, qr{^\s*$}s, 'document OK');
# Now try encoding an anonymous array
@@ -518,53 +453,57 @@
# <anon>III</anon>
$_ = XMLout($ref, rootname => '');
-ok(119, DataCompare($ref, XMLin("<opt>$_</opt>"))); # Parses back OK
-
-ok(120, s{<anon>1</anon>\s*}{}s);
-ok(121, s{<anon>two</anon>\s*}{}s);
-ok(122, s{<anon>III</anon>\s*}{}s);
-ok(123, m{^\s*$}s);
+is_deeply(XMLin("<opt>$_</opt>"), $ref,
+ 'generated doc with no root name from array');
+like($_, qr{
+ ^\s*<anon>1</anon>
+ \s*<anon>two</anon>
+ \s*<anon>III</anon>
+ \s*$}sx, 'document OK');
# Test option error handling
$_ = eval { XMLout($hashref1, searchpath => []) }; # only valid for XMLin()
-ok(124, !defined($_));
-ok(125, $@ =~ /Unrecognised option:/);
+ok(!defined($_), 'caught attempt to specify searchpath on XMLout');
+like($@, qr/Unrecognised option:/, 'with correct error message');
$_ = eval { XMLout($hashref1, 'bogus') };
-ok(126, !defined($_));
-ok(127, $@ =~ /Options must be name=>value pairs .odd number supplied./);
+ok(!defined($_), 'caught attempt to specify odd number of option args');
+like($@, qr/Options must be name=>value pairs \(odd number supplied\)/,
+ 'with correct error message');
# Test output to file
my $TestFile = 'testoutput.xml';
unlink($TestFile);
-ok(128, !-e $TestFile);
+ok(!-e $TestFile, 'output file does not exist');
$xml = XMLout($hashref1);
-XMLout($hashref1, outputfile => $TestFile);
-ok(129, -e $TestFile);
-ok(130, ReadFile($TestFile) eq $xml);
+eval { XMLout($hashref1, outputfile => $TestFile); };
+ok(-e $TestFile, 'created xml output file');
+is(ReadFile($TestFile), $xml, 'Contents match expectations');
unlink($TestFile);
# Test output to an IO handle
-ok(131, !-e $TestFile);
+ok(!-e $TestFile);
my $fh = new IO::File;
-$fh->open(">$TestFile") || die "$!";
-XMLout($hashref1, outputfile => $TestFile);
-$fh->close();
-ok(132, -e $TestFile);
-ok(133, ReadFile($TestFile) eq $xml);
+eval {
+ $fh->open(">$TestFile") || die "$!";
+ XMLout($hashref1, outputfile => $TestFile);
+ $fh->close();
+};
+ok(-e $TestFile, 'create XML output file via IO::File');
+is(ReadFile($TestFile), $xml, 'Contents match expectations');
unlink($TestFile);
# After all that, confirm that the original hashref we supplied has not
# been corrupted.
-ok(134, DataCompare($hashref1, $hashref2));
+is_deeply($hashref1, $hashref2, 'original data not corrupted');
# Confirm that hash keys with leading '-' are skipped
@@ -579,7 +518,7 @@
};
$_ = XMLout($ref, rootname => 'opt');
-ok(135, m{^\s*<opt\s+a="one"\s*/>\s*$}s);
+like($_, qr{^\s*<opt\s+a="one"\s*/>\s*$}s, "skipped hashkeys with '-' prefix");
# Try a more complex unfolding with key attributes named in a hash
@@ -618,33 +557,35 @@
# </opt>
$_ = XMLout($ref, keyattr => { 'car' => 'license', 'option' => 'pn' });
-ok(136, DataCompare($ref, # Parses back OK
- XMLin($_, forcearray => 1,
- keyattr => { 'car' => 'license', 'option' => 'pn' })));
-ok(137, s{\s*make="GM"}{gm}s);
-ok(138, s{\s*id="2"}{gm}s);
-ok(139, s{\s*license="LW1804"}{gm}s);
-ok(140, s{\s*desc="Steering Wheel"}{opt}s);
-ok(141, s{\s*pn="9926543-1167"}{opt}s);
-ok(142, s{\s*key="1"}{opt}s);
-ok(143, s{\s*<cargmgmgm>\s*<optionoptoptopt\s*/>\s*</car>}{CAR}s);
-ok(144, s{\s*make="Ford"}{ford}s);
-ok(145, s{\s*id="1"}{ford}s);
-ok(146, s{\s*license="SH6673"}{ford}s);
-ok(147, s{\s*desc="Electric Windows"}{1}s);
-ok(148, s{\s*pn="6389733317-12"}{1}s);
-ok(149, s{\s*key="2"}{1}s);
-ok(150, s{\s*<option111}{<option}s);
-ok(151, s{\s*desc="Leather Seats"}{2}s);
-ok(152, s{\s*pn="3735498158-01"}{2}s);
-ok(153, s{\s*key="3"}{2}s);
-ok(154, s{\s*<option222}{<option}s);
-ok(155, s{\s*desc="Sun Roof"}{3}s);
-ok(156, s{\s*pn="5776155953-25"}{3}s);
-ok(157, s{\s*key="4"}{3}s);
-ok(158, s{\s*<option333}{<option}s);
-ok(159, s{\s*<carfordfordford>\s*(<option\s*/>\s*){3}</car>}{CAR}s);
-ok(160, s{^<(\w+)\s*>\s*CAR\s*CAR\s*</\1>$}{}s);
+is_deeply(XMLin($_,
+ forcearray => 1,
+ keyattr => { 'car' => 'license', 'option' => 'pn' }
+), $ref, 'generated document from complex nested hash with unfolding');
+ok(s{\s*make="GM"}{gm}s, 'element 1 attribute 1 OK');
+ok(s{\s*id="2"}{gm}s, 'element 1 attribute 2 OK');
+ok(s{\s*license="LW1804"}{gm}s, 'element 1 attribute 3 OK');
+ok(s{\s*desc="Steering Wheel"}{opt}s, 'element 1.1 attribute 1 OK');
+ok(s{\s*pn="9926543-1167"}{opt}s, 'element 1.1 attribute 2 OK');
+ok(s{\s*key="1"}{opt}s, 'element 1.1 attribute 3 OK');
+ok(s{\s*<cargmgmgm>\s*<optionoptoptopt\s*/>\s*</car>}{CAR}s,
+ 'elements 1 and 1.1 OK');
+ok(s{\s*make="Ford"}{ford}s, 'element 2 attribute 1 OK');
+ok(s{\s*id="1"}{ford}s, 'element 2 attribute 2 OK');
+ok(s{\s*license="SH6673"}{ford}s, 'element 2 attribute 3 OK');
+ok(s{\s*desc="Electric Windows"}{1}s, 'element 2.1 attribute 1 OK');
+ok(s{\s*pn="6389733317-12"}{1}s, 'element 2.1 attribute 2 OK');
+ok(s{\s*key="2"}{1}s, 'element 2.1 attribute 3 OK');
+ok(s{\s*<option111}{<option}s, 'element 2.1 OK');
+ok(s{\s*desc="Leather Seats"}{2}s, 'element 2.2 attribute 1 OK');
+ok(s{\s*pn="3735498158-01"}{2}s, 'element 2.2 attribute 2 OK');
+ok(s{\s*key="3"}{2}s, 'element 2.2 attribute 3 OK');
+ok(s{\s*<option222}{<option}s, 'element 2.2 OK');
+ok(s{\s*desc="Sun Roof"}{3}s, 'element 2.3 attribute 1 OK');
+ok(s{\s*pn="5776155953-25"}{3}s, 'element 2.3 attribute 2 OK');
+ok(s{\s*key="4"}{3}s, 'element 2.3 attribute 3 OK');
+ok(s{\s*<option333}{<option}s, 'element 2.3 OK');
+ok(s{\s*<carfordfordford>\s*(<option\s*/>\s*){3}</car>}{CAR}s, 'element 2 OK');
+ok(s{^<(\w+)\s*>\s*CAR\s*CAR\s*</\1>$}{}s, 'document OK');
# Check that empty hashes translate to empty tags
@@ -659,33 +600,34 @@
};
$_ = XMLout($ref);
-
-ok(161, s{<nest2\s*></nest2\s*>\s*}{<NNN>});
-ok(162, s{<nest1\s*>nvalue1</nest1\s*>\s*}{<NNN>});
-ok(163, s{<one\s*attr1\s*=\s*"avalue1">\s*}{<one>});
-ok(164, s{<one\s*>\s*<NNN>\s*<NNN>\s*</one>}{<nnn>});
-ok(165, s{<two\s*></two\s*>\s*}{<nnn>});
-ok(166, m{^\s*<(\w+)\s*>\s*<nnn>\s*<nnn>\s*</\1\s*>\s*$});
+ok(s{<nest2\s*></nest2\s*>\s*}{<NNN>}, 'nested empty hash OK');
+ok(s{<nest1\s*>nvalue1</nest1\s*>\s*}{<NNN>}, 'array OK');
+ok(s{<one\s*attr1\s*=\s*"avalue1">\s*}{<one>}, 'scalar OK');
+ok(s{<one\s*>\s*<NNN>\s*<NNN>\s*</one>}{<nnn>}, 'nesting OK');
+ok(s{<two\s*></two\s*>\s*}{<nnn>}, 'empty hash OK');
+like($_, qr{^\s*<(\w+)\s*>\s*<nnn>\s*<nnn>\s*</\1\s*>\s*$}, 'document OK');
# Check undefined values generate warnings
{
-my $warn = '';
-local $SIG{__WARN__} = sub { $warn = $_[0] };
-$_ = eval {
- $ref = { 'tag' => undef };
- XMLout($ref);
-};
-ok(167, $warn =~ /Use of uninitialized value/);
+ my $warn = '';
+ local $SIG{__WARN__} = sub { $warn = $_[0] };
+ $_ = eval {
+ $ref = { 'tag' => undef };
+ XMLout($ref);
+ };
+ like($warn, qr/Use of uninitialized value/,
+ 'caught warning re uninitialised value');
}
-# Unless undef is mapped to empty tags
+# Unless undef is mapped to empty elements
$ref = { 'tag' => undef };
$_ = XMLout($ref, suppressempty => undef);
-ok(168, m{^\s*<(\w*)\s*>\s*<tag\s*></tag\s*>\s*</\1\s*>\s*$}s);
+like($_, qr{^\s*<(\w*)\s*>\s*<tag\s*></tag\s*>\s*</\1\s*>\s*$}s,
+ 'uninitialiased values successfully mapped to empty elements');
# Test the keeproot option
@@ -700,7 +642,7 @@
my $xml1 = XMLout($ref, rootname => 'sequence');
my $xml2 = XMLout({ 'sequence' => $ref }, keeproot => 1);
-ok(169, DataCompare($xml1, $xml2));
+is_deeply($xml1, $xml2, 'keeproot works as expected');
# Test that items with text content are output correctly
@@ -710,7 +652,7 @@
$_ = XMLout($ref);
-ok(170, m{^\s*<opt\s+one="1">text</opt>\s*$}s);
+like($_, qr{^\s*<opt\s+one="1">text</opt>\s*$}s, 'content keys mapped OK');
# Even if we change the default value for the 'contentkey' option
@@ -719,7 +661,7 @@
$_ = XMLout($ref, contentkey => 'text_content');
-ok(171, m{^\s*<opt\s+one="1">text</opt>\s*$}s);
+like($_, qr{^\s*<opt\s+one="1">text</opt>\s*$}s, 'even when name changed');
# Check 'noattr' option
@@ -743,12 +685,13 @@
$_ = XMLout($ref, noattr => 1);
-ok(172, !m{=}s); # No '=' signs anywhere
-ok(173, DataCompare($ref, XMLin($_))); # Parses back ok
-ok(174, s{\s*<(attr1)>value1</\1>\s*}{NEST}s); # Output meets expectations
-ok(175, s{\s*<(attr2)>value2</\1>\s*}{NEST}s);
-ok(176, s{\s*<(nest)>one</\1>\s*<\1>two</\1>\s*<\1>three</\1>}{NEST}s);
-ok(177, s{^<(\w+)\s*>(NEST\s*){3}</\1>$}{}s);
+unlike($_, qr{=}s, 'generated document with no attributes');
+is_deeply(XMLin($_), $ref, 'parses ok');
+ok(s{\s*<(attr1)>value1</\1>\s*}{NEST}s, 'scalar 1 mapped ok');
+ok(s{\s*<(attr2)>value2</\1>\s*}{NEST}s, 'scalar 2 mapped ok');
+ok(s{\s*<(nest)>one</\1>\s*<\1>two</\1>\s*<\1>three</\1>}{NEST}s,
+'array mapped ok');
+like($_, qr{^<(\w+)\s*>(NEST\s*){3}</\1>$}s, 'document OK');
# Check noattr doesn't screw up keyattr
@@ -777,18 +720,17 @@
$_ = XMLout($ref, noattr => 1, keyattr => [ 'word' ]);
-ok(178, !m{=}s); # No '=' signs anywhere
- # Parses back ok
-ok(179, DataCompare($ref, XMLin($_, keyattr => [ 'word' ])));
-ok(180, s{\s*<(dec)>21</\1>\s*}{21}s);
-ok(181, s{\s*<(hex)>0x15</\1>\s*}{21}s);
-ok(182, s{\s*<(word)>twenty one</\1>\s*}{21}s);
-ok(183, s{\s*<(number)>212121</\1>\s*}{NUM}s);
-ok(184, s{\s*<(dec)>32</\1>\s*}{32}s);
-ok(185, s{\s*<(hex)>0x20</\1>\s*}{32}s);
-ok(186, s{\s*<(word)>thirty two</\1>\s*}{32}s);
-ok(187, s{\s*<(number)>323232</\1>\s*}{NUM}s);
-ok(188, s{^<(\w+)\s*>NUMNUM</\1>$}{}s);
+unlike($_, qr{=}s, 'same again but with unfolding too');
+is_deeply(XMLin($_, keyattr => [ 'word' ]), $ref, 'parsed OK');
+ok(s{\s*<(dec)>21</\1>\s*}{21}s, 'scalar 1.1 mapped OK');
+ok(s{\s*<(hex)>0x15</\1>\s*}{21}s, 'scalar 1.2 mapped OK');
+ok(s{\s*<(word)>twenty one</\1>\s*}{21}s, 'scalar 1.3 mapped OK');
+ok(s{\s*<(number)>212121</\1>\s*}{NUM}s, 'element 1 OK');
+ok(s{\s*<(dec)>32</\1>\s*}{32}s, 'scalar 2.1 mapped OK');
+ok(s{\s*<(hex)>0x20</\1>\s*}{32}s, 'scalar 2.1 mapped OK');
+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');
# 'Stress test' with a data structure that maps to several thousand elements.
@@ -806,12 +748,9 @@
my $opt2 = XMLin($xml, keyattr => { TypeA => 'alpha', TypeB => 'beta', Record => 'id' }, forcearray => 1);
-ok(189, DataCompare($opt1, $opt2));
+is_deeply($opt1, $opt2, 'large datastructure mapped to XML and back OK');
exit(0);
-
-
-
Index: 3_Storable.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/3_Storable.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- 3_Storable.t 14 Feb 2002 21:33:44 -0000 1.4
+++ 3_Storable.t 16 Oct 2002 09:43:35 -0000 1.5
@@ -1,14 +1,13 @@
# $Id$
+# vim: syntax=perl
use strict;
-
+use Test::More;
use File::Spec;
eval { require Storable; };
unless($INC{'Storable.pm'}) {
- print STDERR "no Storable.pm...";
- print "1..0\n";
- exit 0;
+ plan skip_all => 'no Storable.pm';
}
# Initialise filenames and check they're there
@@ -18,91 +17,30 @@
my $CacheFile = File::Spec->catfile('t', 'desertnet.stor');
unless(-e $SrcFile) {
- print STDERR "test data missing...";
- print "1..0\n";
- exit 0;
+ plan skip_all => 'test data missing';
}
-print "1..19\n";
-
-my $t = 1;
-
-##############################################################################
-# S U P P O R T R O U T I N E S
-##############################################################################
-
-##############################################################################
-# Print out 'n ok' or 'n not ok' as expected by test harness.
-# First arg is test number (n). If only one following arg, it is interpreted
-# as true/false value. If two args, equality = true.
-#
+# Make sure we can write to the filesystem and check it uses the same
+# clock as the machine we're running on.
-sub ok {
- my($n, $x, $y) = @_;
- die "Sequence error got $n expected $t" if($n != $t);
- $x = 0 if(@_ > 2 and $x ne $y);
- print(($x ? '' : 'not '), 'ok ', $t++, "\n");
+my $t0 = time();
+unless(open(XML, ">$XMLFile")) {
+ plan skip_all => "can't create test file: $!";
}
+close(XML);
+my $t1 = (stat($XMLFile))[9];
+my $t2 = time();
+if($t1 < $t0 or $t2 < $t1) {
+ plan skip_all => 'time moved backwards!'
+}
-##############################################################################
-# Take two scalar values (may be references) and compare them (recursively
-# if necessary) returning 1 if same, 0 if different.
-#
-
-sub DataCompare {
- my($x, $y) = @_;
-
- my($i);
-
- if(!ref($x)) {
- return(1) if($x eq $y);
- print STDERR "$t:DataCompare: $x != $y\n";
- return(0);
- }
-
- if(ref($x) eq 'ARRAY') {
- unless(ref($y) eq 'ARRAY') {
- print STDERR "$t:DataCompare: expected arrayref, got: $y\n";
- return(0);
- }
- if(scalar(@$x) != scalar(@$y)) {
- print STDERR "$t:DataCompare: expected ", scalar(@$x),
- " element(s), got: ", scalar(@$y), "\n";
- return(0);
- }
- for($i = 0; $i < scalar(@$x); $i++) {
- DataCompare($x->[$i], $y->[$i]) || return(0);
- }
- return(1);
- }
- if(ref($x) eq 'HASH') {
- unless(ref($y) eq 'HASH') {
- print STDERR "$t:DataCompare: expected hashref, got: $y\n";
- return(0);
- }
- if(scalar(keys(%$x)) != scalar(keys(%$y))) {
- print STDERR "$t:DataCompare: expected ", scalar(keys(%$x)),
- " key(s) (", join(', ', keys(%$x)),
- "), got: ", scalar(keys(%$y)), " (", join(', ', keys(%$y)),
- ")\n";
- return(0);
- }
- foreach $i (keys(%$x)) {
- unless(exists($y->{$i})) {
- print STDERR "$t:DataCompare: missing hash key - {$i}\n";
- return(0);
- }
- DataCompare($x->{$i}, $y->{$i}) || return(0);
- }
- return(1);
- }
-
- print STDERR "Don't know how to compare: " . ref($x) . "\n";
- return(0);
-}
+plan tests => 20;
+##############################################################################
+# S U P P O R T R O U T I N E S
+##############################################################################
##############################################################################
# Copy a file
@@ -171,25 +109,25 @@
}
};
-ok(1, CopyFile($SrcFile, $XMLFile)); # Start with known source file
-unlink($CacheFile); # Ensure there are ...
-ok(2, ! -e $CacheFile); # ... no cache files lying around
+ok(CopyFile($SrcFile, $XMLFile), 'copied known good source file');
+unlink($CacheFile);
+ok(! -e $CacheFile, 'no cache files lying around');
my $opt = XMLin($XMLFile);
-ok(3, DataCompare($opt, $Expected)); # Got what we expected
-ok(4, ! -e $CacheFile); # And no cache file was created
+is_deeply($opt, $Expected, 'parsed expected data from file');
+ok(! -e $CacheFile, 'and no cache file was created');
PassTime(time()); # Ensure cache file will be newer
$opt = XMLin($XMLFile, cache => 'storable');
-ok(5, DataCompare($opt, $Expected)); # Got what we expected again
-ok(6, -e $CacheFile); # But this time a cache file was created
-my $t0 = (stat($CacheFile))[9]; # Remember cache timestamp
+is_deeply($opt, $Expected, 'parsed expected data from file (again)');
+ok(-e $CacheFile, 'but this time a cache file was created');
+$t0 = (stat($CacheFile))[9]; # Remember cache timestamp
PassTime($t0);
$opt = XMLin($XMLFile, cache => 'storable');
-ok(7, DataCompare($opt, $Expected)); # Got what we expected from the cache
-my $t1 = (stat($CacheFile))[9]; # Check cache timestamp
-ok(8, $t0, $t1); # has not changed
+is_deeply($opt, $Expected, 'got expected data from cache');
+$t1 = (stat($CacheFile))[9];
+is($t0, $t1, 'and cache timestamp has not changed');
PassTime(time());
$t0 = time();
@@ -197,20 +135,21 @@
print FILE "\n";
close(FILE);
$opt = XMLin($XMLFile, cache => 'storable');
-ok(9, DataCompare($opt, $Expected)); # Got what we expected
-my $t2 = (stat($CacheFile))[9]; # Check cache timestamp
-ok(10, $t1 != $t2); # has changed
+is_deeply($opt, $Expected, 'parsed in expected value again');
+$t2 = (stat($CacheFile))[9];
+isnt($t1, $t2, 'and this time the cache timestamp has changed');
unlink($XMLFile);
-ok(11, ! -e $XMLFile); # Original XML file is gone
+ok(! -e $XMLFile, 'deleted the cache file');
open(FILE, ">$XMLFile"); # Re-create it (empty)
close(FILE);
+ok(-e $XMLFile, 'recreated the source file');
+is(-s $XMLFile, 0, 'but with nothing in it');
PassTime((stat($XMLFile))[9]); # But ensure cache file is newer
unlink($CacheFile); # Seems to be rqd for test on Win32
Storable::nstore($Expected, $CacheFile);
$opt = XMLin($XMLFile, cache => 'storable');
-ok(12, DataCompare($opt, $Expected)); # Got what we expected from the cache
-ok(13, ! -s $XMLFile); # even though the XML file is empty
+is_deeply($opt, $Expected, 'got the expected data from the cache');
$t2 = (stat($CacheFile))[9];
PassTime($t2);
open(FILE, ">$XMLFile") || # Write some new data to the XML file
@@ -219,23 +158,23 @@
close(FILE);
$opt = XMLin($XMLFile); # Parse with no caching
-ok(14, DataCompare($opt, { one => 1, two => 2})); # Got what we expected
+is_deeply($opt, { one => 1, two => 2}, 'parsed in expected data from file');
$t0 = (stat($CacheFile))[9]; # And timestamp on cache file
my $s0 = (-s $CacheFile);
-ok(15, $t0 == $t2); # has not changed
+is($t0, $t2, 'and the cache file was not touched');
# Parse again with caching enabled
$opt = XMLin($XMLFile, cache => 'storable');
- # Came through the cache
-ok(16, DataCompare($opt, { one => 1, two => 2}));
-$t1 = (stat($CacheFile))[9]; # which has been updated
+is_deeply($opt, { one => 1, two => 2}, 'parsed expected data through cache');
+$t1 = (stat($CacheFile))[9];
my $s1 = (-s $CacheFile);
-ok(17, ($t0 != $t1) || ($s0 != $s1)); # Content changes but date may not on Win32
+ok(($t0 != $t1) || ($s0 != $s1),
+'and the cache was updated'); # Content changes but date may not on Win32
-ok(18, CopyFile($SrcFile, $XMLFile)); # Put back the original file
+ok(CopyFile($SrcFile, $XMLFile), 'copied back the original file');
PassTime($t1);
$opt = XMLin($XMLFile, cache => 'storable');
-ok(19, DataCompare($opt, $Expected)); # Got what we expected
+is_deeply($opt, $Expected, 'parsed expected data in through cache');
# Clean up and go
Index: 4_MemShare.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/4_MemShare.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- 4_MemShare.t 5 Feb 2002 22:28:31 -0000 1.2
+++ 4_MemShare.t 16 Oct 2002 09:43:35 -0000 1.3
@@ -1,7 +1,8 @@
# $Id$
+# vim: syntax=perl
use strict;
-
+use Test::More;
use File::Spec;
# Initialise filenames and check they're there
@@ -10,91 +11,30 @@
my $XMLFile = File::Spec->catfile('t', 'desertnet.xml');
unless(-e $SrcFile) {
- print STDERR "test data missing...";
- print "1..0\n";
- exit 0;
+ plan skip_all => 'test data missing';
}
-print "1..7\n";
-
-my $t = 1;
-
-##############################################################################
-# S U P P O R T R O U T I N E S
-##############################################################################
-
-##############################################################################
-# Print out 'n ok' or 'n not ok' as expected by test harness.
-# First arg is test number (n). If only one following arg, it is interpreted
-# as true/false value. If two args, equality = true.
-#
+# Make sure we can write to the filesystem and check it uses the same
+# clock as the machine we're running on.
-sub ok {
- my($n, $x, $y) = @_;
- die "Sequence error got $n expected $t" if($n != $t);
- $x = 0 if(@_ > 2 and $x ne $y);
- print(($x ? '' : 'not '), 'ok ', $t++, "\n");
+my $t0 = time();
+unless(open(XML, ">$XMLFile")) {
+ plan skip_all => "can't create test file: $!";
}
+close(XML);
+my $t1 = (stat($XMLFile))[9];
+my $t2 = time();
+if($t1 < $t0 or $t2 < $t1) {
+ plan skip_all => 'time moved backwards!'
+}
-##############################################################################
-# Take two scalar values (may be references) and compare them (r...
[truncated message content] |
|
From: Christian G. <phi...@us...> - 2002-10-14 20:12:41
|
Update of /cvsroot/perl-xml/XML-LibXML-Common
In directory usw-pr-cvs1:/tmp/cvs-serv9743
Modified Files:
Common.xs
Log Message:
Modified Files:
Common.xs
+ free unused strings
Makefile.PL
?
Index: Common.xs
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-Common/Common.xs,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -u -d -r1.1.1.1 -r1.2
--- Common.xs 2 Sep 2002 09:15:16 -0000 1.1.1.1
+++ Common.xs 14 Oct 2002 20:12:37 -0000 1.2
@@ -108,7 +108,7 @@
}
}
- if ( !tstr ) {
+ if ( !tstr ) {b
croak( "return value missing!" );
}
@@ -117,6 +117,7 @@
#ifdef HAVE_UTF8
SvUTF8_on(RETVAL);
#endif
+ xmlFree(tstr);
}
else {
XSRETURN_UNDEF;
|
|
From: Christian G. <phi...@us...> - 2002-10-14 10:34:56
|
Update of /cvsroot/perl-xml/XML-LibXML-Common
In directory usw-pr-cvs1:/tmp/cvs-serv16183
Modified Files:
Changes Common.pm README MANIFEST
Added Files:
LICENSE
Log Message:
Modified Files:
Changes README MANIFEST
+ some notes about the license and other things
Common.pm
+ version number update ...
Added Files:
LICENSE
+ make people happy :)
--- NEW FILE: LICENSE ---
XML::LibXML::Common is dual licensed under the same terms as Perl itself.
This means at your choice, either the Perl Artistic License, or
the GNU GPL version 1 or higher.
Index: Changes
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-Common/Changes,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- Changes 14 Sep 2002 20:20:30 -0000 1.2
+++ Changes 14 Oct 2002 10:34:53 -0000 1.3
@@ -6,3 +6,6 @@
0.10 Sat Aug 31 20:00:00 2002
- implemented encoding functions
- libxml/ libgdome conform implementation
+
+0.11 Sat Okt 12 21:30:00 2002
+ - added a disclaimer note and the license statement
\ No newline at end of file
Index: Common.pm
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-Common/Common.pm,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -u -d -r1.1.1.1 -r1.2
--- Common.pm 2 Sep 2002 09:15:16 -0000 1.1.1.1
+++ Common.pm 14 Oct 2002 10:34:53 -0000 1.2
@@ -14,7 +14,7 @@
@ISA = qw(DynaLoader Exporter);
-$VERSION = '0.10';
+$VERSION = '0.11';
bootstrap XML::LibXML::Common $VERSION;
Index: README
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-Common/README,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- README 14 Sep 2002 20:20:30 -0000 1.2
+++ README 14 Oct 2002 10:34:53 -0000 1.3
@@ -1,5 +1,5 @@
-XML::LibXML::Common version 0.10
-================================
+XML::LibXML::Common
+===================
XML::LibXML::Common contains several constants and functions that
are shared by XML::LibXML, XML::GDOME and XML::LibXSLT (not all done, yet)
@@ -7,12 +7,23 @@
This package is required at least for XML::LibXML 1.53 or later to
work properly.
-the latest cvs can be found at sourceforge:
-
+The latest cvs can be found at sourceforge:
http://sourceforge.net/projects/perl-xml
-for requests please contact me by e-mail. i try to answer my e-mails
-on a regular basis. but since i am offline from time to time it may take
-up to a week before i will be able to answer.
+For requests please contact me by e-mail. I try to answer my e-mails
+on a regular basis. But since I am offline from time to time it may take
+up to a week before I will be able to answer.
+
+AUTHOR
+======
christian glahn ( christian.glahn at uibk.ac.at )
+
+Copyright 2001-2002 University of Innsbruck, All rights reserved.
+
+DISCLAIMER
+==========
+
+THIS PROGRAM IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT
+WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF
+MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
Index: MANIFEST
===================================================================
RCS file: /cvsroot/perl-xml/XML-LibXML-Common/MANIFEST,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -u -d -r1.1.1.1 -r1.2
--- MANIFEST 2 Sep 2002 09:15:16 -0000 1.1.1.1
+++ MANIFEST 14 Oct 2002 10:34:53 -0000 1.2
@@ -1,5 +1,6 @@
Changes
Common.pm
+LICENSE
Makefile.PL
MANIFEST
README
|
|
From: Grant M. <gr...@us...> - 2002-10-13 03:59:27
|
Update of /cvsroot/perl-xml/xml-simple/t
In directory usw-pr-cvs1:/tmp/cvs-serv31187
Modified Files:
8_Namespaces.t
Log Message:
- fixed test which assumed hash key order
Index: 8_Namespaces.t
===================================================================
RCS file: /cvsroot/perl-xml/xml-simple/t/8_Namespaces.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- 8_Namespaces.t 14 Feb 2002 21:34:34 -0000 1.2
+++ 8_Namespaces.t 13 Oct 2002 03:59:24 -0000 1.3
@@ -26,6 +26,7 @@
print "1..7\n";
+$| = 1;
my $t = 1;
##############################################################################
@@ -202,8 +203,8 @@
$xml = XMLout($opt);
ok(3, $xml =~ m{
^\s*<opt
- \s+{http://www.w3.org/2000/xmlns/}perl="http://www.perl.com/"
- \s+{http://www.perl.com/}attr="value"
+ (\s+{http://www.w3.org/2000/xmlns/}perl="http://www.perl.com/"
+ |\s+{http://www.perl.com/}attr="value"){2}
\s*>
\s*<{http://www.perl.com/}element\s*>data</{http://www.perl.com/}element\s*>
\s*</opt>
@@ -216,8 +217,8 @@
$xml = XMLout($opt, nsexpand => 1);
ok(4, $xml =~ m{
^\s*<opt
- \s+xmlns:perl="http://www.perl.com/"
- \s+perl:attr="value"
+ (\s+xmlns:perl="http://www.perl.com/"
+ |\s+perl:attr="value"){2}
\s*>
\s*<perl:element\s*>data</perl:element\s*>
\s*</opt>
@@ -275,16 +276,20 @@
};
$xml = XMLout($opt, nsexpand => 1);
+my $prefix = '';
+if($xml =~ m{<list\s+xmlns:(\w+)="http://www.phantom.com/"\s*>}) {
+ $prefix = $1;
+}
ok(7, $xml =~ m{
^\s*<opt
\s+xmlns="http://www.orgsoc.org/"
\s*>
- \s*<list\s+xmlns:(\w+)="http://www.phantom.com/"\s*>
- \s*<member>Tom</member>
- \s*<member>Dick</member>
- \s*<member>Larry</member>
- \s*<\1:director>Bill</\1:director>
- \s*<\1:director>Ben</\1:director>
+ \s*<list\s+xmlns:${prefix}="http://www.phantom.com/"\s*>
+ (\s*<member>Tom</member>
+ \s*<member>Dick</member>
+ \s*<member>Larry</member>
+ |\s*<${prefix}:director>Bill</${prefix}:director>
+ \s*<${prefix}:director>Ben</${prefix}:director>){2}
\s*</list>
\s*</opt>
\s*$
|
|
From: Grant M. <gr...@us...> - 2002-10-13 01:32:58
|
Update of /cvsroot/perl-xml/xml-simple/lib/XML/Simple In directory usw-pr-cvs1:/tmp/cvs-serv4891/lib/XML/Simple Modified Files: FAQ.pod Log Message: - added question about empty elements Index: FAQ.pod =================================================================== RCS file: /cvsroot/perl-xml/xml-simple/lib/XML/Simple/FAQ.pod,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- FAQ.pod 13 Oct 2002 01:21:36 -0000 1.2 +++ FAQ.pod 13 Oct 2002 01:32:55 -0000 1.3 @@ -615,6 +615,14 @@ option controls whether hashes get 'unfolded' into arrays. As described above, 'keyattr' is enabled by default. +=head2 Why are empty elements represented as empty hashes? + +An element is always represented as a hash unless it contains only text, in +which case it is represented as a scalar string. + +If you would prefer empty elements to be represented as empty strings or the +undefined value, set the 'suppressempty' option to '' or undef respectively. + =cut |
|
From: Grant M. <gr...@us...> - 2002-10-13 01:21:38
|
Update of /cvsroot/perl-xml/xml-simple/lib/XML/Simple In directory usw-pr-cvs1:/tmp/cvs-serv2950/lib/XML/Simple Modified Files: FAQ.pod Log Message: - added 'Why is XML::Simple so slow?' - added 'Why does XMLout() insert <name> elements (or attributes)?' - sundry minor edits Index: FAQ.pod =================================================================== RCS file: /cvsroot/perl-xml/xml-simple/lib/XML/Simple/FAQ.pod,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- FAQ.pod 13 Oct 2002 01:20:14 -0000 1.1 +++ FAQ.pod 13 Oct 2002 01:21:36 -0000 1.2 @@ -1,4 +1,7 @@ package XML::Simple::FAQ; +1; + +__END__ =head1 Frequently Asked Questions about XML::Simple @@ -120,11 +123,10 @@ Every one of them except XML::Simple :-) -If you're looking for a personal recommendation, I'd suggest you look at -XML::XPath and XML::Twig. You could also try using XML::Parser (since you -probably have it installed already) but may find that the API is a bit -'low-level'. There are more pointers on this subject in the 'Where to from -here?' section of the XML::Simple manual page. +If you're looking for a recommendation, I'd suggest you look at the Perl-XML +FAQ at: + + http://www.perlxml.net/perl-xml-faq.dkb =head1 Installation @@ -132,8 +134,14 @@ =head2 How do I install XML::Simple? -You need to have XML::Parser installed first (it comes 'out of the box' with -ActiveState Perl). Once you have that ... +If you're running ActiveState Perl, you've probably already got XML::Simple +(although you may want to upgrade to version 1.09 or better for SAX support). + +If you do need to install XML::Simple, you'll need to install an XML parser +module first. Install either XML::Parser (which you may have already) or +XML::SAX. If you install both, XML::SAX will be used by default. + +Once you have a parser installed ... On Unix systems, try: @@ -195,11 +203,18 @@ If none of these scenarios match your situation, please confirm you're running the latest version of XML::Simple and then email the output of -'make test' to me at gr...@we... +'make test' to me at gr...@cp... +=head2 Why is XML::Simple so slow? + +If you find that XML::Simple is very slow reading XML, the most likely reason +is that you have XML::SAX installed but no additional SAX parser module. The +XML::SAX distribution includes an XML parser written entirely in Perl. This is +very portable but not very fast. For better performance install either +XML::SAX::Expat or XML::LibXML. -=head1 Usage +=head1 Usage =head2 How do I use XML::Simple? @@ -496,6 +511,12 @@ unless you've got array folding enabled, in which case they'll be folded into a hash +=item * + +empty elements (no text contents B<and> no attributes) will either be +represented as an empty hash, an empty string or undef - depending on the value +of the 'suppressempty' option. + =back If you're in any doubt, use Data::Dumper, eg: @@ -584,6 +605,15 @@ =back + +=head2 Why does XMLout() insert E<lt>nameE<gt> elements (or attributes)? + +Try setting keyattr => []. + +When you call XMLin() to read XML, the 'keyattr' option controls whether arrays +get 'folded' into hashes. Similarly, when you call XMLout(), the 'keyattr' +option controls whether hashes get 'unfolded' into arrays. As described above, +'keyattr' is enabled by default. =cut |
|
From: Grant M. <gr...@us...> - 2002-10-13 01:20:16
|
Update of /cvsroot/perl-xml/xml-simple In directory usw-pr-cvs1:/tmp/cvs-serv2682 Modified Files: MANIFEST Log Message: - added FAQ.pod to distribution Index: MANIFEST =================================================================== RCS file: /cvsroot/perl-xml/xml-simple/MANIFEST,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- MANIFEST 13 Oct 2002 01:16:31 -0000 1.4 +++ MANIFEST 13 Oct 2002 01:20:14 -0000 1.5 @@ -3,6 +3,7 @@ Makefile.PL README lib/XML/Simple.pm +lib/XML/Simple/FAQ.pod maketest t/0_Config.t t/1_XMLin.t |
|
From: Grant M. <gr...@us...> - 2002-10-13 01:20:16
|
Update of /cvsroot/perl-xml/xml-simple/lib/XML/Simple
In directory usw-pr-cvs1:/tmp/cvs-serv2682/lib/XML/Simple
Added Files:
FAQ.pod
Log Message:
- added FAQ.pod to distribution
--- NEW FILE: FAQ.pod ---
package XML::Simple::FAQ;
=head1 Frequently Asked Questions about XML::Simple
=head1 Basics
=head2 What is XML::Simple designed to be used for?
XML::Simple is a Perl module that was originally developed as a tool for
reading and writing configuration data in XML format. You can use it for
many other purposes that involve storing and retrieving structured data in
XML.
You might also find XML::Simple a good starting point for playing with XML
from Perl. It doesn't have a steep learning curve and if you outgrow its
capabilities there are plenty of other Perl/XML modules to 'step up' to.
=head2 Why store configuration data in XML anyway?
The many advantages of using XML format for configuration data include:
=over 4
=item *
Using existing XML parsing tools requires less development time, is easier
and more robust than developing your own config file parsing code
=item *
XML can represent relationships between pieces of data, such as nesting of
sections to arbitrary levels (not easily done with .INI files for example)
=item *
XML is basically just text, so you can easily edit a config file (easier than
editing a Win32 registry)
=item *
XML provides standard solutions for handling character sets and encoding
beyond basic ASCII (important for internationalization)
=item *
If it becomes necessary to change your configuration file format, there are
many tools available for performing transformations on XML files
=item *
XML is an open standard (the world does not need more proprietary binary
file formats)
=item *
Taking the extra step of developing a DTD allows the format of configuration
files to be validated before your program reads them (not directly supported
by XML::Simple)
=item *
Combining a DTD with a good XML editor can give you a GUI config editor for
minimal coding effort
=back
=head2 What isn't XML::Simple good for?
The main limitation of XML::Simple is that it does not work with 'mixed
content' (see the next question). If you consider your XML files contain
marked up text rather than structured data, you should probably use another
module.
If you are working with very large XML files, XML::Simple's approach of
representing the whole file in memory as a 'tree' data structure may not be
suitable.
=head2 What is mixed content?
Consider this example XML:
<document>
<para>This is <em>mixed</em> content.</para>
</document>
This is said to be mixed content, because the E<lt>paraE<gt> element contains
both character data (text content) and nested elements.
Here's some more XML:
<person>
<first_name>Joe</first_name>
<last_name>Bloggs</last_name>
<dob>25-April-1969</dob>
</person>
This second example is not generally considered to be mixed content. The
E<lt>first_nameE<gt>, E<lt>last_nameE<gt> and E<lt>dobE<gt> elements contain
only character data and the E<lt>personE<gt> element contains only nested
elements. (Note: Strictly speaking, the whitespace between the nested
elements is character data, but it is ignored by XML::Simple).
=head2 Why doesn't XML::Simple handle mixed content?
Because if it did, it would no longer be simple :-)
Seriously though, there are plenty of excellent modules that allow you to
work with mixed content in a variety of ways. Handling mixed content
correctly is not easy and by ignoring these issues, XML::Simple is able to
present an API without a steep learning curve.
=head2 Which Perl modules do handle mixed content?
Every one of them except XML::Simple :-)
If you're looking for a personal recommendation, I'd suggest you look at
XML::XPath and XML::Twig. You could also try using XML::Parser (since you
probably have it installed already) but may find that the API is a bit
'low-level'. There are more pointers on this subject in the 'Where to from
here?' section of the XML::Simple manual page.
=head1 Installation
=head2 How do I install XML::Simple?
You need to have XML::Parser installed first (it comes 'out of the box' with
ActiveState Perl). Once you have that ...
On Unix systems, try:
perl -MCPAN -e 'install XML::Simple'
If that doesn't work, download the latest distribution from
http://web.co.nz/~grantm/cpan/ , unpack it and run these commands:
perl Makefile.PL
make
make test
make install
On Win32, if you have a recent build of ActiveState Perl (618 or better) try
this command:
ppm install XML::Simple
If that doesn't work, you really only need the Simple.pm file, so grab it
from the above site and save it in the \site\lib\XML directory under your
Perl installation (typically C:\Perl).
=head2 I'm trying to install XML::Simple and 'make test' fails
Is the directory where you've unpacked XML::Simple mounted from a file server
using NFS, SMB or some other network file sharing? If so, that may cause
errors in the the following test scripts:
3_Storable.t
4_MemShare.t
5_MemCopy.t
The test suite is designed to exercise the boundary conditions of all
XML::Simple's functionality and these three scripts exercise the caching
functions. If XML::Simple is asked to parse a file for which it has a cached
copy of a previous parse, then it compares the timestamp on the XML file with
the timestamp on the cached copy. If the cached copy is *newer* then it will
be used. If the cached copy is older or the same age then the file is
re-parsed. The test scripts will get confused by networked filesystems if
the workstation and server system clocks are not synchronised (to the
second).
If you get an error in one of these three test scripts but you don't plan to
use the caching options (they're not enabled by default), then go right ahead
and run 'make install'. If you do plan to use caching, then try unpacking
the distribution on local disk and doing the build/test there.
It's probably not a good idea to use the caching options with networked
filesystems in production. If the file server's clock is ahead of the local
clock, XML::Simple will re-parse files when it could have used the cached
copy. However if the local clock is ahead of the file server clock and a
file is changed immediately after it is cached, the old cached copy will be
used.
Is one of the three test scripts (above) failing but you're not running on
a network filesystem? Are you running Win32? If so, you may be seeing a bug
in Win32 where writes to a file do not affect its modfication timestamp.
If none of these scenarios match your situation, please confirm you're
running the latest version of XML::Simple and then email the output of
'make test' to me at gr...@we...
=head1 Usage
=head2 How do I use XML::Simple?
If you had an XML document called /etc/appconfig/foo.xml you could 'slurp' it
into a simple data structure (typically a hashref) with these lines of code:
use XML::Simple;
my $config = XMLin('/etc/appconfig/foo.xml');
The XMLin() function accepts options after the filename.
=head2 There are so many options, which ones do I really need to know about?
Although you can get by without using any options, you shouldn't even
consider using XML::Simple in production until you know what these two
options do:
=over 4
=item *
forcearray
=item *
keyattr
=back
The reason you really need to read about them is because the default values
for these options will trip you up if you don't. Although everyone agrees
that these defaults are not ideal, there is not wide agreement on what they
should be changed to. The answer therefore is to read about them (see below)
and select values which are right for you.
=head2 What is the forcearray option all about?
Consider this XML in a file called ./person.xml:
<person>
<first_name>Joe</first_name>
<last_name>Bloggs</last_name>
<hobbie>bungy jumping</hobbie>
<hobbie>sky diving</hobbie>
<hobbie>knitting</hobbie>
</person>
You could read it in with this line:
my $person = XMLin('./person.xml');
Which would give you a data structure like this:
$person = {
'first_name' => 'Joe',
'last_name' => 'Bloggs',
'hobbie' => [ 'bungy jumping', 'sky diving', 'knitting' ]
};
The E<lt>first_nameE<gt> and E<lt>last_nameE<gt> elements are represented as
simple scalar values which you could refer to like this:
print "$person->{first_name} $person->{last_name}\n";
The E<lt>hobbieE<gt> elements are represented as an array - since there is
more than one. You could refer to the first one like this:
print $person->{hobbie}->[0], "\n";
Or the whole lot like this:
print join(', ', @{$person->{hobbie}} ), "\n";
The catch is, that these last two lines of code will only work for people
who have more than one hobbie. If there is only one E<lt>hobbieE<gt>
element, it will be represented as a simple scalar (just like
E<lt>first_nameE<gt> and E<lt>last_nameE<gt>). Which might lead you to write
code like this:
if(ref($person->{hobbie})) {
print join(', ', @{$person->{hobbie}} ), "\n";
}
else {
print $person->{hobbie}, "\n";
}
Don't do that.
One alternative approach is to set the forcearray option to a true value:
my $person = XMLin('./person.xml', forcearray => 1);
Which will give you a data structure like this:
$person = {
'first_name' => [ 'Joe' ],
'last_name' => [ 'Bloggs' ],
'hobbie' => [ 'bungy jumping', 'sky diving', 'knitting' ]
};
Then you can use this line to refer to all the list of hobbies even if there
was only one:
print join(', ', @{$person->{hobbie}} ), "\n";
The downside of this approach is that the E<lt>first_nameE<gt> and
E<lt>last_nameE<gt> elements will also always be represented as arrays even
though there will never be more than one:
print "$person->{first_name}->[0] $person->{last_name}->[0]\n";
This might be OK if you change the XML to use attributes for things that
will always be singular and nested elements for things that may be plural:
<person first_name="Jane" last_name="Bloggs">
<hobbie>motorcycle maintenance</hobbie>
</person>
On the other hand, if you prefer not to use attributes, then you could
specify that any E<lt>hobbieE<gt> elements should always be represented as
arrays and all other nested elements should be simple scalar values unless
there is more than one:
my $person = XMLin('./person.xml', forcearray => [ 'hobbie' ]);
The forcearray option accepts a list of element names which should always
be forced to an array representation:
forcearray => [ qw(hobbie qualification childs_name) ]
See the XML::Simple manual page for more information.
=head2 What is the keyattr option all about?
Consider this sample XML:
<catalog>
<part partnum="1842334" desc="High pressure flange" price="24.50" />
<part partnum="9344675" desc="Threaded gasket" price="9.25" />
<part partnum="5634896" desc="Low voltage washer" price="12.00" />
</catalog>
You could slurp it in with this code:
my $catalog = XMLin('./catalog.xml');
Which would return a data structure like this:
$catalog = {
'part' => [
{
'partnum' => '1842334',
'desc' => 'High pressure flange',
'price' => '24.50'
},
{
'partnum' => '9344675',
'desc' => 'Threaded gasket',
'price' => '9.25'
},
{
'partnum' => '5634896',
'desc' => 'Low voltage washer',
'price' => '12.00'
}
]
};
Then you could access the description of the first part in the catalog
with this code:
print $catalog->{part}->[0]->{desc}, "\n";
However, if you wanted to access the description of the part with the
part number of "9344675" then you'd have to code a loop like this:
foreach my $part (@{$catalog->{part}}) {
if($part->{partnum} eq '9344675') {
print $part->{desc}, "\n";
last;
}
}
The knowledge that each E<lt>partE<gt> element has a unique partnum attribute
allows you to eliminate this search. You can pass this knowledge on to
XML::Simple like this:
my $catalog = XMLin($xml, keyattr => ['partnum']);
Which will return a data structure like this:
$catalog = {
'part' => {
'5634896' => { 'desc' => 'Low voltage washer', 'price' => '12.00' },
'1842334' => { 'desc' => 'High pressure flange', 'price' => '24.50' },
'9344675' => { 'desc' => 'Threaded gasket', 'price' => '9.25' }
}
};
XML::Simple has been able to transform $catalog->{part} from an arrayref to
a hashref (keyed on partnum). This transformation is called 'array folding'.
Through the use of array folding, you can now index directly to the
description of the part you want:
print $catalog->{part}->{9344675}->{desc}, "\n";
The 'keyattr' option also enables array folding when the unique key is in a
nested element rather than an attribute. eg:
<catalog>
<part>
<partnum>1842334</partnum>
<desc>High pressure flange</desc>
<price>24.50</price>
</part>
<part>
<partnum>9344675</partnum>
<desc>Threaded gasket</desc>
<price>9.25</price>
</part>
<part>
<partnum>5634896</partnum>
<desc>Low voltage washer</desc>
<price>12.00</price>
</part>
</catalog>
See the XML::Simple manual page for more information.
=head2 So what's the catch with 'keyattr'?
One thing to watch out for is that you might get array folding even if you
don't supply the keyattr option. The default value for this option is:
[ 'name', 'key', 'id']
Which means if your XML elements have a 'name', 'key' or 'id' attribute (or
nested element) then they may get folded on those values. This means that
you can take advantage of array folding simply through careful choice of
attribute names. On the hand, if you really don't want array folding at all,
you'll need to set 'key attr to an empty list:
my $ref = XMLin($xml, keyattr => []);
A second 'gotcha' is that array folding only works on arrays. That might
seem obvious, but if there's only one record in your XML and you didn't set
the 'forcearray' option then it won't be represented as an array and
consequently won't get folded into a hash. The moral is that if you're
using array folding, you should always turn on the forcearray option.
You probably want to be as specific as you can be too. For instance, the
safest way to parse the E<lt>catalogE<gt> example above would be:
my $catalog = XMLin($xml, keyattr => { part => 'partnum'}
forcearray => ['part']);
By using the hashref for keyattr, you can specify that only E<lt>partE<gt>
elements should be folded on the 'partnum' attribute (and that the
E<lt>partE<gt> elements should not be folded on any other attribute).
By supplying a list of element names for forcearray, you're ensuring that
folding will work even if there's only one E<lt>partE<gt>. You're also
ensuring that if the 'partnum' unique key is supplied in a nested element
then that element won't get forced to an array too.
=head2 How do I know what my data structure should look like?
The rules are fairly straightforward:
=over 4
=item *
each element gets represented as a hash
=item *
unless it contains only text, in which case it'll be a simple scalar value
=item *
or unless there's more than one element with the same name, in which case
they'll be represented as an array
=item *
unless you've got array folding enabled, in which case they'll be folded into
a hash
=back
If you're in any doubt, use Data::Dumper, eg:
use XML::Simple;
use Data::Dumper;
my $ref = XMLin($xml);
print Dumper($ref);
=head2 I'm getting 'Use of uninitialized value' warnings
You're probably trying to index into a non-existant hash key - try
Data::Dumper.
=head2 I'm getting a 'Not an ARRAY reference' error
Something that you expect to be an array is not. The two most likely causes
are that you forgot to use 'forcearray' or that the array got folded into a
hash - try Data::Dumper.
=head2 I'm getting a 'No such array field' error
Something that you expect to be a hash is actually an array. Perhaps array
folding failed because one element was missing the key attribute - try
Data::Dumper.
=head2 I'm getting an 'Out of memory' error
Something in the data structure is not as you expect and Perl may be trying
unsuccessfully to autovivify things - try Data::Dumper.
If you're already using Data::Dumper, try calling Dumper() immediately after
XMLin() - ie: before you attempt to access anything in the data structure.
=head2 My element order is getting jumbled up
If you read an XML file with XMLin() and then write it back out with
XMLout(), the order of the elements will likely be different. (However, if
you read the file back in with XMLin() you'll get the same Perl data
structure).
The reordering happens because XML::Simple uses hashrefs to store your data
and Perl hashes do not really have any order.
It is possible that a future version of XML::Simple will use Tie::IxHash
to store the data in hashrefs which do retain the order. However this will
not fix all cases of element order being lost.
If your application really is sensitive to element order, don't use
XML::Simple (and don't put order-sensitive values in attributes).
=head2 XML::Simple turns nested elements into attributes
If you read an XML file with XMLin() and then write it back out with
XMLout(), some data which was originally stored in nested elements may end up
in attributes. (However, if you read the file back in with XMLin() you'll
get the same Perl data structure).
There are a number of ways you might handle this:
=over 4
=item *
use the 'forcearray' option with XMLin()
=item *
use the 'noattr' option with XMLout()
=item *
live with it
=item *
don't use XML::Simple
=back
=cut
|
|
From: Grant M. <gr...@us...> - 2002-10-13 01:18:59
|
Update of /cvsroot/perl-xml/xml-simple/lib/XML/Simple In directory usw-pr-cvs1:/tmp/cvs-serv2452/lib/XML/Simple Log Message: Directory /cvsroot/perl-xml/xml-simple/lib/XML/Simple added to the repository |
|
From: Grant M. <gr...@us...> - 2002-10-13 01:16:33
|
Update of /cvsroot/perl-xml/xml-simple/lib/XML
In directory usw-pr-cvs1:/tmp/cvs-serv1993/lib/XML
Added Files:
Simple.pm
Log Message:
- moved Simple.pm to lib/XML/Simple.pm
--- NEW FILE: Simple.pm ---
# $Id: Simple.pm,v 1.1 2002/10/13 01:16:31 grantm Exp $
package XML::Simple;
=head1 NAME
XML::Simple - Easy API to maintain XML (esp config files)
=head1 SYNOPSIS
use XML::Simple;
my $ref = XMLin([<xml file or string>] [, <options>]);
my $xml = XMLout($hashref [, <options>]);
Or the object oriented way:
require XML::Simple;
[...2304 lines suppressed...]
This version (1.09) is the current stable version.
=head1 SEE ALSO
B<XML::Simple> requires either B<XML::Parser> or B<XML::SAX>.
To generate documents with namespaces, B<XML::NamespaceSupport> is required.
The optional caching functions require B<Storable>.
=head1 COPYRIGHT
Copyright 1999-2002 Grant McLean E<lt>gr...@cp...E<gt>
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
|
|
From: Grant M. <gr...@us...> - 2002-10-13 01:16:33
|
Update of /cvsroot/perl-xml/xml-simple In directory usw-pr-cvs1:/tmp/cvs-serv1993 Modified Files: MANIFEST Removed Files: Simple.pm Log Message: - moved Simple.pm to lib/XML/Simple.pm Index: MANIFEST =================================================================== RCS file: /cvsroot/perl-xml/xml-simple/MANIFEST,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- MANIFEST 5 Feb 2002 22:16:53 -0000 1.3 +++ MANIFEST 13 Oct 2002 01:16:31 -0000 1.4 @@ -2,7 +2,7 @@ MANIFEST Makefile.PL README -Simple.pm +lib/XML/Simple.pm maketest t/0_Config.t t/1_XMLin.t --- Simple.pm DELETED --- |
|
From: Grant M. <gr...@us...> - 2002-10-13 01:14:35
|
Update of /cvsroot/perl-xml/xml-simple/lib/XML In directory usw-pr-cvs1:/tmp/cvs-serv1522/lib/XML Log Message: Directory /cvsroot/perl-xml/xml-simple/lib/XML added to the repository |
|
From: Grant M. <gr...@us...> - 2002-10-13 01:14:19
|
Update of /cvsroot/perl-xml/xml-simple/lib In directory usw-pr-cvs1:/tmp/cvs-serv1485/lib Log Message: Directory /cvsroot/perl-xml/xml-simple/lib added to the repository |
1 message has been excluded from this view by a project administrator.
