K
kolyapon
Подскажите как исправить следующую ошибку -
Unknown type ''! at 1 at /var/www/html/dir/include//Serialization.pm line 161
Serialization::_parse('Serialization=HASH(0xa9f9cc8)') called at /var/www/html/dir/include//Serialization.pm line 116
Serialization::decode('Serialization=HASH(0xa9f9cc8)', '\x{1}\x{c7}\x{1e}\x{b2}\x{c0}\x{de}\x{9e}\'\x{9d}') called at /var/www/html/dir/include//Serialization.pm line 79
Serialization::unserialize('\x{1}\x{c7}\x{1e}\x{b2}\x{c0}\x{de}\x{9e}\'\x{9d}') called at /var/www/html/dir/include/sub.pm line 83
Ломаю голову - не могу понять из-за чего( Может модуль какой поставить нужно?
Исходник Serialization.pm -
Unknown type ''! at 1 at /var/www/html/dir/include//Serialization.pm line 161
Serialization::_parse('Serialization=HASH(0xa9f9cc8)') called at /var/www/html/dir/include//Serialization.pm line 116
Serialization::decode('Serialization=HASH(0xa9f9cc8)', '\x{1}\x{c7}\x{1e}\x{b2}\x{c0}\x{de}\x{9e}\'\x{9d}') called at /var/www/html/dir/include//Serialization.pm line 79
Serialization::unserialize('\x{1}\x{c7}\x{1e}\x{b2}\x{c0}\x{de}\x{9e}\'\x{9d}') called at /var/www/html/dir/include/sub.pm line 83
Ломаю голову - не могу понять из-за чего( Может модуль какой поставить нужно?
Исходник Serialization.pm -
Код:
package Serialization;
use strict;
use warnings;
BEGIN {
use Exporter ();
our ($VERSION,@EXPORT_OK,@ISA);
# Revision.
$VERSION = 0.27;
# Our inheritence
@ISA = qw(Exporter);
# Stuff they can request.
@EXPORT_OK = qw(unserialize serialize);
}
our (@EXPORT_OK);
=head1 NAME
Serialization - simple flexible means of converting the output of PHP's serialize() into the equivalent Perl memory structure, and vice versa.
=head1 SYNOPSIS
use Serialization qw(serialize unserialize);
my $encoded = serialize({ a => 1, b => 2});
my $hashref = unserialize($encoded);
=cut
=head1 DESCRIPTION
Provides a simple, quick means of serializing perl memory structures (including object data!) into a format that PHP can deserialize() and access, and vice versa.
NOTE: Converts PHP arrays into Perl Arrays when the PHP array used exclusively numeric indexes, and into Perl Hashes then the PHP array did not.
=cut
sub new {
my $self = bless({},shift);
return $self;
}
=head1 FUNCTIONS
Exportable functions..
=cut
=head2 serialize($var)
Serializes the memory structure pointed to by $var, and returns a scalar value of encoded data.
NOTE: Will recursively encode objects, hashes, arrays, etc.
SEE ALSO: ->encode()
=cut
sub serialize {
my $obj = Serialization->new();
return $obj->encode(@_);
}
=head2 unserialize($encoded,[optional CLASS])
Deserializes the encoded data in $encoded, and returns a value (be it a hashref, arrayref, scalar, etc) representing the data structure serialized in $encoded_string.
If the optional CLASS is specified, any objects are blessed into CLASS::$serialized_class. Otherwise, Objects are blessed into Serialization::Object::$serialized_class. (which has no methods)
SEE ALSO: ->decode()
=cut
sub unserialize {
my $obj = Serialization->new();
return $obj->decode(@_);
} # End of sub.
=head1 METHODS
Functionality available if using the object interface..
=cut
=head2 decode($encoded_string,[optional CLASS])
Deserializes the encoded data in $encoded, and returns a value (be it a hashref, arrayref, scalar, etc) representing the data structure serialized in $encoded_string.
If the optional CLASS is specified, any objects are blessed into CLASS::$serialized_class. Otherwise, Objects are blessed into Serialization::Object::$serialized_class. (which has no methods)
SEE ALSO: unserialize()
=cut
sub decode {
my $self = shift;
my $string = shift;
my $class = shift;
use Carp qw(croak confess);
my $cursor = 0;
$$self{'string'} = \$string;
$$self{'cursor'} = \$cursor;
$$self{'strlen'} = length($string);
if ( defined $class ) {
$$self{'class'} = $class;
} else {
$$self{'class'} = 'Serialization::Object';
}
# Ok, start parsing...
my @values = $self->_parse();
# Ok, we SHOULD only have one value..
if ( $#values == -1 ) {
# Oops, none...
return;
} elsif ( $#values == 0 ) {
# Ok, return our one value..
return $values[0];
} else {
# Ok, return a reference to the list.
return \@values;
}
} # End of decode sub.
my %type_table = (
'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 @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;
};
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(); # Toss the seperator
# Ok, get our object name...
$self->_skipchar(); # Toss the seperator
my $name = $self->_readstr($namelen);
$self->_skipchar(); # Toss the seperator
# Ok, our sub elements...
$self->_skipchar(); # Toss the seperator
my $elemcount = $self->_readnum();
$self->_skipchar(); # Toss the seperator
my %value = $self->_parse();
push(@elems,bless(\%value,$$self{'class'} . '::' . $name));
} elsif ( $type eq 'array' ) {
# Ok, our sub elements...
$self->_skipchar(); # Toss the seperator
my $elemcount = $self->_readnum();
$self->_skipchar(); # Toss the seperator
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(); # Toss the seperator
$self->_skipchar(); # Toss the seperator
my $string = $self->_readstr($strlen);
$self->_skipchar(); # Toss the seperator
$self->_skipchar(); # Toss the seperator
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(); # Toss the seperator
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' ) {
# Ok, undef value..
push(@elems,undef);
} else {
confess "Unknown element type '$type' found! (cursor $$cursor)";
}
} # End of while.
# Ok, return our elements list...
return @elems;
} # 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);
$$cursor += $length;
return $str;
} # End of readstr.
sub _readchar {
my $self = shift;
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 $string;
while ( 1 ) {
my $char = $self->_readchar();
if ( $char !~ /^[\d\.]+$/ ) {
$$cursor--;
last;
}
$string .= $char;
} # End of while.
return $string;
} # End of readnum
sub _skipchar {
my $self = shift;
${$$self{'cursor'}}++;
} # Move our cursor one bytes ahead...
=head2 encode($reference)
Serializes the memory structure pointed to by $var, and returns a scalar value of encoded data.
NOTE: Will recursively encode objects, hashes, arrays, etc.
SEE ALSO: serialize()
=cut
sub encode {
my $self = shift;
my $val = shift;
use Carp qw(confess);
if ( ! defined $val ) {
return $self->_encode('null',$val);
} elsif ( ! ref($val) ) {
if ( $val =~ /^-?\d+$/ ) {
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' ) {
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 $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' ) {
if ( ref($val) eq 'ARRAY' ) {
$buffer .= sprintf('a:%d:',($#{$val}+1)) . '{';
map { $buffer .= $self->encode($_); $buffer .= $self->encode($$val[$_]); } 0..$#{$val};
$buffer .= '}';
} else {
$buffer .= sprintf('a:%d:',scalar(keys(%{$val}))) . '{';
foreach ( %{$val} ) { $buffer .= $self->encode($_); }
$buffer .= '}';
}
} 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 .= '}';
} else {
use Carp qw(confess);
confess "Unknown encode type!";
}
return $buffer;
} # End of _encode sub.
=head1 BUGS
None known yet, feel free to report some!
=cut
=head1 TODO
Make faster! (and more efficent?)
=cut
=head1 AUTHOR INFORMATION
Copyright (c) 2003 Jesse Brown <jbrown@cpan.org>. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
=cut
package Serialization::Object;
1;