Помогите понять в чём ошибка

Тема в разделе "Perl программирование", создана пользователем kolyapon, 7 апр 2009.

  1. kolyapon

    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 -


    Код (Text):
    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;
     
  2. Vovochka

    Vovochka Гость

    Все довольно таки просто. Если это ваш модуль и вы передаете туда правильные данные. То у вас ошибка в модуле.
    Если это не ваш модуль, скорее всего, вы передаете туда неправильные данные.
    Лично мне видиться второе.

    Все дело в этом участке кода:
    Код (Text):
    if ( ! exists $type_table{$type} ) {
    confess "Unknown type '$type'! at $$cursor";
    }
    Смысл в том, что $type - это текущая, обрабатываемая буква. И судя по ощибке туда попадает нечно неверное, а именно: 
     
  3. kolyapon

    kolyapon Гость

    дело в том, что на одном сервере скрипт работает нормально, на другом тот же скрипт отдаёт следующие ошибки в логи и не отрабатывает.
     
  4. Vovochka

    Vovochka Гость

    Дело не в скрипте, а во входных данных.
    Они одинаковы? Одинакова кодировка? Все точно?
    Если все три ответа - да, не могу ничем помочь :)
     
Загрузка...

Поделиться этой страницей