miyagawa · jhatmaker · Feb 23, 2010
diff --git a/lib/PHP/Session.pm b/lib/PHP/Session.pm
@@ -7,6 +7,7 @@ $VERSION = '0.27';
 use vars qw(%SerialImpl);
 %SerialImpl = (
     php => 'PHP::Session::Serializer::PHP',
+    phpurlencoded => 'PHP::Session::Serializer::PHPurlencoded',
 );
 
 use Fcntl qw(:flock);

diff --git a/lib/PHP/Session/Serializer/PHPurlencoded.pm b/lib/PHP/Session/Serializer/PHPurlencoded.pm
@@ -0,0 +1,369 @@
+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
+