+#
+# Copyright (c) 1998 Jonathan Eisenzopf <eisen@pobox.com>
+# XML::DumperISO is free software. You can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package XML::DumperISO;
+
+BEGIN {
+ use strict;
+ use vars qw($VAR1 $VERSION);
+ use Data::Dumper;
+ $VERSION = '0.4';
+}
+
+sub new {
+ my $class = shift;
+ my $self = {};
+ return bless $self,$class;
+}
+
+sub pl2xml {
+ my ($obj,$ref) = @_;
+ return $obj->pl2xml_string($ref);
+}
+
+sub pl2xml_string {
+ my ($obj,$ref) = @_;
+ return(
+ "<perldata>" .
+ &Tree2XML($ref, 1) .
+ "\n</perldata>\n"
+ );
+}
+
+sub Tree2XML {
+ my ($ref, $indent) = @_;
+ my $string = '';
+
+ # SCALAR REFERENCE
+ if (defined(ref($ref)) && (ref($ref) eq 'SCALAR')) {
+ $string .= "\n" . " " x $indent . "<scalarref>" . &QuoteXMLChars($$ref) . "</scalarref>";
+ }
+
+ # HASH REFERENCE
+ elsif (defined(ref($ref)) && (ref($ref) eq 'HASH')) {
+ $string .= "\n" . " " x $indent . "<hash>";
+ $indent++;
+ foreach my $key (keys(%$ref)) {
+ $string .= "\n" . " " x $indent . "<item key=\"" . &QuoteXMLChars($key) . "\">";
+ if (ref($ref->{$key})) {
+ $string .= &Tree2XML($ref->{$key}, $indent+1);
+ $string .= "\n" . " " x $indent . "</item>";
+ } else {
+ $string .= &QuoteXMLChars($ref->{$key}) . "</item>";
+ }
+ }
+ $indent--;
+ $string .= "\n" . " " x $indent . "</hash>";
+ }
+
+ # ARRAY REFERENCE
+ elsif (defined(ref($ref)) && (ref($ref) eq 'ARRAY')) {
+ $string .= "\n" . " " x $indent . "<array>";
+ $indent++;
+ for (my $i=0; $i < @$ref; $i++) {
+ $string .= "\n" . " " x $indent . "<item key=\"$i\">";
+ if (ref($ref->[$i])) {
+ $string .= &Tree2XML($ref->[$i], $indent+1);
+ $string .= "\n" . " " x $indent . "</item>";
+ } else {
+ $string .= &QuoteXMLChars($ref->[$i]) . "</item>";
+ }
+ }
+ $indent--;
+ $string .= "\n" . " " x $indent . "</array>";
+ }
+
+ ## SCALAR
+ else {
+ $string .= "\n" . " " x $indent . "<scalar>" . &QuoteXMLChars($ref) . "</scalar>";
+ }
+
+ return($string);
+}
+
+sub QuoteXMLChars {
+ $_[0] =~ s/&/&/g;
+ $_[0] =~ s/</</g;
+ $_[0] =~ s/>/>/g;
+ $_[0] =~ s/'/'/g;
+ $_[0] =~ s/"/"/g;
+ return($_[0]);
+}
+
+sub xml2pl {
+ my ($obj,$tree) = @_;
+
+ ## Skip enclosing "perldata" level
+ my $TopItem = $tree->[1];
+ my $ref = &Undump($TopItem);
+
+ return($ref);
+}
+
+## Undump
+## Takes a parse tree of the XML generated by pl2xml, and recursively
+## undumps it to create a data structure in memory. The top-level
+## object is a scalar, a reference to a scalar, a hash, or an array.
+## Hashes and arrays may themselves contain scalars, or references to
+## scalars, or references to hashes or arrays, with the exception that
+## scalar values are never "undef" because there's currently no way to
+## represent undef in the dumped data.
+
+sub Undump {
+ my ($Tree) = shift;
+ my $ref = undef;
+ my $FoundScalar;
+ my $i;
+
+ for ($i = 1; $i < $#$Tree; $i+=2) {
+ if (lc($Tree->[$i]) eq 'scalar') {
+ ## Make a copy of the string
+ $ref = $Tree->[$i+1]->[2];
+ last;
+ }
+ if (lc($Tree->[$i]) eq 'scalarref') {
+ ## Make a ref to a copy of the string
+ $ref = \ "$Tree->[$i+1]->[2]";
+ last;
+ } elsif (lc($Tree->[$i]) eq 'hash') {
+ $ref = {};
+ my $j;
+ for ($j = 1; $j < $#{$Tree->[$i+1]}; $j+=2) {
+ next unless $Tree->[$i+1]->[$j] eq 'item';
+ my $ItemTree = $Tree->[$i+1]->[$j+1];
+ next unless defined(my $key = $ItemTree->[0]->{key});
+ $ref->{$key} = &Undump($ItemTree);
+ }
+ last;
+ } elsif (lc($Tree->[$i]) eq 'array') {
+ $ref = [];
+ my $j;
+ for ($j = 1; $j < $#{$Tree->[$i+1]}; $j+=2) {
+ next unless $Tree->[$i+1]->[$j] eq 'item';
+ my $ItemTree = $Tree->[$i+1]->[$j+1];
+ next unless defined(my $key = $ItemTree->[0]->{key});
+ $ref->[$key] = &Undump($ItemTree);
+ }
+ last;
+ } elsif (lc($Tree->[$i]) eq '0') {
+ $FoundScalar = $Tree->[$i + 1] unless defined $FoundScalar;
+ } else {
+ ## Unrecognized tag. Just move on.
+ }
+ }
+
+ ## If $ref is not set at this point, it means we've just
+ ## encountered a scalar value directly inside the item tag.
+
+ $ref = $FoundScalar unless defined($ref);
+
+ done:
+ return ($ref);
+}
+
+### TestRoundTrip
+### Tests the conversion of perl data structures into XML and back again
+###
+### Invoke with:
+###
+### perl -e 'use XML::DumperISO; &XML::DumperISO::TestRoundTrip();'
+###
+### The 5 sets of sample data below show some typical cases:
+
+sub TestRoundTrip
+{
+ my $TestRuns =
+ [
+
+ <<'END_TEST1',
+<perldata>
+ <scalar>foo</scalar>
+</perldata>
+END_TEST1
+
+ <<'END_TEST2',
+<perldata>
+ <scalarref>Hi Mom</scalarref>
+</perldata>
+END_TEST2
+
+ <<'END_TEST3',
+<perldata>
+ <hash>
+ <item key="key1">value1</item>
+ <item key="key2">value2</item>
+ </hash>
+</perldata>
+END_TEST3
+
+ <<'END_TEST4',
+<perldata>
+ <array>
+ <item key="0">foo</item>
+ <item key="1">bar</item>
+ </array>
+</perldata>
+END_TEST4
+
+ <<'END_TEST5',
+<perldata>
+ <array>
+ <item key="0">Scalar</item>
+ <item key="1">
+ <scalarref>ScalarRef</scalarref>
+ </item>
+ <item key="2">
+ <array>
+ <item key="0">foo</item>
+ <item key="1">bar</item>
+ </array>
+ </item>
+ <item key="3">
+ <hash>
+ <item key="key1">value1</item>
+ <item key="key2">value2</item>
+ </hash>
+ </item>
+ </array>
+</perldata>
+END_TEST5
+
+ ];
+
+ my $TestNum;
+ my $TestData;
+ foreach $TestData (@$TestRuns)
+ {
+ $TestNum++;
+
+ use XML::Parser;
+ my $Parser = XML::Parser->new(Style => 'Tree');
+ my $Tree = $Parser->parse($TestData);
+
+ my $DumperISO = new XML::DumperISO();
+ my $Ref = $DumperISO->xml2pl($Tree);
+
+ my $ReDump = $DumperISO->pl2xml_string($Ref);
+
+ if ($TestData eq $ReDump)
+ {
+ print STDERR ("Test $TestNum: Success.\n\n" .
+ "Perl tree:\n" .
+ &Data::Dumper::Dumper($Ref) .
+ "\n\n");
+ }
+ else
+ {
+ print STDERR ("TestRoundTrip: data doesn't match!\n\n" .
+ "Orig:\n$TestData\nRound Trip:\n$ReDump\n");
+ }
+ }
+}
+
+
+
+1;
+__END__
+
+=head1 NAME
+
+XML::DumperISO - Perl module for dumping Perl objects from/to XML
+
+=head1 SYNOPSIS
+
+ # Convert Perl code to XML
+ use XML::DumperISO;
+ my $dump = new XML::DumperISO;
+ $data = [
+ {
+ first => 'Jonathan',
+ last => 'Eisenzopf',
+ email => 'eisen@pobox.com'
+ },
+ {
+ first => 'Larry',
+ last => 'Wall',
+ email => 'larry@wall.org'
+ }
+ ];
+ $xml = $dump->pl2xml($perl);
+
+
+ # Convert XML to Perl code
+ use XML::DumperISO;
+ my $dump = new XML::DumperISO;
+
+ # some XML
+ my $xml = <<XML;
+<perldata>
+ <scalar>foo</scalar>
+</perldata>
+XML
+
+ # load Perl data structure from dumped XML
+ $data = $dump->xml2pl($Tree);
+
+=head1 DESCRIPTION
+
+XML::DumperISO dumps Perl data to a structured XML format.
+XML::DumperISO can also read XML data that was previously dumped
+by the module and convert it back to Perl.
+
+This is done via the following 2 methods:
+XML::DumperISO::pl2xml
+XML::DumperISO::xml2pl
+
+=head1 AUTHOR
+
+Jonathan Eisenzopf <eisen@pobox.com>
+
+=head1 CREDITS
+
+Chris Thorman <ct@ignitiondesign.com>
+L.M.Orchard <deus_x@pobox.com>
+DeWitt Clinton <dewitt@eziba.com>
+
+=head1 SEE ALSO
+
+perl(1), XML::Parser(3).
+
+=cut
projects / mecon / scripts.git / commitdiff