[Bps-public-commit] r14222 - in Data-Plist: . lib/Data lib/Data/Plist
kyoki at bestpractical.com
kyoki at bestpractical.com
Thu Jul 17 13:05:12 EDT 2008
Author: kyoki
Date: Thu Jul 17 13:05:12 2008
New Revision: 14222
Added:
Data-Plist/t/binary-write.t
Modified:
Data-Plist/ (props changed)
Data-Plist/lib/Data/Plist.pm
Data-Plist/lib/Data/Plist/BinaryWriter.pm
Data-Plist/lib/Data/Plist/Writer.pm
Log:
r29723 at nyx: kyoki | 2008-07-17 13:04:06 -0400
* fixed integers, strings and arrays
* fixed negative integers
* fixed dates
* added tests
Modified: Data-Plist/lib/Data/Plist.pm
==============================================================================
--- Data-Plist/lib/Data/Plist.pm (original)
+++ Data-Plist/lib/Data/Plist.pm Thu Jul 17 13:05:12 2008
@@ -32,7 +32,7 @@
} 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);
+ return DateTime->from_epoch( epoch => $data->[1] + 978307200);
} elsif ($data->[0] eq "UID" and ref $data->[1]) {
return $self->collapse($data->[1]);
} else {
Modified: Data-Plist/lib/Data/Plist/BinaryWriter.pm
==============================================================================
--- Data-Plist/lib/Data/Plist/BinaryWriter.pm (original)
+++ Data-Plist/lib/Data/Plist/BinaryWriter.pm Thu Jul 17 13:05:12 2008
@@ -2,6 +2,8 @@
use strict;
use warnings;
+use YAML;
+use Math::BigInt;
use base qw/Data::Plist::Writer/;
@@ -10,6 +12,7 @@
$self = $self->new() unless ref $self;
my ( $fh, $object ) = @_;
+ $object = $self->serialize($object);
binmode $fh;
$self->{fh} = $fh;
$self->{index} = [];
@@ -21,19 +24,13 @@
$self->{refsize} = 1;
}
print $fh "bplist00";
- my $top_index = $self->dispatch($object);
- my $offset_size = 1;
- if ( $self->{index}->[-1] > 65535 ) {
- $offset_size = 4;
- }
- elsif ( $self->{index}->[-1] > 255 ) {
- $offset_size = 2;
- }
+ my $top_index = $self->dispatch($object);
+ my $offset_size = $self->int_length( $self->{index}->[-1] );
my $table_offset = tell $fh;
- for (@$self->{index}){
- print $fh (pack ($self->pack_in($offset_size)), $_);
+ for ( @{ $self->{index} } ) {
+ print $fh ( pack $self->pack_in($offset_size), $_ );
}
- print $fh ( pack "x6CC", $offset_size, $self->{refsize} );
+ print $fh ( pack "x6CC", ( $offset_size + 1 ), $self->{refsize} );
print $fh ( pack "x4N", $self->{size} );
print $fh ( pack "x4N", $top_index );
print $fh ( pack "x4N", $table_offset );
@@ -52,44 +49,60 @@
sub make_type {
my $self = shift;
- my ( $typ, $len ) = @_;
+ my ( $type, $len ) = @_;
my $ans = "";
my $optint = "";
if ( $len < 15 ) {
- $typ .= sprintf( "%x", $len );
+ $type .= sprintf( "%x", $len );
}
else {
- $typ .= "f";
- my $optlen = $self->int_length($len);
- $optint = pack( "C" . $self->pack_in($optlen), hex("1" . $optlen), $len)
+ $type .= "f";
+ my $optlen = $self->int_length($len);
+ $optint =
+ pack( "C" . $self->pack_in($optlen), hex( "1" . $optlen ), $len );
}
- $ans = pack( "H*", $typ ) . $optint;
+ $ans = pack( "H*", $type ) . $optint;
return $ans;
}
-sub write_int {
+sub write_integer {
my $self = shift;
my ( $int, $type ) = @_;
my $fmt;
+ my $obj;
unless ( defined $type ) {
$type = "1";
}
my $len = $self->int_length($int);
- $fmt = $self->pack_in($len);
- my $obj = "\x" . $type . $len . pack($fmt, $int);
+
+ if ( $len == 3 ) {
+ if ( $int < 0 ) {
+ $int += Math::BigInt->new(2)->bpow(64);
+ }
+ my $hw = Math::BigInt->new($int);
+ $hw->brsft(32);
+ my $lw = Math::BigInt->new($int);
+ $lw->band( Math::BigInt->new("4294967295") );
+
+ $obj =
+ $self->make_type( $type, $len ) . pack( "N", $hw ) . pack( "N", $lw );
+ }
+ else {
+ $fmt = $self->pack_in($len);
+ $obj = pack( "C" . $fmt, hex( $type . $len ), $int );
+ }
return $self->binary_write($obj);
}
sub write_string {
- my $self = shift;
+ my $self = shift;
my ($string) = @_;
-
- my $type = $self->make_type( "5", length($string) );
- my $obj = $type . pack( "U", $string );
+ my $type = $self->make_type( "5", length($string) );
+ my $obj = $type . $string;
return $self->binary_write($obj);
}
@@ -99,7 +112,8 @@
}
sub write_dict {
- my $self = shift;
+ my $self = shift;
+ my $fh = $self->{fh};
my ($hash) = @_;
my @keys;
my @values;
@@ -108,15 +122,16 @@
push @values, $self->dispatch( $hash->{$key} );
}
my $current = tell $self->{fh};
- print $self->{fh}, $self->make_type( "d", scalar keys(%$hash) );
- my $packvar = $self->pack_in($self->{refsize});
- print $self->{fh}, pack $packvar, $_ for @keys, @values;
+ print $fh $self->make_type( "d", scalar keys(%$hash) );
+ my $packvar = $self->pack_in( $self->{refsize} - 1 );
+ print $fh pack $packvar, $_ for @keys, @values;
push @{ $self->{index} }, $current;
return ( @{ $self->{index} } - 1 );
}
sub write_array {
my $self = shift;
+ my $fh = $self->{fh};
my ($array) = @_;
my $size = @$array;
my @values;
@@ -124,32 +139,32 @@
push @values, $self->dispatch($_);
}
my $current = tell $self->{fh};
- print $self->{fh}, $self->make_type( "a", $size );
- my $packvar = $self->pack_in($self->{refsize});
- print $self->{fh}, pack $packvar, $_ for @values;
+ print $fh $self->make_type( "a", $size );
+ my $packvar = $self->pack_in( $self->{refsize} - 1 );
+ print $fh pack $packvar, $_ for @values;
push @{ $self->{index} }, $current;
return ( @{ $self->{index} } - 1 );
}
sub write_uid {
- my $self = shift;
- my ($id) = @_;
+ my $self = shift;
+ my ($id) = @_;
return $self->write_int( $id, "8" );
}
sub write_real {
my $self = shift;
my ($float) = @_;
- my $type = $self->make_type( "2", 4 );
+ my $type = $self->make_type( "2", 3 );
my $obj = $type . reverse( pack( "d", $float ) );
return $self->binary_write($obj);
}
sub write_date {
- my $self = shift;
- my ($date) = @_;
- my $type = $self->make_type( "3", 4 );
- my $obj = $type . reverse( pack( "d", $date ) );
+ my $self = shift;
+ my ($date) = @_;
+ my $type = $self->make_type( "3", 3 );
+ my $obj = $type . reverse( pack( "d", $date ) );
return $self->binary_write($obj);
}
@@ -193,7 +208,7 @@
}
elsif ( $type eq "array" ) {
$value = 1;
- $value += $_ for map { $self->count($_) } @$arrayref;
+ $value += $_ for map { $self->count($_) } @{ $arrayref->[1] };
return $value;
}
else {
@@ -201,36 +216,49 @@
}
}
-sub binary_write{
- my $self = shift;
- my ($obj) = @_;
+sub binary_write {
+ my $self = shift;
+ my $fh = $self->{fh};
+ my ($obj) = @_;
my $current = tell $self->{fh};
- print $self->{fh}, $obj;
+ print $fh $obj;
push @{ $self->{index} }, $current;
return ( @{ $self->{index} } - 1 );
}
-sub int_length{
+sub int_length {
my $self = shift;
my ($int) = @_;
- if ( $int > 65535 ) {
- return 4;
+ if ( $int > 4294967295 ) {
+ return 3;
+
+ # actually refers to 2^3 bytes
+ }
+ elsif ( $int > 65535 ) {
+ return 2;
+
+ # actually refers to 2^2 bytes
}
elsif ( $int > 255 ) {
- return 2;
+ return 1;
+
+ # I'm sure you see the trend
+ }
+ elsif ( $int < 0 ) {
+ return 3;
}
else {
- return 1;
+ return 0;
}
}
sub pack_in {
my $self = shift;
my ($bytes) = @_;
- my $fmt = ["C", "n", "N", "N"]->[$bytes-1];
- if ($bytes == 3) {
- die "Cannot encode 3 byte integers";
+ if ( $bytes == 3 ) {
+ die "Cannot encode 3 byte integers";
}
+ my $fmt = [ "C", "n", "N" ]->[$bytes];
return $fmt;
}
Modified: Data-Plist/lib/Data/Plist/Writer.pm
==============================================================================
--- Data-Plist/lib/Data/Plist/Writer.pm (original)
+++ Data-Plist/lib/Data/Plist/Writer.pm Thu Jul 17 13:05:12 2008
@@ -2,6 +2,7 @@
use strict;
use warnings;
+use Scalar::Util;
sub new {
my $class = shift;
@@ -14,7 +15,7 @@
my $to = shift;
if (not $to) {
- my $content;
+ my $content = '';
my $fh;
open( $fh, ">", \$content );
$self->write_fh($fh, $object) or return;
@@ -73,7 +74,7 @@
} else {
die "Can't serialize unknown ref @{[ref $value]}\n";
}
- } elsif ( $value !~ /\D/ ) {
+ } elsif ( $value =~ /^-?\d+$/ ) {
return [ integer => $value ];
} elsif ( Scalar::Util::looks_like_number($value) ) {
return [ real => $value ];
@@ -91,7 +92,7 @@
my $object = shift;
return $self->serialize_value($object)
- if ref($object) =~ /ARRAY|HASH/ or not $object->can("serialize");
+ if not ref($object) or ref($object) =~ /ARRAY|HASH/ or not $object->can("serialize");
$object = $object->serialize;
Added: Data-Plist/t/binary-write.t
==============================================================================
--- (empty file)
+++ Data-Plist/t/binary-write.t Thu Jul 17 13:05:12 2008
@@ -0,0 +1,75 @@
+use Test::More no_plan => 1;
+
+use strict;
+use warnings;
+
+use Data::Plist::BinaryWriter;
+use Data::Plist::BinaryReader;
+
+
+
+my $in;
+my $out;
+
+# Create the object
+my $write = Data::Plist::BinaryWriter->new;
+my $read = Data::Plist::BinaryReader->new;
+ok( $write, "Created a binary writer" );
+isa_ok( $write, "Data::Plist::BinaryWriter" );
+
+# Empty dict
+round_trip( {}, 42 );
+
+# Dict containing stuff
+round_trip( { 'kitteh' => 'Angleton', 'MoL' => 42, 'array' => ['Cthulhu'] },
+ 93 );
+
+# Empty array
+round_trip( [], 42 );
+
+# Array containing stuff
+round_trip( ['Cthulhu'], 52 );
+
+# Negative integer
+round_trip( -1, 50 );
+
+# Small integer
+round_trip( 42, 43 );
+
+# Large integer
+round_trip( 777, 44 );
+
+# Even larger integer
+round_trip( 141414, 46 );
+
+# Ginormous integer
+round_trip( 4294967296, 50 );
+
+# Short string
+round_trip( "kitteh", 48 );
+
+# Long string (where long means "more than 15 characters")
+round_trip( "The kyokeach is cute", 64 );
+
+# Real number
+round_trip(3.14159, 50);
+
+# Negative real
+round_trip(-1.985, 50);
+
+# Date
+round_trip(DateTime->new(year => 2001, month => 1, day => 17), 50);
+
+sub round_trip {
+ my ( $input, $expected_size ) = @_;
+ $out = $write->write($input);
+ ok( $out, "Created data structure" );
+ like( $out, qr/^bplist00/, "Bplist begins with correct header" );
+ is( length($out), $expected_size,
+ "Bplist is " . $expected_size . " bytes long." );
+ $in = eval { $read->open_string($out) };
+ is_deeply( $@, '' );
+ ok( $in, "Read back bplist" );
+ isa_ok( $in, "Data::Plist" );
+ is_deeply( $in->data, $input, "Read back " . $input );
+}
More information about the Bps-public-commit
mailing list