| Subject: | [PATCH] Add XML Reader |
See attached file.
| Subject: | 0001-Add-XML-Reader.patch |
From d0b7b62d04b1386254732e915f1684823287232c Mon Sep 17 00:00:00 2001
From: Lubomir Rintel <lkundrak@v3.sk>
Date: Thu, 13 Oct 2011 09:00:53 +0200
Subject: [PATCH] Add XML Reader
---
Makefile.PL | 2 +
lib/Data/Plist.pm | 5 ++-
lib/Data/Plist/XMLReader.pm | 126 +++++++++++++++++++++++++++++++++++++++++++
t/xml-read.t | 79 +++++++++++++++++++++++++++
4 files changed, 211 insertions(+), 1 deletions(-)
create mode 100644 lib/Data/Plist/XMLReader.pm
create mode 100644 t/xml-read.t
diff --git a/Makefile.PL b/Makefile.PL
index cde71bf..c5f6db1 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -14,5 +14,7 @@ requires('Scalar::Util');
requires('UNIVERSAL::isa');
requires('UNIVERSAL::require');
requires('XML::Writer');
+requires('XML::Parser');
+test_requires ('Test::Deep');
&WriteAll;
diff --git a/lib/Data/Plist.pm b/lib/Data/Plist.pm
index 3798587..3d8fc71 100644
--- a/lib/Data/Plist.pm
+++ b/lib/Data/Plist.pm
@@ -267,7 +267,8 @@ L<XML::Writer>
=head1 BUGS AND LIMITATIONS
-No XML reader is included at current.
+UIDs don't seem to be sufficiently well supported by the XML
+readers and writers.
Please report any bugs or feature requests to
C<bug-Data-Plist@rt.cpan.org>, or through the web interface at
@@ -277,6 +278,8 @@ L<http://rt.cpan.org>.
Alex Vandiver and Jacky Chang.
+XML reader support added by Lubomir Rintel <lkundrak@v3.sk>
+
Based on plutil.pl, written by Pete Wilson <wilsonpm@gamewood.net>
=head1 LICENSE
diff --git a/lib/Data/Plist/XMLReader.pm b/lib/Data/Plist/XMLReader.pm
new file mode 100644
index 0000000..a912fb2
--- /dev/null
+++ b/lib/Data/Plist/XMLReader.pm
@@ -0,0 +1,126 @@
+=head1 NAME
+
+Data::Plist::XMLReader - Creates Data::Plists from XML files
+
+=head1 SYNOPSIS
+
+ # Create new
+ my $read = Data::Plist::XMLReader->new;
+
+ # Read from a string
+ my $plist = $read->open_string($xmlstring);
+
+ # Read from a XML file
+ $plist = $read->open_fh($filename);
+
+=head1 DESCRIPTION
+
+C<Data::Plist::XMLReader> takes data formatted as one of
+Apple's XML property lists, either from a string or a
+filehandle and returns it as a C<Data::Plist>.
+
+=cut
+
+package Data::Plist::XMLReader;
+
+use strict;
+use warnings;
+
+use base qw/Data::Plist::Reader/;
+use Data::Plist;
+
+use XML::Parser;
+use MIME::Base64;
+
+=head1 METHODS
+
+=head2 walk $tree
+
+Returns data for given part of XML parse tree.
+
+=cut
+
+sub walk
+{
+ my $tree = shift;
+
+ my @retval;
+ while ( @$tree ) {
+ my $tag = shift @$tree;
+ my $kids = shift @$tree;
+
+ # Raw value
+ if ( $tag eq '0' ) {
+ # Skip empty
+ push @retval, $kids if $kids =~ /\S/;
+ next;
+ }
+
+ my $attrs = shift @$kids;
+
+ # Root
+ if ( $tag eq 'plist' ) {
+ warn 'Unknown version'
+ unless $attrs->{version} eq '1.0';
+ push @retval, walk($kids);
+
+ # Primitive values
+ } elsif ( $tag eq 'null' ) {
+ push @retval, [ null => undef ];
+ } elsif ( $tag eq 'fill' ) {
+ push @retval, [ fill => 15 ];
+ } elsif ( $tag eq 'integer' ) {
+ push @retval, [ integer => int walk($kids) ];
+ } elsif ( $tag =~ /string|ustring|date|real/ ) {
+ push @retval, [ "$tag" => walk($kids) ];
+
+ } elsif ( $tag eq 'data' ) {
+ push @retval, [ data => MIME::Base64::decode_base64 (walk($kids)) ];
+
+ # Boolean
+ } elsif ( $tag eq 'true' ) {
+ push @retval, [ true => 1 ];
+ } elsif ( $tag eq 'false' ) {
+ push @retval, [ false => 0 ];
+
+ # Compounds
+ } elsif ( $tag eq 'key' ) {
+ push @retval, walk($kids);
+ } elsif ( $tag eq 'dict' ) {
+ my %kiddies = walk($kids);
+ $kiddies{UID} = delete $kiddies{'CF$UID'}
+ if exists $kiddies{'CF$UID'};
+ push @retval, [ dict => \%kiddies ];
+ } elsif ( $tag eq 'array' ) {
+ push @retval, [ array => [ walk($kids) ] ];
+
+ # Unknown tag
+ } else {
+ push @retval, [ $tag => walk($kids) ];
+ }
+ }
+
+ return shift @retval unless wantarray;
+ return @retval;
+}
+
+=head2 open_fh $filehandle
+
+Used for reading XML data from a filehandle
+C<$filehandle> rather than a string.
+Returns a C<Data::Plist> containing the top object
+of the C<XML::Parser> tree after it's been passed to
+L</walk>.
+
+=cut
+
+sub open_fh {
+ my $self = shift;
+ $self = $self->new() unless ref $self;
+
+ my($fh) = @_;
+ my $tree = XML::Parser->new( Style => 'Tree' )->parse($fh);
+ return Data::Plist->new( data => walk($tree) );
+}
+
+1;
diff --git a/t/xml-read.t b/t/xml-read.t
new file mode 100644
index 0000000..2740dc9
--- /dev/null
+++ b/t/xml-read.t
@@ -0,0 +1,79 @@
+use Test::More tests => 2;
+use Test::Deep;
+use Data::Plist::XMLReader;
+
+use strict;
+use warnings;
+
+my $xml = <<'EOXML';
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+
+<plist version="1.0">
+ <dict>
+ <key>Hello</key>
+ <string>World</string>
+ <key>Beast</key>
+ <integer>666</integer>
+ <key>CF$UID</key>
+ <integer>1</integer>
+ <key>Beefy</key>
+ <bacon><miracle /></bacon>
+ <key>Stuff</key>
+ <array>
+ <ustring>foo bar baz</ustring>
+ <real>13.37</real>
+ <date>1318489009</date>
+ <true />
+ <false />
+ <null />
+ <array />
+ <dict />
+ <data>c3R1AGZm
+</data>
+ <fill />
+ </array>
+ </dict>
+</plist>
+EOXML
+
+my $reader = Data::Plist::XMLReader->new ();
+my $data = $reader->open_string($xml);
+
+cmp_deeply( $data->{data}, [ 'dict' => {
+ 'Beefy' => [ 'bacon', [ 'miracle', ] ],
+ 'Beast' => [ 'integer', 666 ],
+ 'UID' => [ 'integer', 1 ],
+ 'Hello' => [ 'string', 'World' ],
+ 'Stuff' => [ 'array', [
+ [ 'ustring', 'foo bar baz' ],
+ [ 'real', '13.37' ],
+ [ 'date', '1318489009' ],
+ [ 'true', 1 ],
+ [ 'false', 0 ],
+ [ 'null', undef ],
+ [ 'array', [] ],
+ [ 'dict', {} ],
+ [ 'data', "stu\x00ff" ],
+ [ 'fill', 15 ],
+ ]]
+}]);
+
+cmp_deeply( $data->data, {
+ 'Beast' => 666,
+ 'Beefy' => [ 'miracle' ],
+ 'UID' => 1,
+ 'Hello' => 'World',
+ 'Stuff' => [
+ 'foo bar baz',
+ '13.37',
+ isa('DateTime'),
+ 1,
+ 0,
+ undef,
+ [],
+ {},
+ "stu\x00ff",
+ 15
+ ],
+});
--
1.7.1