embperl/DumperISO.pm

   1 #
   2 # Copyright (c) 1998 Jonathan Eisenzopf <eisen@pobox.com>
   3 # XML::DumperISO is free software. You can redistribute it and/or
   4 # modify it under the same terms as Perl itself.
   5
   6 package XML::DumperISO;
   7
   8 BEGIN {
   9     use strict;
  10     use vars qw($VAR1 $VERSION);
  11     use Data::Dumper;
  12     $VERSION = '0.4';
  13 }
  14
  15 sub new {
  16     my $class = shift;
  17     my $self = {};
  18     return bless $self,$class;
  19 }
  20
  21 sub pl2xml {
  22     my ($obj,$ref) = @_;
  23     return $obj->pl2xml_string($ref);
  24 }
  25
  26 sub pl2xml_string {
  27     my ($obj,$ref) = @_;
  28     return(
  29            "<perldata>" .
  30            &Tree2XML($ref, 1) .
  31            "\n</perldata>\n"
  32            );
  33 }
  34
  35 sub Tree2XML {
  36     my ($ref, $indent) = @_;
  37     my $string = '';
  38
  39     # SCALAR REFERENCE
  40     if (defined(ref($ref)) && (ref($ref) eq 'SCALAR')) {
  41         $string .= "\n" . " " x $indent . "<scalarref>" . &QuoteXMLChars($$ref) . "</scalarref>";
  42     }
  43
  44     # HASH REFERENCE
  45     elsif (defined(ref($ref)) && (ref($ref) eq 'HASH')) {
  46         $string .= "\n" . " " x $indent . "<hash>";
  47         $indent++;
  48         foreach my $key (keys(%$ref)) {
  49             $string .= "\n" . " " x $indent . "<item key=\"" . &QuoteXMLChars($key) . "\">";
  50             if (ref($ref->{$key})) {
  51                 $string .= &Tree2XML($ref->{$key}, $indent+1);
  52                 $string .= "\n" . " " x $indent . "</item>";
  53             } else {
  54                 $string .= &QuoteXMLChars($ref->{$key}) . "</item>";
  55             }
  56         }
  57         $indent--;
  58         $string .= "\n" . " " x $indent . "</hash>";
  59     }
  60
  61     # ARRAY REFERENCE
  62     elsif (defined(ref($ref)) && (ref($ref) eq 'ARRAY')) {
  63         $string .= "\n" . " " x $indent . "<array>";
  64         $indent++;
  65         for (my $i=0; $i < @$ref; $i++) {
  66             $string .= "\n" . " " x $indent . "<item key=\"$i\">";
  67             if (ref($ref->[$i])) {
  68                 $string .= &Tree2XML($ref->[$i], $indent+1);
  69                 $string .= "\n" . " " x $indent . "</item>";
  70             } else {
  71                 $string .= &QuoteXMLChars($ref->[$i]) . "</item>";
  72             }
  73         }
  74         $indent--;
  75         $string .= "\n" . " " x $indent . "</array>";
  76     }
  77
  78     ## SCALAR
  79     else {
  80         $string .= "\n" . " " x $indent . "<scalar>" . &QuoteXMLChars($ref) . "</scalar>";
  81     }
  82
  83     return($string);
  84 }
  85
  86 sub QuoteXMLChars {
  87     $_[0] =~ s/&/&amp;/g;
  88     $_[0] =~ s/</&lt;/g;
  89     $_[0] =~ s/>/&gt;/g;
  90     $_[0] =~ s/'/&apos;/g;
  91     $_[0] =~ s/"/&quot;/g;
  92     return($_[0]);
  93 }
  94
  95 sub xml2pl {
  96     my ($obj,$tree) = @_;
  97
  98     ## Skip enclosing "perldata" level
  99     my $TopItem = $tree->[1];
 100     my $ref = &Undump($TopItem);
 101
 102     return($ref);
 103 }
 104
 105 ## Undump
 106 ## Takes a parse tree of the XML generated by pl2xml, and recursively
 107 ## undumps it to create a data structure in memory.  The top-level
 108 ## object is a scalar, a reference to a scalar, a hash, or an array.
 109 ## Hashes and arrays may themselves contain scalars, or references to
 110 ## scalars, or references to hashes or arrays, with the exception that
 111 ## scalar values are never "undef" because there's currently no way to
 112 ## represent undef in the dumped data.
 113
 114 sub Undump {
 115     my ($Tree) = shift;
 116     my $ref = undef;
 117     my $FoundScalar;
 118     my $i;
 119
 120     for ($i = 1; $i < $#$Tree; $i+=2) {
 121         if (lc($Tree->[$i]) eq 'scalar') {
 122             ## Make a copy of the string
 123             $ref = $Tree->[$i+1]->[2];
 124             last;
 125         }
 126         if (lc($Tree->[$i]) eq 'scalarref') {
 127             ## Make a ref to a copy of the string
 128             $ref = \ "$Tree->[$i+1]->[2]";
 129             last;
 130         } elsif (lc($Tree->[$i]) eq 'hash') {
 131             $ref = {};
 132             my $j;
 133             for ($j = 1; $j < $#{$Tree->[$i+1]}; $j+=2) {
 134                 next unless $Tree->[$i+1]->[$j] eq 'item';
 135                 my $ItemTree = $Tree->[$i+1]->[$j+1];
 136                 next unless defined(my $key = $ItemTree->[0]->{key});
 137                 $ref->{$key} = &Undump($ItemTree);
 138             }
 139             last;
 140         } elsif (lc($Tree->[$i]) eq 'array') {
 141             $ref = [];
 142             my $j;
 143             for ($j = 1; $j < $#{$Tree->[$i+1]}; $j+=2) {
 144                 next unless $Tree->[$i+1]->[$j] eq 'item';
 145                 my $ItemTree = $Tree->[$i+1]->[$j+1];
 146                 next unless defined(my $key = $ItemTree->[0]->{key});
 147                 $ref->[$key] = &Undump($ItemTree);
 148             }
 149             last;
 150         } elsif (lc($Tree->[$i]) eq '0') {
 151             $FoundScalar = $Tree->[$i + 1] unless defined $FoundScalar;
 152         } else {
 153             ## Unrecognized tag.  Just move on.
 154         }
 155     }
 156
 157     ## If $ref is not set at this point, it means we've just
 158     ## encountered a scalar value directly inside the item tag.
 159
 160     $ref = $FoundScalar unless defined($ref);
 161
 162   done:
 163     return ($ref);
 164 }
 165
 166 ### TestRoundTrip
 167 ### Tests the conversion of perl data structures into XML and back again
 168 ###
 169 ### Invoke with:
 170 ###
 171 ###     perl -e 'use XML::DumperISO; &XML::DumperISO::TestRoundTrip();'
 172 ###
 173 ### The 5 sets of sample data below show some typical cases:
 174
 175 sub TestRoundTrip
 176 {
 177         my $TestRuns =
 178                 [
 179
 180                  <<'END_TEST1',
 181 <perldata>
 182  <scalar>foo</scalar>
 183 </perldata>
 184 END_TEST1
 185
 186                  <<'END_TEST2',
 187 <perldata>
 188  <scalarref>Hi Mom</scalarref>
 189 </perldata>
 190 END_TEST2
 191
 192                  <<'END_TEST3',
 193 <perldata>
 194  <hash>
 195   <item key="key1">value1</item>
 196   <item key="key2">value2</item>
 197  </hash>
 198 </perldata>
 199 END_TEST3
 200
 201                  <<'END_TEST4',
 202 <perldata>
 203  <array>
 204   <item key="0">foo</item>
 205   <item key="1">bar</item>
 206  </array>
 207 </perldata>
 208 END_TEST4
 209
 210                  <<'END_TEST5',
 211 <perldata>
 212  <array>
 213   <item key="0">Scalar</item>
 214   <item key="1">
 215    <scalarref>ScalarRef</scalarref>
 216   </item>
 217   <item key="2">
 218    <array>
 219     <item key="0">foo</item>
 220     <item key="1">bar</item>
 221    </array>
 222   </item>
 223   <item key="3">
 224    <hash>
 225     <item key="key1">value1</item>
 226     <item key="key2">value2</item>
 227    </hash>
 228   </item>
 229  </array>
 230 </perldata>
 231 END_TEST5
 232
 233                                         ];
 234
 235         my $TestNum;
 236         my $TestData;
 237         foreach $TestData (@$TestRuns)
 238         {
 239                 $TestNum++;
 240
 241                 use XML::Parser;
 242                 my $Parser = XML::Parser->new(Style => 'Tree');
 243                 my $Tree = $Parser->parse($TestData);
 244
 245                 my $DumperISO = new XML::DumperISO();
 246                 my $Ref = $DumperISO->xml2pl($Tree);
 247
 248                 my $ReDump = $DumperISO->pl2xml_string($Ref);
 249
 250                 if ($TestData eq $ReDump)
 251                 {
 252                         print STDERR ("Test $TestNum: Success.\n\n" .
 253                                                   "Perl tree:\n" .
 254                                                   &Data::Dumper::Dumper($Ref) .
 255                                                   "\n\n");
 256                 }
 257                 else
 258                 {
 259                         print STDERR ("TestRoundTrip: data doesn't match!\n\n" .
 260                                                   "Orig:\n$TestData\nRound Trip:\n$ReDump\n");
 261                 }
 262         }
 263 }
 264
 265
 266
 267 1;
 268 __END__
 269
 270 =head1 NAME
 271
 272 XML::DumperISO - Perl module for dumping Perl objects from/to XML
 273
 274 =head1 SYNOPSIS
 275
 276  # Convert Perl code to XML
 277  use XML::DumperISO;
 278  my $dump = new XML::DumperISO;
 279  $data = [
 280           {
 281             first => 'Jonathan',
 282             last => 'Eisenzopf',
 283             email => 'eisen@pobox.com'
 284           },
 285           {
 286             first => 'Larry',
 287             last => 'Wall',
 288             email => 'larry@wall.org'
 289           }
 290          ];
 291  $xml =  $dump->pl2xml($perl);
 292
 293
 294  # Convert XML to Perl code
 295  use XML::DumperISO;
 296  my $dump = new XML::DumperISO;
 297
 298  # some XML
 299  my $xml = <<XML;
 300 <perldata>
 301  <scalar>foo</scalar>
 302 </perldata>
 303 XML
 304
 305  # load Perl data structure from dumped XML
 306  $data = $dump->xml2pl($Tree);
 307
 308 =head1 DESCRIPTION
 309
 310 XML::DumperISO dumps Perl data to a structured XML format.
 311 XML::DumperISO can also read XML data that was previously dumped
 312 by the module and convert it back to Perl.
 313
 314 This is done via the following 2 methods:
 315 XML::DumperISO::pl2xml
 316 XML::DumperISO::xml2pl
 317
 318 =head1 AUTHOR
 319
 320 Jonathan Eisenzopf <eisen@pobox.com>
 321
 322 =head1 CREDITS
 323
 324 Chris Thorman <ct@ignitiondesign.com>
 325 L.M.Orchard <deus_x@pobox.com>
 326 DeWitt Clinton <dewitt@eziba.com>
 327
 328 =head1 SEE ALSO
 329
 330 perl(1), XML::Parser(3).
 331
 332 =cut