r38335 - in /trunk/libphp-serialization-perl: ./ debian/ lib/PHP/ t/
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sun Jun 21 09:40:11 UTC 2009
Author: ansgar-guest
Date: Sun Jun 21 09:39:56 2009
New Revision: 38335
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38335
Log:
* New upstream release.
* Use minimal debian/rules.
* Bump Standards Version to 3.8.2 (no changes).
Added:
trunk/libphp-serialization-perl/t/07croak.t
- copied unchanged from r38334, branches/upstream/libphp-serialization-perl/current/t/07croak.t
trunk/libphp-serialization-perl/t/08incompletestringRT44700.t
- copied unchanged from r38334, branches/upstream/libphp-serialization-perl/current/t/08incompletestringRT44700.t
trunk/libphp-serialization-perl/t/09floatindexRT42029.t
- copied unchanged from r38334, branches/upstream/libphp-serialization-perl/current/t/09floatindexRT42029.t
Removed:
trunk/libphp-serialization-perl/MANIFEST.bak
Modified:
trunk/libphp-serialization-perl/Changes
trunk/libphp-serialization-perl/MANIFEST
trunk/libphp-serialization-perl/META.yml
trunk/libphp-serialization-perl/debian/changelog
trunk/libphp-serialization-perl/debian/control
trunk/libphp-serialization-perl/debian/rules
trunk/libphp-serialization-perl/lib/PHP/Serialization.pm
trunk/libphp-serialization-perl/t/02basic.t
trunk/libphp-serialization-perl/t/04arraysRT21218.t
trunk/libphp-serialization-perl/t/05RT24441.t
trunk/libphp-serialization-perl/t/06bool_deserializeRT45024.t
Modified: trunk/libphp-serialization-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libphp-serialization-perl/Changes?rev=38335&op=diff
==============================================================================
--- trunk/libphp-serialization-perl/Changes (original)
+++ trunk/libphp-serialization-perl/Changes Sun Jun 21 09:39:56 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: trunk/libphp-serialization-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libphp-serialization-perl/MANIFEST?rev=38335&op=diff
==============================================================================
--- trunk/libphp-serialization-perl/MANIFEST (original)
+++ trunk/libphp-serialization-perl/MANIFEST Sun Jun 21 09:39:56 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: trunk/libphp-serialization-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libphp-serialization-perl/META.yml?rev=38335&op=diff
==============================================================================
--- trunk/libphp-serialization-perl/META.yml (original)
+++ trunk/libphp-serialization-perl/META.yml Sun Jun 21 09:39:56 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: trunk/libphp-serialization-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libphp-serialization-perl/debian/changelog?rev=38335&op=diff
==============================================================================
--- trunk/libphp-serialization-perl/debian/changelog (original)
+++ trunk/libphp-serialization-perl/debian/changelog Sun Jun 21 09:39:56 2009
@@ -1,8 +1,14 @@
-libphp-serialization-perl (0.31-2) UNRELEASED; urgency=low
+libphp-serialization-perl (0.32-1) unstable; urgency=low
+ [ Nathan Handler ]
* debian/watch: Update to ignore development releases.
- -- Nathan Handler <nhandler at ubuntu.com> Sat, 06 Jun 2009 01:36:56 +0000
+ [ Ansgar Burchardt ]
+ * New upstream release.
+ * Use minimal debian/rules.
+ * Bump Standards Version to 3.8.2 (no changes).
+
+ -- Ansgar Burchardt <ansgar at 43-1.org> Sun, 21 Jun 2009 11:38:48 +0200
libphp-serialization-perl (0.31-1) unstable; urgency=low
Modified: trunk/libphp-serialization-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libphp-serialization-perl/debian/control?rev=38335&op=diff
==============================================================================
--- trunk/libphp-serialization-perl/debian/control (original)
+++ trunk/libphp-serialization-perl/debian/control Sun Jun 21 09:39:56 2009
@@ -1,7 +1,7 @@
Source: libphp-serialization-perl
Section: perl
Priority: optional
-Build-Depends: debhelper (>= 7.0.50)
+Build-Depends: debhelper (>= 7)
Build-Depends-Indep: perl (>= 5.8.8-12)
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Homepage: http://search.cpan.org/dist/PHP-Serialization/
@@ -10,7 +10,7 @@
Uploaders: Krzysztof Krzyzaniak (eloy) <eloy at debian.org>,
Jose Luis Rivas <ghostbar38 at gmail.com>, Gunnar Wolf <gwolf at debian.org>,
Ansgar Burchardt <ansgar at 43-1.org>
-Standards-Version: 3.8.1
+Standards-Version: 3.8.2
Package: libphp-serialization-perl
Architecture: all
Modified: trunk/libphp-serialization-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libphp-serialization-perl/debian/rules?rev=38335&op=diff
==============================================================================
--- trunk/libphp-serialization-perl/debian/rules (original)
+++ trunk/libphp-serialization-perl/debian/rules Sun Jun 21 09:39:56 2009
@@ -1,26 +1,3 @@
#!/usr/bin/make -f
-
-build: build-stamp
-build-stamp:
- dh build
- touch $@
-
-clean:
+%:
dh $@
-
-override_dh_clean:
- dh_clean -XMANIFEST.bak
-
-install: install-stamp
-install-stamp: build-stamp
- dh install
- touch $@
-
-binary-arch:
-
-binary-indep: install
- dh $@
-
-binary: binary-arch binary-indep
-
-.PHONY: binary binary-arch binary-indep install clean build
Modified: trunk/libphp-serialization-perl/lib/PHP/Serialization.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libphp-serialization-perl/lib/PHP/Serialization.pm?rev=38335&op=diff
==============================================================================
--- trunk/libphp-serialization-perl/lib/PHP/Serialization.pm (original)
+++ trunk/libphp-serialization-perl/lib/PHP/Serialization.pm Sun Jun 21 09:39:56 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: trunk/libphp-serialization-perl/t/02basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libphp-serialization-perl/t/02basic.t?rev=38335&op=diff
==============================================================================
--- trunk/libphp-serialization-perl/t/02basic.t (original)
+++ trunk/libphp-serialization-perl/t/02basic.t Sun Jun 21 09:39:56 2009
@@ -9,5 +9,4 @@
third_test => -2,
};
my $encoded = serialize($data);
-warn "ENCODED $encoded";
is_deeply($data, unserialize($encoded));
Modified: trunk/libphp-serialization-perl/t/04arraysRT21218.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libphp-serialization-perl/t/04arraysRT21218.t?rev=38335&op=diff
==============================================================================
--- trunk/libphp-serialization-perl/t/04arraysRT21218.t (original)
+++ trunk/libphp-serialization-perl/t/04arraysRT21218.t Sun Jun 21 09:39:56 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: trunk/libphp-serialization-perl/t/05RT24441.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libphp-serialization-perl/t/05RT24441.t?rev=38335&op=diff
==============================================================================
--- trunk/libphp-serialization-perl/t/05RT24441.t (original)
+++ trunk/libphp-serialization-perl/t/05RT24441.t Sun Jun 21 09:39:56 2009
@@ -10,8 +10,7 @@
eval { PHP::Serialization::unserialize $str };
{
- local $TODO = 'BUG!';
- ok(!$@, 'No exception') or warn $@;
+ ok($@, 'Illegal string');
}
__END__
Modified: trunk/libphp-serialization-perl/t/06bool_deserializeRT45024.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libphp-serialization-perl/t/06bool_deserializeRT45024.t?rev=38335&op=diff
==============================================================================
--- trunk/libphp-serialization-perl/t/06bool_deserializeRT45024.t (original)
+++ trunk/libphp-serialization-perl/t/06bool_deserializeRT45024.t Sun Jun 21 09:39:56 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',
More information about the Pkg-perl-cvs-commits
mailing list