r29595 - in /branches/upstream/libphp-serialization-perl/current: Changes META.yml lib/PHP/Serialization.pm t/02basic.t t/04arraysRT21218.t
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Mon Jan 12 13:21:38 UTC 2009
Author: ansgar-guest
Date: Mon Jan 12 13:21:35 2009
New Revision: 29595
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=29595
Log:
[svn-upgrade] Integrating new upstream version, libphp-serialization-perl (0.30)
Modified:
branches/upstream/libphp-serialization-perl/current/Changes
branches/upstream/libphp-serialization-perl/current/META.yml
branches/upstream/libphp-serialization-perl/current/lib/PHP/Serialization.pm
branches/upstream/libphp-serialization-perl/current/t/02basic.t
branches/upstream/libphp-serialization-perl/current/t/04arraysRT21218.t
Modified: branches/upstream/libphp-serialization-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libphp-serialization-perl/current/Changes?rev=29595&op=diff
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/Changes (original)
+++ branches/upstream/libphp-serialization-perl/current/Changes Mon Jan 12 13:21:35 2009
@@ -1,4 +1,9 @@
Revision history for Perl extension PHP::Serialization
+
+0.30 2009-01-11
+ - Significantly cleanup the code to be much prettier.
+ - Fix RT#42279, output sizes a bytes, not characters so that
+ serializing multibyte data works correctly.
0.29 2008-09-17
- Fix bug with negative numbers, RT#6402, patch from
Modified: branches/upstream/libphp-serialization-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libphp-serialization-perl/current/META.yml?rev=29595&op=diff
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/META.yml (original)
+++ branches/upstream/libphp-serialization-perl/current/META.yml Mon Jan 12 13:21:35 2009
@@ -1,13 +1,19 @@
--- #YAML:1.0
-name: PHP-Serialization
-version: 0.29
-abstract: simple flexible means of converting the output of PHP's serialize() into the equivalent Perl memory structure, and vice versa.
-license: ~
-author:
+name: PHP-Serialization
+version: 0.30
+abstract: simple flexible means of converting the output of PHP's serialize() into the equivalent Perl memory structure, and vice versa.
+author:
- Jesse Brown <jbrown at cpan.org>
-generated_by: ExtUtils::MakeMaker version 6.42
-distribution_type: module
-requires:
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+requires: {}
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.48
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: branches/upstream/libphp-serialization-perl/current/lib/PHP/Serialization.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libphp-serialization-perl/current/lib/PHP/Serialization.pm?rev=29595&op=diff
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/lib/PHP/Serialization.pm (original)
+++ branches/upstream/libphp-serialization-perl/current/lib/PHP/Serialization.pm Mon Jan 12 13:21:35 2009
@@ -2,10 +2,13 @@
use strict;
use warnings;
use Exporter ();
+use Scalar::Util qw/blessed/;
+use Carp qw(croak confess);
+use bytes;
use vars qw/$VERSION @ISA @EXPORT_OK/;
-$VERSION = '0.29';
+$VERSION = '0.30';
@ISA = qw(Exporter);
@EXPORT_OK = qw(unserialize serialize);
@@ -32,7 +35,8 @@
=cut
sub new {
- my $self = bless({},shift);
+ my ($class) = shift;
+ my $self = bless {}, blessed($class) ? blessed($class) : $class;
return $self;
}
@@ -53,8 +57,7 @@
=cut
sub serialize {
- my $obj = PHP::Serialization->new();
- return $obj->encode(@_);
+ return __PACKAGE__->new->encode(@_);
}
=head2 unserialize($encoded,[optional CLASS])
@@ -70,9 +73,8 @@
=cut
sub unserialize {
- my $obj = PHP::Serialization->new();
- return $obj->decode(@_);
-} # End of sub.
+ return __PACKAGE__->new->decode(@_);
+}
=head1 METHODS
@@ -93,20 +95,18 @@
=cut
sub decode {
- my $self = shift;
- my $string = shift;
- my $class = shift;
-
- use Carp qw(croak confess);
+ my ($self, $string, $class) = @_;
+
my $cursor = 0;
- $$self{'string'} = \$string;
- $$self{'cursor'} = \$cursor;
- $$self{'strlen'} = length($string);
+ $self->{string} = \$string;
+ $self->{cursor} = \$cursor;
+ $self->{strlen} = length($string);
if ( defined $class ) {
- $$self{'class'} = $class;
- } else {
- $$self{'class'} = 'PHP::Serialization::Object';
+ $self->{class} = $class;
+ }
+ else {
+ $self->{class} = 'PHP::Serialization::Object';
}
# Ok, start parsing...
@@ -116,10 +116,12 @@
if ( $#values == -1 ) {
# Oops, none...
return;
- } elsif ( $#values == 0 ) {
+ }
+ elsif ( $#values == 0 ) {
# Ok, return our one value..
return $values[0];
- } else {
+ }
+ else {
# Ok, return a reference to the list.
return \@values;
}
@@ -127,63 +129,61 @@
} # End of decode sub.
my %type_table = (
- 'O' => 'object',
- 's' => 'scalar',
- 'a' => 'array',
- 'i' => 'integer',
- 'd' => 'float',
- 'b' => 'boolean',
- 'N' => 'undef',
+ O => 'object',
+ s => 'scalar',
+ a => 'array',
+ i => 'integer',
+ d => 'float',
+ b => 'boolean',
+ N => 'undef',
);
sub _parse {
- my $self = shift;
- my $cursor = $$self{'cursor'};
- my $string = $$self{'string'};
- my $strlen = $$self{'strlen'};
-
- use Carp qw(croak confess);
-
+ my ($self) = @_;
+ my $cursor = $self->{cursor};
+ my $string = $self->{string};
+ my $strlen = $self->{strlen};
+ confess("No cursor") unless $cursor;
+ confess("No string") unless $string;
+ confess("No strlen") unless $strlen;
my @elems;
while ( $$cursor < $strlen ) {
# Ok, decode the type...
my $type = $self->_readchar();
# Ok, see if 'type' is a start/end brace...
- if ( $type eq '{' ) { next; };
- if ( $type eq '}' ) {
- last;
- };
+ next if ( $type eq '{' );
+ last if ( $type eq '}' );
if ( ! exists $type_table{$type} ) {
confess "Unknown type '$type'! at $$cursor";
}
- $self->_skipchar(); # Toss the seperator
+ $self->_skipchar; # Toss the seperator
$type = $type_table{$type};
# Ok, do per type processing..
if ( $type eq 'object' ) {
# Ok, get our name count...
my $namelen = $self->_readnum();
- $self->_skipchar(); # Toss the seperator
+ $self->_skipchar;
# Ok, get our object name...
- $self->_skipchar(); # Toss the seperator
+ $self->_skipchar;
my $name = $self->_readstr($namelen);
- $self->_skipchar(); # Toss the seperator
+ $self->_skipchar;
# Ok, our sub elements...
- $self->_skipchar(); # Toss the seperator
+ $self->_skipchar;
my $elemcount = $self->_readnum();
- $self->_skipchar(); # Toss the seperator
+ $self->_skipchar;
my %value = $self->_parse();
- push(@elems,bless(\%value,$$self{'class'} . '::' . $name));
+ push(@elems, bless(\%value, $self->{class} . '::' . $name));
} elsif ( $type eq 'array' ) {
# Ok, our sub elements...
- $self->_skipchar(); # Toss the seperator
+ $self->_skipchar;
my $elemcount = $self->_readnum();
- $self->_skipchar(); # Toss the seperator
+ $self->_skipchar;
my @values = $self->_parse();
# If every other key is not numeric, map to a hash..
@@ -191,7 +191,7 @@
my @newlist;
foreach ( 0..$#values ) {
if ( ($_ % 2) ) {
- push(@newlist,$values[$_]);
+ push(@newlist, $values[$_]);
next;
}
if ( $values[$_] !~ /^\d+$/ ) {
@@ -201,38 +201,43 @@
}
if ( $subtype eq 'array' ) {
# Ok, remap...
- push(@elems,\@newlist);
+ push(@elems, \@newlist);
} else {
# Ok, force into hash..
my %hash = @values;
- push(@elems,\%hash);
+ push(@elems, \%hash);
}
- } elsif ( $type eq 'scalar' ) {
+ }
+ elsif ( $type eq 'scalar' ) {
# Ok, get our string size count...
- my $strlen = $self->_readnum();
- $self->_skipchar(); # Toss the seperator
-
- $self->_skipchar(); # Toss the seperator
+ my $strlen = $self->_readnum;
+ $self->_skipchar;
+
+ $self->_skipchar;
my $string = $self->_readstr($strlen);
- $self->_skipchar(); # Toss the seperator
- $self->_skipchar(); # Toss the seperator
+ $self->_skipchar;
+ $self->_skipchar;
push(@elems,$string);
- } elsif ( $type eq 'integer' || $type eq 'float' ) {
+ }
+ elsif ( $type eq 'integer' || $type eq 'float' ) {
# Ok, read the value..
- my $val = $self->_readnum();
+ my $val = $self->_readnum;
if ( $type eq 'integer' ) { $val = int($val); }
- $self->_skipchar(); # Toss the seperator
- push(@elems,$val);
- } elsif ( $type eq 'boolean' ) {
+ $self->_skipchar;
+ push(@elems, $val);
+ }
+ elsif ( $type eq 'boolean' ) {
# Ok, read our boolen value..
- my $bool = $self->_readchar();
- $self->_skipchar(); # Toss the seperator
- push(@elems,$bool);
- } elsif ( $type eq 'undef' ) {
+ my $bool = $self->_readchar;
+ $self->_skipchar;
+ push(@elems, $bool);
+ }
+ elsif ( $type eq 'undef' ) {
# Ok, undef value..
- push(@elems,undef);
- } else {
+ push(@elems, undef);
+ }
+ else {
confess "Unknown element type '$type' found! (cursor $$cursor)";
}
} # End of while.
@@ -243,30 +248,28 @@
} # End of decode.
sub _readstr {
- my $self = shift;
- my $string = $$self{'string'};
- my $cursor = $$self{'cursor'};
- my $length = shift;
-
- my $str = substr($$string,$$cursor,$length);
+ my ($self, $length) = @_;
+ my $string = $self->{string};
+ my $cursor = $self->{cursor};
+ my $str = substr($$string, $$cursor, $length);
$$cursor += $length;
return $str;
-} # End of readstr.
+}
sub _readchar {
- my $self = shift;
+ my ($self) = @_;
return $self->_readstr(1);
-} # End of readstr.
+}
sub _readnum {
# Reads in a character at a time until we run out of numbers to read...
- my $self = shift;
- my $cursor = $$self{'cursor'};
+ my ($self) = @_;
+ my $cursor = $self->{cursor};
my $string;
while ( 1 ) {
- my $char = $self->_readchar();
+ my $char = $self->_readchar;
if ( $char !~ /^[\d\.-]+$/ ) {
$$cursor--;
last;
@@ -279,7 +282,7 @@
sub _skipchar {
my $self = shift;
- ${$$self{'cursor'}}++;
+ ${$$self{cursor}}++;
} # Move our cursor one bytes ahead...
@@ -294,71 +297,85 @@
=cut
sub encode {
- my $self = shift;
- my $val = shift;
-
- use Carp qw(confess);
+ my ($self, $val) = @_;
+
if ( ! defined $val ) {
- return $self->_encode('null',$val);
- } elsif ( ! ref($val) ) {
+ return $self->_encode('null', $val);
+ }
+ elsif ( blessed $val ) {
+ return $self->_encode('obj', $val);
+ }
+ elsif ( ! ref($val) ) {
if ( $val =~ /^-?\d{1,10}$/ && abs($val) < 2**31 ) {
- return $self->_encode('int',$val);
- } elsif ( $val =~ /^-?\d+\.\d*$/ ) {
- return $self->_encode('float',$val);
- } else {
- return $self->_encode('string',$val);
- }
- } else {
+ return $self->_encode('int', $val);
+ }
+ elsif ( $val =~ /^-?\d+\.\d*$/ ) {
+ return $self->_encode('float', $val);
+ }
+ else {
+ return $self->_encode('string', $val);
+ }
+ }
+ else {
my $type = ref($val);
- if ( $type eq 'HASH' || $type eq 'ARRAY' ) {
- return $self->_encode('array',$val);
- } elsif ( $type eq 'CODE' || $type eq 'REF' || $type eq 'GLOB' || $type eq 'LVALUE' ) {
+ if ($type eq 'HASH' || $type eq 'ARRAY' ) {
+ return $self->_encode('array', $val);
+ }
+ else {
confess "I can't serialize data of type '$type'!";
- } else {
- # Object...
- return $self->_encode('obj',$val);
}
}
-} # End of encode
+}
sub _encode {
- my $self = shift;
- my $type = shift;
- my $val = shift;
+ my ($self, $type, $val) = @_;
my $buffer = '';
if ( $type eq 'null' ) {
$buffer .= 'N;';
- } elsif ( $type eq 'int' ) {
- $buffer .= sprintf('i:%d;',$val);
- } elsif ( $type eq 'float' ) {
- $buffer .= sprintf('d:%s;',$val);
- } elsif ( $type eq 'string' ) {
- $buffer .= sprintf('s:%d:"%s";',length($val),$val);
- } elsif ( $type eq 'array' ) {
+ }
+ elsif ( $type eq 'int' ) {
+ $buffer .= sprintf('i:%d;', $val);
+ }
+ elsif ( $type eq 'float' ) {
+ $buffer .= sprintf('d:%s;', $val);
+ }
+ elsif ( $type eq 'string' ) {
+ $buffer .= sprintf('s:%d:"%s";', length($val), $val);
+ }
+ elsif ( $type eq 'array' ) {
if ( ref($val) eq 'ARRAY' ) {
$buffer .= sprintf('a:%d:',($#{$val}+1)) . '{';
- map { $buffer .= $self->encode($_); $buffer .= $self->encode($$val[$_]); } 0..$#{$val};
+ map { # Ewww
+ $buffer .= $self->encode($_);
+ $buffer .= $self->encode($$val[$_]);
+ } 0..$#{$val};
$buffer .= '}';
- } else {
+ }
+ else {
$buffer .= sprintf('a:%d:',scalar(keys(%{$val}))) . '{';
- foreach ( %{$val} ) { $buffer .= $self->encode($_); }
+ foreach ( %{$val} ) {
+ $buffer .= $self->encode($_);
+ }
$buffer .= '}';
}
- } elsif ( $type eq 'obj' ) {
+ }
+ elsif ( $type eq 'obj' ) {
my $class = ref($val);
$class =~ /(\w+)$/;
my $subclass = $1;
- $buffer .= sprintf('O:%d:"%s":%d:',length($subclass),$subclass,scalar(keys(%{$val}))) . '{';
- foreach ( %{$val} ) { $buffer .= $self->encode($_); }
+ $buffer .= sprintf('O:%d:"%s":%d:', length($subclass), $subclass, scalar(keys %{$val})) . '{';
+ foreach ( %{$val} ) {
+ $buffer .= $self->encode($_);
+ }
$buffer .= '}';
- } else {
- use Carp qw(confess);
+ }
+ else {
confess "Unknown encode type!";
}
return $buffer;
-} # End of _encode sub.
+}
=head1 TODO
Modified: branches/upstream/libphp-serialization-perl/current/t/02basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libphp-serialization-perl/current/t/02basic.t?rev=29595&op=diff
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/t/02basic.t (original)
+++ branches/upstream/libphp-serialization-perl/current/t/02basic.t Mon Jan 12 13:21:35 2009
@@ -9,4 +9,5 @@
third_test => -2,
};
my $encoded = serialize($data);
+warn "ENCODED $encoded";
is_deeply($data, unserialize($encoded));
Modified: branches/upstream/libphp-serialization-perl/current/t/04arraysRT21218.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libphp-serialization-perl/current/t/04arraysRT21218.t?rev=29595&op=diff
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/t/04arraysRT21218.t (original)
+++ branches/upstream/libphp-serialization-perl/current/t/04arraysRT21218.t Mon Jan 12 13:21:35 2009
@@ -1,14 +1,15 @@
use strict;
use warnings;
-use Test::More tests => 2;
+use Data::Dumper;
+use Test::More tests => 3;
BEGIN { use_ok('PHP::Serialization') };
my $data = PHP::Serialization::unserialize(
- q{a:1:{s:3:"lll";a:2:{i:195;a:2:{i:0;i:111;i:1;s:3:"bbb";}i:194;a:2:{i:0;i:222;i:1;s:3:"ccc";}}}}
+ q{a:1:{s:3:"lll";a:2:{i:195;a:1:{i:111;s:3:"bbb";}i:194;a:1:{i:222;s:3:"ccc";}}}}
);
{
- $TODO = 'Not currently sure about the correct representation in this, need to read the PHP manual';
+ $TODO = 'Does not work';
is_deeply($data,
{
@@ -17,5 +18,21 @@
'194' => {222 => 'ccc'},
}
}
- );
-}
+ ) or warn Dumper($data);
+}
+
+$data = PHP::Serialization::unserialize(
+ q{a:1:{s:3:"lll";a:2:{i:195;a:2:{i:0;i:111;i:1;s:3:"bbb";}i:194;a:2:{i:0;i:222;i:1;s:3:"ccc";}}}}
+);
+
+{
+ $TODO = 'Does not work';
+ is_deeply($data,
+ {
+ 'lll' => {
+ '195' => [111, 'bbb'],
+ '194' => [222, 'ccc'],
+ }
+ }
+ ) or warn Dumper($data);
+}
More information about the Pkg-perl-cvs-commits
mailing list