r38333 - in /branches/upstream/libphp-serialization-perl/current: ./ lib/PHP/ t/
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sun Jun 21 09:13:28 UTC 2009
Author: ansgar-guest
Date: Sun Jun 21 09:13:02 2009
New Revision: 38333
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38333
Log:
[svn-upgrade] Integrating new upstream version, libphp-serialization-perl (0.32)
Added:
branches/upstream/libphp-serialization-perl/current/t/07croak.t
branches/upstream/libphp-serialization-perl/current/t/08incompletestringRT44700.t
branches/upstream/libphp-serialization-perl/current/t/09floatindexRT42029.t
Removed:
branches/upstream/libphp-serialization-perl/current/MANIFEST.bak
Modified:
branches/upstream/libphp-serialization-perl/current/Changes
branches/upstream/libphp-serialization-perl/current/MANIFEST
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
branches/upstream/libphp-serialization-perl/current/t/05RT24441.t
branches/upstream/libphp-serialization-perl/current/t/06bool_deserializeRT45024.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=38333&op=diff
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/Changes (original)
+++ branches/upstream/libphp-serialization-perl/current/Changes Sun Jun 21 09:13:02 2009
@@ -1,4 +1,14 @@
Revision history for Perl extension PHP::Serialization
+
+0.32 2009-06-20
+ - Making finite state machine
+ - Fixed bug in arrays RT21218
+ - RT24441 is not a bug
+ - Croaks on incomplete strings. RT44700
+ - Fixed bug with float as index. RT42029
+ - Removed warning from POD
+ - Changed todo in POD
+ - BOLAV at cpan.org
0.31 2009-04-14
- Add warning note to POD
Modified: branches/upstream/libphp-serialization-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libphp-serialization-perl/current/MANIFEST?rev=38333&op=diff
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/MANIFEST (original)
+++ branches/upstream/libphp-serialization-perl/current/MANIFEST Sun Jun 21 09:13:02 2009
@@ -2,7 +2,6 @@
lib/PHP/Serialization.pm
Makefile.PL
MANIFEST This list of files
-MANIFEST.bak
README
t/01use.t
t/02basic.t
@@ -10,4 +9,7 @@
t/04arraysRT21218.t
t/05RT24441.t
t/06bool_deserializeRT45024.t
+t/07croak.t
+t/08incompletestringRT44700.t
+t/09floatindexRT42029.t
META.yml Module meta-data (added by MakeMaker)
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=38333&op=diff
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/META.yml (original)
+++ branches/upstream/libphp-serialization-perl/current/META.yml Sun Jun 21 09:13:02 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: PHP-Serialization
-version: 0.31
+version: 0.32
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>
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=38333&op=diff
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/lib/PHP/Serialization.pm (original)
+++ branches/upstream/libphp-serialization-perl/current/lib/PHP/Serialization.pm Sun Jun 21 09:13:02 2009
@@ -3,12 +3,12 @@
use warnings;
use Exporter ();
use Scalar::Util qw/blessed/;
-use Carp qw(croak confess);
+use Carp qw(croak confess carp);
use bytes;
use vars qw/$VERSION @ISA @EXPORT_OK/;
-$VERSION = '0.31';
+$VERSION = '0.32';
@ISA = qw(Exporter);
@EXPORT_OK = qw(unserialize serialize);
@@ -16,25 +16,6 @@
=head1 NAME
PHP::Serialization - simple flexible means of converting the output of PHP's serialize() into the equivalent Perl memory structure, and vice versa.
-
-=head1 WARNING
-
-B<NOTE:> Not recommended for use, this module is mostly unmaintained, and has
-several severe known bugs. See the following for more information:
-
-=over
-
-=item L<http://rt.cpan.org/Ticket/Display.html?id=21218>
-
-=item L<http://rt.cpan.org/Ticket/Display.html?id=24441>
-
-=item L<http://rt.cpan.org/Ticket/Display.html?id=42029>
-
-=item L<http://rt.cpan.org/Ticket/Display.html?id=44700>
-
-=back
-
-Patches to fix any of these bugs are more than welcome!
=head1 SYNOPSIS
@@ -157,6 +138,134 @@
N => 'undef',
);
+sub _parse_array {
+ my $self = shift;
+ my $elemcount = shift;
+ 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 = ();
+
+ $self->_skipchar('{');
+ foreach my $i (1..$elemcount*2) {
+ push(@elems,$self->_parse_elem);
+ }
+ $self->_skipchar('}');
+ return @elems;
+}
+
+sub _parse_elem {
+ my $self = shift;
+ my $cursor = $self->{cursor};
+ my $string = $self->{string};
+ my $strlen = $self->{strlen};
+
+ my @elems;
+
+ my $type_c = $self->_readchar();
+ my $type = $type_table{$type_c};
+ if (!defined $type) {
+ croak("ERROR: Unknown type $type_c.");
+ }
+
+ if ( $type eq 'object' ) {
+ $self->_skipchar(':');
+ # Ok, get our name count...
+ my $namelen = $self->_readnum();
+ $self->_skipchar(':');
+
+ # Ok, get our object name...
+ $self->_skipchar('"');
+ my $name = $self->_readstr($namelen);
+ $self->_skipchar('"');
+
+ # Ok, our sub elements...
+ $self->_skipchar(':');
+ my $elemcount = $self->_readnum();
+ $self->_skipchar(':');
+
+ my %value = $self->_parse_array($elemcount);
+
+ # TODO: Call wakeup
+ # TODO: Support for objecttypes
+ return bless(\%value, $self->{class} . '::' . $name);
+ } elsif ( $type eq 'array' ) {
+ $self->_skipchar(':');
+ # Ok, our sub elements...
+ my $elemcount = $self->_readnum();
+ $self->_skipchar(':');
+
+ my @values = $self->_parse_array($elemcount);
+ # If every other key is not numeric, map to a hash..
+ my $subtype = 'array';
+ my @newlist;
+ foreach ( 0..$#values ) {
+ if ( ($_ % 2) ) {
+ push(@newlist, $values[$_]);
+ next;
+ } elsif (($_ / 2) ne $values[$_]) {
+ $subtype = 'hash';
+ last;
+ }
+ if ( $values[$_] !~ /^\d+$/ ) {
+ $subtype = 'hash';
+ last;
+ }
+ }
+ if ( $subtype eq 'array' ) {
+ # Ok, remap...
+ return \@newlist;
+ } else {
+ # Ok, force into hash..
+ my %hash = @values;
+ return \%hash;
+ }
+ }
+ elsif ( $type eq 'scalar' ) {
+ $self->_skipchar(':');
+ # Ok, get our string size count...
+ my $strlen = $self->_readnum;
+ $self->_skipchar(':');
+
+ $self->_skipchar('"');
+ my $string = $self->_readstr($strlen);
+ $self->_skipchar('"');
+ $self->_skipchar(';');
+ return $string;
+ }
+ elsif ( $type eq 'integer' || $type eq 'float' ) {
+ $self->_skipchar(':');
+ # Ok, read the value..
+ my $val = $self->_readnum;
+ if ( $type eq 'integer' ) { $val = int($val); }
+ $self->_skipchar(';');
+ return $val;
+ }
+ elsif ( $type eq 'boolean' ) {
+ $self->_skipchar(':');
+ # Ok, read our boolen value..
+ my $bool = $self->_readchar;
+
+ $self->_skipchar;
+ if ($bool eq '0') {
+ $bool = undef;
+ }
+ return $bool;
+ }
+ elsif ( $type eq 'undef' ) {
+ $self->_skipchar(';');
+ return undef;
+ }
+ else {
+ confess "Unknown element type '$type' found! (cursor $$cursor)";
+ }
+
+}
+
sub _parse {
my ($self) = @_;
@@ -166,105 +275,13 @@
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...
- next if ( $type eq '{' );
- last if ( $type eq '}' );
-
- if ( ! exists $type_table{$type} ) {
- confess "Unknown type '$type'! at $$cursor";
- }
- $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;
-
- # Ok, get our object name...
- $self->_skipchar;
- my $name = $self->_readstr($namelen);
- $self->_skipchar;
-
- # Ok, our sub elements...
- $self->_skipchar;
- my $elemcount = $self->_readnum();
- $self->_skipchar;
-
- my %value = $self->_parse();
- push(@elems, bless(\%value, $self->{class} . '::' . $name));
- } elsif ( $type eq 'array' ) {
- # Ok, our sub elements...
- $self->_skipchar;
- my $elemcount = $self->_readnum();
- $self->_skipchar;
-
- my @values = $self->_parse();
- # If every other key is not numeric, map to a hash..
- my $subtype = 'array';
- my @newlist;
- foreach ( 0..$#values ) {
- if ( ($_ % 2) ) {
- push(@newlist, $values[$_]);
- next;
- }
- if ( $values[$_] !~ /^\d+$/ ) {
- $subtype = 'hash';
- last;
- }
- }
- if ( $subtype eq 'array' ) {
- # Ok, remap...
- push(@elems, \@newlist);
- } else {
- # Ok, force into hash..
- my %hash = @values;
- push(@elems, \%hash);
- }
- }
- elsif ( $type eq 'scalar' ) {
- # Ok, get our string size count...
- my $strlen = $self->_readnum;
- $self->_skipchar;
-
- $self->_skipchar;
- my $string = $self->_readstr($strlen);
- $self->_skipchar;
- $self->_skipchar;
-
- push(@elems,$string);
- }
- elsif ( $type eq 'integer' || $type eq 'float' ) {
- # Ok, read the value..
- my $val = $self->_readnum;
- if ( $type eq 'integer' ) { $val = int($val); }
- $self->_skipchar;
- push(@elems, $val);
- }
- elsif ( $type eq 'boolean' ) {
- # Ok, read our boolen value..
- my $bool = $self->_readchar;
- $self->_skipchar;
- if ($bool eq '0') {
- $bool = undef;
- }
- push(@elems, $bool);
- }
- elsif ( $type eq 'undef' ) {
- # Ok, undef value..
- push(@elems, undef);
- }
- else {
- confess "Unknown element type '$type' found! (cursor $$cursor)";
- }
- } # End of while.
-
- # Ok, return our elements list...
+ my @elems;
+ push(@elems,$self->_parse_elem);
+
+ # warn if we have unused chars
+ if ($$cursor != $strlen) {
+ carp("WARN: Unused characters in string after $$cursor.");
+ }
return @elems;
} # End of decode.
@@ -273,6 +290,9 @@
my ($self, $length) = @_;
my $string = $self->{string};
my $cursor = $self->{cursor};
+ if ($$cursor + $length > length($$string)) {
+ croak("ERROR: Read past end of string. Want $length after $$cursor. (".$$string.")");
+ }
my $str = substr($$string, $$cursor, $length);
$$cursor += $length;
@@ -304,7 +324,15 @@
sub _skipchar {
my $self = shift;
- ${$$self{cursor}}++;
+ my $want = shift;
+ my $c = $self->_readchar();
+ if (($want)&&($c ne $want)) {
+ my $cursor = $self->{cursor};
+ my $str = $self->{string};
+ croak("ERROR: Wrong char $c, expected $want at position ".$$cursor." (".$$str.")");
+ }
+ print "_skipchar: WRONG char $c ($want)\n" if (($want)&&($c ne $want));
+ # ${$$self{cursor}}++;
} # Move our cursor one bytes ahead...
@@ -319,7 +347,8 @@
=cut
sub encode {
- my ($self, $val) = @_;
+ my ($self, $val, $iskey) = @_;
+ $iskey=0 unless defined $iskey;
if ( ! defined $val ) {
return $self->_encode('null', $val);
@@ -331,7 +360,7 @@
if ( $val =~ /^-?\d{1,10}$/ && abs($val) < 2**31 ) {
return $self->_encode('int', $val);
}
- elsif ( $val =~ /^-?\d+\.\d*$/ ) {
+ elsif ( $val =~ /^-?\d+\.\d*$/ && !$iskey) {
return $self->_encode('float', $val);
}
else {
@@ -376,8 +405,9 @@
}
else {
$buffer .= sprintf('a:%d:',scalar(keys(%{$val}))) . '{';
- foreach ( %{$val} ) {
- $buffer .= $self->encode($_);
+ while ( my ($key, $value) = each(%{$val}) ) {
+ $buffer .= $self->encode($key,1);
+ $buffer .= $self->encode($value);
}
$buffer .= '}';
}
@@ -401,7 +431,7 @@
=head1 TODO
-Make faster! (and more efficent?)
+Support diffrent object types
=head1 AUTHOR INFORMATION
@@ -412,6 +442,8 @@
Currently maintained by Tomas Doran <bobtfish at bobtfish.net>.
+Rewritten to solve all known bugs by Bjørn-Olav Strand <bolav at cpan.org>
+
=cut
package PHP::Serialization::Object;
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=38333&op=diff
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/t/02basic.t (original)
+++ branches/upstream/libphp-serialization-perl/current/t/02basic.t Sun Jun 21 09:13:02 2009
@@ -9,5 +9,4 @@
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=38333&op=diff
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/t/04arraysRT21218.t (original)
+++ branches/upstream/libphp-serialization-perl/current/t/04arraysRT21218.t Sun Jun 21 09:13:02 2009
@@ -8,8 +8,6 @@
my $data = PHP::Serialization::unserialize(
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 = 'Does not work';
is_deeply($data,
{
@@ -17,22 +15,20 @@
'195' => {111 => 'bbb'},
'194' => {222 => 'ccc'},
}
- }
+ },
+ 'Only numbers as hashindexes works'
) 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'],
}
- }
+ },
+ 'Only numbers as hashindexes works with arrays'
) or warn Dumper($data);
-}
Modified: branches/upstream/libphp-serialization-perl/current/t/05RT24441.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libphp-serialization-perl/current/t/05RT24441.t?rev=38333&op=diff
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/t/05RT24441.t (original)
+++ branches/upstream/libphp-serialization-perl/current/t/05RT24441.t Sun Jun 21 09:13:02 2009
@@ -10,8 +10,7 @@
eval { PHP::Serialization::unserialize $str };
{
- local $TODO = 'BUG!';
- ok(!$@, 'No exception') or warn $@;
+ ok($@, 'Illegal string');
}
__END__
Modified: branches/upstream/libphp-serialization-perl/current/t/06bool_deserializeRT45024.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libphp-serialization-perl/current/t/06bool_deserializeRT45024.t?rev=38333&op=diff
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/t/06bool_deserializeRT45024.t (original)
+++ branches/upstream/libphp-serialization-perl/current/t/06bool_deserializeRT45024.t Sun Jun 21 09:13:02 2009
@@ -3,10 +3,15 @@
use warnings;
use PHP::Serialization;
-use Test::More tests => 1;
+use Test::More tests => 2;
-my $s = 'a:4:{i:0;s:3:"ABC";i:1;s:3:"OPQ";i:2;s:3:"XYZ";i:3;b:0;}';
+my $s = 'b:0;';
my $u = PHP::Serialization::unserialize($s);
+is($u, undef, 'b:0 equals undef');
+
+$s = 'a:4:{i:0;s:3:"ABC";i:1;s:3:"OPQ";i:2;s:3:"XYZ";i:3;b:0;}';
+$u = PHP::Serialization::unserialize($s);
+
is_deeply $u, [
'ABC',
'OPQ',
Added: branches/upstream/libphp-serialization-perl/current/t/07croak.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libphp-serialization-perl/current/t/07croak.t?rev=38333&op=file
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/t/07croak.t (added)
+++ branches/upstream/libphp-serialization-perl/current/t/07croak.t Sun Jun 21 09:13:02 2009
@@ -1,0 +1,12 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use PHP::Serialization;
+use Test::More tests => 1;
+
+my $s = 's:3;"ABC";';
+eval q{
+ my $u = PHP::Serialization::unserialize($s);
+};
+like($@, qr/ERROR/, 'dies');
Added: branches/upstream/libphp-serialization-perl/current/t/08incompletestringRT44700.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libphp-serialization-perl/current/t/08incompletestringRT44700.t?rev=38333&op=file
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/t/08incompletestringRT44700.t (added)
+++ branches/upstream/libphp-serialization-perl/current/t/08incompletestringRT44700.t Sun Jun 21 09:13:02 2009
@@ -1,0 +1,19 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use PHP::Serialization;
+use Test::More tests => 1;
+
+my $encoded_php =
+'a:2:{s:15:"info_buyRequest";a:5:{s:4:"uenc";s:72:"aHR0cDovL3N0YWdpbmcucGNkaXJlY3QuY29tL21vbml0b3JzL2Jsc2FzeTIwMjB3aS5odG1s";s:7:"product";s:3:"663";s:15:"related_product";s:0:"";s:7:"options";a:3:{i:3980;s:5:"12553";i:3981;s:5:"12554";i:3982;s:5:"12555";}s:3:"qty";s:6:"1.0000";}s:7:"options";a:3:{i:0;a:8:{s:5:"label";s:27:"Dead
+Pixel Checking Service";s:5:"value";s:155:"I understand LCD technology
+might have slight imperfections. Even a high quality A Grade panel might
+have up to five dead pixels. Ship without
+pre-checking";s:9:"option_id";s:4:"3980";s:3:"sku";s:0:"";s:5:"price";N;s:10:"price_type";N;s:3:"raw";O:33:"Mage_Catalog_Model_Product_Option":15:{s:11:"';
+
+eval q{
+ my $u = PHP::Serialization::unserialize($encoded_php);
+};
+
+like($@, qr/ERROR/, 'dies');
Added: branches/upstream/libphp-serialization-perl/current/t/09floatindexRT42029.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libphp-serialization-perl/current/t/09floatindexRT42029.t?rev=38333&op=file
==============================================================================
--- branches/upstream/libphp-serialization-perl/current/t/09floatindexRT42029.t (added)
+++ branches/upstream/libphp-serialization-perl/current/t/09floatindexRT42029.t Sun Jun 21 09:13:02 2009
@@ -1,0 +1,12 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use PHP::Serialization;
+use Test::More tests => 1;
+
+my $hash = { 'Volkswagen' => { 'Touareg' => { '2.5' => 1 } }, };
+
+my $str = PHP::Serialization::serialize($hash);
+
+is($str,'a:1:{s:10:"Volkswagen";a:1:{s:7:"Touareg";a:1:{s:3:"2.5";i:1;}}}','Keys are string or int');
More information about the Pkg-perl-cvs-commits
mailing list