[Bps-public-commit] r14129 - in Data-Plist: . lib/Data/Plist lib/Foundation t/data
alexmv at bestpractical.com
alexmv at bestpractical.com
Tue Jul 15 17:11:52 EDT 2008
Author: alexmv
Date: Tue Jul 15 17:11:49 2008
New Revision: 14129
Added:
Data-Plist/t/00-load.t
Data-Plist/t/binary-load.t
Data-Plist/t/data/
Data-Plist/t/data/basic.binary.plist (contents, props changed)
Modified:
Data-Plist/ (props changed)
Data-Plist/lib/Data/Plist/Writer.pm
Data-Plist/lib/Foundation/NSObject.pm
Log:
r34194 at kohr-ah: chmrr | 2008-07-15 17:10:09 -0400
* serialize_value moves to Writer, so we can use it for serializing non-object data
Modified: Data-Plist/lib/Data/Plist/Writer.pm
==============================================================================
--- Data-Plist/lib/Data/Plist/Writer.pm (original)
+++ Data-Plist/lib/Data/Plist/Writer.pm Tue Jul 15 17:11:49 2008
@@ -53,11 +53,45 @@
}
}
+sub serialize_value {
+ my $self = shift;
+ my ($value) = @_;
+ if (not defined $value) {
+ return [ string => '$null' ];
+ } elsif ( ref $value ) {
+ if ( ref $value eq "ARRAY" ) {
+ return [
+ array => [ map { $self->serialize_value($_) } @{$value} ] ];
+ } elsif ( ref $value and ref $value eq "HASH" ) {
+ my %hash = %{$value};
+ $hash{$_} = $self->serialize_value( $hash{$_} ) for keys %hash;
+ return [ dict => \%hash ];
+ } elsif ($value->isa("Foundation::NSObject")) {
+ return $value->serialize;
+ } else {
+ die "Can't serialize unknown ref @{[ref $value]}\n";
+ }
+ } elsif ( $value !~ /\D/ ) {
+ return [ integer => $value ];
+ } elsif ( Scalar::Util::looks_like_number($value) ) {
+ return [ real => $value ];
+ } elsif ( $value =~ /\0/ or $value =~ /<\?xml/) {
+ # XXX TODO: The /<\?xml/ is a hack to get it labelled DATA
+ # until we use BinaryWriter to write nested plists
+ return [ data => $value ];
+ } else {
+ return [ string => $value ];
+ }
+}
+
sub serialize {
my $self = shift;
my $object = shift;
- $object = $object->serialize if ref($object) ne "ARRAY" and $object->can("serialize");
+ return $self->serialize_value($object)
+ if ref($object) =~ /ARRAY|HASH/ or not $object->can("serialize");
+
+ $object = $object->serialize;
local $self->{objects} = [];
local $self->{objcache} = {};
Modified: Data-Plist/lib/Foundation/NSObject.pm
==============================================================================
--- Data-Plist/lib/Foundation/NSObject.pm (original)
+++ Data-Plist/lib/Foundation/NSObject.pm Tue Jul 15 17:11:49 2008
@@ -43,46 +43,13 @@
return { %{ $self } };
}
-sub serialize_value {
- my $self = shift;
- my ($value) = @_;
- if (not defined $value) {
- return [ string => '$null' ];
- } elsif ( ref $value ) {
- if ( ref $value eq "ARRAY" ) {
- return [
- array => [ map { $self->serialize_value($_) } @{$value} ] ];
- } elsif ( ref $value and ref $value eq "HASH" ) {
- my %hash = %{$value};
- $hash{$_} = $self->serialize_value( $hash{$_} ) for keys %hash;
- return [ dict => \%hash ];
- } elsif ($value->isa("Foundation::NSObject")) {
- return $value->serialize;
- } else {
- die "Can't serialize unknown ref @{[ref $value]}\n";
- }
- } elsif ( $value !~ /\D/ ) {
- return [ integer => $value ];
- } elsif ( Scalar::Util::looks_like_number($value) ) {
- return [ real => $value ];
- } elsif ( $value =~ /\0/ or $value =~ /<\?xml/) {
- # XXX TODO: The /<\?xml/ is a hack to get it labelled DATA
- # until we use BinaryWriter to write nested plists
- return [ data => $value ];
- } else {
- return [ string => $value ];
- }
-}
-
-
-
sub serialize {
my $self = shift;
my %dict;
$dict{'$class'} = $self->serialize_class;
my $equiv = $self->serialize_equiv;
for my $key (keys %{$equiv}) {
- my $value = $self->serialize_value($equiv->{$key});
+ my $value = Data::Plist::Writer->serialize_value($equiv->{$key});
if ($value->[0] =~ /^(data|integer|real|true|false)$/) {
$dict{$key} = $value;
} else {
Added: Data-Plist/t/00-load.t
==============================================================================
--- (empty file)
+++ Data-Plist/t/00-load.t Tue Jul 15 17:11:49 2008
@@ -0,0 +1,13 @@
+use Test::More tests => 4;
+
+use strict;
+use warnings;
+
+BEGIN {
+ use_ok('Data::Plist');
+ use_ok('Data::Plist::BinaryReader');
+ use_ok('Data::Plist::XMLWriter');
+ use_ok('Data::Plist::BinaryWriter');
+}
+
+diag("Testing Data::Plist $Data::Plist::VERSION");
Added: Data-Plist/t/binary-load.t
==============================================================================
--- (empty file)
+++ Data-Plist/t/binary-load.t Tue Jul 15 17:11:49 2008
@@ -0,0 +1,126 @@
+use Test::More tests => 40;
+
+use strict;
+use warnings;
+
+use Data::Plist::BinaryReader;
+my $ret;
+
+# Create the object
+my $read = Data::Plist::BinaryReader->new;
+ok( $read, "Created a binary reader" );
+isa_ok( $read, "Data::Plist::BinaryReader" );
+
+### Basic plist munging
+
+# Magic header is magic
+$ret = eval {$read->open_string("moose")};
+ok( not($ret), "Not bplist doesn't load" );
+like( "$@", qr/not a binary plist/i, "Threw an error" );
+
+# No trailer
+$ret = eval {$read->open_string("bplist00")};
+ok( not($ret), "No trailer doesn't load" );
+like( "$@", qr/trailer/i, "Threw an error" );
+
+# Trailer overlaps with header
+$ret = eval {$read->open_string("bplist00" . ("!"x (32 - 8)))};
+ok( not($ret), "Trailer too short doesn't load" );
+like( "$@", qr/trailer/i, "Threw an error" );
+
+# Plist has no real data
+$ret = eval {$read->open_string("bplist00" . pack("x6CC(x4N)3",1,1,0,0,8))};
+ok( not($ret), "Plist with no contents is bogus" );
+like( "$@", qr/top object/i, "Threw an error" );
+
+# Smallest valid bplist!
+$ret = eval {$read->open_string("bplist00" . pack("CCx6CC(x4N)3",0,8,1,1,1,0,9))};
+ok( $ret, "Tiny plist is valid" );
+isa_ok( $ret, "Data::Plist" );
+is_deeply( $ret->raw_data => [ null => 0 ], "Has a null");
+
+
+### Offset table
+
+# Data overlap
+$ret = eval {$read->open_string("bplist00" . pack("Cx6CC(x4N)3",8,1,1,1,0,8))};
+ok( not($ret), "data overlaps with trailer");
+like( "$@", qr/invalid address/i, "Threw an error" );
+
+# More data overlap
+$ret = eval {$read->open_string("bplist00" . pack("CCx6CC(x4N)3",0,9,1,1,1,0,9))};
+ok( not($ret), "data overlaps with trailer");
+like( "$@", qr/invalid address/i, "Threw an error" );
+
+# Offset table doesn't need to be at the end
+$ret = eval {$read->open_string("bplist00" . pack("CCx6CC(x4N)3",9,0,1,1,1,0,8))};
+ok( $ret, "Tiny plist is valid" );
+isa_ok( $ret, "Data::Plist" );
+is_deeply( $ret->raw_data => [ null => 0 ], "Has a null");
+
+# Offset table has too early address
+$ret = eval {$read->open_string("bplist00" . pack("Cx6CC(x4N)3",0,1,1,1,0,8))};
+ok( not($ret), "address too small");
+like( "$@", qr/invalid address/i, "Threw an error" );
+
+# Offset table has too late address
+$ret = eval {$read->open_string("bplist00" . pack("Cx6CC(x4N)3",10,1,1,1,0,8))};
+ok( not($ret), "address too small");
+like( "$@", qr/invalid address/i, "Threw an error" );
+
+# Wrong offset size horks
+$ret = eval {$read->open_string("bplist00" . pack("Cnx6CC(x4N)3",0,8,1,1,1,0,9))};
+ok( not($ret), "Wrong offset");
+like( "$@", qr/invalid address/i, "Threw an error" );
+
+# Two byte addresses do work
+$ret = eval {$read->open_string("bplist00" . pack("Cnx6CC(x4N)3",0,8,2,1,1,0,9))};
+ok( $ret, "Two byte addresses work" );
+isa_ok( $ret, "Data::Plist" );
+is_deeply( $ret->raw_data => [ null => 0 ], "Has a null");
+
+
+### More complex testing
+
+# Load from a file
+$ret = $read->open_file("t/data/basic.binary.plist");
+ok( $ret, "Got a value from open with a filename" );
+isa_ok( $ret, "Data::Plist" );
+ok( $ret->raw_data, "Has data inside" );
+
+# Load from fh
+my $fh;
+open( $fh, "<", "t/data/basic.binary.plist");
+$ret = $read->open_fh( $fh );
+ok( $ret, "Opening from a fh worked" );
+isa_ok( $ret, "Data::Plist" );
+ok( $ret->raw_data, "Has data inside" );
+
+# Load from string
+my $str = do {local @ARGV = "t/data/basic.binary.plist"; local $/; <>};
+ok( $str, "Read binary data in by hand" );
+$ret = $read->open_string( $str );
+ok( $ret, "Opening from a string worked" );
+isa_ok( $ret, "Data::Plist" );
+ok( $ret->raw_data, "Has data inside" );
+
+# Test raw structure
+is_deeply(
+ $ret->raw_data,
+ [ dict => {
+ a => [
+ array => [
+ [ integer => 1 ],
+ [ integer => 2 ],
+ [ dict => {
+ foo => [ string => "bar" ],
+ baz => [ string => "troz" ],
+ zort => [ string => '$null' ],
+ }
+ ]
+ ]
+ ]
+ }
+ ],
+ "Raw structure matches",
+);
Added: Data-Plist/t/data/basic.binary.plist
==============================================================================
Binary file. No diff available.
More information about the Bps-public-commit
mailing list