| Subject: | New serialize_handler -- PHPurlencoded |
Hello,
Would you be interested in extending the current perl module to include
PHPurlencoded as a new serialize_handler option? (currently PHP is the
default and only option).
If so, I have included the PHP::Session::PHPurlencoded perl module that
could be included in your distribution (along with the single line that
would need to be added to the PHP::Session perl module itself).
*** Session.pm.orig 2009-03-03 22:26:07.000000000 -0700
--- Session.pm.new 2009-03-03 23:07:38.000000000 -0700
***************
*** 7,12 ****
--- 7,13 ----
use vars qw(%SerialImpl);
%SerialImpl = (
php => 'PHP::Session::Serializer::PHP',
+ phpurlencoded => 'PHP::Session::Serializer::PHPurlencoded',
);
use Fcntl qw(:flock);
| Subject: | PHPurlencoded.pm |
package PHP::Session::Serializer::PHPurlencoded;
use strict;
use vars qw($VERSION);
$VERSION = 0.26;
sub _croak { require Carp; Carp::croak(@_) }
sub new {
my $class = shift;
bless {
buffer => undef,
data => {},
state => undef,
stack => [],
array => [], # array-ref of hash-ref
}, $class;
}
# encoder starts here
sub encode {
my($self, $data) = @_;
my $body;
for my $key (keys %$data) {
if (defined $data->{$key}) {
$body .= "$key|" . $self->do_encode($data->{$key});
} else {
$body .= "!$key|";
}
}
$body =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
return $body;
}
sub do_encode {
my($self, $value) = @_;
if (! defined $value) {
return $self->encode_null($value);
}
elsif (! ref $value) {
if (is_int($value)) {
return $self->encode_int($value);
}
elsif (is_float($value)) {
return $self->encode_double($value);
}
else {
return $self->encode_string($value);
}
}
elsif (ref $value eq 'HASH') {
return $self->encode_array($value);
}
elsif (ref $value eq 'ARRAY') {
return $self->encode_array($value);
}
elsif (ref $value eq 'PHP::Session::Object') {
return $self->encode_object($value);
}
else {
_croak("Can't encode ", ref($value));
}
}
sub encode_null {
my($self, $value) = @_;
return 'N;';
}
sub encode_int {
my($self, $value) = @_;
return sprintf 'i:%d;', $value;
}
sub encode_double {
my($self, $value) = @_;
return sprintf "d:%s;", $value; # XXX hack
}
sub encode_string {
my($self, $value) = @_;
return sprintf 's:%d:"%s";', length($value), $value;
}
sub encode_array {
my($self, $value) = @_;
my %array = ref $value eq 'HASH' ? %$value : map { $_ => $value->[$_] } 0..$#{$value};
return sprintf 'a:%d:{%s}', scalar(keys %array), join('', map $self->do_encode($_), %array);
}
sub encode_object {
my($self, $value) = @_;
my %impl = %$value;
my $class = delete $impl{_class};
return sprintf 'O:%d:"%s":%d:{%s}', length($class), $class, scalar(keys %impl),
join('', map $self->do_encode($_), %impl);
}
sub is_int {
local $_ = shift;
/^-?(0|[1-9]\d{0,8})$/;
}
sub is_float {
local $_ = shift;
/^-?(0|[1-9]\d{0,8})\.\d+$/;
}
# decoder starts here
sub decode {
my($self, $data) = @_;
$data =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;
$self->{buffer} = $data;
$self->change_state('VarName');
while (defined $self->{buffer} && length $self->{buffer}) {
$self->{state}->parse($self);
}
return $self->{data};
}
sub change_state {
my($self, $state) = @_;
$self->{state} = "PHP::Session::Serializer::PHPurlencoded::State::$state"; # optimization
# $self->{state} = PHP::Session::Serializer::PHPurlencoded::State->new($state);
}
sub set {
my($self, $key, $value) = @_;
$self->{data}->{$key} = $value;
}
sub push_stack {
my($self, $stuff) = @_;
push @{$self->{stack}}, $stuff;
}
sub pop_stack {
my $self = shift;
pop @{$self->{stack}};
}
sub extract_stack {
my($self, $num) = @_;
return $num ? splice(@{$self->{stack}}, -$num) : ();
}
# array: [ [ $length, $consuming, $class ], [ $length, $consuming, $class ] .. ]
sub start_array {
my($self, $length, $class) = @_;
unshift @{$self->{array}}, [ $length, 0, $class ];
}
sub in_array {
my $self = shift;
return scalar @{$self->{array}};
}
sub consume_array {
my $self = shift;
$self->{array}->[0]->[1]++;
}
sub finished_array {
my $self = shift;
return $self->{array}->[0]->[0] * 2 == $self->{array}->[0]->[1];
}
sub elements_count {
my $self = shift;
return $self->{array}->[0]->[0];
}
sub process_value {
my($self, $value, $empty_skip) = @_;
if ($self->in_array()) {
unless ($empty_skip) {
$self->push_stack($value);
$self->consume_array();
}
if ($self->finished_array()) {
# just finished array
my $array = shift @{$self->{array}}; # shift it
my @values = $self->extract_stack($array->[0] * 2);
my $class = $array->[2];
if (defined $class) {
# object
my $real_value = bless {
_class => $class,
@values,
}, 'PHP::Session::Object';
$self->process_value($real_value);
} else {
# array is hash
$self->process_value({ @values });
}
$self->change_state('ArrayEnd');
$self->{state}->parse($self);
} else {
# not yet finished
$self->change_state('VarType');
}
}
else {
# not in array
my $varname = $self->pop_stack;
$self->set($varname => $value);
$self->change_state('VarName');
}
}
sub weird {
my $self = shift;
_croak("weird data: $self->{buffer}");
}
package PHP::Session::Serializer::PHPurlencoded::State::VarName;
sub parse {
my($self, $decoder) = @_;
$decoder->{buffer} =~ s/^(!?)(.*?)\|// or $decoder->weird;
if ($1) {
$decoder->set($2 => undef);
} else {
$decoder->push_stack($2);
$decoder->change_state('VarType');
}
}
package PHP::Session::Serializer::PHPurlencoded::State::VarType;
my @re = (
's:(\d+):', # string
'i:(-?\d+);', # integer
'd:(-?\d+(?:\.\d+)?);', # double
'a:(\d+):', # array
'O:(\d+):', # object
'(N);', # null
'b:([01]);', # boolean
'[Rr]:(\d+);', # reference count?
);
sub parse {
my($self, $decoder) = @_;
my $re = join "|", @re;
$decoder->{buffer} =~ s/^(?:$re)// or $decoder->weird;
if (defined $1) { # string
$decoder->push_stack($1);
$decoder->change_state('String');
}
elsif (defined $2) { # integer
$decoder->process_value($2);
}
elsif (defined $3) { # double
$decoder->process_value($3);
}
elsif (defined $4) { # array
$decoder->start_array($4);
$decoder->change_state('ArrayStart');
}
elsif (defined $5) { # object
$decoder->push_stack($5);
$decoder->change_state('ClassName');
}
elsif (defined $6) { # null
$decoder->process_value(undef);
}
elsif (defined $7) { # boolean
$decoder->process_value($7);
}
elsif (defined $8) { # reference
$decoder->process_value($8);
}
}
package PHP::Session::Serializer::PHPurlencoded::State::String;
sub parse {
my($self, $decoder) = @_;
my $length = $decoder->pop_stack();
# .{$length} has a limit on length
# $decoder->{buffer} =~ s/^"(.{$length})";//s or $decoder->weird;
my $value = substr($decoder->{buffer}, 0, $length + 3, "");
$value =~ s/^"// and $value =~ s/";$// or $decoder->weird;
$decoder->process_value($value);
}
package PHP::Session::Serializer::PHPurlencoded::State::ArrayStart;
sub parse {
my($self, $decoder) = @_;
$decoder->{buffer} =~ s/^{// or $decoder->weird;
if ($decoder->elements_count) {
$decoder->change_state('VarType');
} else {
$decoder->process_value(undef, 1);
}
}
package PHP::Session::Serializer::PHPurlencoded::State::ArrayEnd;
sub parse {
my($self, $decoder) = @_;
$decoder->{buffer} =~ s/^}// or $decoder->weird;
my $next_state = $decoder->in_array() ? 'VarType' : 'VarName';
$decoder->change_state($next_state);
}
package PHP::Session::Serializer::PHPurlencoded::State::ClassName;
sub parse {
my($self, $decoder) = @_;
my $length = $decoder->pop_stack();
# $decoder->{buffer} =~ s/^"(.{$length})":(\d+):// or $decoder->weird;
my $value = substr($decoder->{buffer}, 0, $length + 3, "");
$value =~ s/^"// and $value =~ s/":$// or $decoder->weird;
$decoder->{buffer} =~ s/^(\d+):// or $decoder->weird;
$decoder->start_array($1, $value); # $length, $class
$decoder->change_state('ArrayStart');
}
1;
__END__
=head1 NAME
PHP::Session::Serializer::PHPurlencoded - serialize / deserialize PHP session data
=head1 SYNOPSIS
use PHP::Session::Serializer::PHPurlencoded;
$serializer = PHP::Session::Serializer::PHPurlencoded->new;
$enc = $serializer->encode(\%data);
$hashref = $serializer->decode($enc);
=head1 TODO
=over 4
=item *
Add option to restore PHP object as is.
=item *
Get back PHP array as Perl array?
=back
=head1 AUTHOR
Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
L<PHP::Session>
=cut