← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/local/src/github.com/foswiki/core/bin/view
  Run on Sun Dec 4 17:17:59 2011
Reported on Sun Dec 4 17:26:46 2011

Filename/usr/local/src/github.com/foswiki/core/lib/CPAN/lib/CGI/Session.pm
StatementsExecuted 302 statements in 8.44ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1113.88ms107msCGI::Session::::_load_pluggablesCGI::Session::_load_pluggables
111486µs613µsCGI::Session::::BEGIN@7CGI::Session::BEGIN@7
1382393µs503µsCGI::Session::::paramCGI::Session::param
332259µs2.38msCGI::Session::::flushCGI::Session::flush
111228µs114msCGI::Session::::loadCGI::Session::load
853144µs208µsCGI::Session::::idCGI::Session::id
194191µs91µsCGI::Session::::_test_statusCGI::Session::_test_status
182173µs73µsCGI::Session::::datarefCGI::Session::dataref
32150µs130µsCGI::Session::::_driverCGI::Session::_driver
153142µs42µsCGI::Session::::CORE:matchCGI::Session::CORE:match (opcode)
11140µs114msCGI::Session::::newCGI::Session::new
32131µs31µsCGI::Session::::_serializerCGI::Session::_serializer
32130µs30µsCGI::Session::::_set_statusCGI::Session::_set_status
11124µs31µsCGI::Session::::BEGIN@5CGI::Session::BEGIN@5
22221µs21µsCGI::Session::::nameCGI::Session::name
21121µs21µsCGI::Session::::_unset_statusCGI::Session::_unset_status
11119µs123µsCGI::Session::::BEGIN@6CGI::Session::BEGIN@6
11112µs48µsCGI::Session::::DESTROYCGI::Session::DESTROY
11111µs11µsCGI::Session::::_set_query_or_sidCGI::Session::_set_query_or_sid
1118µs8µsCGI::Session::::importCGI::Session::import
0000s0sCGI::Session::::__ANON__[:471]CGI::Session::__ANON__[:471]
0000s0sCGI::Session::::_id_generatorCGI::Session::_id_generator
0000s0sCGI::Session::::_ip_matchesCGI::Session::_ip_matches
0000s0sCGI::Session::::_reset_statusCGI::Session::_reset_status
0000s0sCGI::Session::::_str2secondsCGI::Session::_str2seconds
0000s0sCGI::Session::::atimeCGI::Session::atime
0000s0sCGI::Session::::clearCGI::Session::clear
0000s0sCGI::Session::::closeCGI::Session::close
0000s0sCGI::Session::::cookieCGI::Session::cookie
0000s0sCGI::Session::::ctimeCGI::Session::ctime
0000s0sCGI::Session::::deleteCGI::Session::delete
0000s0sCGI::Session::::dumpCGI::Session::dump
0000s0sCGI::Session::::etimeCGI::Session::etime
0000s0sCGI::Session::::expireCGI::Session::expire
0000s0sCGI::Session::::findCGI::Session::find
0000s0sCGI::Session::::http_headerCGI::Session::http_header
0000s0sCGI::Session::::is_emptyCGI::Session::is_empty
0000s0sCGI::Session::::is_expiredCGI::Session::is_expired
0000s0sCGI::Session::::is_newCGI::Session::is_new
0000s0sCGI::Session::::load_paramCGI::Session::load_param
0000s0sCGI::Session::::parse_dsnCGI::Session::parse_dsn
0000s0sCGI::Session::::queryCGI::Session::query
0000s0sCGI::Session::::remote_addrCGI::Session::remote_addr
0000s0sCGI::Session::::save_paramCGI::Session::save_param
0000s0sCGI::Session::::traceCGI::Session::trace
0000s0sCGI::Session::::tracemsgCGI::Session::tracemsg
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package CGI::Session;
2
3# $Id: Session.pm 456 2009-01-03 01:16:43Z markstos $
4
5244µs238µs
# spent 31µs (24+7) within CGI::Session::BEGIN@5 which was called: # once (24µs+7µs) by Foswiki::LoginManager::Session::BEGIN@22 at line 5
use strict;
# spent 31µs making 1 call to CGI::Session::BEGIN@5 # spent 7µs making 1 call to strict::import
6256µs2228µs
# spent 123µs (19+104) within CGI::Session::BEGIN@6 which was called: # once (19µs+104µs) by Foswiki::LoginManager::Session::BEGIN@22 at line 6
use Carp;
# spent 123µs making 1 call to CGI::Session::BEGIN@6 # spent 104µs making 1 call to Exporter::import
726.57ms1613µs
# spent 613µs (486+127) within CGI::Session::BEGIN@7 which was called: # once (486µs+127µs) by Foswiki::LoginManager::Session::BEGIN@22 at line 7
use CGI::Session::ErrorHandler;
# spent 613µs making 1 call to CGI::Session::BEGIN@7
8
9114µs@CGI::Session::ISA = qw( CGI::Session::ErrorHandler );
1012µs$CGI::Session::VERSION = '4.40';
1111µs$CGI::Session::NAME = 'CGISESSID';
1212µs$CGI::Session::IP_MATCH = 0;
13
14sub STATUS_UNSET () { 1 << 0 } # denotes session that's resetted
15sub STATUS_NEW () { 1 << 1 } # denotes session that's just created
16sub STATUS_MODIFIED () { 1 << 2 } # denotes session that needs synchronization
17sub STATUS_DELETED () { 1 << 3 } # denotes session that needs deletion
18sub STATUS_EXPIRED () { 1 << 4 } # denotes session that was expired.
19
20
# spent 8µs within CGI::Session::import which was called: # once (8µs+0s) by Foswiki::LoginManager::BEGIN@1 at line 1 of (eval 47)[/usr/local/src/github.com/foswiki/core/lib/Foswiki/LoginManager.pm:98]
sub import {
21212µs my ( $class, @args ) = @_;
22
23 return unless @args;
24
25 ARG:
26 foreach my $arg (@args) {
27 if ( $arg eq '-ip_match' ) {
28 $CGI::Session::IP_MATCH = 1;
29 last ARG;
30 }
31 }
32}
33
34
# spent 114ms (40µs+114) within CGI::Session::new which was called: # once (40µs+114ms) by Foswiki::LoginManager::loadSession at line 342 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/LoginManager.pm
sub new {
35618µs my ( $class, @args ) = @_;
36
37 my $self;
38318µs if ( ref $class ) {
39
40 #
41 # Called as an object method as in $session->new()...
42 #
43 $self = bless {%$class}, ref($class);
44 $class = ref $class;
45 $self->_reset_status();
46
47 #
48 # Object may still have public data associated with it, but we
49 # don't care about that, since we want to leave that to the
50 # client's disposal. However, if new() was requested on an
51 # expired session, we already know that '_DATA' table is
52 # empty, since it was the job of flush() to empty '_DATA'
53 # after deleting. How do we know flush() was already called on
54 # an expired session? Because load() - constructor always
55 # calls flush() on all to-be expired sessions
56 #
57 }
58 else {
59
60 #
61 # Called as a class method as in CGI::Session->new()
62 #
63
64# Start fresh with error reporting. Errors in past objects shouldn't affect this one.
65122µs $class->set_error('');
# spent 22µs making 1 call to CGI::Session::ErrorHandler::set_error
66
671114ms $self = $class->load(@args);
# spent 114ms making 1 call to Foswiki::LoginManager::Session::load
68 if ( not defined $self ) {
69 return $class->set_error( "new(): failed: " . $class->errstr );
70 }
71 }
72
73 my $dataref = $self->{_DATA};
74 unless ( $dataref->{_SESSION_ID} ) {
75
76 #
77 # Absence of '_SESSION_ID' can only signal:
78 # * Expired session: Because load() - constructor is required to
79 # empty contents of _DATA - table
80 # * Unavailable session: Such sessions are the ones that don't
81 # exist on datastore, but are requested by client
82 # * New session: When no specific session is requested to be loaded
83 #
84 my $id =
85 $self->_id_generator()
86 ->generate_id( $self->{_DRIVER_ARGS}, $self->{_CLAIMED_ID} );
87 unless ( defined $id ) {
88 return $self->set_error("Couldn't generate new SESSION-ID");
89 }
90 $dataref->{_SESSION_ID} = $id;
91 $dataref->{_SESSION_CTIME} = $dataref->{_SESSION_ATIME} = time();
92 $dataref->{_SESSION_REMOTE_ADDR} = $ENV{REMOTE_ADDR} || "";
93 $self->_set_status(STATUS_NEW);
94 }
95 return $self;
96}
97
98113µs135µs
# spent 48µs (12+35) within CGI::Session::DESTROY which was called: # once (12µs+35µs) by Foswiki::LoginManager::finish at line 183 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/LoginManager.pm
sub DESTROY { $_[0]->flush() }
# spent 35µs making 1 call to CGI::Session::flush
99sub close { $_[0]->flush() }
100
10114µs*param_hashref = \&dataref;
10214µsmy $avoid_single_use_warning = *param_hashref;
10318105µs
# spent 73µs within CGI::Session::dataref which was called 18 times, avg 4µs/call: # 16 times (64µs+0s) by CGI::Session::id at line 112, avg 4µs/call # 2 times (9µs+0s) by CGI::Session::flush at line 257, avg 4µs/call
sub dataref { $_[0]->{_DATA} }
104
105sub is_empty { !defined( $_[0]->id ) }
106
107sub is_expired { $_[0]->_test_status(STATUS_EXPIRED) }
108
109sub is_new { $_[0]->_test_status(STATUS_NEW) }
110
111
# spent 208µs (144+64) within CGI::Session::id which was called 8 times, avg 26µs/call: # 3 times (58µs+25µs) by CGI::Session::flush at line 232, avg 28µs/call # 2 times (30µs+15µs) by CGI::Session::flush at line 262, avg 23µs/call # once (26µs+10µs) by Foswiki::Validation::generateValidationKey at line 105 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Validation.pm # once (16µs+7µs) by Foswiki::LoginManager::loadSession at line 457 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/LoginManager.pm # once (14µs+7µs) by Foswiki::LoginManager::_addSessionCookieToResponse at line 813 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/LoginManager.pm
sub id {
1128128µs1664µs return defined( $_[0]->dataref ) ? $_[0]->dataref->{_SESSION_ID} : undef;
# spent 64µs making 16 calls to CGI::Session::dataref, avg 4µs/call
113}
114
115# Last Access Time
116sub atime {
117 return defined( $_[0]->dataref ) ? $_[0]->dataref->{_SESSION_ATIME} : undef;
118}
119
120# Creation Time
121sub ctime {
122 return defined( $_[0]->dataref ) ? $_[0]->dataref->{_SESSION_CTIME} : undef;
123}
124
125
# spent 130µs (50+80) within CGI::Session::_driver which was called 3 times, avg 43µs/call: # 2 times (22µs+0s) by CGI::Session::flush at line 244, avg 11µs/call # once (28µs+80µs) by CGI::Session::load at line 747
sub _driver {
126952µs my $self = shift;
127 defined( $self->{_OBJECTS}->{driver} )
128 and return $self->{_OBJECTS}->{driver};
129 my $pm = "CGI::Session::Driver::" . $self->{_DSN}->{driver};
130180µs defined( $self->{_OBJECTS}->{driver} = $pm->new( $self->{_DRIVER_ARGS} ) )
# spent 80µs making 1 call to CGI::Session::Driver::new
131 or die $pm->errstr();
132 return $self->{_OBJECTS}->{driver};
133}
134
135
# spent 31µs within CGI::Session::_serializer which was called 3 times, avg 10µs/call: # 2 times (19µs+0s) by CGI::Session::flush at line 245, avg 10µs/call # once (12µs+0s) by CGI::Session::load at line 757
sub _serializer {
136737µs my $self = shift;
137 defined( $self->{_OBJECTS}->{serializer} )
138 and return $self->{_OBJECTS}->{serializer};
139 return $self->{_OBJECTS}->{serializer} =
140 "CGI::Session::Serialize::" . $self->{_DSN}->{serializer};
141}
142
143sub _id_generator {
144 my $self = shift;
145 defined( $self->{_OBJECTS}->{id} ) and return $self->{_OBJECTS}->{id};
146 return $self->{_OBJECTS}->{id} = "CGI::Session::ID::" . $self->{_DSN}->{id};
147}
148
149sub _ip_matches {
150 return ( $_[0]->{_DATA}->{_SESSION_REMOTE_ADDR} eq $ENV{REMOTE_ADDR} );
151}
152
153# parses the DSN string and returns it as a hash.
154# Notably: Allows unique abbreviations of the keys: driver, serializer and 'id'.
155# Also, keys and values of the returned hash are lower-cased.
156sub parse_dsn {
157 my $self = shift;
158 my $dsn_str = shift;
159 croak "parse_dsn(): usage error" unless $dsn_str;
160
161 require Text::Abbrev;
162 my $abbrev = Text::Abbrev::abbrev( "driver", "serializer", "id" );
163 my %dsn_map = map { split /:/ } ( split /;/, $dsn_str );
164 my %dsn = map { $abbrev->{ lc $_ }, lc $dsn_map{$_} } keys %dsn_map;
165 return \%dsn;
166}
167
168sub query {
169 my $self = shift;
170
171 if ( $self->{_QUERY} ) {
172 return $self->{_QUERY};
173 }
174
175 # require CGI::Session::Query;
176 # return $self->{_QUERY} = CGI::Session::Query->new();
177 require CGI;
178 return $self->{_QUERY} = CGI->new();
179}
180
181
# spent 21µs within CGI::Session::name which was called 2 times, avg 10µs/call: # once (11µs+0s) by CGI::Session::load at line 733 # once (10µs+0s) by Foswiki::LoginManager::makeLoginManager at line 106 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/LoginManager.pm
sub name {
182617µs my $self = shift;
183
18412µs if ( ref $self ) {
18519µs unless (@_) {
186 return $self->{_NAME} || $CGI::Session::NAME;
187 }
188 return $self->{_NAME} = $_[0];
189 }
190
191 $CGI::Session::NAME = $_[0] if @_;
192 return $CGI::Session::NAME;
193}
194
195sub dump {
196 my $self = shift;
197
198 require Data::Dumper;
199 my $d = Data::Dumper->new( [$self], [ ref $self ] );
200 $d->Deepcopy(1);
201 return $d->Dump();
202}
203
204
# spent 30µs within CGI::Session::_set_status which was called 3 times, avg 10µs/call: # 2 times (21µs+0s) by CGI::Session::param at line 325, avg 11µs/call # once (9µs+0s) by CGI::Session::load at line 818
sub _set_status {
205934µs my $self = shift;
206 croak "_set_status(): usage error" unless @_;
207 $self->{_STATUS} |= $_[0];
208}
209
210
# spent 21µs within CGI::Session::_unset_status which was called 2 times, avg 10µs/call: # 2 times (21µs+0s) by CGI::Session::flush at line 265, avg 10µs/call
sub _unset_status {
211623µs my $self = shift;
212 croak "_unset_status(): usage error" unless @_;
213 $self->{_STATUS} &= ~$_[0];
214}
215
216sub _reset_status {
217 $_[0]->{_STATUS} = STATUS_UNSET;
218}
219
220
# spent 91µs within CGI::Session::_test_status which was called 19 times, avg 5µs/call: # 13 times (62µs+0s) by CGI::Session::param at line 276, avg 5µs/call # 2 times (10µs+0s) by CGI::Session::flush at line 256, avg 5µs/call # 2 times (10µs+0s) by CGI::Session::flush at line 237, avg 5µs/call # 2 times (9µs+0s) by CGI::Session::flush at line 247, avg 5µs/call
sub _test_status {
22119126µs return $_[0]->{_STATUS} & $_[1];
222}
223
224
# spent 2.38ms (259µs+2.12) within CGI::Session::flush which was called 3 times, avg 792µs/call: # once (109µs+1.06ms) by Foswiki::LoginManager::complete at line 530 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/LoginManager.pm # once (137µs+1.03ms) by Foswiki::LoginManager::userLoggedIn at line 656 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/LoginManager.pm # once (13µs+22µs) by CGI::Session::DESTROY at line 98
sub flush {
22521138µs my $self = shift;
226
227 # Would it be better to die or err if something very basic is wrong here?
228 # I'm trying to address the DESTORY related warning
229 # from: http://rt.cpan.org/Ticket/Display.html?id=17541
230 # return unless defined $self;
231
232383µs return unless $self->id; # <-- empty session
# spent 83µs making 3 calls to CGI::Session::id, avg 28µs/call
233
234 # neither new, nor deleted nor modified
235 return if !defined( $self->{_STATUS} ) or $self->{_STATUS} == STATUS_UNSET;
236
237210µs if ( $self->_test_status(STATUS_NEW)
# spent 10µs making 2 calls to CGI::Session::_test_status, avg 5µs/call
238 && $self->_test_status(STATUS_DELETED) )
239 {
240 $self->{_DATA} = {};
241 return $self->_unset_status( STATUS_NEW | STATUS_DELETED );
242 }
243
244222µs my $driver = $self->_driver();
# spent 22µs making 2 calls to CGI::Session::_driver, avg 11µs/call
245219µs my $serializer = $self->_serializer();
# spent 19µs making 2 calls to CGI::Session::_serializer, avg 10µs/call
246
24729µs if ( $self->_test_status(STATUS_DELETED) ) {
# spent 9µs making 2 calls to CGI::Session::_test_status, avg 5µs/call
248 defined( $driver->remove( $self->id ) )
249 or return $self->set_error(
250 "flush(): couldn't remove session data: " . $driver->errstr );
251 $self->{_DATA} = {}; # <-- removing all the data, making sure
252 # it won't be accessible after flush()
253 return $self->_unset_status(STATUS_DELETED);
254 }
255
256899µs210µs if ( $self->_test_status( STATUS_NEW | STATUS_MODIFIED ) ) {
# spent 10µs making 2 calls to CGI::Session::_test_status, avg 5µs/call
2574791µs my $datastr = $serializer->freeze( $self->dataref );
# spent 782µs making 2 calls to CGI::Session::Serialize::default::freeze, avg 391µs/call # spent 9µs making 2 calls to CGI::Session::dataref, avg 4µs/call
258 unless ( defined $datastr ) {
259 return $self->set_error(
260 "flush(): couldn't freeze data: " . $serializer->errstr );
261 }
26241.15ms defined( $driver->store( $self->id, $datastr ) )
# spent 1.11ms making 2 calls to CGI::Session::Driver::file::store, avg 553µs/call # spent 45µs making 2 calls to CGI::Session::id, avg 23µs/call
263 or return $self->set_error(
264 "flush(): couldn't store datastr: " . $driver->errstr );
265221µs $self->_unset_status( STATUS_NEW | STATUS_MODIFIED );
# spent 21µs making 2 calls to CGI::Session::_unset_status, avg 10µs/call
266 }
267 return 1;
268}
269
270sub trace { }
271sub tracemsg { }
272
273
# spent 503µs (393+110) within CGI::Session::param which was called 13 times, avg 39µs/call: # 5 times (74µs+20µs) by Foswiki::LoginManager::loadSession at line 464 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/LoginManager.pm, avg 19µs/call # 2 times (32µs+8µs) by Foswiki::Validation::_getSecret at line 350 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Validation.pm, avg 20µs/call # once (80µs+23µs) by Foswiki::LoginManager::loadSession at line 463 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/LoginManager.pm # once (79µs+17µs) by Foswiki::LoginManager::userLoggedIn at line 641 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/LoginManager.pm # once (58µs+22µs) by Foswiki::Validation::generateValidationKey at line 127 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Validation.pm # once (29µs+10µs) by Foswiki::Validation::expireValidationKeys at line 230 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Validation.pm # once (24µs+5µs) by Foswiki::LoginManager::loadSession at line 352 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/LoginManager.pm # once (16µs+4µs) by Foswiki::Validation::generateValidationKey at line 104 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Validation.pm
sub param {
27449160µs my ( $self, @args ) = @_;
275
2761362µs if ( $self->_test_status(STATUS_DELETED) ) {
# spent 62µs making 13 calls to CGI::Session::_test_status, avg 5µs/call
277 carp "param(): attempt to read/write deleted session";
278 }
279
280 # USAGE: $s->param();
281 # DESC: Returns all the /public/ parameters
28211103µs if ( @args == 0 ) {
2831163µs1019µs return grep { !/^_SESSION_/ } keys %{ $self->{_DATA} };
# spent 19µs making 10 calls to CGI::Session::CORE:match, avg 2µs/call
284 }
285
286 # USAGE: $s->param( $p );
287 # DESC: returns a specific session parameter
288 elsif ( @args == 1 ) {
289 return $self->{_DATA}->{ $args[0] };
290 }
291
292 # USAGE: $s->param( -name => $n, -value => $v );
293 # DESC: Updates session data using CGI.pm's 'named param' syntax.
294 # Only public records can be set!
295 my %args = @args;
296 my ( $name, $value ) = @args{qw(-name -value)};
297 if ( defined $name && defined $value ) {
298 if ( $name =~ m/^_SESSION_/ ) {
299
300 carp "param(): attempt to write to private parameter";
301 return;
302 }
303 $self->_set_status(STATUS_MODIFIED);
304 return $self->{_DATA}->{$name} = $value;
305 }
306
307# USAGE: $s->param(-name=>$n);
308# DESC: access to session data (public & private) using CGI.pm's 'named parameter' syntax.
309 return $self->{_DATA}->{ $args{'-name'} } if defined $args{'-name'};
310
311 # USAGE: $s->param($name, $value);
312 # USAGE: $s->param($name1 => $value1, $name2 => $value2 [,...]);
313 # DESC: updates one or more **public** records using simple syntax
314860µs if ( ( @args % 2 ) == 0 ) {
315 my $modified_cnt = 0;
316 ARG_PAIR:
317637µs while ( my ( $name, $val ) = each %args ) {
31828µs if ( $name =~ m/^_SESSION_/ ) {
# spent 8µs making 2 calls to CGI::Session::CORE:match, avg 4µs/call
319 carp "param(): attempt to write to private parameter";
320 next ARG_PAIR;
321 }
322 $self->{_DATA}->{$name} = $val;
323 ++$modified_cnt;
324 }
325221µs $self->_set_status(STATUS_MODIFIED);
# spent 21µs making 2 calls to CGI::Session::_set_status, avg 11µs/call
326 return $modified_cnt;
327 }
328
329 # If we reached this far none of the expected syntax were
330 # detected. Syntax error
331 croak "param(): usage error. Invalid syntax";
332}
333
334sub delete { $_[0]->_set_status(STATUS_DELETED) }
335
33612µs*header = \&http_header;
33712µsmy $avoid_single_use_warning_again = *header;
338
339sub http_header {
340 my $self = shift;
341 return $self->query->header(
342 -cookie => $self->cookie,
343 -type => 'text/html',
344 @_
345 );
346}
347
348sub cookie {
349 my $self = shift;
350
351 my $query = $self->query();
352 my $cookie = undef;
353
354 if ( $self->is_expired ) {
355 $cookie = $query->cookie(
356 -name => $self->name,
357 -value => $self->id,
358 -expires => '-1d',
359 @_
360 );
361 }
362 elsif ( my $t = $self->expire ) {
363 $cookie = $query->cookie(
364 -name => $self->name,
365 -value => $self->id,
366 -expires => '+' . $t . 's',
367 @_
368 );
369 }
370 else {
371 $cookie =
372 $query->cookie( -name => $self->name, -value => $self->id, @_ );
373 }
374 return $cookie;
375}
376
377sub save_param {
378 my $self = shift;
379 my ( $query, $params ) = @_;
380
381 $query ||= $self->query();
382 $params ||= [ $query->param ];
383
384 for my $p (@$params) {
385 my @values = $query->param($p) or next;
386 if ( @values > 1 ) {
387 $self->param( $p, \@values );
388 }
389 else {
390 $self->param( $p, $values[0] );
391 }
392 }
393 $self->_set_status(STATUS_MODIFIED);
394}
395
396sub load_param {
397 my $self = shift;
398 my ( $query, $params ) = @_;
399
400 $query ||= $self->query();
401 $params ||= [ $self->param ];
402
403 for (@$params) {
404 $query->param( -name => $_, -value => $self->param($_) );
405 }
406}
407
408sub clear {
409 my $self = shift;
410 my $params = shift;
411
412 #warn ref($params);
413 if ( defined $params ) {
414 $params = [$params] unless ref $params;
415 }
416 else {
417 $params = [ $self->param ];
418 }
419
420 for ( grep { !/^_SESSION_/ } @$params ) {
421 delete $self->{_DATA}->{$_};
422 }
423 $self->_set_status(STATUS_MODIFIED);
424}
425
426sub find {
427 my $class = shift;
428 my ( $dsn, $coderef, $dsn_args );
429
430 # find( \%code )
431 if ( @_ == 1 ) {
432 $coderef = $_[0];
433 }
434
435 # find( $dsn, \&code, \%dsn_args )
436 else {
437 ( $dsn, $coderef, $dsn_args ) = @_;
438 }
439
440 unless ( $coderef && ref($coderef) && ( ref $coderef eq 'CODE' ) ) {
441 croak "find(): usage error.";
442 }
443
444 my $driver;
445 if ($dsn) {
446 my $hashref = $class->parse_dsn($dsn);
447 $driver = $hashref->{driver};
448 }
449 $driver ||= "file";
450 my $pm = "CGI::Session::Driver::" . ( $driver =~ /(.*)/ )[0];
451 eval "require $pm";
452 if ( my $errmsg = $@ ) {
453 return $class->set_error( "find(): couldn't load driver." . $errmsg );
454 }
455
456 my $driver_obj = $pm->new($dsn_args);
457 unless ($driver_obj) {
458 return $class->set_error(
459 "find(): couldn't create driver object. " . $pm->errstr );
460 }
461
462 my $dont_update_atime = 0;
463 my $driver_coderef = sub {
464 my ($sid) = @_;
465 my $session = $class->load( $dsn, $sid, $dsn_args, $dont_update_atime );
466 unless ($session) {
467 return $class->set_error(
468 "find(): couldn't load session '$sid'. " . $class->errstr );
469 }
470 $coderef->($session);
471 };
472
473 defined( $driver_obj->traverse($driver_coderef) )
474 or return $class->set_error(
475 "find(): traverse seems to have failed. " . $driver_obj->errstr );
476 return 1;
477}
478
479# $Id: Session.pm 456 2009-01-03 01:16:43Z markstos $
480
481=pod
482
483=head1 NAME
484
485CGI::Session - persistent session data in CGI applications
486
487=head1 SYNOPSIS
488
489 # Object initialization:
490 use CGI::Session;
491 $session = new CGI::Session();
492
493 $CGISESSID = $session->id();
494
495 # Send proper HTTP header with cookies:
496 print $session->header();
497
498 # Storing data in the session:
499 $session->param('f_name', 'Sherzod');
500 # or
501 $session->param(-name=>'l_name', -value=>'Ruzmetov');
502
503 # Flush the data from memory to the storage driver at least before your
504 # program finishes since auto-flushing can be unreliable.
505 $session->flush();
506
507 # Retrieving data:
508 my $f_name = $session->param('f_name');
509 # or
510 my $l_name = $session->param(-name=>'l_name');
511
512 # Clearing a certain session parameter:
513 $session->clear(["l_name", "f_name"]);
514
515 # Expire '_is_logged_in' flag after 10 idle minutes:
516 $session->expire('is_logged_in', '+10m')
517
518 # Expire the session itself after 1 idle hour:
519 $session->expire('+1h');
520
521 # Delete the session for good:
522 $session->delete();
523 $session->flush(); # Recommended practice says use flush() after delete().
524
525=head1 DESCRIPTION
526
527CGI::Session provides an easy, reliable and modular session management system across HTTP requests.
528
529=head1 METHODS
530
531Following is the overview of all the available methods accessible via CGI::Session object.
532
533=head2 new()
534
535=head2 new( $sid )
536
537=head2 new( $query )
538
539=head2 new( $dsn, $query||$sid )
540
541=head2 new( $dsn, $query||$sid, \%dsn_args )
542
543=head2 new( $dsn, $query||$sid, \%dsn_args, \%session_params )
544
545Constructor. 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">.
546
547Can 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.
548
549If 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>.
550
551If 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>.
552
553If 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:
554
555 $s = CGI::Session->new("driver:mysql", undef);
556 $s = CGI::Session->new("driver:sqlite", $sid);
557 $s = CGI::Session->new("driver:db_file", $query);
558 $s = CGI::Session->new("serializer:storable;id:incr", $sid);
559 # etc...
560
561Briefly, C<new()> will return an initialized session object with a valid id, whereas C<load()> may return
562an empty session object with an undefined id.
563
564Tests are provided (t/new_with_undef.t and t/load_with_undef.t) to clarify the result of calling C<new()> and C<load()>
565with undef, or with an initialized CGI object with an undefined or fake CGISESSID.
566
567You are strongly advised to run the old-fashioned 'make test TEST_FILES=t/new_with_undef.t TEST_VERBOSE=1'
568or the new-fangled 'prove -v t/new_with_undef.t', for both new*.t and load*.t, and examine the output.
569
570Following data source components are supported:
571
572=over 4
573
574=item *
575
576B<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>
577
578=item *
579
580B<serializer> - serializer to be used to encode the data structure before saving
581in 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>.
582
583=item *
584
585B<id> - ID generator to use when new session is to be created. Available ID generator is L<md5|CGI::Session::ID::md5>
586
587=back
588
589For example, to get CGI::Session store its data using DB_File and serialize data using FreezeThaw:
590
591 $s = new CGI::Session("driver:DB_File;serializer:FreezeThaw", undef);
592
593If 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.
594
595If 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 )
596
597The following is a list of the current keys:
598
599=over
600
601=item *
602
603B<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.
604
605=back
606
607undef is acceptable as a valid placeholder to any of the above arguments, which will force default behavior.
608
609=head2 load()
610
611=head2 load( $query||$sid )
612
613=head2 load( $dsn, $query||$sid )
614
615=head2 load( $dsn, $query, \%dsn_args )
616
617=head2 load( $dsn, $query, \%dsn_args, \%session_params )
618
619Accepts the same arguments as new(), and also returns a new session object, or
620undef on failure. The difference is, L<new()|/"new"> can create a new session if
621it detects expired and non-existing sessions, but C<load()> does not.
622
623C<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:
624
625 $s = CGI::Session->load() or die CGI::Session->errstr();
626 if ( $s->is_expired ) {
627 print $s->header(),
628 $cgi->start_html(),
629 $cgi->p("Your session timed out! Refresh the screen to start new session!")
630 $cgi->end_html();
631 exit(0);
632 }
633
634 if ( $s->is_empty ) {
635 $s = $s->new() or die $s->errstr;
636 }
637
638Notice: All I<expired> sessions are empty, but not all I<empty> sessions are expired!
639
640Briefly, C<new()> will return an initialized session object with a valid id, whereas C<load()> may return
641an empty session object with an undefined id.
642
643Tests are provided (t/new_with_undef.t and t/load_with_undef.t) to clarify the result of calling C<new()> and C<load()>
644with undef, or with an initialized CGI object with an undefined or fake CGISESSID.
645
646You are strongly advised to run the old-fashioned 'make test TEST_FILES=t/new_with_undef.t TEST_VERBOSE=1'
647or the new-fangled 'prove -v t/new_with_undef.t', for both new*.t and load*.t, and examine the output.
648
649=cut
650
651# pass a true value as the fourth parameter if you want to skip the changing of
652# access time This isn't documented more formally, because it only called by
653# find().
654
# spent 114ms (228µs+113) within CGI::Session::load which was called: # once (228µs+113ms) by Foswiki::LoginManager::Session::load at line 34 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/LoginManager/Session.pm
sub load {
65525130µs my $class = shift;
656 return $class->set_error("called as instance method") if ref $class;
657 return $class->set_error("Too many arguments provided to load()") if @_ > 5;
658
659 my $self = bless {
660 _DATA => {
661 _SESSION_ID => undef,
662 _SESSION_CTIME => undef,
663 _SESSION_ATIME => undef,
664 _SESSION_REMOTE_ADDR => $ENV{REMOTE_ADDR} || "",
665
666#
667# Following two attributes may not exist in every single session, and declaring
668# them now will force these to get serialized into database, wasting space. But they
669# are here to remind the coder of their purpose
670#
671# _SESSION_ETIME => undef,
672# _SESSION_EXPIRE_LIST => {}
673 }, # session data
674 _DSN => {}, # parsed DSN params
675 _OBJECTS => {}, # keeps necessary objects
676 _DRIVER_ARGS => {}, # arguments to be passed to driver
677 _CLAIMED_ID => undef, # id **claimed** by client
678 _STATUS => STATUS_UNSET, # status of the session object
679 _QUERY => undef # query object
680 }, $class;
681
682 my ( $dsn, $query_or_sid, $dsn_args, $update_atime, $params );
683
684 # load($query||$sid)
685616µs if ( @_ == 1 ) {
686 $self->_set_query_or_sid( $_[0] );
687 }
688
689 # Two or more args passed:
690 # load($dsn, $query||$sid)
691 elsif ( @_ > 1 ) {
692 ( $dsn, $query_or_sid, $dsn_args, $update_atime ) = @_;
693
694# Make it backwards-compatible (update_atime is an undocumented key in %$params).
695# In fact, update_atime as a key is not used anywhere in the code as yet.
696# This patch is part of the patch for RT#33437.
697 if ( ref $update_atime and ref $update_atime eq 'HASH' ) {
698 $params = {%$update_atime};
699 $update_atime = $params->{'update_atime'};
700
701 if ( $params->{'name'} ) {
702 $self->{_NAME} = $params->{'name'};
703 }
704 }
705
706 # Since $update_atime is not part of the public API
707 # we ignore any value but the one we use internally: 0.
708 if ( defined $update_atime and $update_atime ne '0' ) {
709 return $class->set_error(
710"Too many arguments to load(). First extra argument was: $update_atime"
711 );
712 }
713
714 if ( defined $dsn ) { # <-- to avoid 'Uninitialized value...' warnings
715 $self->{_DSN} = $self->parse_dsn($dsn);
716 }
717111µs $self->_set_query_or_sid($query_or_sid);
# spent 11µs making 1 call to CGI::Session::_set_query_or_sid
718
719 # load($dsn, $query, \%dsn_args);
720
721 $self->{_DRIVER_ARGS} = $dsn_args if defined $dsn_args;
722
723 }
724
7251107ms $self->_load_pluggables();
# spent 107ms making 1 call to CGI::Session::_load_pluggables
726
727# Did load_pluggable fail? If so, return undef, just like $class->set_error() would
728115µs return if $class->errstr;
# spent 15µs making 1 call to CGI::Session::ErrorHandler::errstr
729
730313µs if ( not defined $self->{_CLAIMED_ID} ) {
731110µs my $query = $self->query();
# spent 10µs making 1 call to Foswiki::LoginManager::Session::query
732115µs eval {
7332449µs $self->{_CLAIMED_ID} = $query->cookie( $self->name )
# spent 438µs making 1 call to Foswiki::Request::cookie # spent 11µs making 1 call to CGI::Session::name
734 || $query->param( $self->name );
735 };
736 if ( my $errmsg = $@ ) {
737 return $class->set_error(
738"query object $query does not support cookie() and param() methods: "
739 . $errmsg );
740 }
741 }
742
743 # No session is being requested. Just return an empty session
744 return $self unless $self->{_CLAIMED_ID};
745
746 # Attempting to load the session
7471108µs my $driver = $self->_driver();
# spent 108µs making 1 call to CGI::Session::_driver
7481452µs my $raw_data = $driver->retrieve( $self->{_CLAIMED_ID} );
# spent 452µs making 1 call to CGI::Session::Driver::file::retrieve
749 unless ( defined $raw_data ) {
750 return $self->set_error(
751 "load(): couldn't retrieve data: " . $driver->errstr );
752 }
753
754 # Requested session couldn't be retrieved
755 return $self unless $raw_data;
756
757112µs my $serializer = $self->_serializer();
# spent 12µs making 1 call to CGI::Session::_serializer
75815.34ms $self->{_DATA} = $serializer->thaw($raw_data);
# spent 5.34ms making 1 call to CGI::Session::Serialize::default::thaw
759 unless ( defined $self->{_DATA} ) {
760
761 #die $raw_data . "\n";
762 return $self->set_error(
763 "load(): couldn't thaw() data using $serializer:"
764 . $serializer->errstr );
765 }
766 unless ( defined( $self->{_DATA} )
767 && ref( $self->{_DATA} )
768 && ( ref $self->{_DATA} eq 'HASH' )
769 && defined( $self->{_DATA}->{_SESSION_ID} ) )
770 {
771 return $self->set_error("Invalid data structure returned from thaw()");
772 }
773
774 # checking if previous session ip matches current ip
775 if ($CGI::Session::IP_MATCH) {
776 unless ( $self->_ip_matches ) {
777 $self->_set_status(STATUS_DELETED);
778 $self->flush;
779 return $self;
780 }
781 }
782
783 # checking for expiration ticker
784 if ( $self->{_DATA}->{_SESSION_ETIME} ) {
785 if (
786 (
787 $self->{_DATA}->{_SESSION_ATIME} +
788 $self->{_DATA}->{_SESSION_ETIME}
789 ) <= time()
790 )
791 {
792 $self->_set_status(
793 STATUS_EXPIRED | # <-- so client can detect expired sessions
794 STATUS_DELETED
795 ); # <-- session should be removed from database
796 $self->flush(); # <-- flush() will do the actual removal!
797 return $self;
798 }
799 }
800
801 # checking expiration tickers of individuals parameters, if any:
802 my @expired_params = ();
80312µs while ( my ( $param, $max_exp_interval ) =
804 each %{ $self->{_DATA}->{_SESSION_EXPIRE_LIST} } )
805 {
806 if (
807 ( $self->{_DATA}->{_SESSION_ATIME} + $max_exp_interval ) <= time() )
808 {
809 push @expired_params, $param;
810 }
811 }
812 $self->clear( \@expired_params ) if @expired_params;
813
814 # We update the atime by default, but if this (otherwise undocoumented)
815 # parameter is explicitly set to false, we'll turn the behavior off
816218µs if ( !defined $update_atime ) {
817 $self->{_DATA}->{_SESSION_ATIME} = time(); # <-- updating access time
81819µs $self->_set_status(STATUS_MODIFIED); # <-- access time modified above
# spent 9µs making 1 call to CGI::Session::_set_status
819 }
820
821 return $self;
822}
823
824# set the input as a query object or session ID, depending on what it looks like.
825
# spent 11µs within CGI::Session::_set_query_or_sid which was called: # once (11µs+0s) by CGI::Session::load at line 717
sub _set_query_or_sid {
826313µs my $self = shift;
827 my $query_or_sid = shift;
82812µs if ( ref $query_or_sid ) { $self->{_QUERY} = $query_or_sid }
829 else { $self->{_CLAIMED_ID} = $query_or_sid }
830}
831
832
# spent 107ms (3.88+103) within CGI::Session::_load_pluggables which was called: # once (3.88ms+103ms) by CGI::Session::load at line 725
sub _load_pluggables {
833626µs my ($self) = @_;
834
835 my %DEFAULT_FOR = (
836 driver => "file",
837 serializer => "default",
838 id => "md5",
839 );
840 my %SUBDIR_FOR = (
841 driver => "Driver",
842 serializer => "Serialize",
843 id => "ID",
844 );
845 my $dsn = $self->{_DSN};
846 foreach my $plug (qw(driver serializer id)) {
847971µs my $mod_name = $dsn->{$plug};
84837µs if ( not defined $mod_name ) {
849 $mod_name = $DEFAULT_FOR{$plug};
850 }
85115149µs316µs if ( $mod_name =~ /^(\w+)$/ ) {
# spent 16µs making 3 calls to CGI::Session::CORE:match, avg 5µs/call
852
853 # Looks good. Put it into the dsn hash
854 $dsn->{$plug} = $mod_name = $1;
855
856 # Put together the actual module name to load
857 my $prefix = join '::', ( __PACKAGE__, $SUBDIR_FOR{$plug}, q{} );
858 $mod_name = $prefix . $mod_name;
859
860 ## See if we can load load it
861 eval "require $mod_name";
# spent 185µs executing statements in string eval # spent 158µs executing statements in string eval # spent 145µs executing statements in string eval
862 if ($@) {
863 my $msg = $@;
864 return $self->set_error( "couldn't load $mod_name: " . $msg );
865 }
866 }
867 else {
868
869 # do something here about bad name for a pluggable
870 }
871 }
872 return;
873}
874
875=pod
876
877=head2 id()
878
879Returns effective ID for a session. Since effective ID and claimed ID can differ, valid session id should always
880be retrieved using this method.
881
882=head2 param($name)
883
884=head2 param(-name=E<gt>$name)
885
886Used 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.
887
888=head2 param($name, $value)
889
890=head2 param(-name=E<gt>$name, -value=E<gt>$value)
891
892Used in either of the above syntax assigns a new value to $name parameter,
893which can later be retrieved with previously introduced param() syntax. C<$value>
894may be a scalar, arrayref or hashref.
895
896Attempts to set parameter names that start with I<_SESSION_> will trigger
897a warning and undef will be returned.
898
899=head2 param_hashref()
900
901B<Deprecated>. Use L<dataref()|/"dataref"> instead.
902
903=head2 dataref()
904
905Returns reference to session's data table:
906
907 $params = $s->dataref();
908 $sid = $params->{_SESSION_ID};
909 $name= $params->{name};
910 # etc...
911
912Useful for having all session data in a hashref, but too risky to update.
913
914=head2 save_param()
915
916=head2 save_param($query)
917
918=head2 save_param($query, \@list)
919
920Saves 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.
921
922=head2 load_param()
923
924=head2 load_param($query)
925
926=head2 load_param($query, \@list)
927
928Loads 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.
929
930=head2 clear()
931
932=head2 clear('field')
933
934=head2 clear(\@list)
935
936Clears parameters from the session object.
937
938With no parameters, all fields are cleared. If passed a single parameter or a
939reference to an array, only the named parameters are cleared.
940
941=head2 flush()
942
943Synchronizes data in memory with the copy serialized by the driver. Call flush()
944if you need to access the session from outside the current session object. You should
945call flush() sometime before your program exits.
946
947As a last resort, CGI::Session will automatically call flush for you just
948before the program terminates or session object goes out of scope. Automatic
949flushing has proven to be unreliable, and in some cases is now required
950in places that worked with CGI::Session 3.x.
951
952Always explicitly calling C<flush()> on the session before the
953program exits is recommended. For extra safety, call it immediately after
954every important session update.
955
956Also see L<A Warning about Auto-flushing>
957
958=head2 atime()
959
960Read-only method. Returns the last access time of the session in seconds from epoch. This time is used internally while
961auto-expiring sessions and/or session parameters.
962
963=head2 ctime()
964
965Read-only method. Returns the time when the session was first created in seconds from epoch.
966
967=head2 expire()
968
969=head2 expire($time)
970
971=head2 expire($param, $time)
972
973Sets expiration interval relative to L<atime()|/"atime">.
974
975If 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.
976
977Second 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.
978
979By using the third syntax you can set the expiration interval for a particular
980session parameter, say I<~logged-in>. This would cause the library call clear()
981on the parameter when its time is up. Note it only makes sense to set this value to
982something I<earlier> than when the whole session expires. Passing 0 cancels expiration.
983
984All the time values should be given in the form of seconds. Following keywords are also supported for your convenience:
985
986 +-----------+---------------+
987 | alias | meaning |
988 +-----------+---------------+
989 | s | Second |
990 | m | Minute |
991 | h | Hour |
992 | d | Day |
993 | w | Week |
994 | M | Month |
995 | y | Year |
996 +-----------+---------------+
997
998Examples:
999
1000 $session->expire("2h"); # expires in two hours
1001 $session->expire(0); # cancel expiration
1002 $session->expire("~logged-in", "10m"); # expires '~logged-in' parameter after 10 idle minutes
1003
1004Note: 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">.
1005
1006=cut
1007
100811µs*expires = \&expire;
100912µsmy $prevent_warning = \&expires;
1010sub etime { $_[0]->expire() }
1011
1012sub expire {
1013 my $self = shift;
1014
1015 # no params, just return the expiration time.
1016 if ( not @_ ) {
1017 return $self->{_DATA}->{_SESSION_ETIME};
1018 }
1019
1020 # We have just a time
1021 elsif ( @_ == 1 ) {
1022 my $time = $_[0];
1023
1024 # If 0 is passed, cancel expiration
1025 if ( defined $time && ( $time =~ m/^\d$/ ) && ( $time == 0 ) ) {
1026 $self->{_DATA}->{_SESSION_ETIME} = undef;
1027 $self->_set_status(STATUS_MODIFIED);
1028 }
1029
1030 # set the expiration to this time
1031 else {
1032 $self->{_DATA}->{_SESSION_ETIME} = $self->_str2seconds($time);
1033 $self->_set_status(STATUS_MODIFIED);
1034 }
1035 }
1036
1037 # If we get this far, we expect expire($param,$time)
1038 # ( This would be a great use of a Perl6 multi sub! )
1039 else {
1040 my ( $param, $time ) = @_;
1041 if ( ( $time =~ m/^\d$/ ) && ( $time == 0 ) ) {
1042 delete $self->{_DATA}->{_SESSION_EXPIRE_LIST}->{$param};
1043 $self->_set_status(STATUS_MODIFIED);
1044 }
1045 else {
1046 $self->{_DATA}->{_SESSION_EXPIRE_LIST}->{$param} =
1047 $self->_str2seconds($time);
1048 $self->_set_status(STATUS_MODIFIED);
1049 }
1050 }
1051 return 1;
1052}
1053
1054# =head2 _str2seconds()
1055#
1056# my $secs = $self->_str2seconds('1d')
1057#
1058# Takes a CGI.pm-style time representation and returns an equivalent number
1059# of seconds.
1060#
1061# See the docs of expire() for more detail.
1062#
1063# =cut
1064
1065sub _str2seconds {
1066 my $self = shift;
1067 my ($str) = @_;
1068
1069 return unless defined $str;
1070 return $str if $str =~ m/^[-+]?\d+$/;
1071
1072 my %_map = (
1073 s => 1,
1074 m => 60,
1075 h => 3600,
1076 d => 86400,
1077 w => 604800,
1078 M => 2592000,
1079 y => 31536000
1080 );
1081
1082 my ( $koef, $d ) = $str =~ m/^([+-]?\d+)([smhdwMy])$/;
1083 unless ( defined($koef) && defined($d) ) {
1084 die
1085"_str2seconds(): couldn't parse '$str' into \$koef and \$d parts. Possible invalid syntax";
1086 }
1087 return $koef * $_map{$d};
1088}
1089
1090=pod
1091
1092=head2 is_new()
1093
1094Returns true only for a brand new session.
1095
1096=head2 is_expired()
1097
1098Tests whether session initialized using L<load()|/"load"> is to be expired. This method works only on sessions initialized with load():
1099
1100 $s = CGI::Session->load() or die CGI::Session->errstr;
1101 if ( $s->is_expired ) {
1102 die "Your session expired. Please refresh";
1103 }
1104 if ( $s->is_empty ) {
1105 $s = $s->new() or die $s->errstr;
1106 }
1107
1108
1109=head2 is_empty()
1110
1111Returns true for sessions that are empty. It's preferred way of testing whether requested session was loaded successfully or not:
1112
1113 $s = CGI::Session->load($sid);
1114 if ( $s->is_empty ) {
1115 $s = $s->new();
1116 }
1117
1118Actually, the above code is nothing but waste. The same effect could've been achieved by saying:
1119
1120 $s = CGI::Session->new( $sid );
1121
1122L<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.
1123
1124=head2 delete()
1125
1126Sets the objects status to be "deleted". Subsequent read/write requests on the
1127same object will fail. To physically delete it from the data store you need to call L<flush()>.
1128CGI::Session attempts to do this automatically when the object is being destroyed (usually as
1129the script exits), but see L<A Warning about Auto-flushing>.
1130
1131=head2 find( \&code )
1132
1133=head2 find( $dsn, \&code )
1134
1135=head2 find( $dsn, \&code, \%dsn_args )
1136
1137Experimental 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:
1138
1139The following line, for instance, will remove sessions already expired, but which are still on disk:
1140
1141 CGI::Session->find( sub {} );
1142
1143Notice, 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:
1144
1145 CGI::Session->find( \&purge );
1146 sub purge {
1147 my ($session) = @_;
1148 next if $session->is_empty; # <-- already expired?!
1149 if ( ($session->ctime + 3600*240) <= time() ) {
1150 $session->delete();
1151 $session->flush(); # Recommended practice says use flush() after delete().
1152 }
1153 }
1154
1155B<Note>: find will not change the modification or access times on the sessions it returns.
1156
1157Explanation of the 3 parameters to C<find()>:
1158
1159=over 4
1160
1161=item $dsn
1162
1163This is the DSN (Data Source Name) used by CGI::Session to control what type of
1164sessions you previously created and what type of sessions you now wish method
1165C<find()> to pass to your callback.
1166
1167The default value is defined above, in the docs for method C<new()>, and is
1168'driver:file;serializer:default;id:md5'.
1169
1170Do not confuse this DSN with the DSN arguments mentioned just below, under \%dsn_args.
1171
1172=item \&code
1173
1174This is the callback provided by you (i.e. the caller of method C<find()>)
1175which is called by CGI::Session once for each session found by method C<find()>
1176which matches the given $dsn.
1177
1178There is no default value for this coderef.
1179
1180When your callback is actually called, the only parameter is a session. If you
1181want to call a subroutine you already have with more parameters, you can
1182achieve this by creating an anonymous subroutine that calls your subroutine
1183with the parameters you want. For example:
1184
1185 CGI::Session->find($dsn, sub { my_subroutine( @_, 'param 1', 'param 2' ) } );
1186 CGI::Session->find($dsn, sub { $coderef->( @_, $extra_arg ) } );
1187
1188Or if you wish, you can define a sub generator as such:
1189
1190 sub coderef_with_args {
1191 my ( $coderef, @params ) = @_;
1192 return sub { $coderef->( @_, @params ) };
1193 }
1194
1195 CGI::Session->find($dsn, coderef_with_args( $coderef, 'param 1', 'param 2' ) );
1196
1197=item \%dsn_args
1198
1199If your $dsn uses file-based storage, then this hashref might contain keys such as:
1200
1201 {
1202 Directory => Value 1,
1203 NoFlock => Value 2,
1204 UMask => Value 3
1205 }
1206
1207If your $dsn uses db-based storage, then this hashref contains (up to) 3 keys, and looks like:
1208
1209 {
1210 DataSource => Value 1,
1211 User => Value 2,
1212 Password => Value 3
1213 }
1214
1215These 3 form the DSN, username and password used by DBI to control access to your database server,
1216and hence are only relevant when using db-based sessions.
1217
1218The default value of this hashref is undef.
1219
1220=back
1221
1222B<Note:> find() is meant to be convenient, not necessarily efficient. It's best suited in cron scripts.
1223
1224=head1 MISCELLANEOUS METHODS
1225
1226=head2 remote_addr()
1227
1228Returns 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.
1229
1230=cut
1231
1232sub remote_addr { return $_[0]->{_DATA}->{_SESSION_REMOTE_ADDR} }
1233
1234=pod
1235
1236=head2 errstr()
1237
1238Class method. Returns last error message from the library.
1239
1240=head2 dump()
1241
1242Returns a dump of the session object. Useful for debugging purposes only.
1243
1244=head2 header()
1245
1246Replacement 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:
1247
1248 $cookie = CGI::Cookie->new(-name=>$session->name, -value=>$session->id);
1249 print $cgi->header(-cookie=>$cookie);
1250
1251You can minimize the above into:
1252
1253 print $session->header();
1254
1255It 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:
1256
1257 CGI::Session->name("MY_SID");
1258 $session = new CGI::Session(undef, $cgi, \%attrs);
1259
1260Now, $session->header() uses "MY_SID" as a name for the session cookie.
1261
1262=head2 query()
1263
1264Returns query object associated with current session object. Default query object class is L<CGI.pm|CGI>.
1265
1266=head2 DEPRECATED METHODS
1267
1268These methods exist solely for for compatibility with CGI::Session 3.x.
1269
1270=head3 close()
1271
1272Closes the session. Using flush() is recommended instead, since that's exactly what a call
1273to close() does now.
1274
1275=head1 DISTRIBUTION
1276
1277CGI::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.
1278
1279=head2 DRIVERS
1280
1281Following drivers are included in the standard distribution:
1282
1283=over 4
1284
1285=item *
1286
1287L<file|CGI::Session::Driver::file> - default driver for storing session data in plain files. Full name: B<CGI::Session::Driver::file>
1288
1289=item *
1290
1291L<db_file|CGI::Session::Driver::db_file> - for storing session data in BerkelyDB. Requires: L<DB_File>.
1292Full name: B<CGI::Session::Driver::db_file>
1293
1294=item *
1295
1296L<mysql|CGI::Session::Driver::mysql> - for storing session data in MySQL tables. Requires L<DBI|DBI> and L<DBD::mysql|DBD::mysql>.
1297Full name: B<CGI::Session::Driver::mysql>
1298
1299=item *
1300
1301L<sqlite|CGI::Session::Driver::sqlite> - for storing session data in SQLite. Requires L<DBI|DBI> and L<DBD::SQLite|DBD::SQLite>.
1302Full name: B<CGI::Session::Driver::sqlite>
1303
1304=back
1305
1306=head2 SERIALIZERS
1307
1308=over 4
1309
1310=item *
1311
1312L<default|CGI::Session::Serialize::default> - default data serializer. Uses standard L<Data::Dumper|Data::Dumper>.
1313Full name: B<CGI::Session::Serialize::default>.
1314
1315=item *
1316
1317L<storable|CGI::Session::Serialize::storable> - serializes data using L<Storable>. Requires L<Storable>.
1318Full name: B<CGI::Session::Serialize::storable>.
1319
1320=item *
1321
1322L<freezethaw|CGI::Session::Serialize::freezethaw> - serializes data using L<FreezeThaw>. Requires L<FreezeThaw>.
1323Full name: B<CGI::Session::Serialize::freezethaw>
1324
1325=item *
1326
1327L<yaml|CGI::Session::Serialize::yaml> - serializes data using YAML. Requires L<YAML> or L<YAML::Syck>.
1328Full name: B<CGI::Session::Serialize::yaml>
1329
1330=back
1331
1332=head2 ID GENERATORS
1333
1334Following ID generators are available:
1335
1336=over 4
1337
1338=item *
1339
1340L<md5|CGI::Session::ID::md5> - generates 32 character long hexadecimal string. Requires L<Digest::MD5|Digest::MD5>.
1341Full name: B<CGI::Session::ID::md5>.
1342
1343=item *
1344
1345L<incr|CGI::Session::ID::incr> - generates incremental session ids.
1346
1347=item *
1348
1349L<static|CGI::Session::ID::static> - generates static session ids. B<CGI::Session::ID::static>
1350
1351=back
1352
1353=head1 A Warning about Auto-flushing
1354
1355Auto-flushing can be unreliable for the following reasons. Explict flushing
1356after key session updates is recommended.
1357
1358=over 4
1359
1360=item If the C<DBI> handle goes out of scope before the session variable
1361
1362For database-stored sessions, if the C<DBI> handle has gone out of scope before
1363the auto-flushing happens, auto-flushing will fail.
1364
1365=item Circular references
1366
1367If the calling code contains a circular reference, it's possible that your
1368C<CGI::Session> object will not be destroyed until it is too late for
1369auto-flushing to work. You can find circular references with a tool like
1370L<Devel::Cycle>.
1371
1372In particular, these modules are known to contain circular references which
1373lead to this problem:
1374
1375=over 4
1376
1377=item CGI::Application::Plugin::DebugScreen V 0.06
1378
1379=item CGI::Application::Plugin::ErrorPage before version 1.20
1380
1381=back
1382
1383=item Signal handlers
1384
1385If your application may receive signals, there is an increased chance that the
1386signal will arrive after the session was updated but before it is auto-flushed
1387at object destruction time.
1388
1389=back
1390
1391=head1 A Warning about UTF8
1392
1393Trying to use UTF8 in a program which uses CGI::Session has lead to problems. See RT#21981 and RT#28516.
1394
1395In the first case the user tried "use encoding 'utf8';" in the program, and in the second case the user tried
1396"$dbh->do(qq|set names 'utf8'|);".
1397
1398Until this problem is understood and corrected, users are advised to avoid UTF8 in conjunction with CGI::Session.
1399
1400For details, see: http://rt.cpan.org/Public/Bug/Display.html?id=28516 (and ...id=21981).
1401
1402=head1 TRANSLATIONS
1403
1404This document is also available in Japanese.
1405
1406=over 4
1407
1408=item o
1409
1410Translation based on 4.14: http://digit.que.ne.jp/work/index.cgi?Perldoc/ja
1411
1412=item o
1413
1414Translation based on 3.11, including Cookbook and Tutorial: http://perldoc.jp/docs/modules/CGI-Session-3.11/
1415
1416=back
1417
1418=head1 CREDITS
1419
1420CGI::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
1421
1422=over 4
1423
1424=item Andy Lester
1425
1426=item Brian King E<lt>mrbbking@mac.comE<gt>
1427
1428=item Olivier Dragon E<lt>dragon@shadnet.shad.caE<gt>
1429
1430=item Adam Jacob E<lt>adam@sysadminsith.orgE<gt>
1431
1432=item Igor Plisco E<lt>igor@plisco.ruE<gt>
1433
1434=item Mark Stosberg
1435
1436=item Matt LeBlanc E<lt>mleblanc@cpan.orgE<gt>
1437
1438=item Shawn Sorichetti
1439
1440=item Ron Savage
1441
1442=item Rhesa Rozendaal
1443
1444He suggested Devel::Cycle to help debugging.
1445
1446=back
1447
1448Also, many people on the CGI::Application and CGI::Session mailing lists have contributed ideas and
1449suggestions, and battled publicly with bugs, all of which has helped.
1450
1451=head1 COPYRIGHT
1452
1453Copyright (C) 2001-2005 Sherzod Ruzmetov E<lt>sherzodr@cpan.orgE<gt>. All rights reserved.
1454This library is free software. You can modify and or distribute it under the same terms as Perl itself.
1455
1456=head1 PUBLIC CODE REPOSITORY
1457
1458You can see what the developers have been up to since the last release by
1459checking out the code repository. You can browse the Subversion repository from here:
1460
1461 http://svn.cromedome.net/repos/CGI-Session
1462
1463Or check it directly with C<svn> from here:
1464
1465 https://svn.cromedome.net/repos/CGI-Session
1466
1467=head1 SUPPORT
1468
1469If you need help using CGI::Session, ask on the mailing list. You can ask the
1470list by sending your questions to cgi-session-user@lists.sourceforge.net .
1471
1472You can subscribe to the mailing list at https://lists.sourceforge.net/lists/listinfo/cgi-session-user .
1473
1474Bug reports can be submitted at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CGI-Session
1475
1476=head1 AUTHOR
1477
1478Sherzod Ruzmetov C<sherzodr@cpan.org>
1479
1480Mark Stosberg became a co-maintainer during the development of 4.0. C<markstos@cpan.org>.
1481
1482Ron Savage became a co-maintainer during the development of 4.30. C<rsavage@cpan.org>.
1483
1484If you would like support, ask on the mailing list as describe above. The
1485maintainers and other users are subscribed to it.
1486
1487=head1 SEE ALSO
1488
1489To learn more both about the philosophy and CGI::Session programming style,
1490consider the following:
1491
1492=over 4
1493
1494=item *
1495
1496L<CGI::Session::Tutorial|CGI::Session::Tutorial> - extended CGI::Session manual. Also includes library architecture and driver specifications.
1497
1498=item *
1499
1500We also provide mailing lists for CGI::Session users. To subscribe to the list
1501or browse the archives visit
1502https://lists.sourceforge.net/lists/listinfo/cgi-session-user
1503
1504=item * B<RFC 2109> - The primary spec for cookie handing in use, defining the "Cookie:" and "Set-Cookie:" HTTP headers.
1505Available at L<http://www.ietf.org/rfc/rfc2109.txt>. A newer spec, RFC 2965 is meant to obsolete it with "Set-Cookie2"
1506and "Cookie2" headers, but even of 2008, the newer spec is not widely supported. See L<http://www.ietf.org/rfc/rfc2965.txt>
1507
1508=item *
1509
1510L<Apache::Session|Apache::Session> - an alternative to CGI::Session.
1511
1512=back
1513
1514=cut
1515
1516119µs1;
1517
 
# spent 42µs within CGI::Session::CORE:match which was called 15 times, avg 3µs/call: # 10 times (19µs+0s) by CGI::Session::param at line 283, avg 2µs/call # 3 times (16µs+0s) by CGI::Session::_load_pluggables at line 851, avg 5µs/call # 2 times (8µs+0s) by CGI::Session::param at line 318, avg 4µs/call
sub CGI::Session::CORE:match; # opcode