[Bps-public-commit] r14034 - in Data-Plist: . lib/Data/Plist
alexmv at bestpractical.com
alexmv at bestpractical.com
Sat Jul 12 00:19:20 EDT 2008
Author: alexmv
Date: Sat Jul 12 00:19:13 2008
New Revision: 14034
Added:
Data-Plist/lib/Data/Plist/Reader.pm
Data-Plist/lib/Data/Plist/Writer.pm
Data-Plist/lib/Data/Plist/XMLWriter.pm
Modified:
Data-Plist/ (props changed)
Data-Plist/ical-import.pl
Data-Plist/lib/Data/Plist.pm
Data-Plist/lib/Data/Plist/BinaryReader.pm
Log:
r34086 at kohr-ah: chmrr | 2008-07-11 23:50:51 -0400
* Parent classes for readers and writers
* XML output class
* "int" => "integer"
* perltidy
Modified: Data-Plist/ical-import.pl
==============================================================================
--- Data-Plist/ical-import.pl (original)
+++ Data-Plist/ical-import.pl Sat Jul 12 00:19:13 2008
@@ -6,6 +6,7 @@
use YAML;
use Data::Plist;
use Data::Plist::BinaryReader;
+use Data::Plist::XMLWriter;
use Email::MIME;
use File::Slurp;
@@ -17,5 +18,6 @@
}
my $p = Data::Plist::BinaryReader->open_string($content);
- print YAML::Dump($p->object("Foundation"));
+ print YAML::Dump($p->raw_object);
+# print Data::Plist::XMLWriter->open_string($p->raw_object);
}
Modified: Data-Plist/lib/Data/Plist.pm
==============================================================================
--- Data-Plist/lib/Data/Plist.pm (original)
+++ Data-Plist/lib/Data/Plist.pm Sat Jul 12 00:19:13 2008
@@ -64,7 +64,7 @@
return unless exists $data->[1]{'$top'};
return unless exists $data->[1]{'$version'};
- return unless $data->[1]{'$version'}[0] eq "int";
+ return unless $data->[1]{'$version'}[0] eq "integer";
return unless $data->[1]{'$version'}[1] eq "100000";
return 1;
@@ -136,8 +136,4 @@
return $self->reify($self->collapse($self->raw_object), $prefix);
}
-sub serialize {
- my $self = shift;
-}
-
1;
Modified: Data-Plist/lib/Data/Plist/BinaryReader.pm
==============================================================================
--- Data-Plist/lib/Data/Plist/BinaryReader.pm (original)
+++ Data-Plist/lib/Data/Plist/BinaryReader.pm Sat Jul 12 00:19:13 2008
@@ -3,15 +3,11 @@
use strict;
use warnings;
+use base qw/Data::Plist::Reader/;
+
use Encode qw(decode);
use Fcntl qw(:seek);
use Math::BigInt;
-use MIME::Base64;
-
-sub new {
- my $class = shift;
- return bless { offsets => [], refsize => undef } => $class;
-}
sub read_misc {
my $self = shift;
@@ -30,7 +26,7 @@
}
}
-sub read_int { # int
+sub read_integer {
my $self = shift;
my ($size) = @_;
@@ -53,17 +49,17 @@
}
}
- return [ "int", $val ];
+ return [ "integer", $val ];
}
-sub read_real { # real
+sub read_real {
my $self = shift;
my ($size) = @_;
die "Real > 8 bytes" if ( $size > 3 );
my ( $buf, $val );
read( $self->{fh}, $buf, 1 << $size );
- if ( $size == 0 ) { # 1 byte float = error?
+ if ( $size == 0 ) { # 1 byte float = error?
die "1 byte real found";
} elsif ( $size == 1 ) { # 2 byte float???
die "2 byte real found";
@@ -95,7 +91,7 @@
# Binary data is often a binary plist! Unpack it.
if ( $buf =~ /^bplist00/ ) {
- $buf = eval { (ref $self)->open_string($buf) } || $buf;
+ $buf = eval { ( ref $self )->open_string($buf) } || $buf;
}
return [ "data", $buf ];
@@ -165,7 +161,7 @@
my ($size) = @_;
# UIDs are stored internally identically to ints
- my $v = $self->read_int($size)->[1];
+ my $v = $self->read_integer($size)->[1];
return [ UID => $v ];
}
@@ -173,8 +169,8 @@
my $self = shift;
my ($objNum) = @_;
- if (defined $objNum) {
- unless ($objNum < @{$self->{offsets}}) {
+ if ( defined $objNum ) {
+ unless ( $objNum < @{ $self->{offsets} } ) {
warn "Bad offset: $objNum\n";
return;
}
@@ -183,54 +179,32 @@
# get object type/size
my $buf;
+ read( $self->{fh}, $buf, 1 )
+ or die "Can't read type byte: $!\byte:";
- if ( read( $self->{fh}, $buf, 1 ) != 1 ) {
- die "Didn't read type byte: $!";
- }
- my $size = unpack( "C*", $buf ) & 0xF;
- $buf = unpack( "H*", $buf );
- my $objType = substr( $buf, 0, 1 );
- if ( $objType ne "0" && $objType ne "8" && $size == 15 ) {
+ my $size = unpack( "C*", $buf ) & 0x0F; # Low nybble is size
+ my $objType = unpack( "C*", $buf ) >> 4; # High nybble is type
+ if ( $objType != 0 and $objType != 8 and $size == 15 ) {
$size = $self->binary_read->[1];
}
my %types = (
- 0 => "misc",
- 1 => "int",
- 2 => "real",
- 3 => "date",
- 4 => "data",
- 5 => "string",
- 6 => "ustring",
- 8 => "uid",
- a => "array",
- d => "dict",
+ 0 => "misc",
+ 1 => "integer",
+ 2 => "real",
+ 3 => "date",
+ 4 => "data",
+ 5 => "string",
+ 6 => "ustring",
+ 8 => "uid",
+ 10 => "array",
+ 13 => "dict",
);
return [ "??? $objType ???", undef ] unless $types{$objType};
my $method = "read_" . $types{$objType};
die "Can't $method" unless $self->can($method);
- my $v = $self->$method($size);
- return $v;
-}
-
-sub open_string {
- my $self = shift;
- my ($content) = @_;
-
- my $fh;
- open( $fh, "<", \$content );
- return $self->open_fh($fh);
-}
-
-sub open_file {
- my $self = shift;
- my ($filename) = @_;
-
- my $fh;
- open( $fh, "<", $filename ) or die "can't open $filename for conversion";
- binmode($fh);
- return $self->open_fh($fh);
+ return $self->$method($size);
}
sub open_fh {
@@ -242,8 +216,8 @@
my $buf;
$self->{fh} = $fh;
seek( $self->{fh}, 0, SEEK_SET );
- read( $self->{fh}, $buf, 8);
- unless ($buf eq "bplist00") {
+ read( $self->{fh}, $buf, 8 );
+ unless ( $buf eq "bplist00" ) {
die "Not a binary plist file\n";
}
@@ -251,24 +225,29 @@
seek( $self->{fh}, -32, SEEK_END );
my $end = tell( $self->{fh} );
- unless (read( $self->{fh}, $buf, 32 ) == 32) {
+ unless ( read( $self->{fh}, $buf, 32 ) == 32 ) {
die "Read of plist trailer failed\n";
}
+ local $self->{refsize};
my ( $OffsetSize, $NumObjects, $TopObject, $OffsetTableOffset );
( $OffsetSize, $self->{refsize}, $NumObjects, $TopObject,
$OffsetTableOffset
) = unpack "x6CC(x4N)3", $buf;
# Sanity check the trailer
- if ($OffsetSize < 1 or $OffsetSize > 4) {
+ if ( $OffsetSize < 1 or $OffsetSize > 4 ) {
die "Invalid offset size\n";
- } elsif ( $self->{refsize} < 1 or $self->{refsize} > 2) {
+ } elsif ( $self->{refsize} < 1 or $self->{refsize} > 2 ) {
die "Invalid reference size\n";
- } elsif ( 2 ** (8 * $self->{refsize}) < $NumObjects ) {
- die "Reference size (@{[$self->{refsize}]}) is too small for purported number of objects ($NumObjects)\n";
+ } elsif ( 2**( 8 * $self->{refsize} ) < $NumObjects ) {
+ die
+ "Reference size (@{[$self->{refsize}]}) is too small for purported number of objects ($NumObjects)\n";
} elsif ( $TopObject >= $NumObjects ) {
die "Invalid top object identifier\n";
- } elsif ( $OffsetTableOffset < 8 or $OffsetTableOffset > $end or $OffsetTableOffset + $NumObjects * $OffsetSize > $end) {
+ } elsif ( $OffsetTableOffset < 8
+ or $OffsetTableOffset > $end
+ or $OffsetTableOffset + $NumObjects * $OffsetSize > $end )
+ {
die "Invalid offset table address\n";
}
@@ -290,11 +269,11 @@
}
# Catch invalid offset addresses in the offset table
- if (grep {$_ < 8 or $_ >= $end} @Offsets) {
+ if ( grep { $_ < 8 or $_ >= $end } @Offsets ) {
die "Invalid address in offset table\n";
}
- $self->{offsets} = \@Offsets;
+ local $self->{offsets} = \@Offsets;
my $top = $self->binary_read($TopObject);
close($fh);
Added: Data-Plist/lib/Data/Plist/Reader.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Data/Plist/Reader.pm Sat Jul 12 00:19:13 2008
@@ -0,0 +1,36 @@
+package Data::Plist::Reader;
+
+use strict;
+use warnings;
+
+sub new {
+ my $class = shift;
+ return bless {} => $class;
+}
+
+sub open_string {
+ my $self = shift;
+ my ($content) = @_;
+
+ my $fh;
+ open( $fh, "<", \$content );
+ return $self->open_fh($fh);
+}
+
+sub open_file {
+ my $self = shift;
+ my ($filename) = @_;
+
+ my $fh;
+ open( $fh, "<", $filename ) or die "can't open $filename for conversion";
+ binmode($fh);
+ return $self->open_fh($fh);
+}
+
+sub open_fh {
+ my $self = shift;
+
+ die "Unimplemented!";
+}
+
+1;
Added: Data-Plist/lib/Data/Plist/Writer.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Data/Plist/Writer.pm Sat Jul 12 00:19:13 2008
@@ -0,0 +1,81 @@
+package Data::Plist::Writer;
+
+use strict;
+use warnings;
+
+sub new {
+ my $class = shift;
+ return bless {} => $class;
+}
+
+sub open_string {
+ my $self = shift;
+ my ($object) = @_;
+
+ my $fh;
+ my $content;
+ open( $fh, ">", \$content );
+ $self->open_fh($fh, $object) or return "moose";
+ return $content;
+}
+
+sub open_file {
+ my $self = shift;
+ my ($filename, $object) = @_;
+
+ my $fh;
+ open( $fh, ">", $filename ) or die "can't open $filename for conversion";
+ binmode($fh);
+ return $self->open_fh($fh, $object);
+}
+
+sub open_fh {
+ my $self = shift;
+ my ($fh, $object) = @_;
+
+ die "Unimplemented!";
+}
+
+sub fold_uids {
+ my $self = shift;
+ my $data = shift;
+
+ if ($data->[0] eq "UID") {
+ require Digest::MD5;
+ my $digest = Digest::MD5::md5_hex(YAML::Dump($data->[1]));
+ if (exists $self->{objcache}{$digest}) {
+ return [ UID => $self->{objcache}{$digest} ];
+ }
+ push @{$self->{objects}}, $self->fold_uids($data->[1]);
+ $self->{objcache}{$digest} = @{$self->{objects}} - 1;
+ return [ UID => @{$self->{objects}} - 1 ];
+ } elsif ($data->[0] eq "array") {
+ return ["array", [map {$self->fold_uids($_)} @{$data->[1]}]];
+ } elsif ($data->[0] eq "dict") {
+ my %dict = %{$data->[1]};
+ $dict{$_} = $self->fold_uids($dict{$_}) for keys %dict;
+ return ["dict", \%dict];
+ } else {
+ return $data;
+ }
+}
+
+sub serialize {
+ my $self = shift;
+ my $object = shift;
+
+ local $self->{objects} = [];
+ local $self->{objcache} = {};
+ my $top = $self->fold_uids( [ dict => { root => $object } ] );
+
+ return [
+ dict => {
+ '$archiver' => [ string => "NSKeyedArchiver" ],
+ '$version' => [ integer => 100_000 ],
+ '$top' => $top,
+ '$objects' => [ array => $self->{objects} ],
+ },
+ ];
+}
+
+1;
Added: Data-Plist/lib/Data/Plist/XMLWriter.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Data/Plist/XMLWriter.pm Sat Jul 12 00:19:13 2008
@@ -0,0 +1,65 @@
+package Data::Plist::XMLWriter;
+
+use strict;
+use warnings;
+
+use base qw/Data::Plist::Writer/;
+use XML::Writer;
+use MIME::Base64 qw//;
+
+sub open_fh {
+ my $self = shift;
+ $self = $self->new() unless ref $self;
+
+ my ( $fh, $object ) = @_;
+ local $self->{x}
+ = XML::Writer->new( OUTPUT => $fh, DATA_MODE => 1, DATA_INDENT => 8 );
+ $self->{x}->xmlDecl();
+ $self->{x}->doctype(
+ "plist",
+ "-//Apple//DTD PLIST 1.0//EN",
+ "http://www.apple.com/DTDs/PropertyList-1.0.dtd"
+ );
+ $self->{x}->startTag( plist => version => "1.0" );
+ $self->xml_write( $self->serialize($object) );
+ $self->{x}->endTag("plist");
+ $self->{x}->end();
+
+ return 1;
+}
+
+sub xml_write {
+ my $self = shift;
+ my $data = shift;
+
+ if ( $data->[0] =~ /^(true|false)$/ ) {
+ $self->{x}->emptyTag( $data->[0] );
+ } elsif ( $data->[0] =~ /^(integer|real|date|string|ustring)$/ ) {
+ $self->{x}->dataElement( $data->[0], $data->[1] );
+ } elsif ( $data->[0] eq "UID" ) {
+ # UIDs are only hackishly supported in the XML version.
+ # Apple's plutil converts them as follows:
+ $self->{x}->startTag("dict");
+ $self->{x}->dataElement( "key", 'CF$UID' );
+ $self->{x}->dataElement( "integer", $data->[1] );
+ $self->{x}->endTag("dict");
+ } elsif ( $data->[0] eq "data" ) {
+ $self->{x}->dataElement( "data",
+ MIME::Base64::encode_base64( $data->[1] ) );
+ } elsif ( $data->[0] eq "dict" ) {
+ $self->{x}->startTag("dict");
+ for my $k ( keys %{ $data->[1] } ) {
+ $self->{x}->dataElement( "key", $k );
+ $self->xml_write( $data->[1]{$k} );
+ }
+ $self->{x}->endTag("dict");
+ } elsif ( $data->[0] eq "array" ) {
+ $self->{x}->startTag("array");
+ $self->xml_write($_) for @{ $data->[1] };
+ $self->{x}->endTag("array");
+ } else {
+ $self->{x}->comment( $data->[0] );
+ }
+}
+
+1;
More information about the Bps-public-commit
mailing list