home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / PHP.pm < prev    next >
Encoding:
Perl POD Document  |  2003-10-04  |  8.1 KB  |  364 lines
  1. package PHP::Session::Serializer::PHP;
  2.  
  3. use strict;
  4. use vars qw($VERSION);
  5. $VERSION = 0.22;
  6.  
  7. sub _croak { require Carp; Carp::croak(@_) }
  8.  
  9. sub new {
  10.     my $class = shift;
  11.     bless {
  12.     buffer => undef,
  13.     data   => {},
  14.     state  => undef,
  15.     stack  => [],
  16.     array  => [],        # array-ref of array-ref
  17.     }, $class;
  18. }
  19.  
  20. # encoder starts here
  21.  
  22. sub encode {
  23.     my($self, $data) = @_;
  24.     my $body;
  25.     for my $key (keys %$data) {
  26.     if (defined $data->{$key}) {
  27.         $body .= "$key|" . $self->do_encode($data->{$key});
  28.     } else {
  29.         $body .= "!$key|";
  30.         }
  31.     }
  32.     return $body;
  33. }
  34.  
  35. sub do_encode {
  36.     my($self, $value) = @_;
  37.     if (! defined $value) {
  38.     return $self->encode_null($value);
  39.     }
  40.     elsif (! ref $value) {
  41.     if (is_int($value)) {
  42.         return $self->encode_int($value);
  43.     }
  44.     elsif (is_float($value)) {
  45.         return $self->encode_double($value);
  46.     }
  47.     else {
  48.         return $self->encode_string($value);
  49.     }
  50.     }
  51.     elsif (ref $value eq 'HASH') {
  52.     return $self->encode_array($value);
  53.     }
  54.     elsif (ref $value eq 'ARRAY') {
  55.     return $self->encode_array($value);
  56.     }
  57.     elsif (ref $value eq 'PHP::Session::Object') {
  58.     return $self->encode_object($value);
  59.     }
  60.     else {
  61.     _croak("Can't encode ", ref($value));
  62.     }
  63. }
  64.  
  65. sub encode_null {
  66.     my($self, $value) = @_;
  67.     return 'N;';
  68. }
  69.  
  70. sub encode_int {
  71.     my($self, $value) = @_;
  72.     return sprintf 'i:%d;', $value;
  73. }
  74.  
  75. sub encode_double {
  76.     my($self, $value) = @_;
  77.     return sprintf "d:%s;", $value; # XXX hack
  78. }
  79.  
  80. sub encode_string {
  81.     my($self, $value) = @_;
  82.     return sprintf 's:%d:"%s";', length($value), $value;
  83. }
  84.  
  85. sub encode_array {
  86.     my($self, $value) = @_;
  87.     my %array = ref $value eq 'HASH' ? %$value : map { $_ => $value->[$_] } 0..$#{$value};
  88.     return sprintf 'a:%d:{%s}', scalar(keys %array), join('', map $self->do_encode($_), %array);
  89. }
  90.  
  91. sub encode_object {
  92.     my($self, $value) = @_;
  93.     my %impl = %$value;
  94.     my $class = delete $impl{_class};
  95.     return sprintf 'O:%d:"%s":%d:{%s}', length($class), $class, scalar(keys %impl),
  96.     join('', map $self->do_encode($_), %impl);
  97. }
  98.  
  99. sub is_int {
  100.     local $_ = shift;
  101.     /^-?(0|[1-9]\d{0,8})$/;
  102. }
  103.  
  104. sub is_float {
  105.     local $_ = shift;
  106.     /^-?(0|[1-9]\d{0,8})\.\d+$/;
  107. }
  108.  
  109. # decoder starts here
  110.  
  111. sub decode {
  112.     my($self, $data) = @_;
  113.     $self->{buffer} = $data;
  114.     $self->change_state('VarName');
  115.     while (defined $self->{buffer} && length $self->{buffer}) {
  116.     $self->{state}->parse($self);
  117.     }
  118.     return $self->{data};
  119. }
  120.  
  121. sub change_state {
  122.     my($self, $state) = @_;
  123.     $self->{state} = "PHP::Session::Serializer::PHP::State::$state"; # optimization
  124. #    $self->{state} = PHP::Session::Serializer::PHP::State->new($state);
  125.  
  126. }
  127.  
  128. sub set {
  129.     my($self, $key, $value) = @_;
  130.     $self->{data}->{$key} = $value;
  131. }
  132.  
  133. sub push_stack {
  134.     my($self, $stuff) = @_;
  135.     push @{$self->{stack}}, $stuff;
  136. }
  137.  
  138. sub pop_stack {
  139.     my $self = shift;
  140.     pop @{$self->{stack}};
  141. }
  142.  
  143. sub extract_stack {
  144.     my($self, $num) = @_;
  145.     return $num ? splice(@{$self->{stack}}, -$num) : ();
  146. }
  147.  
  148. # array: [ [ $length, $consuming, $class ], [ $length, $consuming, $class ]  .. ]
  149.  
  150. sub start_array {
  151.     my($self, $length, $class) = @_;
  152.     unshift @{$self->{array}}, [ $length, 0, $class ];
  153. }
  154.  
  155. sub in_array {
  156.     my $self = shift;
  157.     return scalar @{$self->{array}};
  158. }
  159.  
  160. sub consume_array {
  161.     my $self = shift;
  162.     $self->{array}->[0]->[1]++;
  163. }
  164.  
  165. sub finished_array {
  166.     my $self = shift;
  167.     return $self->{array}->[0]->[0] * 2 == $self->{array}->[0]->[1];
  168. }
  169.  
  170. sub elements_count {
  171.     my $self = shift;
  172.     return $self->{array}->[0]->[0];
  173. }
  174.  
  175. sub process_value {
  176.     my($self, $value, $empty_skip) = @_;
  177.     if ($self->in_array()) {
  178.     unless ($empty_skip) {
  179.         $self->push_stack($value);
  180.         $self->consume_array();
  181.     }
  182.     if ($self->finished_array()) {
  183.         # just finished array
  184.         my $array  = shift @{$self->{array}}; # shift it
  185.         my @values = $self->extract_stack($array->[0] * 2);
  186.         my $class  = $array->[2];
  187.         if (defined $class) {
  188.         # object
  189.         my $real_value = bless {
  190.             _class => $class,
  191.             @values,
  192.         }, 'PHP::Session::Object';
  193.         $self->process_value($real_value);
  194.         } else {
  195.         # array is hash
  196.         $self->process_value({ @values });
  197.         }
  198.         $self->change_state('ArrayEnd');
  199.         $self->{state}->parse($self);
  200.     } else {
  201.         # not yet finished
  202.         $self->change_state('VarType');
  203.     }
  204.     }
  205.     else {
  206.     # not in array
  207.     my $varname = $self->pop_stack;
  208.     $self->set($varname => $value);
  209.     $self->change_state('VarName');
  210.     }
  211. }
  212.  
  213. sub weird {
  214.     my $self = shift;
  215.     _croak("weird data: $self->{buffer}");
  216. }
  217.  
  218. package PHP::Session::Serializer::PHP::State::VarName;
  219.  
  220. sub parse {
  221.     my($self, $decoder) = @_;
  222.     $decoder->{buffer} =~ s/^(!?)(.*?)\|// or $decoder->weird;
  223.     if ($1) {
  224.     $decoder->set($2 => undef);
  225.     } else {
  226.     $decoder->push_stack($2);
  227.     $decoder->change_state('VarType');
  228.     }
  229. }
  230.  
  231. package PHP::Session::Serializer::PHP::State::VarType;
  232.  
  233. my @re = (
  234.     's:(\d+):',            # string
  235.     'i:(-?\d+);',        # integer
  236.     'd:(-?\d+(?:\.\d+)?);',    # double
  237.     'a:(\d+):',            # array
  238.     'O:(\d+):',            # object
  239.     '(N);',            # null
  240.     'b:([01]);',        # boolean
  241. );
  242.  
  243. sub parse {
  244.     my($self, $decoder) = @_;
  245.     my $re = join "|", @re;
  246.     $decoder->{buffer} =~ s/^(?:$re)// or $decoder->weird;
  247.     if (defined $1) {        # string
  248.     $decoder->push_stack($1);
  249.     $decoder->change_state('String');
  250.     }
  251.     elsif (defined $2) {    # integer
  252.     $decoder->process_value($2);
  253.     }
  254.     elsif (defined $3) {    # double
  255.     $decoder->process_value($3);
  256.     }
  257.     elsif (defined $4) {    # array
  258.     $decoder->start_array($4);
  259.     $decoder->change_state('ArrayStart');
  260.     }
  261.     elsif (defined $5) {    # object
  262.     $decoder->push_stack($5);
  263.     $decoder->change_state('ClassName');
  264.     }
  265.     elsif (defined $6) {    # null
  266.     $decoder->process_value(undef);
  267.     }
  268.     elsif (defined $7) {    # boolean
  269.     $decoder->process_value($7);
  270.     }
  271. }
  272.  
  273. package PHP::Session::Serializer::PHP::State::String;
  274.  
  275. sub parse {
  276.     my($self, $decoder) = @_;
  277.     my $length = $decoder->pop_stack();
  278.  
  279.     # .{$length} has a limit on length
  280.     # $decoder->{buffer} =~ s/^"(.{$length})";//s or $decoder->weird;
  281.     my $value = substr($decoder->{buffer}, 0, $length + 3, "");
  282.     $value =~ s/^"// and $value =~ s/";$// or $decoder->weird;
  283.     $decoder->process_value($value);
  284. }
  285.  
  286. package PHP::Session::Serializer::PHP::State::ArrayStart;
  287.  
  288. sub parse {
  289.     my($self, $decoder) = @_;
  290.     $decoder->{buffer} =~ s/^{// or $decoder->weird;
  291.     if ($decoder->elements_count) {
  292.     $decoder->change_state('VarType');
  293.     } else {
  294.     $decoder->process_value(undef, 1);
  295.     }
  296. }
  297.  
  298. package PHP::Session::Serializer::PHP::State::ArrayEnd;
  299.  
  300. sub parse {
  301.     my($self, $decoder) = @_;
  302.     $decoder->{buffer} =~ s/^}// or $decoder->weird;
  303.     my $next_state = $decoder->in_array() ? 'VarType' : 'VarName';
  304.     $decoder->change_state($next_state);
  305. }
  306.  
  307. package PHP::Session::Serializer::PHP::State::ClassName;
  308.  
  309. sub parse {
  310.     my($self, $decoder) = @_;
  311.     my $length = $decoder->pop_stack();
  312. #    $decoder->{buffer} =~ s/^"(.{$length})":(\d+):// or $decoder->weird;
  313.     my $value = substr($decoder->{buffer}, 0, $length + 3, "");
  314.     $value =~ s/^"// and $value =~ s/":$// or $decoder->weird;
  315.     $decoder->{buffer} =~ s/^(\d+):// or $decoder->weird;
  316.     $decoder->start_array($1, $value); # $length, $class
  317.     $decoder->change_state('ArrayStart');
  318. }
  319.  
  320.  
  321. 1;
  322. __END__
  323.  
  324. =head1 NAME
  325.  
  326. PHP::Session::Serializer::PHP - serialize / deserialize PHP session data
  327.  
  328. =head1 SYNOPSIS
  329.  
  330.   use PHP::Session::Serializer::PHP;
  331.  
  332.   $serializer = PHP::Session::Serializer::PHP->new;
  333.  
  334.   $enc     = $serializer->encode(\%data);
  335.   $hashref = $serializer->decode($enc);
  336.  
  337. =head1 TODO
  338.  
  339. =over 4
  340.  
  341. =item *
  342.  
  343. Add option to restore PHP object as is.
  344.  
  345. =item *
  346.  
  347. Get back PHP array as Perl array?
  348.  
  349. =back
  350.  
  351. =head1 AUTHOR
  352.  
  353. Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
  354.  
  355. This library is free software; you can redistribute it and/or modify
  356. it under the same terms as Perl itself.
  357.  
  358. =head1 SEE ALSO
  359.  
  360. L<PHP::Session>
  361.  
  362. =cut
  363.  
  364.