1
package CGI::Session::Serialize::default;
3
# $Id: default.pm 447 2008-11-01 03:46:08Z markstos $
8
use CGI::Session::ErrorHandler;
9
use Scalar::Util qw(blessed reftype refaddr);
11
use vars qw( %overloaded );
14
@CGI::Session::Serialize::default::ISA = ( "CGI::Session::ErrorHandler" );
15
$CGI::Session::Serialize::default::VERSION = '4.38';
19
my ($class, $data) = @_;
22
new Data::Dumper([$data], ["D"]);
30
# ;$D added to make certain we get our data structure back when we thaw
31
return $d->Dump() . ';$D';
35
my ($class, $string) = @_;
38
my ($safe_string) = $string =~ m/^(.*)$/s;
39
my $rv = Safe->new->reval( $safe_string );
41
return $class->set_error("thaw(): couldn't thaw. $@");
49
my @filter = __scan(shift);
52
# We allow the value assigned to a key to be undef.
53
# Hence the defined() test is not in the while().
56
defined(my $x = shift @filter) or next;
57
$seen{refaddr $x || ''}++ and next;
59
my $r = reftype $x or next;
61
# we use this form to make certain we have aliases
62
# to the values in %$x and not copies
63
push @filter, __scan(@{$x}{keys %$x});
64
} elsif ($r eq "ARRAY") {
65
push @filter, __scan(@$x);
66
} elsif ($r eq "SCALAR" || $r eq "REF") {
67
push @filter, __scan($$x);
72
# we need to do this because the values we get back from the safe compartment
73
# will have packages defined from the safe compartment's *main instead of
76
# $_ gets aliased to each value from @_ which are aliases of the values in
77
# the current data structure
80
if (overload::Overloaded($_)) {
81
my $address = refaddr $_;
83
# if we already rebuilt and reblessed this item, use the cached
84
# copy so our ds is consistent with the one we serialized
85
if (exists $overloaded{$address}) {
86
$_ = $overloaded{$address};
88
my $reftype = reftype $_;
89
if ($reftype eq "HASH") {
90
$_ = $overloaded{$address} = bless { %$_ }, ref $_;
91
} elsif ($reftype eq "ARRAY") {
92
$_ = $overloaded{$address} = bless [ @$_ ], ref $_;
93
} elsif ($reftype eq "SCALAR" || $reftype eq "REF") {
94
$_ = $overloaded{$address} = bless \do{my $o = $$_},ref $_;
96
croak "Do not know how to reconstitute blessed object of base type $reftype";
116
CGI::Session::Serialize::default - Default CGI::Session serializer
120
This library is used by CGI::Session driver to serialize session data before storing it in disk.
122
All the methods are called as class methods.
128
=item freeze($class, \%hash)
130
Receives two arguments. First is the class name, the second is the data to be serialized. Should return serialized string on success, undef on failure. Error message should be set using C<set_error()|CGI::Session::ErrorHandler/"set_error()">
132
=item thaw($class, $string)
134
Received two arguments. First is the class name, second is the I<frozen> data string. Should return thawed data structure on success, undef on failure. Error message should be set using C<set_error()|CGI::Session::ErrorHandler/"set_error()">
140
For support and licensing see L<CGI::Session|CGI::Session>