[Bps-public-commit] r14017 - in Data-Plist: . lib lib/Data/Plist lib/Foundation
alexmv at bestpractical.com
alexmv at bestpractical.com
Fri Jul 11 14:31:27 EDT 2008
Author: alexmv
Date: Fri Jul 11 14:31:24 2008
New Revision: 14017
Added:
Data-Plist/lib/
Data-Plist/lib/Data/
Data-Plist/lib/Data/Plist/
Data-Plist/lib/Data/Plist.pm
Data-Plist/lib/Data/Plist/BinaryReader.pm
Data-Plist/lib/Foundation/
Data-Plist/lib/Foundation/LibraryToDo.pm
Data-Plist/lib/Foundation/NSArray.pm
Data-Plist/lib/Foundation/NSData.pm
Data-Plist/lib/Foundation/NSDate.pm
Data-Plist/lib/Foundation/NSMutableArray.pm
Data-Plist/lib/Foundation/NSMutableData.pm
Data-Plist/lib/Foundation/NSMutableString.pm
Data-Plist/lib/Foundation/NSObject.pm
Data-Plist/lib/Foundation/NSString.pm
Data-Plist/lib/Foundation/NSURL.pm
Data-Plist/lib/Foundation/ToDo.pm
Data-Plist/lib/Foundation/ToDoAlarm.pm
Data-Plist/lib/Foundation/ToDoAlarms.pm
Modified:
Data-Plist/ (props changed)
Log:
r34068 at kohr-ah: chmrr | 2008-07-11 14:31:19 -0400
* Initial import; inflates perl objects from binary plists
Added: Data-Plist/lib/Data/Plist.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Data/Plist.pm Fri Jul 11 14:31:24 2008
@@ -0,0 +1,139 @@
+package Data::Plist;
+
+use strict;
+use warnings;
+
+use Encode qw(decode encode);
+use Fcntl qw(:seek);
+use DateTime;
+use POSIX ();
+use Math::BigInt;
+use MIME::Base64;
+use UNIVERSAL::require;
+
+use vars qw/$VERSION/;
+$VERSION = "1.5";
+
+sub new {
+ my $class = shift;
+ return bless { uids => undef, data => undef, @_ } => $class;
+}
+
+sub collapse {
+ my $self = shift;
+ my ($data) = @_;
+
+ unless (ref $data eq "ARRAY") {
+ warn "Got $data?";
+ return "???";
+ }
+
+ if ($data->[0] eq "array") {
+ return [ map $self->collapse($_), @{$data->[1]} ];
+ } elsif ($data->[0] eq "dict") {
+ my %dict = %{$data->[1]};
+ $dict{$_} = $self->collapse($dict{$_}) for keys %dict;
+ return \%dict;
+ } elsif ($data->[0] eq "string") {
+ return $data->[1] eq '$null' ? undef : $data->[1];
+ } elsif ($data->[0] eq "date") {
+ return DateTime->new( epoch => $data->[1] + 978307200);
+ } elsif ($data->[0] eq "UID" and ref $data->[1]) {
+ return $self->collapse($data->[1]);
+ } else {
+ return $data->[1];
+ }
+
+ return $data;
+}
+
+sub raw_data {
+ my $self = shift;
+ return $self->{data};
+}
+
+sub data {
+ my $self = shift;
+ return $self->collapse($self->raw_data);
+}
+
+sub is_archive {
+ my $self = shift;
+ my $data = $self->raw_data;
+ return unless $data->[0] eq "dict";
+
+ return unless exists $data->[1]{'$archiver'};
+ return unless $data->[1]{'$archiver'}[0] eq "string";
+ return unless $data->[1]{'$archiver'}[1] eq "NSKeyedArchiver";
+
+ return unless exists $data->[1]{'$objects'};
+ return unless $data->[1]{'$objects'}[0] eq "array";
+
+ 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'}[1] eq "100000";
+
+ return 1;
+}
+
+sub unref {
+ my $self = shift;
+ my $p = shift;
+ if ($p->[0] eq "UID") {
+ return ["UID", $self->unref( $self->raw_data->[1]{'$objects'}[1][ $p->[1] ] )];
+ } elsif ($p->[0] eq "array") {
+ return ["array", [map {$self->unref($_)} @{$p->[1]}]]
+ } elsif ($p->[0] eq "dict") {
+ my %dict = %{$p->[1]};
+ $dict{$_} = $self->unref($dict{$_}) for keys %dict;
+ return ["dict", \%dict];
+ } elsif ($p->[0] eq "data" and ref $p->[1] and $p->[1]->isa("Data::Plist")) {
+ return $p->[1]->raw_object;
+ } else {
+ return $p;
+ }
+}
+
+sub reify {
+ my $self = shift;
+ my $data = shift;
+
+ return $data unless ref $data;
+ if (ref $data eq "HASH") {
+ my $hash = { %{$data} };
+ my $class = delete $hash->{'$class'};
+ $hash->{$_} = $self->reify($hash->{$_}) for keys %{$hash};
+ if ($class and ref $class and ref $class eq "HASH" and $class->{'$classname'}) {
+ my $classname = "Foundation::" . $class->{'$classname'};
+ if (not $classname->require) {
+ warn "Can't require $classname: $@\n";
+ } elsif (not $classname->isa("Foundation::NSObject")) {
+ warn "$classname isn't a Foundation::NSObject\n";
+ } else {
+ bless($hash, $classname);
+ $hash = $hash->replacement;
+ }
+ }
+ return $hash;
+ } elsif (ref $data eq "ARRAY") {
+ return [map $self->reify($_), @{$data}];
+ } else {
+ return $data;
+ }
+}
+
+sub raw_object {
+ my $self = shift;
+ return unless $self->is_archive;
+ return $self->unref($self->raw_data->[1]{'$top'}[1]{root});
+}
+
+sub object {
+ my $self = shift;
+ return unless $self->is_archive;
+ return $self->reify($self->collapse($self->raw_object));
+}
+
+1;
Added: Data-Plist/lib/Data/Plist/BinaryReader.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Data/Plist/BinaryReader.pm Fri Jul 11 14:31:24 2008
@@ -0,0 +1,286 @@
+package Data::Plist::BinaryReader;
+
+use strict;
+use warnings;
+
+use Encode qw(decode);
+use Fcntl qw(:seek);
+use Math::BigInt;
+use MIME::Base64;
+
+sub new {
+ my $class = shift;
+ return bless { offsets => [], refsize => undef, uids => [] } => $class;
+}
+
+sub read_misc {
+ my $self = shift;
+
+ my ($objLen) = @_;
+ if ( $objLen == 0 ) {
+ return [ "null", 0 ];
+ } elsif ( $objLen == 8 ) {
+ return [ "false", 0 ];
+ } elsif ( $objLen == 9 ) {
+ return [ "true", 1 ];
+ } elsif ( $objLen == 15 ) {
+ return [ "fill", 15 ];
+ }
+}
+
+sub read_int { # int
+ my $self = shift;
+
+ my ($objLen) = @_;
+ die "Integer > 8 bytes = $objLen" if ( $objLen > 3 );
+
+ my $byteLen = 1 << $objLen;
+
+ my ( $buf, $val );
+ read( $self->{fh}, $buf, $byteLen );
+ if ( $objLen == 0 ) {
+ $val = unpack( "C", $buf );
+ } elsif ( $objLen == 1 ) {
+ $val = unpack( "n", $buf );
+ } elsif ( $objLen == 2 ) {
+ $val = unpack( "N", $buf );
+ } elsif ( $objLen == 3 ) {
+
+ my ( $hw, $lw ) = unpack( "NN", $buf );
+ $val = Math::BigInt->new($hw)->blsft(32)->bior($lw);
+ if ( $val->bcmp( Math::BigInt->new(2)->bpow(63) ) > 0 ) {
+ $val -= Math::BigInt->new(2)->bpow(64);
+ }
+ }
+
+ return [ "int", $val ];
+}
+
+sub read_real { # real
+ my $self = shift;
+ my ($objLen) = @_;
+ die "Real > 8 bytes" if ( $objLen > 3 );
+
+ my $byteLen = 1 << $objLen;
+
+ my ( $buf, $val );
+ read( $self->{fh}, $buf, $byteLen );
+ if ( $objLen == 0 ) { # 1 byte float = error?
+ die "1 byte real found";
+ } elsif ( $objLen == 1 ) { # 2 byte float???
+ die "2 byte real found";
+ } elsif ( $objLen == 2 ) {
+ $val = unpack( "f", reverse $buf );
+ } elsif ( $objLen == 3 ) {
+ $val = unpack( "d", reverse $buf );
+ }
+
+ return [ "real", $val ];
+}
+
+sub read_date { # date
+ my $self = shift;
+ my ($objLen) = @_;
+ die "Date > 8 bytes" if ( $objLen > 3 );
+
+ my $byteLen = 1 << $objLen;
+
+ my ( $buf, $val );
+ read( $self->{fh}, $buf, $byteLen );
+ if ( $objLen == 0 ) { # 1 byte NSDate = error?
+ die "1 byte NSDate found";
+ } elsif ( $objLen == 1 ) { # 2 byte NSDate???
+ die "2 byte NSDate found";
+ } elsif ( $objLen == 2 ) {
+ $val = unpack( "f", reverse $buf );
+ } elsif ( $objLen == 3 ) {
+ $val = unpack( "d", reverse $buf );
+ }
+
+ return [ "date", $val ];
+}
+
+sub read_data { # binary data
+ my $self = shift;
+ my ($byteLen) = @_;
+
+ my $buf;
+ read( $self->{fh}, $buf, $byteLen );
+
+ if ( $buf =~ /^bplist00/ ) {
+ $buf = eval { (ref $self)->open_string($buf) } || $buf;
+ }
+
+ return [ "data", $buf ];
+}
+
+sub read_string { # byte (utf8?) string
+ my $self = shift;
+ my ($objLen) = @_;
+
+ my $buf;
+ read( $self->{fh}, $buf, $objLen );
+
+ $buf = pack "U0C*", unpack "C*", $buf; # mark as Unicode
+
+ return [ "string", $buf ];
+}
+
+sub read_ustring { # unicode string
+ my $self = shift;
+ my ($objLen) = @_;
+
+ my $buf;
+ read( $self->{fh}, $buf, 2 * $objLen );
+
+ return [ "ustring", decode( "UTF-16BE", $buf ) ];
+}
+
+sub read_refs {
+ my $self = shift;
+ my ($count) = @_;
+ my $buf;
+ read( $self->{fh}, $buf, $count * $self->{refsize} );
+ return unpack( ( $self->{refsize} == 1 ? "C*" : "n*" ), $buf );
+}
+
+sub read_array { # array
+ my $self = shift;
+ my ($objLen) = @_;
+
+ return [
+ "array", [ map { $self->binary_read($_) } $self->read_refs($objLen) ]
+ ];
+}
+
+sub read_dict { # dictionary
+ my $self = shift;
+ my ($objLen) = @_;
+ my %dict;
+
+ # read keys
+ my @keys = $self->read_refs($objLen);
+ my @objs = $self->read_refs($objLen);
+
+ for my $j ( 0 .. $#keys ) {
+ my $key = $self->binary_read( $keys[$j] );
+ die "Type isn't string!" unless $key->[0] eq "string";
+ $key = $key->[1];
+ my $obj = $self->binary_read( $objs[$j] );
+ $dict{$key} = $obj;
+ }
+
+ return [ "dict", \%dict ];
+}
+
+sub read_uid {
+ my $self = shift;
+ my ($objLen) = @_;
+
+ my $v = $self->read_int(0)->[1];
+ my $uid = [ UID => $v ];
+ push @{ $self->{uids} }, $uid;
+ return $uid;
+}
+
+sub binary_read {
+ my $self = shift;
+ my ($objNum) = @_;
+
+ seek( $self->{fh}, $self->{offsets}[$objNum], SEEK_SET )
+ if defined $objNum;
+
+ # get object type/size
+ my $buf;
+
+ if ( read( $self->{fh}, $buf, 1 ) != 1 ) {
+ die "Didn't read type byte: $!";
+ }
+ my $objLen = unpack( "C*", $buf ) & 0xF;
+ $buf = unpack( "H*", $buf );
+ my $objType = substr( $buf, 0, 1 );
+ if ( $objType ne "0" && $objType ne "8" && $objLen == 15 ) {
+ $objLen = $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",
+ );
+
+ return [ "??? $objType ???", undef ] unless $types{$objType};
+ my $method = "read_" . $types{$objType};
+ die "Can't $method" unless $self->can($method);
+ my $v = $self->$method($objLen);
+ 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);
+}
+
+sub open_fh {
+ my $self = shift;
+ $self = $self->new() unless ref $self;
+
+ my ($fh) = @_;
+
+ $self->{fh} = $fh;
+
+ # get trailer
+ seek( $self->{fh}, -32, SEEK_END );
+ my $buf;
+ read( $self->{fh}, $buf, 32 );
+ my ( $OffsetSize, $NumObjects, $TopObject, $OffsetTableOffset );
+ ( $OffsetSize, $self->{refsize}, $NumObjects, $TopObject,
+ $OffsetTableOffset
+ ) = unpack "x6CC(x4N)3", $buf;
+
+ # get the offset table
+ seek( $fh, $OffsetTableOffset, SEEK_SET );
+
+ my $rawOffsetTable;
+ my $readSize
+ = read( $self->{fh}, $rawOffsetTable, $NumObjects * $OffsetSize );
+ if ( $readSize != $NumObjects * $OffsetSize ) {
+ die "rawOffsetTable read $readSize expected ",
+ $NumObjects * $OffsetSize;
+ }
+
+ my @Offsets = unpack( [ "", "C*", "n*", "(H6)*", "N*" ]->[$OffsetSize],
+ $rawOffsetTable );
+ if ( $OffsetSize == 3 ) {
+ @Offsets = map { hex($_) } @Offsets;
+ }
+ $self->{offsets} = \@Offsets;
+
+ my $top = $self->binary_read($TopObject);
+ close($fh);
+
+ return Data::Plist->new( data => $top );
+}
+
+1;
Added: Data-Plist/lib/Foundation/LibraryToDo.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Foundation/LibraryToDo.pm Fri Jul 11 14:31:24 2008
@@ -0,0 +1,47 @@
+package Foundation::LibraryToDo;
+
+use base qw/Foundation::ToDo Class::Accessor/;
+
+my %mapping = (
+ alarms => [ "ToDo Alarms" => undef ],
+ cal_id => [ "ToDo Calendar ID" => "string" ],
+ calendar => [ "ToDo Calendar Title" => "string" ],
+ complete => [ "ToDo Completed" => "bool" ],
+ completed_at => [ "ToDo Date Completed" => undef ],
+ created => [ "ToDo Date Created" => undef ],
+ due => [ "ToDo Due Date" => undef ],
+ notes => [ "ToDo Notes" => "string" ],
+ priority => [ "ToDo Priority" => "int" ],
+ title => [ "ToDo Title" => "string" ],
+ url => [ "ToDo URL" => undef ],
+ id => [ "ToDo iCal ID" => "string" ],
+ keys_digest => [ "ToDo Keys Digest" => undef ],
+);
+
+my %lookup = (map {($mapping{$_}[0] => $_)} keys %mapping);
+
+
+sub init {
+ my $self = shift;
+
+ __PACKAGE__->mk_accessors(grep {not $self->can($_)} keys %mapping);
+ $self->{$lookup{$_}} = delete $self->{$_} for grep {exists $lookup{$_}} keys %{$self};
+
+ $self->due(undef) unless delete $self->{"ToDo Due Date Enabled"};
+ $self->priority(undef) unless delete $self->{"ToDo Priority Enabled"};
+}
+
+sub serialize {
+ my $self = shift;
+ my $ret = {};
+
+ for my $k (keys %mapping) {
+ $ret->{$keys}
+ }
+
+ return ["dict", $ret];
+}
+
+1;
+
+
Added: Data-Plist/lib/Foundation/NSArray.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Foundation/NSArray.pm Fri Jul 11 14:31:24 2008
@@ -0,0 +1,7 @@
+package Foundation::NSArray;
+
+use base qw/Foundation::NSObject/;
+
+1;
+
+
Added: Data-Plist/lib/Foundation/NSData.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Foundation/NSData.pm Fri Jul 11 14:31:24 2008
@@ -0,0 +1,7 @@
+package Foundation::NSData;
+
+use base qw/Foundation::NSObject/;
+
+1;
+
+
Added: Data-Plist/lib/Foundation/NSDate.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Foundation/NSDate.pm Fri Jul 11 14:31:24 2008
@@ -0,0 +1,19 @@
+package Foundation::NSDate;
+
+use base qw/Foundation::NSObject DateTime/;
+
+sub replacement {
+ my $self = shift;
+ my $dt = DateTime->from_epoch( epoch => $self->{"NS.time"} + 978307200 );
+ bless $dt, (ref $self);
+ return $dt;
+}
+
+sub serialize {
+ my $self = shift;
+ return { "NS.time" => $self->epoch - 978307200 };
+}
+
+1;
+
+
Added: Data-Plist/lib/Foundation/NSMutableArray.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Foundation/NSMutableArray.pm Fri Jul 11 14:31:24 2008
@@ -0,0 +1,7 @@
+package Foundation::NSMutableArray;
+
+use base qw/Foundation::NSArray/;
+
+1;
+
+
Added: Data-Plist/lib/Foundation/NSMutableData.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Foundation/NSMutableData.pm Fri Jul 11 14:31:24 2008
@@ -0,0 +1,15 @@
+package Foundation::NSMutableData;
+
+use base qw/Foundation::NSData/;
+
+sub data {
+ my $self = shift;
+ return $self->{"NS.data"};
+}
+
+sub serialize {
+}
+
+1;
+
+
Added: Data-Plist/lib/Foundation/NSMutableString.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Foundation/NSMutableString.pm Fri Jul 11 14:31:24 2008
@@ -0,0 +1,10 @@
+package Foundation::NSMutableString;
+
+use base qw/Foundation::NSString/;
+
+sub replacement {
+ my $self = shift;
+ return $self->{"NS.string"};
+}
+
+1;
Added: Data-Plist/lib/Foundation/NSObject.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Foundation/NSObject.pm Fri Jul 11 14:31:24 2008
@@ -0,0 +1,13 @@
+package Foundation::NSObject;
+
+sub init {
+ my $self = shift;
+}
+
+sub replacement {
+ my $self = shift;
+ $self->init;
+ return $self;
+}
+
+1;
Added: Data-Plist/lib/Foundation/NSString.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Foundation/NSString.pm Fri Jul 11 14:31:24 2008
@@ -0,0 +1,5 @@
+package Foundation::NSString;
+
+use base qw/Foundation::NSObject/;
+
+1;
Added: Data-Plist/lib/Foundation/NSURL.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Foundation/NSURL.pm Fri Jul 11 14:31:24 2008
@@ -0,0 +1,17 @@
+package Foundation::NSURL;
+
+use base qw/Foundation::NSObject URI::http/;
+
+sub replacement {
+ my $self = shift;
+ my $uri = URI->new($self->{"NS.relative"}, "http");
+ bless $uri, (ref $self);
+ return $uri;
+}
+
+sub serialize {
+ my $self = shift;
+ return { "NS.relative" => $self->as_string };
+}
+
+1;
Added: Data-Plist/lib/Foundation/ToDo.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Foundation/ToDo.pm Fri Jul 11 14:31:24 2008
@@ -0,0 +1,7 @@
+package Foundation::ToDo;
+
+use base qw/Foundation::NSObject/;
+
+1;
+
+
Added: Data-Plist/lib/Foundation/ToDoAlarm.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Foundation/ToDoAlarm.pm Fri Jul 11 14:31:24 2008
@@ -0,0 +1,5 @@
+package Foundation::ToDoAlarm;
+
+use base qw/Foundation::NSObject/;
+
+1;
Added: Data-Plist/lib/Foundation/ToDoAlarms.pm
==============================================================================
--- (empty file)
+++ Data-Plist/lib/Foundation/ToDoAlarms.pm Fri Jul 11 14:31:24 2008
@@ -0,0 +1,7 @@
+package Foundation::ToDoAlarms;
+
+use base qw/Foundation::NSObject/;
+
+1;
+
+
More information about the Bps-public-commit
mailing list