@@ -1,4 +1,96 @@
Revision history for Perl extension PHP::Session
+0.25 Tue Aug 23 22:13:33 UTC 2005
+ - Documentation improvement
+ http://www.perlmonks.org/?node_id=429647
+
+0.24 Thu Jul 6 20:21:24 PDT 2005
+ - Addded 'R' and 'r' decoding (reference count?)
+ (Thanks to Carl Stehle)
+
+0.23 Thu Apr 14 10:28:06 JST 2005
+ - Added binmode $handle for Win32 platform
+ (Thanks to Carl Stehle)
+
+0.22 Sun Oct 5 05:33:32 JST 2003
+ * Fixed bug that it fails to decode strings longer than 32766 bytes
+ (https://rt.cpan.org/Ticket/Display.html?id=3970)
+
+0.21 Wed Oct 1 08:19:55 JST 2003
+ * Fixed bug that it decodes "0123" as integer 123.
+ (https://rt.cpan.org/Ticket/Display.html?id=3917)
+
+0.20 Tue Apr 15 13:15:36 JST 2003
+ - Minor pod fix
+ * Fixed bug which fails to decode session data with "\n" in it
+ (Thanks to Andy Lester)
+
+0.19 Tue Feb 25 19:21:10 JST 2003
+ - Optimized decoder using static method
+
+0.18 Tue Feb 25 18:42:40 JST 2003
+ - Fixed test failures due to 5.8 MakeMaker bug (warnings disabled by default)
+
+0.17 Tue Feb 25 16:43:05 JST 2003
+ * Fixed bug that fails to decode strings with "}" in it
+ This has made me rewrite decoder code from scratch!
+ * Fixed bug in object encoding
+
+0.16 Mon Feb 24 20:35:20 JST 2003
+ * Fixed bug that encodes strings like "20030224203445" as integer
+ (Thanks to PIA)
+ * Fixed parser bug that string like qq(A\";B) is not restored correctly
+
+0.15 Tue Jan 28 23:22:38 JST 2003
+ * Added new auto_save option in constructor
+
+0.14 Wed Sep 18 17:02:16 JST 2002
+ * Fixed bug that "." is not encoded properly
+ (Thanks to Tony Mattila)
+
+0.13 Tue Jul 16 19:35:58 JST 2002
+ - improved documentation
+
+0.12 Tue Jul 16 17:04:46 JST 2002
+ * Fixed bug in double serialization
+ * Fixed bug in double/string/int detection of Perl scalar
+ (Thanks to Pasha Sadri, Thai Tran and Vincent C. Rubino)
+
+0.11 Wed Jul 10 05:23:19 JST 2002
+ * Fixed bug in hash/array serialization
+ (Thanks to Pasha Sadri and Thai Tran)
+
+0.10 Mon Jul 1 18:26:54 JST 2002
+ * correctly encode/decode undefined value in PHP
+ (Thanks to Lupe Christoph)
+
+0.09 Fri Jun 28 04:26:31 JST 2002
+ * Fixed bug in newline handling
+ (Thanks to Lupe Christoph)
+
+0.08 Tue Jun 4 00:08:40 JST 2002
+ * now this module can create session file, with { create => 1 } option
+ (Thanks to Andy Lester and Thomas Eibner)
+
+0.07 Sat Apr 6 17:44:38 JST 2002
+ - uses File::Spec for portablity
+
+0.06 Wed Mar 27 01:57:06 JST 2002
+ * exposed Serializer API
+ * Added encoding: Perl array => PHP array
+
+0.05 Mon Mar 18 16:36:27 JST 2002
+ * added Boolean type (ext/var.h in PHP source code)
+
+0.04 Fri Mar 15 16:14:32 JST 2002
+ * added destroy()
+
+0.03 Fri Mar 15 16:01:35 JST 2002
+ * added session ID validation
+ * implemented save()
+
+0.02 Thu Mar 14 04:37:39 JST 2002
+ - added UNIVERSAL::require as PREREQ_PM
+
0.01 Wed Mar 13 15:54:53 2002
- original version
@@ -1,9 +1,25 @@
Changes
-MANIFEST
-Makefile.PL
-README
lib/PHP/Session.pm
lib/PHP/Session/Serializer/PHP.pm
+Makefile.PL
+MANIFEST
+META.yml Module meta-data (added by MakeMaker)
+README
t/00_compile.t
t/01_deserialize.t
+t/02_validate.t
+t/03_methods.t
+t/04_save.t
+t/05_create.t
+t/06_hash.t
+t/07_int_double.t
+t/08_auto_save.t
+t/09_int_str.t
+t/10_quote.t
+t/11_bracket.t
+t/12_newline.t
+t/13_length.t
t/lib/TestUtil.pm
+t/sess_bracket
+t/sess_newline
+t/sess_quote
@@ -0,0 +1,12 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: PHP-Session
+version: 0.25
+version_from: lib/PHP/Session.pm
+installdirs: site
+requires:
+ Test::More: 0.32
+ UNIVERSAL::require: 0.03
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.27
@@ -4,6 +4,6 @@ WriteMakefile(
'VERSION_FROM' => 'lib/PHP/Session.pm', # finds $VERSION
'PREREQ_PM' => {
Test::More => 0.32,
- Text::Balanced => 1.89,
+ UNIVERSAL::require => 0.03,
},
);
@@ -20,21 +20,72 @@ SYNOPSIS
$session->unset;
# check if data is registered
- $session->is_registerd('bar');
+ $session->is_registered('bar');
- # save session data (*UNIMPLEMENTED*)
+ # save session data
$session->save;
+ # destroy session
+ $session->destroy;
+
+ # create session file, if not existent
+ $session = PHP::Session->new($new_sid, { create => 1 });
+
DESCRIPTION
PHP::Session provides a way to read / write PHP4 session files, with
- which you can make your Perl applicatiion session shared with PHP4.
+ which you can make your Perl application session shared with PHP4.
-TODO
- * saving session data into file is UNIMPLEMENTED.
+ If you like Apache::Session interface for session management, there is a
+ glue for Apache::Session of this module, Apache::Session::PHP.
- * WDDX support, using WDDX.pm
+OPTIONS
+ Constructor "new" takes some options as hashref.
+
+ save_path
+ path to directory where session files are stored. default: "/tmp".
+
+ serialize_handler
+ type of serialization handler. Currently only PHP default
+ serialization is supported.
+
+ create
+ whether to create session file, if it's not existent yet. default: 0
+
+ auto_save
+ whether to save modification to session file automatically. default:
+ 0
+
+ Consider cases like this:
+
+ my $session = PHP::Session->new($sid, { auto_save => 1 });
+ $session->param(foo => 'bar');
- * "Apache::Session::PHP"
+ # Oops, you forgot save() method!
+
+ If you set "auto_save" to true value and when you forget to call
+ "save" method after parameter modification, this module would save
+ session file automatically when session object goes out of scope.
+
+ If you set it to 0 (default) and turn warnings on, this module would
+ give you a warning like:
+
+ PHP::Session: some keys are changed but not modified.
+
+NOTES
+ * Array in PHP is hash in Perl.
+
+ * Objects in PHP are restored as objects blessed into
+ PHP::Session::Object (Null class) and original class name is stored
+ in "_class" key.
+
+ * Locking when save()ing data is acquired via exclusive "flock", same
+ as PHP implementation.
+
+ * Not tested so much, thus there may be some bugs in
+ (des|s)erialization code. If you find any, tell me via email.
+
+TODO
+ * WDDX support, using WDDX.pm
AUTHOR
Tatsuhiko Miyagawa <miyagawa@bulknews.net>
@@ -43,5 +94,6 @@ AUTHOR
under the same terms as Perl itself.
SEE ALSO
- the WDDX manpage, the Apache::Session manpage
+ the Apache::Session::PHP manpage, the WDDX manpage, the Apache::Session
+ manpage, the CGI::kSession manpage
@@ -1,84 +1,324 @@
package PHP::Session::Serializer::PHP;
+
use strict;
-use Text::Balanced qw(extract_bracketed);
+use vars qw($VERSION);
+$VERSION = 0.24;
+
+sub _croak { require Carp; Carp::croak(@_) }
sub new {
my $class = shift;
- bless { _data => {} }, $class;
+ bless {
+ buffer => undef,
+ data => {},
+ state => undef,
+ stack => [],
+ array => [], # array-ref of hash-ref
+ }, $class;
}
-my $var_re = '(\w+)\|';
-my $str_re = 's:\d+:"(.*?)"\;';
-my $int_re = 'i:(\d+);';
-my $dig_re = 'd:([\-\d\.]+);';
-my $arr_re = 'a:(\d+):';
-my $obj_re = 'O:\d+:"(.*?)":\d+:';
-my $nul_re = '(N);';
-
-use constant VARNAME => 0;
-use constant STRING => 1;
-use constant INTEGER => 2;
-use constant DIGIT => 3;
-use constant ARRAY => 4;
-use constant CLASSNAME => 5;
-use constant NULL => 6;
+# encoder starts here
-sub decode {
+sub encode {
my($self, $data) = @_;
- while ($data =~ s/^$var_re(?:$str_re|$int_re|$dig_re|$arr_re|$obj_re|$nul_re)//) {
- my @match = ($1, $2, $3, $4, $5, $6, $7);
- my @literal = grep defined, @match[STRING, INTEGER, DIGIT];
- @literal and $self->{_data}->{$match[VARNAME]} = $literal[0], next;
-
- if (defined $match[NULL]) {
- $self->{_data}->{$match[VARNAME]} = undef;
- next;
- }
+ my $body;
+ for my $key (keys %$data) {
+ if (defined $data->{$key}) {
+ $body .= "$key|" . $self->do_encode($data->{$key});
+ } else {
+ $body .= "!$key|";
+ }
+ }
+ return $body;
+}
- my $bracket = extract_bracketed($data, '{}');
- my %data = $self->do_decode($bracket);
- if (defined $match[ARRAY]) {
- $self->{_data}->{$match[VARNAME]} = \%data;
+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);
}
- elsif (defined $match[CLASSNAME]) {
- $self->{_data}->{$match[VARNAME]} = bless {
- _class => $match[CLASSNAME],
- %data,
- }, 'PHP::Session::Object';
+ else {
+ return $self->encode_string($value);
}
}
- return $self->{_data};
+ 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 do_decode {
+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/^{(.*)}$/$1/;
- my @data;
- while ($data =~ s/^($str_re|$int_re|$dig_re|$arr_re|$obj_re)//) {
- my @match = ($1, $2, $3, $4, $5, $6, $7);
- my @literal = grep defined, @match[STRING, INTEGER, DIGIT];
- @literal and push @data, $literal[0] and next;
-
- if (defined $match[NULL]) {
- push @data, undef;
- next;
- }
+ $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::PHP::State::$state"; # optimization
+# $self->{state} = PHP::Session::Serializer::PHP::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];
+}
- my $bracket = extract_bracketed($data, '{}');
- my %data = $self->do_decode($bracket);
- if (defined $match[ARRAY]) {
- push @data, \%data;
+sub process_value {
+ my($self, $value, $empty_skip) = @_;
+ if ($self->in_array()) {
+ unless ($empty_skip) {
+ $self->push_stack($value);
+ $self->consume_array();
}
- elsif (defined $match[CLASSNAME]) {
- push @data, bless {
- _class => $match[CLASSNAME],
- %data,
- }, 'PHP::Session::Object';
+ 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');
}
}
- return @data;
+ 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::PHP::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::PHP::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);
+ }
+}
+
+package PHP::Session::Serializer::PHP::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::PHP::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::PHP::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::PHP::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__
@@ -88,7 +328,12 @@ PHP::Session::Serializer::PHP - serialize / deserialize PHP session data
=head1 SYNOPSIS
-B<DO NOT USE THIS MODULE DIRECTLY>.
+ use PHP::Session::Serializer::PHP;
+
+ $serializer = PHP::Session::Serializer::PHP->new;
+
+ $enc = $serializer->encode(\%data);
+ $hashref = $serializer->decode($enc);
=head1 TODO
@@ -96,7 +341,11 @@ B<DO NOT USE THIS MODULE DIRECTLY>.
=item *
-clean up the code!
+Add option to restore PHP object as is.
+
+=item *
+
+Get back PHP array as Perl array?
=back
@@ -2,23 +2,28 @@ package PHP::Session;
use strict;
use vars qw($VERSION);
-$VERSION = 0.01;
+$VERSION = 0.25;
use vars qw(%SerialImpl);
%SerialImpl = (
php => 'PHP::Session::Serializer::PHP',
);
+use Fcntl qw(:flock);
use FileHandle;
+use File::Spec;
use UNIVERSAL::require;
sub _croak { require Carp; Carp::croak(@_) }
+sub _carp { require Carp; Carp::carp(@_) }
sub new {
my($class, $sid, $opt) = @_;
my %default = (
save_path => '/tmp',
serialize_handler => 'php',
+ create => 0,
+ auto_save => 0,
);
$opt ||= {};
my $self = bless {
@@ -26,7 +31,9 @@ sub new {
%$opt,
_sid => $sid,
_data => {},
+ _changed => 0,
}, $class;
+ $self->_validate_sid;
$self->_parse_session;
return $self;
}
@@ -42,6 +49,7 @@ sub get {
sub set {
my($self, $key, $value) = @_;
+ $self->{_changed}++;
$self->{_data}->{$key} = $value;
}
@@ -60,23 +68,60 @@ sub is_registered {
return exists $self->{_data}->{$key};
}
+sub decode {
+ my($self, $data) = @_;
+ $self->serializer->decode($data);
+}
+
+sub encode {
+ my($self, $data) = @_;
+ $self->serializer->encode($data);
+}
+
sub save {
- die 'UNIMPLEMENTED';
+ my $self = shift;
+ my $handle = FileHandle->new("> " . $self->_file_path)
+ or _croak("can't write session file: $!");
+ flock $handle, LOCK_EX;
+ $handle->print($self->encode($self->{_data}));
+ $handle->close;
+ $self->{_changed} = 0; # init
+}
+
+sub destroy {
+ my $self = shift;
+ unlink $self->_file_path;
+}
+
+sub DESTROY {
+ my $self = shift;
+ if ($self->{_changed}) {
+ if ($self->{auto_save}) {
+ $self->save;
+ } else {
+ _carp("PHP::Session: some keys are changed but not saved.") if $^W;
+ }
+ }
}
# private methods
+sub _validate_sid {
+ my $self = shift;
+ my($id) = $self->id =~ /^([0-9a-zA-Z]*)$/; # untaint
+ defined $id or _croak("Invalid session id: ", $self->id);
+ $self->{_sid} = $id;
+}
+
sub _parse_session {
my $self = shift;
my $cont = $self->_slurp_content;
+ if (!$cont && !$self->{create}) {
+ _croak($self->_file_path, ": $!");
+ }
$self->{_data} = $self->decode($cont);
}
-sub decode {
- my($self, $data) = @_;
- $self->serializer->decode($data);
-}
-
sub serializer {
my $self = shift;
my $impl = $SerialImpl{$self->{serialize_handler}};
@@ -86,13 +131,13 @@ sub serializer {
sub _file_path {
my $self = shift;
- return $self->{save_path} . '/sess_' . $self->id;
+ return File::Spec->catfile($self->{save_path}, 'sess_' . $self->id);
}
sub _slurp_content {
my $self = shift;
- my $handle = FileHandle->new($self->_file_path)
- or _croak("session file not found: $!");
+ my $handle = FileHandle->new($self->_file_path) or return;
+ binmode $handle;
local $/ = undef;
return scalar <$handle>;
}
@@ -124,31 +169,120 @@ PHP::Session - read / write PHP session files
$session->unset;
# check if data is registered
- $session->is_registerd('bar');
+ $session->is_registered('bar');
- # save session data (*UNIMPLEMENTED*)
+ # save session data
$session->save;
+ # destroy session
+ $session->destroy;
+
+ # create session file, if not existent
+ $session = PHP::Session->new($new_sid, { create => 1 });
+
=head1 DESCRIPTION
PHP::Session provides a way to read / write PHP4 session files, with
-which you can make your Perl applicatiion session shared with PHP4.
+which you can make your Perl application session shared with PHP4.
-=head1 TODO
+If you like Apache::Session interface for session management, there is
+a glue for Apache::Session of this module, Apache::Session::PHP.
+
+=head1 OPTIONS
+
+Constructor C<new> takes some options as hashref.
+
+=over 4
+
+=item save_path
+
+path to directory where session files are stored. default: C</tmp>.
+
+=item serialize_handler
+
+type of serialization handler. Currently only PHP default
+serialization is supported.
+
+=item create
+
+whether to create session file, if it's not existent yet. default: 0
+
+=item auto_save
+
+whether to save modification to session file automatically. default: 0
+
+Consider cases like this:
+
+ my $session = PHP::Session->new($sid, { auto_save => 1 });
+ $session->set(foo => 'bar');
+
+ # Oops, you forgot save() method!
+
+If you set C<auto_save> to true value and when you forget to call
+C<save> method after parameter modification, this module would save
+session file automatically when session object goes out of scope.
+
+If you set it to 0 (default) and turn warnings on, this module would
+give you a warning like:
+
+ PHP::Session: some keys are changed but not modified.
+
+=back
+
+=head1 EXAMPLE
+
+ use strict;
+ use PHP::Session;
+ use CGI::Lite;
+ my $session_name = 'PHPSESSID'; # change this if needed
+
+ print "Content-type: text/plain\n\n";
+
+ my $cgi = new CGI::Lite;
+
+ my $cookies = $cgi->parse_cookies;
+ if ($cookies->{$session_name}) {
+ my $session = PHP::Session->new($cookies->{$session_name});
+ # now, try to print uid variable from PHP session
+ print "uid:",Dumper($session->get('uid'));
+ } else {
+ print "can't find session cookie $session_name";
+ }
+
+
+=head1 NOTES
=over 4
=item *
-saving session data into file is B<UNIMPLEMENTED>.
+Array in PHP is hash in Perl.
=item *
-WDDX support, using WDDX.pm
+Objects in PHP are restored as objects blessed into
+PHP::Session::Object (Null class) and original class name is stored in
+C<_class> key.
+
+=item *
+
+Locking when save()ing data is acquired via exclusive C<flock>, same as
+PHP implementation.
+
+=item *
+
+Not tested so much, thus there may be some bugs in
+(des|s)erialization code. If you find any, tell me via email.
+
+=back
+
+=head1 TODO
+
+=over 4
=item *
-C<Apache::Session::PHP>
+WDDX support, using WDDX.pm
=back
@@ -161,6 +295,6 @@ it under the same terms as Perl itself.
=head1 SEE ALSO
-L<WDDX>, L<Apache::Session>
+L<Apache::Session::PHP>, L<WDDX>, L<Apache::Session>, L<CGI::kSession>
=cut
@@ -1,5 +1,5 @@
use strict;
-use Test::More tests => 22;
+use Test::More tests => 24;
use lib 't/lib';
use TestUtil;
@@ -7,7 +7,7 @@ use TestUtil;
use PHP::Session;
chomp(my $sess = <<'SESSION');
-baz|O:3:"foo":2:{s:3:"bar";s:2:"ok";s:3:"yes";s:4:"done";}arr|a:1:{i:3;O:3:"foo":2:{s:3:"bar";s:2:"ok";s:3:"yes";s:4:"done";}}
+baz|O:3:"foo":2:{s:3:"bar";s:2:"ok";s:3:"yes";s:4:"done";}arr|a:1:{i:3;O:3:"foo":2:{s:3:"bar";s:2:"ok";s:3:"yes";s:4:"done";}}!foo|
SESSION
;
@@ -31,10 +31,13 @@ write_file('t/sess_1234', $sess);
is $arr->{3}->{_class}, 'foo';
is $arr->{3}->{bar}, 'ok';
is $arr->{3}->{yes}, 'done';
+ $session->destroy;
+
+ is $session->get('foo'), undef, 'foo is undef';
}
chomp(my $sess2 = <<'SESSION');
-count|i:2;c|i:12;a|a:4:{i:1;s:3:"foo";i:2;O:3:"baz":0:{}i:3;s:3:"bar";i:4;d:-1.2;}d|N;
+count|i:2;c|i:12;!foo|a|a:4:{i:1;s:3:"foo";i:2;O:3:"baz":0:{}i:3;s:3:"bar";i:4;d:-1.2;}d|N;
SESSION
;
write_file('t/sess_abcd', $sess2);
@@ -47,6 +50,8 @@ write_file('t/sess_abcd', $sess2);
is $session->get('count'), 2;
is $session->get('c'), 12;
+ is $session->get('foo'), undef, 'foo is undef';
+
my $arr = $session->get('a');
is ref($arr), 'HASH';
is $arr->{1}, 'foo';
@@ -55,6 +60,7 @@ write_file('t/sess_abcd', $sess2);
is $arr->{3}, 'bar';
is $arr->{4}, -1.2;
is $arr->{d}, undef;
+ $session->destroy;
}
-END { unlink $_ for ('t/sess_1234', 't/sess_abcd'); }
+
@@ -0,0 +1,10 @@
+use strict;
+use Test::More tests => 1;
+
+use PHP::Session;
+
+eval {
+ my $session = PHP::Session->new('---');
+ fail 'no exception';
+};
+like $@, qr/Invalid/;
@@ -0,0 +1,28 @@
+use strict;
+use Test::More tests => 4;
+
+use lib 't/lib';
+use TestUtil;
+
+use PHP::Session;
+
+chomp(my $sess = <<'SESSION');
+baz|O:3:"foo":2:{s:3:"bar";s:2:"ok";s:3:"yes";s:4:"done";}arr|a:1:{i:3;O:3:"foo":2:{s:3:"bar";s:2:"ok";s:3:"yes";s:4:"done";}}
+SESSION
+ ;
+
+write_file('t/sess_1234', $sess);
+
+{
+ my $session = PHP::Session->new('1234', { save_path => 't' });
+ isa_ok $session, 'PHP::Session';
+
+ $session->unregister('foo');
+ is $session->get('foo'), undef, 'unregister';
+
+ ok $session->is_registered('baz'), 'is_registered';
+ $session->unset;
+ is_deeply $session->{_data}, {}, '_data is an empty hash';
+}
+
+END { unlink $_ for ('t/sess_1234'); }
@@ -0,0 +1,39 @@
+use strict;
+use Test::More tests => 2;
+
+use lib 't/lib';
+use TestUtil;
+
+use PHP::Session;
+
+my @sessions;
+
+chomp(my $sess = <<'SESSION');
+baz|O:3:"foo":2:{s:3:"bar";s:2:"ok";s:3:"yes";s:4:"done";}arr|a:1:{i:3;O:3:"foo":2:{s:3:"bar";s:2:"ok";s:3:"yes";s:4:"done";}}!foo|
+SESSION
+ ;
+
+push @sessions, {
+ sid => '1234',
+ cont => $sess,
+};
+
+chomp(my $sess2 = <<'SESSION');
+count|i:2;c|i:12;!foo|a|a:4:{i:1;s:3:"foo";i:2;O:3:"baz":0:{}i:3;s:3:"bar";i:4;d:-1.2;}d|N;
+SESSION
+ ;
+
+push @sessions, {
+ sid => 'abcd',
+ cont => $sess,
+};
+
+for my $session (@sessions) {
+ my $filename = "t/sess_" . $session->{sid};
+ write_file($filename, $session->{cont});
+ my $php = PHP::Session->new($session->{sid}, { save_path => 't' });
+ $php->save;
+ my $php2 = PHP::Session->new($session->{sid}, { save_path => 't' });
+ is_deeply $php, $php2;
+ $php->destroy;
+}
@@ -0,0 +1,27 @@
+use strict;
+use Test::More tests => 3;
+
+use lib 't/lib';
+use TestUtil;
+
+use PHP::Session;
+
+{
+ eval { my $php = PHP::Session->new("abcd", { save_path => 't' }); };
+ ok $@, $@;
+}
+
+{
+ my $php = PHP::Session->new("abcd", { save_path => 't', create => 1 });
+ $php->set(foo => "bar");
+ $php->save;
+ ok( -e "t/sess_abcd", "create");
+}
+
+{
+ my $php = PHP::Session->new("abcd", { save_path => 't' });
+ is $php->get('foo'), 'bar';
+}
+
+unlink 't/sess_abcd';
+
@@ -0,0 +1,25 @@
+use strict;
+use Test::More tests => 4;
+
+use lib 't/lib';
+use TestUtil;
+
+use PHP::Session;
+
+{
+ my $session = PHP::Session->new('1234', { save_path => 't', create => 1 });
+ $session->set(foo => { hi => 'there' });
+ $session->save;
+ ok(-e "t/sess_1234", 'session created');
+}
+
+my $cont = read_file('t/sess_1234');
+is $cont, q(foo|a:1:{s:2:"hi";s:5:"there";}), 'session created: a=1';
+
+{
+ my $session = PHP::Session->new('1234', { save_path => 't' });
+ my $data = $session->get('foo');
+ is ref($data), 'HASH';
+ is_deeply $data, { hi => 'there' };
+ $session->destroy;
+}
@@ -0,0 +1,31 @@
+use strict;
+use Test::More tests => 8;
+
+use lib 't/lib';
+use TestUtil;
+
+use PHP::Session;
+
+{
+ my $session = PHP::Session->new('1234', { save_path => 't', create => 1 });
+ $session->set(foo => '-2');
+ $session->set(bar => '-2.1');
+ $session->set(baz => '2-1');
+ $session->set(dot => '.');
+ $session->save;
+ ok(-e "t/sess_1234", 'session created');
+}
+
+my $cont = read_file('t/sess_1234');
+like $cont, qr/foo\|i:-2/;
+like $cont, qr/bar\|d:-2\.1/;
+like $cont, qr/baz\|s:3:"2-1"/;
+
+{
+ my $session = PHP::Session->new('1234', { save_path => 't' });
+ is $session->get('foo'), -2;
+ is $session->get('bar'), -2.1;
+ is $session->get('baz'), '2-1';
+ is $session->get('dot'), '.';
+ $session->destroy;
+}
@@ -0,0 +1,47 @@
+use PHP::Session;
+use Test::More tests => 4;
+
+local $^W = 1; # for 5.8 MakeMaker bug
+
+my $warn;
+$SIG{__WARN__} = sub { $warn .= "@_" };
+
+{
+ my $sess = PHP::Session->new("foobar", {
+ save_path => 't', create => 1,
+ });
+ $sess->set(foo => 'foo');
+}
+
+like $warn, qr/PHP::Session: some keys are changed but not saved/, 'warnings';
+undef $warn;
+
+
+{
+ my $sess = PHP::Session->new("foobar", {
+ save_path => 't', create => 1,
+ });
+ $sess->set(foo => 'foo');
+ $sess->save;
+}
+
+is $warn, undef, 'no warnings';
+
+{
+ my $sess = PHP::Session->new("foobar", {
+ save_path => 't',
+ auto_save => 1,
+ });
+ $sess->set(bar => 'baz');
+}
+
+is $warn, undef, 'no warnings here';
+
+{
+ my $sess = PHP::Session->new("foobar", {
+ save_path => 't',
+ auto_save => 1,
+ });
+ is $sess->get('bar'), 'baz', 'bar is baz: saved';
+ $sess->destroy();
+}
@@ -0,0 +1,25 @@
+use strict;
+use Test::More tests => 5;
+
+use lib 't/lib';
+use TestUtil;
+
+use PHP::Session;
+
+my $sid = "12345";
+
+my @tests = qw(20030224000000 012345 1.4 01.4 123545);
+
+for my $test (@tests) {
+ { my $session = PHP::Session->new($sid, { create => 1, save_path => 't' });
+ $session->set(text => $test);
+ $session->save(); }
+
+ { my $session = PHP::Session->new($sid, { save_path => 't' });
+ is $session->get('text'), $test, "testdata is $test";
+ $session->destroy(); }
+}
+
+
+
+
@@ -0,0 +1,12 @@
+use strict;
+use Test::More tests => 2;
+
+use PHP::Session;
+
+my $sid = "quote";
+my $save_path = "t";
+
+my $session = PHP::Session->new($sid, { save_path => $save_path });
+is $session->get('a')->{5}, -200;
+is $session->get('a')->{6}, "B\";'z";
+
@@ -0,0 +1,12 @@
+use strict;
+use Test::More tests => 1;
+
+use PHP::Session;
+
+my $sid = "bracket";
+my $save_path = "t";
+
+my $session = PHP::Session->new($sid, { save_path => $save_path });
+is $session->get('a')->{7}, "foo}bar";
+
+
@@ -0,0 +1,11 @@
+use strict;
+use Test::More tests => 1;
+
+use PHP::Session;
+
+my $sid = "newline";
+my $save_path = "t";
+
+my $session = PHP::Session->new($sid, { save_path => $save_path });
+is $session->get('data'), "foo\nbar";
+
@@ -0,0 +1,25 @@
+use strict;
+use Test::More tests => 2;
+
+use lib 't/lib';
+use TestUtil;
+
+use PHP::Session;
+
+my $sid = "12345";
+
+my @tests = ("a" x 32766, "a" x 32767);
+
+for my $test (@tests) {
+ { my $session = PHP::Session->new($sid, { create => 1, save_path => 't' });
+ $session->set(text => $test);
+ $session->save(); }
+
+ { my $session = PHP::Session->new($sid, { save_path => 't' });
+ is $session->get('text'), $test, "testdata is $test";
+ $session->destroy(); }
+}
+
+
+
+
@@ -8,13 +8,13 @@ use FileHandle;
sub write_file {
my($file, $cont) = @_;
- my $out = FileHandle->new("> $file");
+ my $out = FileHandle->new("> $file") or die "$file: $!";
$out->print($cont);
}
sub read_file {
my $file = shift;
- my $in = FileHandle->new($file);
+ my $in = FileHandle->new($file) or die "$file: $!";
local $/;
my $cont = <$in>;
return $cont;
@@ -0,0 +1 @@
+data|a:2:{s:2:"hi";s:3:"foo";s:3:"foo";s:3:"bar";}c|i:5;a|a:7:{i:1;s:3:"foo";i:2;O:3:"baz":0:{}i:3;s:3:"bar";i:4;d:-1.2;i:5;i:-200;i:6;s:5:"B";'z";i:7;s:7:"foo}bar";}d|N;!e|bool|b:0;!f|
\ No newline at end of file
@@ -0,0 +1,2 @@
+data|s:7:"foo
+bar";
\ No newline at end of file
@@ -0,0 +1 @@
+data|a:2:{s:2:"hi";s:3:"foo";s:3:"foo";s:3:"bar";}c|i:3;a|a:6:{i:1;s:3:"foo";i:2;O:3:"baz":0:{}i:3;s:3:"bar";i:4;d:-1.2;i:5;i:-200;i:6;s:5:"B";'z";}d|N;!e|bool|b:0;!f|
\ No newline at end of file