3
# $Id: Session.pm 456 2009-01-03 01:16:43Z markstos $
7
use CGI::Session::ErrorHandler;
9
@CGI::Session::ISA = qw( CGI::Session::ErrorHandler );
10
$CGI::Session::VERSION = '4.40';
11
$CGI::Session::NAME = 'CGISESSID';
12
$CGI::Session::IP_MATCH = 0;
14
sub STATUS_UNSET () { 1 << 0 } # denotes session that's resetted
15
sub STATUS_NEW () { 1 << 1 } # denotes session that's just created
16
sub STATUS_MODIFIED () { 1 << 2 } # denotes session that needs synchronization
17
sub STATUS_DELETED () { 1 << 3 } # denotes session that needs deletion
18
sub STATUS_EXPIRED () { 1 << 4 } # denotes session that was expired.
21
my ($class, @args) = @_;
26
foreach my $arg (@args) {
27
if ($arg eq '-ip_match') {
28
$CGI::Session::IP_MATCH = 1;
35
my ($class, @args) = @_;
40
# Called as an object method as in $session->new()...
42
$self = bless { %$class }, ref( $class );
44
$self->_reset_status();
46
# Object may still have public data associated with it, but we
47
# don't care about that, since we want to leave that to the
48
# client's disposal. However, if new() was requested on an
49
# expired session, we already know that '_DATA' table is
50
# empty, since it was the job of flush() to empty '_DATA'
51
# after deleting. How do we know flush() was already called on
52
# an expired session? Because load() - constructor always
53
# calls flush() on all to-be expired sessions
58
# Called as a class method as in CGI::Session->new()
61
# Start fresh with error reporting. Errors in past objects shouldn't affect this one.
62
$class->set_error('');
64
$self = $class->load( @args );
65
if (not defined $self) {
66
return $class->set_error( "new(): failed: " . $class->errstr );
70
my $dataref = $self->{_DATA};
71
unless ($dataref->{_SESSION_ID}) {
73
# Absence of '_SESSION_ID' can only signal:
74
# * Expired session: Because load() - constructor is required to
75
# empty contents of _DATA - table
76
# * Unavailable session: Such sessions are the ones that don't
77
# exist on datastore, but are requested by client
78
# * New session: When no specific session is requested to be loaded
80
my $id = $self->_id_generator()->generate_id(
81
$self->{_DRIVER_ARGS},
84
unless (defined $id) {
85
return $self->set_error( "Couldn't generate new SESSION-ID" );
87
$dataref->{_SESSION_ID} = $id;
88
$dataref->{_SESSION_CTIME} = $dataref->{_SESSION_ATIME} = time();
89
$dataref->{_SESSION_REMOTE_ADDR} = $ENV{REMOTE_ADDR} || "";
90
$self->_set_status( STATUS_NEW );
95
sub DESTROY { $_[0]->flush() }
96
sub close { $_[0]->flush() }
98
*param_hashref = \&dataref;
99
my $avoid_single_use_warning = *param_hashref;
100
sub dataref { $_[0]->{_DATA} }
102
sub is_empty { !defined($_[0]->id) }
104
sub is_expired { $_[0]->_test_status( STATUS_EXPIRED ) }
106
sub is_new { $_[0]->_test_status( STATUS_NEW ) }
108
sub id { return defined($_[0]->dataref) ? $_[0]->dataref->{_SESSION_ID} : undef }
111
sub atime { return defined($_[0]->dataref) ? $_[0]->dataref->{_SESSION_ATIME} : undef }
114
sub ctime { return defined($_[0]->dataref) ? $_[0]->dataref->{_SESSION_CTIME} : undef }
118
defined($self->{_OBJECTS}->{driver}) and return $self->{_OBJECTS}->{driver};
119
my $pm = "CGI::Session::Driver::" . $self->{_DSN}->{driver};
120
defined($self->{_OBJECTS}->{driver} = $pm->new( $self->{_DRIVER_ARGS} ))
121
or die $pm->errstr();
122
return $self->{_OBJECTS}->{driver};
127
defined($self->{_OBJECTS}->{serializer}) and return $self->{_OBJECTS}->{serializer};
128
return $self->{_OBJECTS}->{serializer} = "CGI::Session::Serialize::" . $self->{_DSN}->{serializer};
134
defined($self->{_OBJECTS}->{id}) and return $self->{_OBJECTS}->{id};
135
return $self->{_OBJECTS}->{id} = "CGI::Session::ID::" . $self->{_DSN}->{id};
139
return ( $_[0]->{_DATA}->{_SESSION_REMOTE_ADDR} eq $ENV{REMOTE_ADDR} );
143
# parses the DSN string and returns it as a hash.
144
# Notably: Allows unique abbreviations of the keys: driver, serializer and 'id'.
145
# Also, keys and values of the returned hash are lower-cased.
149
croak "parse_dsn(): usage error" unless $dsn_str;
151
require Text::Abbrev;
152
my $abbrev = Text::Abbrev::abbrev( "driver", "serializer", "id" );
153
my %dsn_map = map { split /:/ } (split /;/, $dsn_str);
154
my %dsn = map { $abbrev->{lc $_}, lc $dsn_map{$_} } keys %dsn_map;
161
if ( $self->{_QUERY} ) {
162
return $self->{_QUERY};
164
# require CGI::Session::Query;
165
# return $self->{_QUERY} = CGI::Session::Query->new();
167
return $self->{_QUERY} = CGI->new();
176
return $self->{_NAME} || $CGI::Session::NAME;
178
return $self->{_NAME} = $_[0];
181
$CGI::Session::NAME = $_[0] if @_;
182
return $CGI::Session::NAME;
189
require Data::Dumper;
190
my $d = Data::Dumper->new([$self], [ref $self]);
198
croak "_set_status(): usage error" unless @_;
199
$self->{_STATUS} |= $_[0];
205
croak "_unset_status(): usage error" unless @_;
206
$self->{_STATUS} &= ~$_[0];
211
$_[0]->{_STATUS} = STATUS_UNSET;
215
return $_[0]->{_STATUS} & $_[1];
222
# Would it be better to die or err if something very basic is wrong here?
223
# I'm trying to address the DESTORY related warning
224
# from: http://rt.cpan.org/Ticket/Display.html?id=17541
225
# return unless defined $self;
227
return unless $self->id; # <-- empty session
229
# neither new, nor deleted nor modified
230
return if !defined($self->{_STATUS}) or $self->{_STATUS} == STATUS_UNSET;
232
if ( $self->_test_status(STATUS_NEW) && $self->_test_status(STATUS_DELETED) ) {
234
return $self->_unset_status(STATUS_NEW | STATUS_DELETED);
237
my $driver = $self->_driver();
238
my $serializer = $self->_serializer();
240
if ( $self->_test_status(STATUS_DELETED) ) {
241
defined($driver->remove($self->id)) or
242
return $self->set_error( "flush(): couldn't remove session data: " . $driver->errstr );
243
$self->{_DATA} = {}; # <-- removing all the data, making sure
244
# it won't be accessible after flush()
245
return $self->_unset_status(STATUS_DELETED);
248
if ( $self->_test_status(STATUS_NEW | STATUS_MODIFIED) ) {
249
my $datastr = $serializer->freeze( $self->dataref );
250
unless ( defined $datastr ) {
251
return $self->set_error( "flush(): couldn't freeze data: " . $serializer->errstr );
253
defined( $driver->store($self->id, $datastr) ) or
254
return $self->set_error( "flush(): couldn't store datastr: " . $driver->errstr);
255
$self->_unset_status(STATUS_NEW | STATUS_MODIFIED);
264
my ($self, @args) = @_;
266
if ($self->_test_status( STATUS_DELETED )) {
267
carp "param(): attempt to read/write deleted session";
270
# USAGE: $s->param();
271
# DESC: Returns all the /public/ parameters
273
return grep { !/^_SESSION_/ } keys %{ $self->{_DATA} };
275
# USAGE: $s->param( $p );
276
# DESC: returns a specific session parameter
278
return $self->{_DATA}->{ $args[0] }
282
# USAGE: $s->param( -name => $n, -value => $v );
283
# DESC: Updates session data using CGI.pm's 'named param' syntax.
284
# Only public records can be set!
286
my ($name, $value) = @args{ qw(-name -value) };
287
if (defined $name && defined $value) {
288
if ($name =~ m/^_SESSION_/) {
290
carp "param(): attempt to write to private parameter";
293
$self->_set_status( STATUS_MODIFIED );
294
return $self->{_DATA}->{ $name } = $value;
297
# USAGE: $s->param(-name=>$n);
298
# DESC: access to session data (public & private) using CGI.pm's 'named parameter' syntax.
299
return $self->{_DATA}->{ $args{'-name'} } if defined $args{'-name'};
301
# USAGE: $s->param($name, $value);
302
# USAGE: $s->param($name1 => $value1, $name2 => $value2 [,...]);
303
# DESC: updates one or more **public** records using simple syntax
304
if ((@args % 2) == 0) {
305
my $modified_cnt = 0;
307
while (my ($name, $val) = each %args) {
308
if ( $name =~ m/^_SESSION_/) {
309
carp "param(): attempt to write to private parameter";
312
$self->{_DATA}->{ $name } = $val;
315
$self->_set_status(STATUS_MODIFIED);
316
return $modified_cnt;
319
# If we reached this far none of the expected syntax were
320
# detected. Syntax error
321
croak "param(): usage error. Invalid syntax";
326
sub delete { $_[0]->_set_status( STATUS_DELETED ) }
329
*header = \&http_header;
330
my $avoid_single_use_warning_again = *header;
333
return $self->query->header(-cookie=>$self->cookie, -type=>'text/html', @_);
339
my $query = $self->query();
342
if ( $self->is_expired ) {
343
$cookie = $query->cookie( -name=>$self->name, -value=>$self->id, -expires=> '-1d', @_ );
345
elsif ( my $t = $self->expire ) {
346
$cookie = $query->cookie( -name=>$self->name, -value=>$self->id, -expires=> '+' . $t . 's', @_ );
349
$cookie = $query->cookie( -name=>$self->name, -value=>$self->id, @_ );
360
my ($query, $params) = @_;
362
$query ||= $self->query();
363
$params ||= [ $query->param ];
365
for my $p ( @$params ) {
366
my @values = $query->param($p) or next;
368
$self->param($p, \@values);
370
$self->param($p, $values[0]);
373
$self->_set_status( STATUS_MODIFIED );
380
my ($query, $params) = @_;
382
$query ||= $self->query();
383
$params ||= [ $self->param ];
386
$query->param(-name=>$_, -value=>$self->param($_));
395
if (defined $params) {
396
$params = [ $params ] unless ref $params;
399
$params = [ $self->param ];
402
for ( grep { ! /^_SESSION_/ } @$params ) {
403
delete $self->{_DATA}->{$_};
405
$self->_set_status( STATUS_MODIFIED );
411
my ($dsn, $coderef, $dsn_args);
417
# find( $dsn, \&code, \%dsn_args )
419
($dsn, $coderef, $dsn_args) = @_;
422
unless ( $coderef && ref($coderef) && (ref $coderef eq 'CODE') ) {
423
croak "find(): usage error.";
428
my $hashref = $class->parse_dsn( $dsn );
429
$driver = $hashref->{driver};
432
my $pm = "CGI::Session::Driver::" . ($driver =~ /(.*)/)[0];
434
if (my $errmsg = $@ ) {
435
return $class->set_error( "find(): couldn't load driver." . $errmsg );
438
my $driver_obj = $pm->new( $dsn_args );
439
unless ( $driver_obj ) {
440
return $class->set_error( "find(): couldn't create driver object. " . $pm->errstr );
443
my $dont_update_atime = 0;
444
my $driver_coderef = sub {
446
my $session = $class->load( $dsn, $sid, $dsn_args, $dont_update_atime );
447
unless ( $session ) {
448
return $class->set_error( "find(): couldn't load session '$sid'. " . $class->errstr );
450
$coderef->( $session );
453
defined($driver_obj->traverse( $driver_coderef ))
454
or return $class->set_error( "find(): traverse seems to have failed. " . $driver_obj->errstr );
458
# $Id: Session.pm 456 2009-01-03 01:16:43Z markstos $
464
CGI::Session - persistent session data in CGI applications
468
# Object initialization:
470
$session = new CGI::Session();
472
$CGISESSID = $session->id();
474
# Send proper HTTP header with cookies:
475
print $session->header();
477
# Storing data in the session:
478
$session->param('f_name', 'Sherzod');
480
$session->param(-name=>'l_name', -value=>'Ruzmetov');
482
# Flush the data from memory to the storage driver at least before your
483
# program finishes since auto-flushing can be unreliable.
487
my $f_name = $session->param('f_name');
489
my $l_name = $session->param(-name=>'l_name');
491
# Clearing a certain session parameter:
492
$session->clear(["l_name", "f_name"]);
494
# Expire '_is_logged_in' flag after 10 idle minutes:
495
$session->expire('is_logged_in', '+10m')
497
# Expire the session itself after 1 idle hour:
498
$session->expire('+1h');
500
# Delete the session for good:
502
$session->flush(); # Recommended practice says use flush() after delete().
506
CGI::Session provides an easy, reliable and modular session management system across HTTP requests.
510
Following is the overview of all the available methods accessible via CGI::Session object.
518
=head2 new( $dsn, $query||$sid )
520
=head2 new( $dsn, $query||$sid, \%dsn_args )
522
=head2 new( $dsn, $query||$sid, \%dsn_args, \%session_params )
524
Constructor. Returns new session object, or undef on failure. Error message is accessible through L<errstr() - class method|CGI::Session::ErrorHandler/errstr>. If called on an already initialized session will re-initialize the session based on already configured object. This is only useful after a call to L<load()|/"load">.
526
Can accept up to three arguments, $dsn - Data Source Name, $query||$sid - query object OR a string representing session id, and finally, \%dsn_args, arguments used by $dsn components.
528
If called without any arguments, $dsn defaults to I<driver:file;serializer:default;id:md5>, $query||$sid defaults to C<< CGI->new() >>, and C<\%dsn_args> defaults to I<undef>.
530
If called with a single argument, it will be treated either as C<$query> object, or C<$sid>, depending on its type. If argument is a string , C<new()> will treat it as session id and will attempt to retrieve the session from data store. If it fails, will create a new session id, which will be accessible through L<id() method|/"id">. If argument is an object, L<cookie()|CGI/cookie> and L<param()|CGI/param> methods will be called on that object to recover a potential C<$sid> and retrieve it from data store. If it fails, C<new()> will create a new session id, which will be accessible through L<id() method|/"id">. C<name()> will define the name of the query parameter and/or cookie name to be requested, defaults to I<CGISESSID>.
532
If called with two arguments first will be treated as $dsn, and second will be treated as $query or $sid or undef, depending on its type. Some examples of this syntax are:
534
$s = CGI::Session->new("driver:mysql", undef);
535
$s = CGI::Session->new("driver:sqlite", $sid);
536
$s = CGI::Session->new("driver:db_file", $query);
537
$s = CGI::Session->new("serializer:storable;id:incr", $sid);
540
Briefly, C<new()> will return an initialized session object with a valid id, whereas C<load()> may return
541
an empty session object with an undefined id.
543
Tests are provided (t/new_with_undef.t and t/load_with_undef.t) to clarify the result of calling C<new()> and C<load()>
544
with undef, or with an initialized CGI object with an undefined or fake CGISESSID.
546
You are strongly advised to run the old-fashioned 'make test TEST_FILES=t/new_with_undef.t TEST_VERBOSE=1'
547
or the new-fangled 'prove -v t/new_with_undef.t', for both new*.t and load*.t, and examine the output.
549
Following data source components are supported:
555
B<driver> - CGI::Session driver. Available drivers are L<file|CGI::Session::Driver::file>, L<db_file|CGI::Session::Driver::db_file>, L<mysql|CGI::Session::Driver::mysql> and L<sqlite|CGI::Session::Driver::sqlite>. Third party drivers are welcome. For driver specs consider L<CGI::Session::Driver|CGI::Session::Driver>
559
B<serializer> - serializer to be used to encode the data structure before saving
560
in the disk. Available serializers are L<storable|CGI::Session::Serialize::storable>, L<freezethaw|CGI::Session::Serialize::freezethaw> and L<default|CGI::Session::Serialize::default>. Default serializer will use L<Data::Dumper|Data::Dumper>.
564
B<id> - ID generator to use when new session is to be created. Available ID generator is L<md5|CGI::Session::ID::md5>
568
For example, to get CGI::Session store its data using DB_File and serialize data using FreezeThaw:
570
$s = new CGI::Session("driver:DB_File;serializer:FreezeThaw", undef);
572
If called with three arguments, first two will be treated as in the previous example, and third argument will be C<\%dsn_args>, which will be passed to C<$dsn> components (namely, driver, serializer and id generators) for initialization purposes. Since all the $dsn components must initialize to some default value, this third argument should not be required for most drivers to operate properly.
574
If called with four arguments, the first three match previous examples. The fourth argument must be a hash reference with parameters to be used by the CGI::Session object. (see \%session_params above )
576
The following is a list of the current keys:
582
B<name> - Name to use for the cookie/query parameter name. This defaults to CGISESSID. This can be altered or accessed by the C<name> accessor.
586
undef is acceptable as a valid placeholder to any of the above arguments, which will force default behavior.
590
=head2 load( $query||$sid )
592
=head2 load( $dsn, $query||$sid )
594
=head2 load( $dsn, $query, \%dsn_args )
596
=head2 load( $dsn, $query, \%dsn_args, \%session_params )
598
Accepts the same arguments as new(), and also returns a new session object, or
599
undef on failure. The difference is, L<new()|/"new"> can create a new session if
600
it detects expired and non-existing sessions, but C<load()> does not.
602
C<load()> is useful to detect expired or non-existing sessions without forcing the library to create new sessions. So now you can do something like this:
604
$s = CGI::Session->load() or die CGI::Session->errstr();
605
if ( $s->is_expired ) {
608
$cgi->p("Your session timed out! Refresh the screen to start new session!")
613
if ( $s->is_empty ) {
614
$s = $s->new() or die $s->errstr;
617
Notice: All I<expired> sessions are empty, but not all I<empty> sessions are expired!
619
Briefly, C<new()> will return an initialized session object with a valid id, whereas C<load()> may return
620
an empty session object with an undefined id.
622
Tests are provided (t/new_with_undef.t and t/load_with_undef.t) to clarify the result of calling C<new()> and C<load()>
623
with undef, or with an initialized CGI object with an undefined or fake CGISESSID.
625
You are strongly advised to run the old-fashioned 'make test TEST_FILES=t/new_with_undef.t TEST_VERBOSE=1'
626
or the new-fangled 'prove -v t/new_with_undef.t', for both new*.t and load*.t, and examine the output.
630
# pass a true value as the fourth parameter if you want to skip the changing of
631
# access time This isn't documented more formally, because it only called by
635
return $class->set_error( "called as instance method") if ref $class;
636
return $class->set_error( "Too many arguments provided to load()") if @_ > 5;
640
_SESSION_ID => undef,
641
_SESSION_CTIME => undef,
642
_SESSION_ATIME => undef,
643
_SESSION_REMOTE_ADDR => $ENV{REMOTE_ADDR} || "",
645
# Following two attributes may not exist in every single session, and declaring
646
# them now will force these to get serialized into database, wasting space. But they
647
# are here to remind the coder of their purpose
649
# _SESSION_ETIME => undef,
650
# _SESSION_EXPIRE_LIST => {}
652
_DSN => {}, # parsed DSN params
653
_OBJECTS => {}, # keeps necessary objects
654
_DRIVER_ARGS=> {}, # arguments to be passed to driver
655
_CLAIMED_ID => undef, # id **claimed** by client
656
_STATUS => STATUS_UNSET,# status of the session object
657
_QUERY => undef # query object
660
my ($dsn,$query_or_sid,$dsn_args,$update_atime,$params);
663
$self->_set_query_or_sid($_[0]);
665
# Two or more args passed:
666
# load($dsn, $query||$sid)
668
($dsn, $query_or_sid, $dsn_args,$update_atime) = @_;
670
# Make it backwards-compatible (update_atime is an undocumented key in %$params).
671
# In fact, update_atime as a key is not used anywhere in the code as yet.
672
# This patch is part of the patch for RT#33437.
673
if ( ref $update_atime and ref $update_atime eq 'HASH' ) {
674
$params = {%$update_atime};
675
$update_atime = $params->{'update_atime'};
677
if ($params->{'name'}) {
678
$self->{_NAME} = $params->{'name'};
682
# Since $update_atime is not part of the public API
683
# we ignore any value but the one we use internally: 0.
684
if (defined $update_atime and $update_atime ne '0') {
685
return $class->set_error( "Too many arguments to load(). First extra argument was: $update_atime");
688
if ( defined $dsn ) { # <-- to avoid 'Uninitialized value...' warnings
689
$self->{_DSN} = $self->parse_dsn($dsn);
691
$self->_set_query_or_sid($query_or_sid);
693
# load($dsn, $query, \%dsn_args);
695
$self->{_DRIVER_ARGS} = $dsn_args if defined $dsn_args;
699
$self->_load_pluggables();
701
# Did load_pluggable fail? If so, return undef, just like $class->set_error() would
702
return undef if $class->errstr;
704
if (not defined $self->{_CLAIMED_ID}) {
705
my $query = $self->query();
707
$self->{_CLAIMED_ID} = $query->cookie( $self->name ) || $query->param( $self->name );
709
if ( my $errmsg = $@ ) {
710
return $class->set_error( "query object $query does not support cookie() and param() methods: " . $errmsg );
714
# No session is being requested. Just return an empty session
715
return $self unless $self->{_CLAIMED_ID};
717
# Attempting to load the session
718
my $driver = $self->_driver();
719
my $raw_data = $driver->retrieve( $self->{_CLAIMED_ID} );
720
unless ( defined $raw_data ) {
721
return $self->set_error( "load(): couldn't retrieve data: " . $driver->errstr );
724
# Requested session couldn't be retrieved
725
return $self unless $raw_data;
727
my $serializer = $self->_serializer();
728
$self->{_DATA} = $serializer->thaw($raw_data);
729
unless ( defined $self->{_DATA} ) {
730
#die $raw_data . "\n";
731
return $self->set_error( "load(): couldn't thaw() data using $serializer:" .
732
$serializer->errstr );
734
unless (defined($self->{_DATA}) && ref ($self->{_DATA}) && (ref $self->{_DATA} eq 'HASH') &&
735
defined($self->{_DATA}->{_SESSION_ID}) ) {
736
return $self->set_error( "Invalid data structure returned from thaw()" );
739
# checking if previous session ip matches current ip
740
if($CGI::Session::IP_MATCH) {
741
unless($self->_ip_matches) {
742
$self->_set_status( STATUS_DELETED );
748
# checking for expiration ticker
749
if ( $self->{_DATA}->{_SESSION_ETIME} ) {
750
if ( ($self->{_DATA}->{_SESSION_ATIME} + $self->{_DATA}->{_SESSION_ETIME}) <= time() ) {
751
$self->_set_status( STATUS_EXPIRED | # <-- so client can detect expired sessions
752
STATUS_DELETED ); # <-- session should be removed from database
753
$self->flush(); # <-- flush() will do the actual removal!
758
# checking expiration tickers of individuals parameters, if any:
759
my @expired_params = ();
760
while (my ($param, $max_exp_interval) = each %{ $self->{_DATA}->{_SESSION_EXPIRE_LIST} } ) {
761
if ( ($self->{_DATA}->{_SESSION_ATIME} + $max_exp_interval) <= time() ) {
762
push @expired_params, $param;
765
$self->clear(\@expired_params) if @expired_params;
767
# We update the atime by default, but if this (otherwise undocoumented)
768
# parameter is explicitly set to false, we'll turn the behavior off
769
if ( ! defined $update_atime ) {
770
$self->{_DATA}->{_SESSION_ATIME} = time(); # <-- updating access time
771
$self->_set_status( STATUS_MODIFIED ); # <-- access time modified above
778
# set the input as a query object or session ID, depending on what it looks like.
779
sub _set_query_or_sid {
781
my $query_or_sid = shift;
782
if ( ref $query_or_sid){ $self->{_QUERY} = $query_or_sid }
783
else { $self->{_CLAIMED_ID} = $query_or_sid }
787
sub _load_pluggables {
792
serializer => "default",
797
serializer => "Serialize",
800
my $dsn = $self->{_DSN};
801
foreach my $plug qw(driver serializer id) {
802
my $mod_name = $dsn->{ $plug };
803
if (not defined $mod_name) {
804
$mod_name = $DEFAULT_FOR{ $plug };
806
if ($mod_name =~ /^(\w+)$/) {
808
# Looks good. Put it into the dsn hash
809
$dsn->{ $plug } = $mod_name = $1;
811
# Put together the actual module name to load
812
my $prefix = join '::', (__PACKAGE__, $SUBDIR_FOR{ $plug }, q{});
813
$mod_name = $prefix . $mod_name;
815
## See if we can load load it
816
eval "require $mod_name";
819
return $self->set_error("couldn't load $mod_name: " . $msg);
823
# do something here about bad name for a pluggable
833
Returns effective ID for a session. Since effective ID and claimed ID can differ, valid session id should always
834
be retrieved using this method.
838
=head2 param(-name=E<gt>$name)
840
Used in either of the above syntax returns a session parameter set to $name or undef if it doesn't exist. If it's called on a deleted method param() will issue a warning but return value is not defined.
842
=head2 param($name, $value)
844
=head2 param(-name=E<gt>$name, -value=E<gt>$value)
846
Used in either of the above syntax assigns a new value to $name parameter,
847
which can later be retrieved with previously introduced param() syntax. C<$value>
848
may be a scalar, arrayref or hashref.
850
Attempts to set parameter names that start with I<_SESSION_> will trigger
851
a warning and undef will be returned.
853
=head2 param_hashref()
855
B<Deprecated>. Use L<dataref()|/"dataref"> instead.
859
Returns reference to session's data table:
861
$params = $s->dataref();
862
$sid = $params->{_SESSION_ID};
863
$name= $params->{name};
866
Useful for having all session data in a hashref, but too risky to update.
870
=head2 save_param($query)
872
=head2 save_param($query, \@list)
874
Saves query parameters to session object. In other words, it's the same as calling L<param($name, $value)|/"param"> for every single query parameter returned by C<< $query->param() >>. The first argument, if present, should be either CGI object or any object which can provide param() method. If it's undef, defaults to the return value of L<query()|/"query">, which returns C<< CGI->new >>. If second argument is present and is a reference to an array, only those query parameters found in the array will be stored in the session. undef is a valid placeholder for any argument to force default behavior.
878
=head2 load_param($query)
880
=head2 load_param($query, \@list)
882
Loads session parameters into a query object. The first argument, if present, should be query object, or any other object which can provide param() method. If second argument is present and is a reference to an array, only parameters found in that array will be loaded to the query object.
886
=head2 clear('field')
890
Clears parameters from the session object.
892
With no parameters, all fields are cleared. If passed a single parameter or a
893
reference to an array, only the named parameters are cleared.
897
Synchronizes data in memory with the copy serialized by the driver. Call flush()
898
if you need to access the session from outside the current session object. You should
899
call flush() sometime before your program exits.
901
As a last resort, CGI::Session will automatically call flush for you just
902
before the program terminates or session object goes out of scope. Automatic
903
flushing has proven to be unreliable, and in some cases is now required
904
in places that worked with CGI::Session 3.x.
906
Always explicitly calling C<flush()> on the session before the
907
program exits is recommended. For extra safety, call it immediately after
908
every important session update.
910
Also see L<A Warning about Auto-flushing>
914
Read-only method. Returns the last access time of the session in seconds from epoch. This time is used internally while
915
auto-expiring sessions and/or session parameters.
919
Read-only method. Returns the time when the session was first created in seconds from epoch.
925
=head2 expire($param, $time)
927
Sets expiration interval relative to L<atime()|/"atime">.
929
If used with no arguments, returns the expiration interval if it was ever set. If no expiration was ever set, returns undef. For backwards compatibility, a method named C<etime()> does the same thing.
931
Second form sets an expiration time. This value is checked when previously stored session is asked to be retrieved, and if its expiration interval has passed, it will be expunged from the disk immediately. Passing 0 cancels expiration.
933
By using the third syntax you can set the expiration interval for a particular
934
session parameter, say I<~logged-in>. This would cause the library call clear()
935
on the parameter when its time is up. Note it only makes sense to set this value to
936
something I<earlier> than when the whole session expires. Passing 0 cancels expiration.
938
All the time values should be given in the form of seconds. Following keywords are also supported for your convenience:
940
+-----------+---------------+
942
+-----------+---------------+
950
+-----------+---------------+
954
$session->expire("2h"); # expires in two hours
955
$session->expire(0); # cancel expiration
956
$session->expire("~logged-in", "10m"); # expires '~logged-in' parameter after 10 idle minutes
958
Note: all the expiration times are relative to session's last access time, not to its creation time. To expire a session immediately, call L<delete()|/"delete">. To expire a specific session parameter immediately, call L<clear([$name])|/"clear">.
963
my $prevent_warning = \&expires;
964
sub etime { $_[0]->expire() }
968
# no params, just return the expiration time.
970
return $self->{_DATA}->{_SESSION_ETIME};
972
# We have just a time
975
# If 0 is passed, cancel expiration
976
if ( defined $time && ($time =~ m/^\d$/) && ($time == 0) ) {
977
$self->{_DATA}->{_SESSION_ETIME} = undef;
978
$self->_set_status( STATUS_MODIFIED );
980
# set the expiration to this time
982
$self->{_DATA}->{_SESSION_ETIME} = $self->_str2seconds( $time );
983
$self->_set_status( STATUS_MODIFIED );
986
# If we get this far, we expect expire($param,$time)
987
# ( This would be a great use of a Perl6 multi sub! )
989
my ($param, $time) = @_;
990
if ( ($time =~ m/^\d$/) && ($time == 0) ) {
991
delete $self->{_DATA}->{_SESSION_EXPIRE_LIST}->{ $param };
992
$self->_set_status( STATUS_MODIFIED );
994
$self->{_DATA}->{_SESSION_EXPIRE_LIST}->{ $param } = $self->_str2seconds( $time );
995
$self->_set_status( STATUS_MODIFIED );
1001
# =head2 _str2seconds()
1003
# my $secs = $self->_str2seconds('1d')
1005
# Takes a CGI.pm-style time representation and returns an equivalent number
1008
# See the docs of expire() for more detail.
1016
return unless defined $str;
1017
return $str if $str =~ m/^[-+]?\d+$/;
1029
my ($koef, $d) = $str =~ m/^([+-]?\d+)([smhdwMy])$/;
1030
unless ( defined($koef) && defined($d) ) {
1031
die "_str2seconds(): couldn't parse '$str' into \$koef and \$d parts. Possible invalid syntax";
1033
return $koef * $_map{ $d };
1041
Returns true only for a brand new session.
1045
Tests whether session initialized using L<load()|/"load"> is to be expired. This method works only on sessions initialized with load():
1047
$s = CGI::Session->load() or die CGI::Session->errstr;
1048
if ( $s->is_expired ) {
1049
die "Your session expired. Please refresh";
1051
if ( $s->is_empty ) {
1052
$s = $s->new() or die $s->errstr;
1058
Returns true for sessions that are empty. It's preferred way of testing whether requested session was loaded successfully or not:
1060
$s = CGI::Session->load($sid);
1061
if ( $s->is_empty ) {
1065
Actually, the above code is nothing but waste. The same effect could've been achieved by saying:
1067
$s = CGI::Session->new( $sid );
1069
L<is_empty()|/"is_empty"> is useful only if you wanted to catch requests for expired sessions, and create new session afterwards. See L<is_expired()|/"is_expired"> for an example.
1073
Sets the objects status to be "deleted". Subsequent read/write requests on the
1074
same object will fail. To physically delete it from the data store you need to call L<flush()>.
1075
CGI::Session attempts to do this automatically when the object is being destroyed (usually as
1076
the script exits), but see L<A Warning about Auto-flushing>.
1078
=head2 find( \&code )
1080
=head2 find( $dsn, \&code )
1082
=head2 find( $dsn, \&code, \%dsn_args )
1084
Experimental feature. Executes \&code for every session object stored in disk, passing initialized CGI::Session object as the first argument of \&code. Useful for housekeeping purposes, such as for removing expired sessions. Following line, for instance, will remove sessions already expired, but are still in disk:
1086
The following line, for instance, will remove sessions already expired, but which are still on disk:
1088
CGI::Session->find( sub {} );
1090
Notice, above \&code didn't have to do anything, because load(), which is called to initialize sessions inside find(), will automatically remove expired sessions. Following example will remove all the objects that are 10+ days old:
1092
CGI::Session->find( \&purge );
1095
next if $session->is_empty; # <-- already expired?!
1096
if ( ($session->ctime + 3600*240) <= time() ) {
1098
$session->flush(); # Recommended practice says use flush() after delete().
1102
B<Note>: find will not change the modification or access times on the sessions it returns.
1104
Explanation of the 3 parameters to C<find()>:
1110
This is the DSN (Data Source Name) used by CGI::Session to control what type of
1111
sessions you previously created and what type of sessions you now wish method
1112
C<find()> to pass to your callback.
1114
The default value is defined above, in the docs for method C<new()>, and is
1115
'driver:file;serializer:default;id:md5'.
1117
Do not confuse this DSN with the DSN arguments mentioned just below, under \%dsn_args.
1121
This is the callback provided by you (i.e. the caller of method C<find()>)
1122
which is called by CGI::Session once for each session found by method C<find()>
1123
which matches the given $dsn.
1125
There is no default value for this coderef.
1127
When your callback is actually called, the only parameter is a session. If you
1128
want to call a subroutine you already have with more parameters, you can
1129
achieve this by creating an anonymous subroutine that calls your subroutine
1130
with the parameters you want. For example:
1132
CGI::Session->find($dsn, sub { my_subroutine( @_, 'param 1', 'param 2' ) } );
1133
CGI::Session->find($dsn, sub { $coderef->( @_, $extra_arg ) } );
1135
Or if you wish, you can define a sub generator as such:
1137
sub coderef_with_args {
1138
my ( $coderef, @params ) = @_;
1139
return sub { $coderef->( @_, @params ) };
1142
CGI::Session->find($dsn, coderef_with_args( $coderef, 'param 1', 'param 2' ) );
1146
If your $dsn uses file-based storage, then this hashref might contain keys such as:
1149
Directory => Value 1,
1154
If your $dsn uses db-based storage, then this hashref contains (up to) 3 keys, and looks like:
1157
DataSource => Value 1,
1162
These 3 form the DSN, username and password used by DBI to control access to your database server,
1163
and hence are only relevant when using db-based sessions.
1165
The default value of this hashref is undef.
1169
B<Note:> find() is meant to be convenient, not necessarily efficient. It's best suited in cron scripts.
1171
=head1 MISCELLANEOUS METHODS
1173
=head2 remote_addr()
1175
Returns the remote address of the user who created the session for the first time. Returns undef if variable REMOTE_ADDR wasn't present in the environment when the session was created.
1179
sub remote_addr { return $_[0]->{_DATA}->{_SESSION_REMOTE_ADDR} }
1185
Class method. Returns last error message from the library.
1189
Returns a dump of the session object. Useful for debugging purposes only.
1193
Replacement for L<CGI.pm|CGI>'s header() method. Without this method, you usually need to create a CGI::Cookie object and send it as part of the HTTP header:
1195
$cookie = CGI::Cookie->new(-name=>$session->name, -value=>$session->id);
1196
print $cgi->header(-cookie=>$cookie);
1198
You can minimize the above into:
1200
print $session->header();
1202
It will retrieve the name of the session cookie from C<$session->name()> which defaults to C<$CGI::Session::NAME>. If you want to use a different name for your session cookie, do something like following before creating session object:
1204
CGI::Session->name("MY_SID");
1205
$session = new CGI::Session(undef, $cgi, \%attrs);
1207
Now, $session->header() uses "MY_SID" as a name for the session cookie.
1211
Returns query object associated with current session object. Default query object class is L<CGI.pm|CGI>.
1213
=head2 DEPRECATED METHODS
1215
These methods exist solely for for compatibility with CGI::Session 3.x.
1219
Closes the session. Using flush() is recommended instead, since that's exactly what a call
1220
to close() does now.
1224
CGI::Session consists of several components such as L<drivers|"DRIVERS">, L<serializers|"SERIALIZERS"> and L<id generators|"ID GENERATORS">. This section lists what is available.
1228
Following drivers are included in the standard distribution:
1234
L<file|CGI::Session::Driver::file> - default driver for storing session data in plain files. Full name: B<CGI::Session::Driver::file>
1238
L<db_file|CGI::Session::Driver::db_file> - for storing session data in BerkelyDB. Requires: L<DB_File>.
1239
Full name: B<CGI::Session::Driver::db_file>
1243
L<mysql|CGI::Session::Driver::mysql> - for storing session data in MySQL tables. Requires L<DBI|DBI> and L<DBD::mysql|DBD::mysql>.
1244
Full name: B<CGI::Session::Driver::mysql>
1248
L<sqlite|CGI::Session::Driver::sqlite> - for storing session data in SQLite. Requires L<DBI|DBI> and L<DBD::SQLite|DBD::SQLite>.
1249
Full name: B<CGI::Session::Driver::sqlite>
1259
L<default|CGI::Session::Serialize::default> - default data serializer. Uses standard L<Data::Dumper|Data::Dumper>.
1260
Full name: B<CGI::Session::Serialize::default>.
1264
L<storable|CGI::Session::Serialize::storable> - serializes data using L<Storable>. Requires L<Storable>.
1265
Full name: B<CGI::Session::Serialize::storable>.
1269
L<freezethaw|CGI::Session::Serialize::freezethaw> - serializes data using L<FreezeThaw>. Requires L<FreezeThaw>.
1270
Full name: B<CGI::Session::Serialize::freezethaw>
1274
L<yaml|CGI::Session::Serialize::yaml> - serializes data using YAML. Requires L<YAML> or L<YAML::Syck>.
1275
Full name: B<CGI::Session::Serialize::yaml>
1279
=head2 ID GENERATORS
1281
Following ID generators are available:
1287
L<md5|CGI::Session::ID::md5> - generates 32 character long hexadecimal string. Requires L<Digest::MD5|Digest::MD5>.
1288
Full name: B<CGI::Session::ID::md5>.
1292
L<incr|CGI::Session::ID::incr> - generates incremental session ids.
1296
L<static|CGI::Session::ID::static> - generates static session ids. B<CGI::Session::ID::static>
1300
=head1 A Warning about Auto-flushing
1302
Auto-flushing can be unreliable for the following reasons. Explict flushing
1303
after key session updates is recommended.
1307
=item If the C<DBI> handle goes out of scope before the session variable
1309
For database-stored sessions, if the C<DBI> handle has gone out of scope before
1310
the auto-flushing happens, auto-flushing will fail.
1312
=item Circular references
1314
If the calling code contains a circular reference, it's possible that your
1315
C<CGI::Session> object will not be destroyed until it is too late for
1316
auto-flushing to work. You can find circular references with a tool like
1319
In particular, these modules are known to contain circular references which
1320
lead to this problem:
1324
=item CGI::Application::Plugin::DebugScreen V 0.06
1326
=item CGI::Application::Plugin::ErrorPage before version 1.20
1330
=item Signal handlers
1332
If your application may receive signals, there is an increased chance that the
1333
signal will arrive after the session was updated but before it is auto-flushed
1334
at object destruction time.
1338
=head1 A Warning about UTF8
1340
Trying to use UTF8 in a program which uses CGI::Session has lead to problems. See RT#21981 and RT#28516.
1342
In the first case the user tried "use encoding 'utf8';" in the program, and in the second case the user tried
1343
"$dbh->do(qq|set names 'utf8'|);".
1345
Until this problem is understood and corrected, users are advised to avoid UTF8 in conjunction with CGI::Session.
1347
For details, see: http://rt.cpan.org/Public/Bug/Display.html?id=28516 (and ...id=21981).
1351
This document is also available in Japanese.
1357
Translation based on 4.14: http://digit.que.ne.jp/work/index.cgi?Perldoc/ja
1361
Translation based on 3.11, including Cookbook and Tutorial: http://perldoc.jp/docs/modules/CGI-Session-3.11/
1367
CGI::Session evolved to what it is today with the help of following developers. The list doesn't follow any strict order, but somewhat chronological. Specifics can be found in F<Changes> file
1373
=item Brian King E<lt>mrbbking@mac.comE<gt>
1375
=item Olivier Dragon E<lt>dragon@shadnet.shad.caE<gt>
1377
=item Adam Jacob E<lt>adam@sysadminsith.orgE<gt>
1379
=item Igor Plisco E<lt>igor@plisco.ruE<gt>
1383
=item Matt LeBlanc E<lt>mleblanc@cpan.orgE<gt>
1385
=item Shawn Sorichetti
1389
=item Rhesa Rozendaal
1391
He suggested Devel::Cycle to help debugging.
1395
Also, many people on the CGI::Application and CGI::Session mailing lists have contributed ideas and
1396
suggestions, and battled publicly with bugs, all of which has helped.
1400
Copyright (C) 2001-2005 Sherzod Ruzmetov E<lt>sherzodr@cpan.orgE<gt>. All rights reserved.
1401
This library is free software. You can modify and or distribute it under the same terms as Perl itself.
1403
=head1 PUBLIC CODE REPOSITORY
1405
You can see what the developers have been up to since the last release by
1406
checking out the code repository. You can browse the Subversion repository from here:
1408
http://svn.cromedome.net/repos/CGI-Session
1410
Or check it directly with C<svn> from here:
1412
https://svn.cromedome.net/repos/CGI-Session
1416
If you need help using CGI::Session, ask on the mailing list. You can ask the
1417
list by sending your questions to cgi-session-user@lists.sourceforge.net .
1419
You can subscribe to the mailing list at https://lists.sourceforge.net/lists/listinfo/cgi-session-user .
1421
Bug reports can be submitted at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CGI-Session
1425
Sherzod Ruzmetov C<sherzodr@cpan.org>
1427
Mark Stosberg became a co-maintainer during the development of 4.0. C<markstos@cpan.org>.
1429
Ron Savage became a co-maintainer during the development of 4.30. C<rsavage@cpan.org>.
1431
If you would like support, ask on the mailing list as describe above. The
1432
maintainers and other users are subscribed to it.
1436
To learn more both about the philosophy and CGI::Session programming style,
1437
consider the following:
1443
L<CGI::Session::Tutorial|CGI::Session::Tutorial> - extended CGI::Session manual. Also includes library architecture and driver specifications.
1447
We also provide mailing lists for CGI::Session users. To subscribe to the list
1448
or browse the archives visit
1449
https://lists.sourceforge.net/lists/listinfo/cgi-session-user
1451
=item * B<RFC 2109> - The primary spec for cookie handing in use, defining the "Cookie:" and "Set-Cookie:" HTTP headers.
1452
Available at L<http://www.ietf.org/rfc/rfc2109.txt>. A newer spec, RFC 2965 is meant to obsolete it with "Set-Cookie2"
1453
and "Cookie2" headers, but even of 2008, the newer spec is not widely supported. See L<http://www.ietf.org/rfc/rfc2965.txt>
1457
L<Apache::Session|Apache::Session> - an alternative to CGI::Session.
added
removed
foswiki/lib/CPAN/lib/CGI/Session.pm
