[Bps-public-commit] r14397 - in Data-Plist: . lib/Data/Plist
kyoki at bestpractical.com
kyoki at bestpractical.com
Tue Jul 22 18:14:57 EDT 2008
Author: kyoki
Date: Tue Jul 22 18:14:53 2008
New Revision: 14397
Modified:
Data-Plist/ (props changed)
Data-Plist/lib/Data/Plist/BinaryReader.pm
Data-Plist/lib/Data/Plist/BinaryWriter.pm
Data-Plist/t/binary-write.t
Log:
r29911 at nyx: kyoki | 2008-07-22 18:14:47 -0400
* perltidy
* more tests
* fixed integers and offset sizes
Modified: Data-Plist/lib/Data/Plist/BinaryReader.pm
==============================================================================
--- Data-Plist/lib/Data/Plist/BinaryReader.pm (original)
+++ Data-Plist/lib/Data/Plist/BinaryReader.pm Tue Jul 22 18:14:53 2008
@@ -16,13 +16,17 @@
my ($type) = @_;
if ( $type == 0 ) {
return [ "null", 0 ];
- } elsif ( $type == 8 ) {
+ }
+ elsif ( $type == 8 ) {
return [ "false", 0 ];
- } elsif ( $type == 9 ) {
+ }
+ elsif ( $type == 9 ) {
return [ "true", 1 ];
- } elsif ( $type == 15 ) {
+ }
+ elsif ( $type == 15 ) {
return [ "fill", 15 ];
- } else {
+ }
+ else {
return [ "???", $type ];
}
}
@@ -33,20 +37,24 @@
my ( $buf, $val );
read( $self->{fh}, $buf, 1 << $size );
- if ( $size == 0 ) { # 8 bit
+ if ( $size == 0 ) { # 8 bit
$val = unpack( "C", $buf );
- } elsif ( $size == 1 ) { # 16 bit
+ }
+ elsif ( $size == 1 ) { # 16 bit
$val = unpack( "n", $buf );
- } elsif ( $size == 2 ) { # 32 bit
+ }
+ elsif ( $size == 2 ) { # 32 bit
$val = unpack( "N", $buf );
- } elsif ( $size == 3 ) { # 64 bit
+ }
+ elsif ( $size == 3 ) { # 64 bit
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);
}
- } else {
+ }
+ else {
die "Invalid size for integer ($size)";
}
@@ -61,9 +69,11 @@
read( $self->{fh}, $buf, 1 << $size );
if ( $size == 2 ) { # 32 bit
$val = unpack( "f", reverse $buf );
- } elsif ( $size == 3 ) { # 64 bit
+ }
+ elsif ( $size == 3 ) { # 64 bit
$val = unpack( "d", reverse $buf );
- } else {
+ }
+ else {
die "Invalid size for real ($size)";
}
@@ -74,7 +84,7 @@
my $self = shift;
my ($size) = @_;
die "Invalid size for date ($size)"
- if ( $size > 3 or $size < 2 );
+ if ( $size > 3 or $size < 2 );
# Dates are just stored as floats
return [ "date", $self->read_real($size)->[1] ];
@@ -129,9 +139,8 @@
my $self = shift;
my ($size) = @_;
- return [
- "array", [ map { $self->binary_read($_) } $self->read_refs($size) ]
- ];
+ return [ "array",
+ [ map { $self->binary_read($_) } $self->read_refs($size) ] ];
}
sub read_dict {
@@ -169,19 +178,19 @@
if ( defined $objNum ) {
die "Bad offset: $objNum"
- unless $objNum < @{ $self->{offsets} };
+ unless $objNum < @{ $self->{offsets} };
seek( $self->{fh}, $self->{offsets}[$objNum], SEEK_SET );
}
# get object type/size
my $buf;
read( $self->{fh}, $buf, 1 )
- or die "Can't read type byte: $!\byte:";
+ or die "Can't read type byte: $!\byte:";
my $size = unpack( "C*", $buf ) & 0x0F; # Low nybble is size
my $objType = unpack( "C*", $buf ) >> 4; # High nybble is type
$size = $self->binary_read->[1]
- if $objType != 0 and $size == 15;
+ if $objType != 0 and $size == 15;
my %types = (
0 => "misc",
@@ -210,11 +219,11 @@
# with "Out of memory" or "panic: memory wrap"; Do some
# error-proofing here.
die "Not a binary plist file\n"
- unless length $str >= 8 and substr( $str, 0, 8 ) eq "bplist00";
+ unless length $str >= 8 and substr( $str, 0, 8 ) eq "bplist00";
die "Read of plist trailer failed\n"
- unless length $str >= 40;
+ unless length $str >= 40;
die "Invalid top object identifier\n"
- unless length $str > 40;
+ unless length $str > 40;
return $self->SUPER::open_string($str);
}
@@ -235,63 +244,68 @@
# get trailer
eval { seek( $self->{fh}, -32, SEEK_END ) }
- or die "Read of plist trailer failed\n";
+ or die "Read of plist trailer failed\n";
my $end = tell( $self->{fh} );
die "Read of plist trailer failed\n"
- unless $end >= 8;
+ unless $end >= 8;
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,
+ (
+ $OffsetSize, $self->{refsize}, $NumObjects, $TopObject,
$OffsetTableOffset
) = unpack "x6CC(x4N)3", $buf;
# Sanity check the trailer
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 ) {
+ }
+ elsif ( 2**( 8 * $self->{refsize} ) < $NumObjects ) {
die
- "Reference size (@{[$self->{refsize}]}) is too small for purported number of objects ($NumObjects)\n";
- } elsif ( $TopObject >= $NumObjects ) {
+"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
+ }
+ elsif ($OffsetTableOffset < 8
or $OffsetTableOffset > $end
or $OffsetTableOffset + $NumObjects * $OffsetSize > $end )
{
- die "Invalid offset table address (overlap with header or footer.";
+ die "Invalid offset table address (overlap with header or footer).";
}
# get the offset table
seek( $fh, $OffsetTableOffset, SEEK_SET );
my $offsetTable;
- my $readSize
- = read( $self->{fh}, $offsetTable, $NumObjects * $OffsetSize );
+ my $readSize = read( $self->{fh}, $offsetTable, $NumObjects * $OffsetSize );
if ( $readSize != $NumObjects * $OffsetSize ) {
die "Offset table read $readSize bytes, expected ",
- $NumObjects * $OffsetSize;
+ $NumObjects * $OffsetSize;
}
- my @Offsets = unpack( [ "", "C*", "n*", "(H6)*", "N*" ]->[$OffsetSize],
- $offsetTable );
+ my @Offsets =
+ unpack( [ "", "C*", "n*", "(H6)*", "N*" ]->[$OffsetSize], $offsetTable );
if ( $OffsetSize == 3 ) {
@Offsets = map { hex($_) } @Offsets;
}
# Catch invalid offset addresses in the offset table
- if (grep {
- $_ < 8
- or $_ >= $end
- or ($_ >= $OffsetTableOffset
+ if (
+ grep {
+ $_ < 8
+ or $_ >= $end
+ or ( $_ >= $OffsetTableOffset
and $_ < $OffsetTableOffset + $NumObjects * $OffsetSize )
} @Offsets
- )
+ )
{
die "Invalid address in offset table\n";
}
@@ -304,4 +318,18 @@
return Data::Plist->new( data => $top );
}
+sub convert_int {
+ my $self = shift;
+ my ($int) = @_;
+ if ( $int == 8 ) {
+ return 4;
+ }
+ elsif ( $int == 4 ) {
+ return 3;
+ }
+ else {
+ return $int;
+ }
+}
+
1;
Modified: Data-Plist/lib/Data/Plist/BinaryWriter.pm
==============================================================================
--- Data-Plist/lib/Data/Plist/BinaryWriter.pm (original)
+++ Data-Plist/lib/Data/Plist/BinaryWriter.pm Tue Jul 22 18:14:53 2008
@@ -27,12 +27,16 @@
}
print $fh "bplist00";
my $top_index = $self->dispatch($object);
- my $offset_size = $self->int_length( $self->{index}->[-1] );
+ my $offset_size = $self->bytes( $self->{index}->[-1] );
my $table_offset = tell $fh;
for ( @{ $self->{index} } ) {
- print $fh ( pack $self->pack_in($offset_size), $_ );
+ my $value = pack $self->pack_in( $offset_size - 1 ), $_;
+ if ( $offset_size == 3 ) {
+ $value = substr $value, -3;
+ }
+ print $fh $value;
}
- print $fh ( pack "x6CC", ( $offset_size + 1 ), $self->{refsize} );
+ print $fh ( pack "x6CC", ($offset_size), $self->{refsize} );
print $fh ( pack "x4N", scalar keys %{ $self->{objcache} } );
print $fh ( pack "x4N", $top_index );
print $fh ( pack "x4N", $table_offset );
@@ -45,7 +49,7 @@
my ($arrayref) = @_;
my $type = $arrayref->[0];
my $method = "write_" . $type;
- my $digest = eval{Digest::MD5::md5_hex( Storable::freeze( $arrayref ) )};
+ my $digest = eval { Digest::MD5::md5_hex( Storable::freeze($arrayref) ) };
die "Can't $method" unless $self->can($method);
$self->{objcache}{$digest} = $self->$method( $arrayref->[1] )
unless ( exists $self->{objcache}{$digest} );
@@ -58,13 +62,12 @@
my $ans = "";
my $optint = "";
-
if ( $len < 15 ) {
$type .= sprintf( "%x", $len );
}
else {
$type .= "f";
- my $optlen = $self->int_length($len);
+ my $optlen = $self->power($len);
$optint =
pack( "C" . $self->pack_in($optlen), hex( "1" . $optlen ), $len );
}
@@ -82,7 +85,7 @@
unless ( defined $type ) {
$type = "1";
}
- my $len = $self->int_length($int);
+ my $len = $self->power($int);
if ( $len == 3 ) {
if ( $int < 0 ) {
@@ -242,7 +245,7 @@
return ( @{ $self->{index} } - 1 );
}
-sub int_length {
+sub power {
my $self = shift;
my ($int) = @_;
if ( $int > 4294967295 ) {
@@ -268,13 +271,35 @@
}
}
-sub pack_in {
+sub bytes {
my $self = shift;
- my ($power) = @_;
- if ( $power == 4 ) {
- die "Cannot encode 2**4 byte integers";
+ my ($int) = @_;
+ if ( $int > 2**24 ) {
+ return 4;
+
+ # actually refers to 4 bytes
}
- my $fmt = [ "C", "n", "N", "N" ]->[$power];
+ elsif ( $int > 2**16 ) {
+ return 3;
+
+ # actually refers to 3 bytes
+ }
+ elsif ( $int > 255 ) {
+ return 2;
+
+ # I'm sure you see the trend
+ }
+ else {
+ return 1;
+ }
+}
+
+sub pack_in {
+
+ # can be used with powers or bytes
+ my $self = shift;
+ my ($int) = @_;
+ my $fmt = [ "C", "n", "N", "N" ]->[$int];
return $fmt;
}
Modified: Data-Plist/t/binary-write.t
==============================================================================
--- Data-Plist/t/binary-write.t (original)
+++ Data-Plist/t/binary-write.t Tue Jul 22 18:14:53 2008
@@ -1,4 +1,4 @@
-use Test::More tests => 204;
+use Test::More tests => 223;
use strict;
use warnings;
@@ -14,7 +14,7 @@
# Dict containing stuff
round_trip( { 'kitteh' => 'Angleton', 'MoL' => 42, 'array' => ['Cthulhu'] },
- 93 );
+ 93 );
# Empty array
round_trip( [], 42 );
@@ -44,15 +44,7 @@
round_trip( "The kyokeach is cute", 64 );
# Ustring
-my $writer = Data::Plist::BinaryWriter->new(serialize => 0);
-my $reader = Data::Plist::BinaryReader->new;
-my $ustring = eval{$reader->open_file("t/data/ustring.binary.plist")};
-ok ($ustring->raw_data, "Got data");
-$ustring = $ustring->raw_data;
-my $orig = $writer->write($ustring);
-ok ($orig, "Created data structure");
-like( $orig, qr/^bplist00/, "Bplist begins with correct header" );
-is( "$@", '', "No errors thrown." );
+files("t/data/ustring.binary.plist");
# Real number
round_trip( 3.14159, 50 );
@@ -66,6 +58,9 @@
# Caching
round_trip( { 'kitteh' => 'Angleton', 'Laundry' => 'Angleton' }, 73 );
+# refsize = 2
+round_trip( [ 1 .. 300 ], 1891 );
+
# UIDs
preserialized_trip( [ UID => 1 ], 43 );
@@ -76,26 +71,47 @@
preserialized_trip( [ null => 0 ], 42 );
# Data
-preserialized_trip ( [ data => "\x00"], 43);
+preserialized_trip( [ data => "\x00" ], 43 );
-# refsize = 2
-round_trip([1..300], 1891);
+# OffsetSize == 3
+preserialized_trip( [ array => [ [ data => "\x00" x 65536 ] ] ], 65590 );
# Fails thanks to unknown data type
-my $fail = Data::Plist::BinaryWriter->new( serialize => 0);
-my $ret = eval{$fail->write([ random => 0 ])};
-ok (not ($ret), "Binary plist didn't write.");
-like ($@, qr/can't/i, "Threw an error.");
+my $fail = Data::Plist::BinaryWriter->new( serialize => 0 );
+my $ret = eval { $fail->write( [ random => 0 ] ) };
+ok( not($ret), "Binary plist didn't write." );
+like( $@, qr/can't/i, "Threw an error." );
+
+# Large files
+files("examples/bigfiles/bigfile-00.binary.plist");
+
+sub files {
+ my $write = Data::Plist::BinaryWriter->new( serialize => 0 );
+ my $read = Data::Plist::BinaryReader->new;
+ my ($filename) = @_;
+ my $str = do { local @ARGV = $filename; local $/; <> };
+ my $output;
+ ok( $str, "Read binary data in by hand" );
+ $output = eval { $read->open_string($str) };
+ ok( $output, "Opening from a string worked" );
+ isa_ok( $output, "Data::Plist" );
+ $output = $output->raw_data;
+ ok( $output, "Has data inside" );
+ my $orig = $write->write($output);
+ ok( $orig, "Created data structure" );
+ like( $orig, qr/^bplist00/, "Bplist begins with correct header" );
+ is( "$@", '', "No errors thrown." );
+}
sub round_trip {
my $write = Data::Plist::BinaryWriter->new;
- $in = trip($write, @_);
+ $in = trip( $write, @_ );
is_deeply( $in->data, $_[0], "Read back " . $_[0] );
}
sub preserialized_trip {
my $write = Data::Plist::BinaryWriter->new( serialize => 0 );
- $in = trip($write, @_);
+ $in = trip( $write, @_ );
is_deeply( $in->raw_data, $_[0], "Read back " . $_[0] );
}
@@ -104,7 +120,7 @@
my ( $write, $input, $expected_size ) = @_;
ok( $write, "Created a binary writer" );
isa_ok( $write, "Data::Plist::BinaryWriter" );
- $out = $write->write($input);
+ $out = eval { $write->write($input) };
ok( $out, "Created data structure" );
like( $out, qr/^bplist00/, "Bplist begins with correct header" );
is( "$@", '', "No errors thrown." );
More information about the Bps-public-commit
mailing list