libdata-dumpxml-perl-1.06.orig/0000755000000000000000000000000010415635034015122 5ustar rootrootlibdata-dumpxml-perl-1.06.orig/Changes0000644000000000000000000000365210415635034016423 0ustar rootroot2003-12-18 Gisle Aas Release 1.06 Documentation fixes by Paul Croome . 2003-01-06 Gisle Aas Release 1.05 XML Schema fix by Jonathan Stowe . 2002-12-27 Gisle Aas Release 1.04 Fixed duplicte ATTLIST definition of undef in the DTD. 2001-12-30 Gisle Aas Release 1.03 Enabling of namespace prefix would generate bad XML; a few end tags would end up un-prefixed. Patch by Jonathan Stowe . Setting $INDENT to "", now suppress most newlines in the output too. New configuration variable: $INDENT_STYLE Documentation improved a bit. Data::DumpXML::Parser will now turn on the 'Namespaces' option automatically. Data-DumpXML.xsd fixes: - make element 'key' a complex type with simple content (instead of mixed) 2001-12-11 Gisle Aas Release 1.02 Added namespace support based on a patch by Jonathan Stowe. Added an XML Schema document that describes the dump format. Escape ']]>' when it occurs strings. 2000-09-19 Gisle Aas Release 1.01 Added Blesser argument to Data::DumpXML::Parser. This can be used to guard which objects are restored. Patch by Jonathan Stowe . 2000-09-11 Gisle Aas Release 1.00 Compensate for the way references to references are stringified in perl-5.7.0. 2000-01-13 Gisle Aas Release 0.02 Fix " typo; spotted by Matt Sergeant Don't encode ">", just because we can. Deal with binary hash keys. The parser will now use av_push instead of av_store and a index to build arrays. 2000-01-10 Gisle Aas Release 0.01 Based on Data-Dump-0.03 libdata-dumpxml-perl-1.06.orig/Data-DumpXML.dtd0000644000000000000000000000153110415635034017754 0ustar rootroot libdata-dumpxml-perl-1.06.orig/Data-DumpXML.xsd0000644000000000000000000000474410415635034020010 0ustar rootroot libdata-dumpxml-perl-1.06.orig/DumpXML.pm0000644000000000000000000002144710415635034016756 0ustar rootrootpackage Data::DumpXML; use strict; use vars qw(@EXPORT_OK $VERSION); require Exporter; *import = \&Exporter::import; @EXPORT_OK=qw(dump_xml dump_xml2 dump); $VERSION = "1.06"; # $Date: 2003/12/18 09:18:27 $ # configuration use vars qw($INDENT $INDENT_STYLE $XML_DECL $CPAN $NAMESPACE $NS_PREFIX $SCHEMA_LOCATION $DTD_LOCATION); $INDENT_STYLE = "XML" unless defined $INDENT_STYLE; $XML_DECL = 1 unless defined $XML_DECL; $INDENT = " " unless defined $INDENT; $CPAN = "http://www.cpan.org/modules/by-authors/Gisle_Aas/" unless defined $CPAN; $NAMESPACE = $CPAN . "Data-DumpXML-1.05.xsd" unless defined $NAMESPACE; $NS_PREFIX = "" unless defined $NS_PREFIX; $SCHEMA_LOCATION = "" unless defined $SCHEMA_LOCATION; $DTD_LOCATION = $CPAN . "Data-DumpXML-1.04.dtd" unless defined $DTD_LOCATION; # other globals use vars qw($NL); use overload (); use vars qw(%seen %ref $count $prefix); sub dump_xml2 { local $DTD_LOCATION = ""; local $XML_DECL = ""; dump_xml(@_); } sub dump_xml { local %seen; local %ref; local $count = 0; local $prefix = ($NAMESPACE && $NS_PREFIX) ? "$NS_PREFIX:" : ""; local $NL = ($INDENT) ? "\n" : ""; my $out = ""; $out .= qq(\n) if $XML_DECL; $out .= qq(\n) if $DTD_LOCATION; $out .= "<${prefix}data"; $out .= " " . ($NS_PREFIX ? "xmlns:$NS_PREFIX" : "xmlns") . qq(="$NAMESPACE") if $NAMESPACE; $out .= qq( xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="$SCHEMA_LOCATION") if $SCHEMA_LOCATION; $out .= ">"; $out .= format_list(map _dump($_), @_); $out .= "\n"; $count = 0; $out =~ s/\01/$ref{++$count} ? qq( id="r$ref{$count}") : ""/ge; print STDERR $out unless defined wantarray; $out; } *dump = \&dump_xml; sub _dump { my $rval = \$_[0]; shift; my $deref = shift; $rval = $$rval if $deref; my($class, $type, $id); if (overload::StrVal($rval) =~ /^(?:([^=]+)=)?([A-Z]+)\(0x([^\)]+)\)$/) { $class = $1; $type = $2; $id = $3; } else { return qq(); } if (my $seq = $seen{$id}) { my $ref_no = $ref{$seq} || ($ref{$seq} = keys(%ref) + 1); return qq(<${prefix}alias ref="r$ref_no"/>); } $seen{$id} = ++$count; $class = $class ? " class=" . quote($class) : ""; $id = "\1"; # magic that is removed or expanded to ' id="r1"' in the end. if ($type eq "SCALAR" || $type eq "REF") { return "<${prefix}undef$class$id/>" unless defined $$rval; return "<${prefix}ref$class$id>" . format_list(_dump($$rval, 1)) . "" if ref $$rval; my($str, $enc) = esc($$rval); return "<${prefix}str$class$id$enc>$str"; } elsif ($type eq "ARRAY") { return "<${prefix}array$class$id/>" unless @$rval; return "<${prefix}array$class$id>" . format_list(map _dump($_), @$rval) . ""; } elsif ($type eq "HASH") { my $out = "<${prefix}hash$class$id>$NL"; for my $key (sort keys %$rval) { my $val = \$rval->{$key}; $val = _dump($$val); if ($INDENT) { $val =~ s/^/$INDENT$INDENT/gm; $out .= $INDENT; } my($str, $enc) = esc($key); $out .= "<${prefix}key$enc>$str$NL$val$NL"; } if ($INDENT_STYLE eq "Lisp") { # kill final NL substr($out, -length($NL)) = ""; } $out .= ""; return $out; } elsif ($type eq "GLOB") { return "<${prefix}glob$class$id/>"; } elsif ($type eq "CODE") { return "<${prefix}code$class$id/>"; } else { #warn "Can't handle $type data"; return ""; } die "Assert"; } sub format_list { my @elem = @_; if ($INDENT) { for (@elem) { s/^/$INDENT/gm; } } return join($NL, "", @elem, ($INDENT_STYLE eq "Lisp" ? () : ("")) ); } # put a string value in double quotes sub quote { local($_) = shift; s/&/&/g; s/\"/"/g; s/]]>/]]>/g; s//]]>/g; s/([^\040-\176])/sprintf("&#x%x;", ord($1))/ge; return $_, ""; } 1; __END__ =head1 NAME Data::DumpXML - Dump arbitrary data structures as XML =head1 SYNOPSIS use Data::DumpXML qw(dump_xml); $xml = dump_xml(@list) =head1 DESCRIPTION This module provides a single function called dump_xml() that takes a list of Perl values as its argument and produces a string as its result. The string returned is an XML document that represents any Perl data structures passed to the function. Reference loops are handled correctly. The following data model is used: data : scalar* scalar = undef | str | ref | alias ref : scalar | array | hash | glob | code array: scalar* hash: (key scalar)* The distribution comes with an XML schema and a DTD that more formally describe this structure. As an example of the XML documents produced, the following call: $a = bless [1,2], "Foo"; dump_xml($a); produces: 1 2 If dump_xml() is called in a void context, then the dump is printed on STDERR automatically. For compatibility with C, there is also an alias for dump_xml() called simply dump(). C is a class that can restore data structures dumped by dump_xml(). =head2 Configuration variables The generated XML is influenced by a set of configuration variables. If you modify them, then it is a good idea to localize the effect. For example: sub my_dump_xml { local $Data::DumpXML::INDENT = ""; local $Data::DumpXML::XML_DECL = 0; local $Data::DumpXML::DTD_LOCATION = ""; local $Data::DumpXML::NS_PREFIX = "dumpxml"; return dump_xml(@_); } The variables are: =over =item $Data::DumpXML::INDENT You can set the variable $Data::DumpXML::INDENT to control the amount of indenting. The variable contains the whitespace you want to be used for each level of indenting. The default is a single space. To suppress indenting, set it to "". =item $Data::DumpXML::INDENT_STYLE This variable controls where end element are placed. If you set this variable to the value "Lisp" then end tags are not prefixed by NL. This give a more compact output. =item $Data::DumpXML::XML_DECL This boolean variable controls whether an XML declaration should be prefixed to the output. The XML declaration is the thingy. The default is 1. Set this value to 0 to suppress the declaration. =item $Data::DumpXML::NAMESPACE This variable contains the namespace used for the XML elements. The default is to let this be a URI that actually resolve to the XML schema on CPAN. Set it to "" to disable use of namespaces. =item $Data::DumpXML::NS_PREFIX This variable contains the namespace prefix to use on the elements. The default is "", which means that a default namespace will be declared. =item $Data::DumpXML::SCHEMA_LOCATION This variable contains the location of the XML schema. If this variable is non-empty, then an C attribute is added to the top level C element. The default is not to include this, as the location can be inferred from the default XML namespace used. =item $Data::DumpXML::DTD_LOCATION This variable contains the location of the DTD. If this variable is non-empty, then a is included in the output. The default is to point to the DTD on CPAN. Set it to "" to suppress the line. =back =head1 BUGS Class names with 8-bit characters are dumped as Latin-1, but converted to UTF-8 when restored by the Data::DumpXML::Parser. The content of globs and subroutines are not dumped. They are restored as the strings "** glob **" and "** code **". LVALUE and IO objects are not dumped at all. They simply disappear from the restored data structure. =head1 SEE ALSO L, L, L, L =head1 AUTHORS The C module is written by Gisle Aas , based on C. The C module was written by Gisle Aas, based on C by Gurusamy Sarathy . Copyright 1998-2003 Gisle Aas. Copyright 1996-1998 Gurusamy Sarathy. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut libdata-dumpxml-perl-1.06.orig/DumpXML/0000755000000000000000000000000010415635034016410 5ustar rootrootlibdata-dumpxml-perl-1.06.orig/DumpXML/Parser.pm0000755000000000000000000000677210415635034020221 0ustar rootrootpackage Data::DumpXML::Parser; use strict; use vars qw($VERSION @ISA); $VERSION = "1.01"; require XML::Parser; @ISA=qw(XML::Parser); sub new { my($class, %arg) = @_; $arg{Style} = "Data::DumpXML::ParseStyle"; $arg{Namespaces} = 1; return $class->SUPER::new(%arg); } package Data::DumpXML::ParseStyle; use Array::RefElem qw(av_push hv_store); sub Init { my $p = shift; $p->{dump_data} = []; push(@{$p->{stack}}, $p->{dump_data}); } sub Start { my($p, $tag, %attr) = @_; $p->{in_str}++ if $tag eq "str" || $tag eq "key"; my $obj = [\%attr]; push(@{$p->{stack}[-1]}, $obj); push(@{$p->{stack}}, $obj); } sub Char { my($p, $str) = @_; return unless $p->{in_str}; push(@{$p->{stack}[-1]}, $str); } sub End { my($p, $tag) = @_; my $obj = pop(@{$p->{stack}}); my $attr = shift(@$obj); my $ref; if ($tag eq "str" || $tag eq "key") { $p->{in_str}--; my $val = join("", @$obj); if (my $enc = $attr->{encoding}) { if ($enc eq "base64") { require MIME::Base64; $val = MIME::Base64::decode($val); } else { warn "Unknown encoding '$enc'"; } } $ref = \$val; } elsif ($tag eq "ref") { my $val = $obj->[0]; $ref = \$val; } elsif ($tag eq "array" || $tag eq "data") { my @val; for (@$obj) { av_push(@val, $$_); } $ref = \@val; } elsif ($tag eq "hash") { my %val; while (@$obj) { my $keyref = shift @$obj; my $valref = shift @$obj; hv_store(%val, $$keyref, $$valref); } $ref = \%val; } elsif ($tag eq "undef") { my $val = undef; $ref = \$val; } elsif ($tag eq "alias") { $ref = $p->{alias}{$attr->{ref}}; } else { my $val = "*** $tag ***"; $ref = \$val; } $p->{stack}[-1][-1] = $ref; if (my $class = $attr->{class}) { if (exists $p->{Blesser}) { my $blesser = $p->{Blesser}; if (ref($blesser) eq "CODE") { &$blesser($ref, $class); } } else { bless $ref, $class; } } if (my $id = $attr->{id}) { $p->{alias}->{$id} = $ref; } } sub Final { my $p = shift; my $data = $p->{dump_data}[0]; return $data; } 1; __END__ =head1 NAME Data::DumpXML::Parser - Restore data dumped by Data::DumpXML =head1 SYNOPSIS use Data::DumpXML::Parser; my $p = Data::DumpXML::Parser->new; my $data = $p->parsefile(shift || "test.xml"); =head1 DESCRIPTION C is an C subclass that can recreate the data structure from an XML document produced by C. The parserfile() method returns a reference to an array of the values dumped. The constructor method new() takes a single additional argument to that of C: =over =item Blesser => CODEREF A subroutine that is invoked to bless restored objects. The subroutine is invoked with two arguments: a reference to the object, and a string containing the class name. If not provided, the built-in C function is used. For situations where the input file cannot necessarily be trusted and blessing arbitrary Classes might give malicious input the ability to exploit the DESTROY methods of modules used by the code, it is a good idea to provide a no-op blesser: my $p = Data::DumpXML::Parser->new(Blesser => sub {}); =back =head1 SEE ALSO L, L =head1 AUTHOR Copyright 2001 Gisle Aas. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut libdata-dumpxml-perl-1.06.orig/MANIFEST0000644000000000000000000000020310415635034016246 0ustar rootrootChanges Data-DumpXML.xsd Data-DumpXML.dtd DumpXML.pm DumpXML/Parser.pm MANIFEST Makefile.PL README TODO t/basic.t t/dump-restore.t libdata-dumpxml-perl-1.06.orig/Makefile.PL0000644000000000000000000000047210415635034017077 0ustar rootrootuse ExtUtils::MakeMaker; WriteMakefile( NAME => "Data::DumpXML", VERSION_FROM => "DumpXML.pm", PREREQ_PM => { 'MIME::Base64' => 2.00, 'XML::Parser' => 2.00, 'Array::RefElem' => 0.01, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz'}, ); libdata-dumpxml-perl-1.06.orig/README0000644000000000000000000000042510415635034016003 0ustar rootrootData::DumpXML Dump arbitrary perl data structures as XML and restore them. Requires XML::Parser, MIME::Base64 and Array::RefElem. Copyright 2000-2003 Gisle Aas. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. libdata-dumpxml-perl-1.06.orig/TODO0000644000000000000000000000030310415635034015606 0ustar rootrootCheck if HTML::Parser is faster at decoding XML. Dump glob content Dump io Regexp objects? LVALUE objects Use "a", "b", ... for IDs instead of "r1", "r2", "r3",... Dump empty strings as libdata-dumpxml-perl-1.06.orig/t/0000755000000000000000000000000010415635034015365 5ustar rootrootlibdata-dumpxml-perl-1.06.orig/t/basic.t0000644000000000000000000000262110415635034016634 0ustar rootrootprint "1..6\n"; use strict; use Data::DumpXML qw(dump_xml); my $xml; $xml = remove_space(dump_xml(33)); print "not " unless $xml =~ m,33,; print "ok 1\n"; $xml = remove_space(dump_xml(\33)); print "not " unless $xml =~ m,33,; print "ok 2\n"; $xml = remove_space(dump_xml({"\1" => "\0"})); print "not " unless $xml =~ m,AQ==AA==,; print "ok 3\n"; my $undef = undef; my $ref1 = \$undef; bless $ref1, "undef-class"; my $ref2 = \$ref1; bless $ref2, "ref-class"; $xml = remove_space(dump_xml(bless {ref => $ref2}, "Bar")); print "not " unless $xml =~ m,ref,; print "ok 4\n"; my @a = (1..3); my $a = \$a[1]; $xml = remove_space(dump_xml($a, \@a)); print "not " unless $xml =~ m,213,; print "ok 5\n"; # test escaping $xml = remove_space(dump_xml(["&", "<>", "]]>"])); print "not " unless $xml =~ m,&<>]]>,; print "ok 6\n"; #------------ sub remove_space { my $xml = shift; $xml =~ s/>\s+ 33, bar => "<>" }, "Obj"; my @tests = ( [1..10], [\1], [\\\\\\1], [undef], [bless[], "Foo"], [$obj, $obj, \$obj, [$obj, $obj]], [\$obj->{foo}, $obj, $obj], [{"\0" => "\1"}], [bless [], 'Class&<>"'], # funny class name [join("", map chr, 0.255)], ["ære våre børn"], #[bless["ære våre børn"], "fårepølse"], # high-bit class names are mangled ); print "1.." . (@tests + 3) . "\n"; my $testno = 1; for (@tests) { my $xml1 = dump_xml(@$_); #print $xml1; my $restore = Data::DumpXML::Parser->new->parse($xml1); my $xml2 = dump_xml(@$restore); unless ($xml1 eq $xml2) { print $xml1; print $xml2; print "not "; } print "ok " . $testno++ . "\n"; } #print $xml; print "Testing Blesser...\n"; my $xml = dump_xml($obj); my $thistest = $testno++; my $p = Data::DumpXML::Parser->new(Blesser => sub { my($o, $c) = @_; print "not " unless ref($o) eq "HASH" and $o->{foo} == 33 and $c eq "Obj"; print "ok $thistest\n"; bless $o, $c . "::Bar"; }); my $res = $p->parse($xml); print "not " unless ref($res->[0]) eq "Obj::Bar"; print "ok " . $testno++ . "\n"; # Test with namespace prefixes $xml = do { local $Data::DumpXML::NS_PREFIX="dump"; dump_xml($obj) }; #print $xml; $p = Data::DumpXML::Parser->new(); $res = $p->parse($xml); print "not " unless ref($res->[0]) eq "Obj" && $res->[0]{foo} eq 33; print "ok " . $testno++ . "\n";