[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