line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::Session; |
2
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
438705
|
use parent 'Data::Session::Base'; |
|
3
|
|
|
|
|
382
|
|
|
3
|
|
|
|
|
24
|
|
4
|
3
|
|
|
3
|
|
176
|
no autovivification; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
14
|
|
5
|
3
|
|
|
3
|
|
143
|
use strict; |
|
3
|
|
|
|
|
15
|
|
|
3
|
|
|
|
|
91
|
|
6
|
3
|
|
|
3
|
|
24
|
use warnings; |
|
3
|
|
|
|
|
23
|
|
|
3
|
|
|
|
|
121
|
|
7
|
|
|
|
|
|
|
|
8
|
3
|
|
|
3
|
|
1200
|
use Class::Load ':all'; # For try_load_class() and is_class_loaded(). |
|
3
|
|
|
|
|
41421
|
|
|
3
|
|
|
|
|
600
|
|
9
|
|
|
|
|
|
|
|
10
|
3
|
|
|
3
|
|
29
|
use File::Spec; # For catdir. |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
103
|
|
11
|
3
|
|
|
3
|
|
1665
|
use File::Slurper 'read_dir'; |
|
3
|
|
|
|
|
48650
|
|
|
3
|
|
|
|
|
270
|
|
12
|
|
|
|
|
|
|
|
13
|
3
|
|
|
3
|
|
30
|
use Hash::FieldHash ':all'; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
429
|
|
14
|
|
|
|
|
|
|
|
15
|
3
|
|
|
3
|
|
24
|
use Try::Tiny; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
19157
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
fieldhash my %my_drivers => 'my_drivers'; |
18
|
|
|
|
|
|
|
fieldhash my %my_id_generators => 'my_id_generators'; |
19
|
|
|
|
|
|
|
fieldhash my %my_serializers => 'my_serializers'; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
our $errstr = ''; |
22
|
|
|
|
|
|
|
our $VERSION = '1.18'; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# ----------------------------------------------- |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub atime |
27
|
|
|
|
|
|
|
{ |
28
|
134
|
|
|
134
|
1
|
394
|
my($self, $atime) = @_; |
29
|
134
|
|
|
|
|
431
|
my($data) = $self -> session; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# This is really only for use by load_session(). |
32
|
|
|
|
|
|
|
|
33
|
134
|
100
|
|
|
|
449
|
if (defined $atime) |
34
|
|
|
|
|
|
|
{ |
35
|
132
|
|
|
|
|
341
|
$$data{_SESSION_ATIME} = $atime; |
36
|
|
|
|
|
|
|
|
37
|
132
|
|
|
|
|
502
|
$self -> session($data); |
38
|
132
|
|
|
|
|
559
|
$self -> modified(1); |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
134
|
|
|
|
|
476
|
return $$data{_SESSION_ATIME}; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
} # End of atime. |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# ----------------------------------------------- |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub check_expiry |
48
|
|
|
|
|
|
|
{ |
49
|
132
|
|
|
132
|
1
|
440
|
my($self) = @_; |
50
|
|
|
|
|
|
|
|
51
|
132
|
100
|
66
|
|
|
567
|
if ($self -> etime && ( ($self -> atime + $self -> etime) < time) ) |
52
|
|
|
|
|
|
|
{ |
53
|
1
|
50
|
|
|
|
30
|
($self -> verbose) && $self -> log('Expiring id: ' . $self -> id); |
54
|
|
|
|
|
|
|
|
55
|
1
|
|
|
|
|
14
|
$self -> delete; |
56
|
1
|
|
|
|
|
8
|
$self -> expired(1); |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
} # End of check_expiry. |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# ----------------------------------------------- |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub clear |
64
|
|
|
|
|
|
|
{ |
65
|
243
|
|
|
243
|
1
|
536
|
my($self, $name) = @_; |
66
|
243
|
|
|
|
|
982
|
my($data) = $self -> session; |
67
|
|
|
|
|
|
|
|
68
|
243
|
100
|
|
|
|
744
|
if (! $name) |
|
|
50
|
|
|
|
|
|
69
|
|
|
|
|
|
|
{ |
70
|
242
|
|
|
|
|
532
|
$name = [$self -> param]; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
elsif (ref($name) ne 'ARRAY') |
73
|
|
|
|
|
|
|
{ |
74
|
1
|
|
|
|
|
5
|
$name = [$name]; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
else |
77
|
|
|
|
|
|
|
{ |
78
|
0
|
|
|
|
|
0
|
$name = [grep{! /^_/} @$name]; |
|
0
|
|
|
|
|
0
|
|
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
243
|
|
|
|
|
612
|
for my $key (@$name) |
82
|
|
|
|
|
|
|
{ |
83
|
432
|
|
|
|
|
1188
|
delete $$data{$key}; |
84
|
432
|
|
|
|
|
848
|
delete $$data{_SESSION_PTIME}{$key}; |
85
|
|
|
|
|
|
|
|
86
|
432
|
|
|
|
|
1380
|
$self -> modified(1); |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
243
|
|
|
|
|
754
|
$self -> session($data); |
90
|
|
|
|
|
|
|
|
91
|
243
|
|
|
|
|
492
|
return 1; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
} # End of clear. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# ----------------------------------------------- |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub cookie |
98
|
|
|
|
|
|
|
{ |
99
|
1
|
|
|
1
|
1
|
4
|
my($self) = shift; |
100
|
1
|
|
|
|
|
5
|
my($q) = $self -> query; |
101
|
1
|
|
|
|
|
10
|
my(@param) = ('-name' => $self -> name, '-value' => $self -> id, @_); |
102
|
1
|
|
|
|
|
3
|
my($cookie) = ''; |
103
|
|
|
|
|
|
|
|
104
|
1
|
50
|
|
|
|
26
|
if (! $q -> can('cookie') ) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
105
|
|
|
|
|
|
|
{ |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
elsif ($self -> expired) |
108
|
|
|
|
|
|
|
{ |
109
|
0
|
|
|
|
|
0
|
$cookie = $q -> cookie(@param, -expires => '-1d'); |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
elsif (my($t) = $self -> expire) |
112
|
|
|
|
|
|
|
{ |
113
|
1
|
|
|
|
|
10
|
$cookie = $q -> cookie(@param, -expires => "+${t}s"); |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
else |
116
|
|
|
|
|
|
|
{ |
117
|
0
|
|
|
|
|
0
|
$cookie = $q -> cookie(@param); |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
1
|
|
|
|
|
589
|
return $cookie; |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
} # End of cookie. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# ----------------------------------------------- |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub ctime |
127
|
|
|
|
|
|
|
{ |
128
|
0
|
|
|
0
|
1
|
0
|
my($self) = @_; |
129
|
0
|
|
|
|
|
0
|
my($data) = $self -> session; |
130
|
|
|
|
|
|
|
|
131
|
0
|
|
|
|
|
0
|
return $$data{_SESSION_CTIME}; |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
} # End of ctime. |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
# ----------------------------------------------- |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub delete |
138
|
|
|
|
|
|
|
{ |
139
|
242
|
|
|
242
|
1
|
3976
|
my($self) = @_; |
140
|
242
|
|
|
|
|
1348
|
my($result) = $self -> driver_class -> remove($self -> id); |
141
|
|
|
|
|
|
|
|
142
|
242
|
|
|
|
|
992
|
$self -> clear; |
143
|
242
|
|
|
|
|
811
|
$self -> deleted(1); |
144
|
|
|
|
|
|
|
|
145
|
242
|
|
|
|
|
687
|
return $result; |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
} # End of delete. |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# ----------------------------------------------- |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub DESTROY |
152
|
|
|
|
|
|
|
{ |
153
|
251
|
|
|
251
|
|
43757
|
my($self) = @_; |
154
|
|
|
|
|
|
|
|
155
|
251
|
|
|
|
|
591
|
$self -> flush; |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
} # End of DESTROY. |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# ----------------------------------------------- |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub dump |
162
|
|
|
|
|
|
|
{ |
163
|
0
|
|
|
0
|
1
|
0
|
my($self, $heading) = @_; |
164
|
0
|
|
|
|
|
0
|
my($data) = $self -> session; |
165
|
|
|
|
|
|
|
|
166
|
0
|
0
|
|
|
|
0
|
($heading) && $self -> log($heading); |
167
|
|
|
|
|
|
|
|
168
|
0
|
|
|
|
|
0
|
for my $key (sort keys %$data) |
169
|
|
|
|
|
|
|
{ |
170
|
0
|
0
|
|
|
|
0
|
if (ref($$data{$key}) eq 'HASH') |
171
|
|
|
|
|
|
|
{ |
172
|
0
|
|
|
|
|
0
|
$self -> log("$key: " . join(', ', map{"$_: $$data{$key}{$_}"} sort keys %{$$data{$key} }) ); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
else |
175
|
|
|
|
|
|
|
{ |
176
|
0
|
|
|
|
|
0
|
$self -> log("$key: $$data{$key}"); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
} # End of dump. |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
# ----------------------------------------------- |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub etime |
185
|
|
|
|
|
|
|
{ |
186
|
227
|
|
|
227
|
1
|
15672
|
my($self) = @_; |
187
|
227
|
|
|
|
|
843
|
my($data) = $self -> session; |
188
|
|
|
|
|
|
|
|
189
|
227
|
|
|
|
|
1440
|
return $$data{_SESSION_ETIME}; |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
} # End of etime. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
# ----------------------------------------------- |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub expire |
196
|
|
|
|
|
|
|
{ |
197
|
6
|
|
|
6
|
1
|
57
|
my($self, @arg) = @_; |
198
|
|
|
|
|
|
|
|
199
|
6
|
100
|
|
|
|
25
|
if (! @arg) |
200
|
|
|
|
|
|
|
{ |
201
|
2
|
|
|
|
|
10
|
return $self -> etime; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
4
|
100
|
|
|
|
18
|
if ($#arg == 0) |
205
|
|
|
|
|
|
|
{ |
206
|
|
|
|
|
|
|
# Set the expiry time of the session. |
207
|
|
|
|
|
|
|
|
208
|
2
|
|
|
|
|
9
|
my($data) = $self -> session; |
209
|
2
|
|
|
|
|
11
|
my($time) = $self -> validate_time($arg[0]); |
210
|
|
|
|
|
|
|
|
211
|
2
|
50
|
|
|
|
17
|
if ($$data{_SESSION_ETIME} != $time) |
212
|
|
|
|
|
|
|
{ |
213
|
2
|
|
|
|
|
6
|
$$data{_SESSION_ETIME} = $time; |
214
|
|
|
|
|
|
|
|
215
|
2
|
|
|
|
|
8
|
$self -> session($data); |
216
|
2
|
|
|
|
|
10
|
$self -> modified(1); |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
else |
220
|
|
|
|
|
|
|
{ |
221
|
|
|
|
|
|
|
# Set the expiry times of session parameters. |
222
|
|
|
|
|
|
|
|
223
|
2
|
|
|
|
|
6
|
my($data) = $self -> session; |
224
|
2
|
|
|
|
|
6
|
my($modified) = 0; |
225
|
2
|
|
|
|
|
6
|
my(%arg) = @arg; |
226
|
|
|
|
|
|
|
|
227
|
2
|
|
|
|
|
4
|
my($time); |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
# Warning: The next line ignores 'each %{@arg}'. |
230
|
|
|
|
|
|
|
|
231
|
2
|
|
|
|
|
10
|
while (my($key, $value) = each %arg) |
232
|
|
|
|
|
|
|
{ |
233
|
2
|
|
|
|
|
8
|
$time = $self -> validate_time($value); |
234
|
|
|
|
|
|
|
|
235
|
2
|
100
|
|
|
|
9
|
($time == 0) && next; |
236
|
|
|
|
|
|
|
|
237
|
1
|
50
|
33
|
|
|
8
|
if (! $$data{_SESSION_PTIME}{$key} || ($$data{_SESSION_PTIME}{$key} ne $time) ) |
238
|
|
|
|
|
|
|
{ |
239
|
1
|
|
|
|
|
5
|
$$data{_SESSION_PTIME}{$key} = $time; |
240
|
|
|
|
|
|
|
|
241
|
1
|
|
|
|
|
5
|
$modified = 1; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
2
|
100
|
|
|
|
7
|
if ($modified) |
246
|
|
|
|
|
|
|
{ |
247
|
1
|
|
|
|
|
5
|
$self -> session($data); |
248
|
1
|
|
|
|
|
5
|
$self -> modified(1); |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
4
|
|
|
|
|
14
|
return 1; |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
} # End of expire. |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# ----------------------------------------------- |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub flush |
259
|
|
|
|
|
|
|
{ |
260
|
335
|
|
|
335
|
1
|
972
|
my($self) = @_; |
261
|
|
|
|
|
|
|
|
262
|
335
|
100
|
100
|
|
|
2029
|
if ($self -> modified && ! $self -> deleted) |
263
|
|
|
|
|
|
|
{ |
264
|
92
|
|
|
|
|
938
|
$self -> driver_class -> store |
265
|
|
|
|
|
|
|
( |
266
|
|
|
|
|
|
|
$self -> id, |
267
|
|
|
|
|
|
|
$self -> serializer_class -> freeze($self -> session), |
268
|
|
|
|
|
|
|
$self -> etime |
269
|
|
|
|
|
|
|
); |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
335
|
50
|
|
|
|
1514
|
($self -> verbose > 1) && $self -> dump('Flushing. New: ' . $self -> is_new . '. Modified: ' . $self -> modified . '. Deleted: ' . $self -> deleted); |
273
|
|
|
|
|
|
|
|
274
|
335
|
|
|
|
|
3844
|
return 1; |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
} # End of flush. |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
# ----------------------------------------------- |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
sub get_my_drivers |
281
|
|
|
|
|
|
|
{ |
282
|
251
|
|
|
251
|
0
|
741
|
my($self) = @_; |
283
|
251
|
|
|
|
|
1089
|
my($path) = $self -> _get_pm_path('Driver'); |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
# Warning: Use sort map{} read_dir, not map{} sort read_dir. But, why? |
286
|
|
|
|
|
|
|
|
287
|
251
|
|
|
|
|
1606
|
my(@driver) = sort map{s/.pm//; $_} read_dir($path); |
|
2008
|
|
|
|
|
43416
|
|
|
2008
|
|
|
|
|
6237
|
|
288
|
|
|
|
|
|
|
|
289
|
251
|
50
|
|
|
|
1729
|
($#driver < 0) && die __PACKAGE__ . '. No drivers available'; |
290
|
|
|
|
|
|
|
|
291
|
251
|
50
|
|
|
|
2038
|
($self -> verbose > 1) && $self -> log('Drivers: ' . join(', ', @driver) ); |
292
|
|
|
|
|
|
|
|
293
|
251
|
|
|
|
|
1655
|
$self -> my_drivers(\@driver); |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
} # End of get_my_drivers. |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
# ----------------------------------------------- |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
sub get_my_id_generators |
300
|
|
|
|
|
|
|
{ |
301
|
251
|
|
|
251
|
0
|
640
|
my($self) = @_; |
302
|
251
|
|
|
|
|
875
|
my($path) = $self -> _get_pm_path('ID'); |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
# Warning: Use sort map{} read_dir, not map{} sort read_dir. But, why? |
305
|
|
|
|
|
|
|
|
306
|
251
|
|
|
|
|
1166
|
my(@id_generator) = sort map{s/.pm//; $_} read_dir($path); |
|
2510
|
|
|
|
|
30620
|
|
|
2510
|
|
|
|
|
6220
|
|
307
|
|
|
|
|
|
|
|
308
|
251
|
50
|
|
|
|
1486
|
($#id_generator < 0) && die __PACKAGE__ . '. No id generators available'; |
309
|
|
|
|
|
|
|
|
310
|
251
|
50
|
|
|
|
1457
|
($self -> verbose > 1) && $self -> log('Id generators: ' . join(', ', @id_generator) ); |
311
|
|
|
|
|
|
|
|
312
|
251
|
|
|
|
|
1418
|
$self -> my_id_generators(\@id_generator); |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
} # End of get_my_id_generators. |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
# ----------------------------------------------- |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
sub get_my_serializers |
319
|
|
|
|
|
|
|
{ |
320
|
251
|
|
|
251
|
0
|
767
|
my($self) = @_; |
321
|
251
|
|
|
|
|
907
|
my($path) = $self -> _get_pm_path('Serialize'); |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
# Warning: Use sort map{} read_dir, not map{} sort read_dir. But, why? |
324
|
|
|
|
|
|
|
|
325
|
251
|
|
|
|
|
1322
|
my(@serializer) = sort map{s/.pm//; $_} read_dir($path); |
|
1255
|
|
|
|
|
25188
|
|
|
1255
|
|
|
|
|
3597
|
|
326
|
|
|
|
|
|
|
|
327
|
251
|
50
|
|
|
|
1564
|
($#serializer < 0) && die __PACKAGE__ . '. No serializers available'; |
328
|
|
|
|
|
|
|
|
329
|
251
|
50
|
|
|
|
1455
|
($self -> verbose > 1) && $self -> log('Serializers: ' . join(', ', @serializer) ); |
330
|
|
|
|
|
|
|
|
331
|
251
|
|
|
|
|
1709
|
$self -> my_serializers(\@serializer); |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
} # End of get_my_serializers. |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
# ----------------------------------------------- |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
sub _get_pm_path |
338
|
|
|
|
|
|
|
{ |
339
|
753
|
|
|
753
|
|
1703
|
my($self, $subdir) = @_; |
340
|
753
|
|
|
|
|
1856
|
my($path) = $INC{'Data/Session.pm'}; |
341
|
753
|
|
|
|
|
3845
|
$path =~ s/\.pm$//; |
342
|
|
|
|
|
|
|
|
343
|
753
|
|
|
|
|
9402
|
return File::Spec -> catdir($path, $subdir); |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
# ----------------------------------------------- |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
sub http_header |
349
|
|
|
|
|
|
|
{ |
350
|
1
|
|
|
1
|
1
|
6
|
my($self) = shift; |
351
|
1
|
|
|
|
|
5
|
my($cookie) = $self -> cookie; |
352
|
|
|
|
|
|
|
|
353
|
1
|
|
|
|
|
3
|
my($header); |
354
|
|
|
|
|
|
|
|
355
|
1
|
50
|
|
|
|
8
|
if ($cookie) |
356
|
|
|
|
|
|
|
{ |
357
|
1
|
|
|
|
|
230
|
$header = $self -> query -> header(-cookie => $cookie, @_); |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
else |
360
|
|
|
|
|
|
|
{ |
361
|
0
|
|
|
|
|
0
|
$header = $self -> query -> header(@_); |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
|
364
|
1
|
|
|
|
|
563
|
return $header; |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
} # End of http_header. |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
# ----------------------------------------------- |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
sub load_driver |
371
|
|
|
|
|
|
|
{ |
372
|
251
|
|
|
251
|
0
|
687
|
my($self, $arg) = @_; |
373
|
251
|
|
|
|
|
1214
|
my($class) = join('::', __PACKAGE__, 'Driver', $self -> driver_option); |
374
|
|
|
|
|
|
|
|
375
|
251
|
|
|
|
|
1404
|
try_load_class($class); |
376
|
|
|
|
|
|
|
|
377
|
251
|
50
|
|
|
|
26907
|
die __PACKAGE__ . ". Unable to load class '$class'" if (! is_class_loaded($class) ); |
378
|
|
|
|
|
|
|
|
379
|
251
|
50
|
|
|
|
10171
|
($self -> verbose > 1) && $self -> log("Loaded driver_option: $class"); |
380
|
|
|
|
|
|
|
|
381
|
251
|
|
|
|
|
2447
|
$self -> driver_class($class -> new(%$arg) ); |
382
|
|
|
|
|
|
|
|
383
|
251
|
50
|
|
|
|
1600
|
($self -> verbose > 1) && $self -> log("Initialized driver_class: $class"); |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
} # End of load_driver. |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
# ----------------------------------------------- |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
sub load_id_generator |
390
|
|
|
|
|
|
|
{ |
391
|
251
|
|
|
251
|
0
|
687
|
my($self, $arg) = @_; |
392
|
251
|
|
|
|
|
1314
|
my($class) = join('::', __PACKAGE__, 'ID', $self -> id_option); |
393
|
|
|
|
|
|
|
|
394
|
251
|
|
|
|
|
1148
|
try_load_class($class); |
395
|
|
|
|
|
|
|
|
396
|
251
|
50
|
|
|
|
18177
|
die __PACKAGE__ . ". Unable to load class '$class'" if (! is_class_loaded($class) ); |
397
|
|
|
|
|
|
|
|
398
|
251
|
50
|
|
|
|
10202
|
($self -> verbose > 1) && $self -> log("Loaded id_option: $class"); |
399
|
|
|
|
|
|
|
|
400
|
251
|
|
|
|
|
2332
|
$self -> id_class($class -> new(%$arg) ); |
401
|
|
|
|
|
|
|
|
402
|
251
|
50
|
|
|
|
1472
|
($self -> verbose > 1) && $self -> log("Initialized id_class: $class"); |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
} # End of load_id_generator. |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
# ----------------------------------------------- |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
sub load_param |
409
|
|
|
|
|
|
|
{ |
410
|
40
|
|
|
40
|
1
|
25346
|
my($self, $q, $name) = @_; |
411
|
|
|
|
|
|
|
|
412
|
40
|
50
|
|
|
|
171
|
if (! defined $q) |
413
|
|
|
|
|
|
|
{ |
414
|
40
|
|
|
|
|
129
|
$q = $self -> load_query_class; |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
|
417
|
40
|
|
|
|
|
167
|
my($data) = $self -> session; |
418
|
|
|
|
|
|
|
|
419
|
40
|
50
|
|
|
|
248
|
if (! $name) |
|
|
50
|
|
|
|
|
|
420
|
|
|
|
|
|
|
{ |
421
|
0
|
|
|
|
|
0
|
$name = [sort keys %$data]; |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
elsif (ref($name) ne 'ARRAY') |
424
|
|
|
|
|
|
|
{ |
425
|
0
|
|
|
|
|
0
|
$name = [$name]; |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
|
428
|
40
|
|
|
|
|
110
|
for my $key (grep{! /^_/} @$name) |
|
80
|
|
|
|
|
299
|
|
429
|
|
|
|
|
|
|
{ |
430
|
80
|
|
|
|
|
3042
|
$q -> param($key => $$data{$key}); |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
|
433
|
40
|
|
|
|
|
2157
|
return $q; |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
} # End of load_param. |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
# ----------------------------------------------- |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
sub load_query_class |
440
|
|
|
|
|
|
|
{ |
441
|
154
|
|
|
154
|
1
|
369
|
my($self) = @_; |
442
|
|
|
|
|
|
|
|
443
|
154
|
100
|
|
|
|
852
|
if (! $self -> query) |
444
|
|
|
|
|
|
|
{ |
445
|
119
|
|
|
|
|
420
|
my($class) = $self -> query_class; |
446
|
|
|
|
|
|
|
|
447
|
119
|
|
|
|
|
445
|
try_load_class($class); |
448
|
|
|
|
|
|
|
|
449
|
119
|
50
|
|
|
|
7316
|
die __PACKAGE__ . ". Unable to load class '$class'" if (! is_class_loaded($class) ); |
450
|
|
|
|
|
|
|
|
451
|
119
|
50
|
|
|
|
4405
|
($self -> verbose > 1) && $self -> log('Loaded query_class: ' . $class); |
452
|
|
|
|
|
|
|
|
453
|
119
|
|
|
|
|
824
|
$self -> query($class -> new); |
454
|
|
|
|
|
|
|
|
455
|
119
|
50
|
|
|
|
40137
|
($self -> verbose > 1) && $self -> log('Called query_class -> new: ' . $class); |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
|
458
|
154
|
|
|
|
|
663
|
return $self -> query; |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
} # End of load_query_class. |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
# ----------------------------------------------- |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
sub load_serializer |
465
|
|
|
|
|
|
|
{ |
466
|
251
|
|
|
251
|
0
|
689
|
my($self, $arg) = @_; |
467
|
251
|
|
|
|
|
1266
|
my($class) = join('::', __PACKAGE__, 'Serialize', $self -> serializer_option); |
468
|
|
|
|
|
|
|
|
469
|
251
|
|
|
|
|
942
|
try_load_class($class); |
470
|
|
|
|
|
|
|
|
471
|
251
|
50
|
|
|
|
16398
|
die __PACKAGE__ . ". Unable to load class '$class'" if (! is_class_loaded($class) ); |
472
|
|
|
|
|
|
|
|
473
|
251
|
50
|
|
|
|
10324
|
($self -> verbose > 1) && $self -> log("Loaded serializer_option: $class"); |
474
|
|
|
|
|
|
|
|
475
|
251
|
|
|
|
|
2639
|
$self -> serializer_class($class -> new(%$arg) ); |
476
|
|
|
|
|
|
|
|
477
|
251
|
50
|
|
|
|
1642
|
($self -> verbose > 1) && $self -> log("Initialized serializer_class: $class"); |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
} # End of load_serializer. |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
# ----------------------------------------------- |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
sub load_session |
484
|
|
|
|
|
|
|
{ |
485
|
251
|
|
|
251
|
1
|
694
|
my($self) = @_; |
486
|
251
|
|
|
|
|
1191
|
my($id) = $self -> user_id; |
487
|
|
|
|
|
|
|
|
488
|
251
|
50
|
|
|
|
1315
|
($self -> verbose > 1) && $self -> log("Loading session for id: $id"); |
489
|
|
|
|
|
|
|
|
490
|
251
|
100
|
|
|
|
927
|
if ($id) |
491
|
|
|
|
|
|
|
{ |
492
|
137
|
|
|
|
|
713
|
my($raw_data) = $self -> driver_class -> retrieve($id); |
493
|
|
|
|
|
|
|
|
494
|
137
|
50
|
|
|
|
886
|
($self -> verbose > 1) && $self -> log("Tried to retrieve session for id: $id. Length of raw data: @{[length($raw_data)]}"); |
|
0
|
|
|
|
|
0
|
|
495
|
|
|
|
|
|
|
|
496
|
137
|
100
|
|
|
|
524
|
if (! $raw_data) |
497
|
|
|
|
|
|
|
{ |
498
|
5
|
|
|
|
|
24
|
$self -> new_session($id); |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
else |
501
|
|
|
|
|
|
|
{ |
502
|
|
|
|
|
|
|
# Retrieved an old session, so flag it as accessed, and not-new. |
503
|
|
|
|
|
|
|
|
504
|
132
|
|
|
|
|
812
|
my($data) = $self -> serializer_class -> thaw($raw_data); |
505
|
|
|
|
|
|
|
|
506
|
132
|
50
|
|
|
|
27308
|
if ($self -> verbose > 1) |
507
|
|
|
|
|
|
|
{ |
508
|
0
|
|
|
|
|
0
|
for my $key (sort keys %{$$data{_SESSION_PTIME} }) |
|
0
|
|
|
|
|
0
|
|
509
|
|
|
|
|
|
|
{ |
510
|
0
|
|
|
|
|
0
|
$self -> log("Recovered session parameter expiry time: $key: $$data{_SESSION_PTIME}{$key}"); |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
|
514
|
132
|
|
|
|
|
886
|
$self -> id($id); |
515
|
132
|
|
|
|
|
682
|
$self -> is_new(0); |
516
|
132
|
|
|
|
|
613
|
$self -> session($data); |
517
|
|
|
|
|
|
|
|
518
|
132
|
50
|
|
|
|
703
|
($self -> verbose > 1) && $self -> dump('Loaded'); |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
# Check for session expiry. |
521
|
|
|
|
|
|
|
|
522
|
132
|
|
|
|
|
610
|
$self -> check_expiry; |
523
|
|
|
|
|
|
|
|
524
|
132
|
50
|
|
|
|
509
|
($self -> verbose > 1) && $self -> dump('Loaded and checked expiry'); |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
# Check for session parameter expiry. |
527
|
|
|
|
|
|
|
# Stockpile keys to be cleared. We can't call $self -> clear($key) inside the loop, |
528
|
|
|
|
|
|
|
# because it updates $$data{_SESSION_PTIME}, which in turns confuses 'each'. |
529
|
|
|
|
|
|
|
|
530
|
132
|
|
|
|
|
304
|
my(@stack); |
531
|
|
|
|
|
|
|
|
532
|
132
|
|
|
|
|
282
|
while (my($key, $time) = each %{$$data{_SESSION_PTIME} }) |
|
133
|
|
|
|
|
806
|
|
533
|
|
|
|
|
|
|
{ |
534
|
1
|
50
|
33
|
|
|
11
|
if ($time && ( ($self -> atime + $time) < time) ) |
535
|
|
|
|
|
|
|
{ |
536
|
1
|
|
|
|
|
6
|
push @stack, $key; |
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
|
540
|
132
|
|
|
|
|
393
|
$self -> clear($_) for @stack; |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
# We can't do this above, just after my($data)..., since it's used just above, as $self -> atime(). |
543
|
|
|
|
|
|
|
|
544
|
132
|
|
|
|
|
558
|
$self -> atime(time); |
545
|
|
|
|
|
|
|
|
546
|
132
|
50
|
|
|
|
602
|
($self -> verbose > 1) && $self -> dump('Loaded and checked parameter expiry'); |
547
|
|
|
|
|
|
|
} |
548
|
|
|
|
|
|
|
} |
549
|
|
|
|
|
|
|
else |
550
|
|
|
|
|
|
|
{ |
551
|
114
|
|
|
|
|
399
|
$self -> new_session(0); |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
251
|
50
|
|
|
|
1289
|
($self -> verbose > 1) && $self -> log("Loaded session for id: " . $self -> id); |
555
|
|
|
|
|
|
|
|
556
|
251
|
|
|
|
|
1042
|
return 1; |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
} # End of load_session. |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
# ----------------------------------------------- |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
sub new |
563
|
|
|
|
|
|
|
{ |
564
|
251
|
|
|
251
|
1
|
6261105
|
my($class, %arg) = @_; |
565
|
251
|
|
50
|
|
|
1998
|
$arg{debug} ||= 0; # new(...). |
566
|
251
|
|
|
|
|
639
|
$arg{deleted} = 0; # Internal. |
567
|
251
|
|
|
|
|
757
|
$arg{expired} = 0; # Internal. |
568
|
251
|
|
100
|
|
|
911
|
$arg{id} ||= 0; # new(...). |
569
|
251
|
|
|
|
|
652
|
$arg{modified} = 0; # Internal. |
570
|
251
|
|
100
|
|
|
1489
|
$arg{name} ||= 'CGISESSID'; # new(...). |
571
|
251
|
|
100
|
|
|
1271
|
$arg{query} ||= ''; # new(...). |
572
|
251
|
|
50
|
|
|
1335
|
$arg{query_class} ||= 'CGI'; # new(...). |
573
|
251
|
|
|
|
|
782
|
$arg{session} = {}; # Internal. |
574
|
251
|
|
50
|
|
|
820
|
$arg{type} ||= ''; # new(...). |
575
|
251
|
|
50
|
|
|
878
|
$arg{verbose} ||= 0; # new(...). |
576
|
|
|
|
|
|
|
|
577
|
251
|
|
|
|
|
402
|
my($self); |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
try |
580
|
|
|
|
|
|
|
{ |
581
|
251
|
|
|
251
|
|
32561
|
$self = from_hash(bless({}, $class), \%arg); |
582
|
|
|
|
|
|
|
|
583
|
251
|
|
|
|
|
1663
|
$self -> get_my_drivers; |
584
|
251
|
|
|
|
|
1262
|
$self -> get_my_id_generators; |
585
|
251
|
|
|
|
|
1115
|
$self -> get_my_serializers; |
586
|
251
|
|
|
|
|
1311
|
$self -> parse_options; |
587
|
251
|
|
|
|
|
1107
|
$self -> validate_options; |
588
|
251
|
|
|
|
|
1136
|
$self -> load_driver(\%arg); |
589
|
251
|
|
|
|
|
1334
|
$self -> load_id_generator(\%arg); |
590
|
251
|
|
|
|
|
1370
|
$self -> load_serializer(\%arg); |
591
|
251
|
|
|
|
|
1391
|
$self -> load_session; # Calls user_id() which calls load_query_class() if necessary. |
592
|
|
|
|
|
|
|
} |
593
|
|
|
|
|
|
|
catch |
594
|
|
|
|
|
|
|
{ |
595
|
0
|
|
|
0
|
|
0
|
$errstr = $_; |
596
|
0
|
|
|
|
|
0
|
$self = undef; |
597
|
251
|
|
|
|
|
3042
|
}; |
598
|
|
|
|
|
|
|
|
599
|
251
|
|
|
|
|
8367
|
return $self; |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
} # End of new. |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
# ----------------------------------------------- |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
sub new_session |
606
|
|
|
|
|
|
|
{ |
607
|
119
|
|
|
119
|
0
|
279
|
my($self, $id) = @_; |
608
|
119
|
100
|
|
|
|
806
|
$id = $id ? $id : $self -> id_class -> generate; |
609
|
119
|
|
|
|
|
2877
|
my($time) = time; |
610
|
|
|
|
|
|
|
|
611
|
119
|
|
|
|
|
1600
|
$self -> session |
612
|
|
|
|
|
|
|
({ |
613
|
|
|
|
|
|
|
_SESSION_ATIME => $time, # Access time. |
614
|
|
|
|
|
|
|
_SESSION_CTIME => $time, # Create time. |
615
|
|
|
|
|
|
|
_SESSION_ETIME => 0, # Session expiry time. |
616
|
|
|
|
|
|
|
_SESSION_ID => $id, # Session id. |
617
|
|
|
|
|
|
|
_SESSION_PTIME => {}, # Parameter expiry times. |
618
|
|
|
|
|
|
|
}); |
619
|
|
|
|
|
|
|
|
620
|
119
|
|
|
|
|
747
|
$self -> id($id); |
621
|
119
|
|
|
|
|
720
|
$self -> is_new(1); |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
} # End of new_session. |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
# ----------------------------------------------- |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
sub param |
628
|
|
|
|
|
|
|
{ |
629
|
692
|
|
|
692
|
1
|
110091
|
my($self, @arg) = @_; |
630
|
692
|
|
|
|
|
2111
|
my($data) = $self -> session; |
631
|
|
|
|
|
|
|
|
632
|
692
|
100
|
|
|
|
2474
|
if ($#arg < 0) |
|
|
100
|
|
|
|
|
|
633
|
|
|
|
|
|
|
{ |
634
|
242
|
|
|
|
|
2132
|
return grep{! /^_/} sort keys %$data; |
|
1641
|
|
|
|
|
4656
|
|
635
|
|
|
|
|
|
|
} |
636
|
|
|
|
|
|
|
elsif ($#arg == 0) |
637
|
|
|
|
|
|
|
{ |
638
|
|
|
|
|
|
|
# If only 1 name is supplied, return the session's data for that name. |
639
|
|
|
|
|
|
|
|
640
|
283
|
|
|
|
|
1709
|
return $$data{$arg[0]}; |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
# Otherwise, loop over all the supplied data. |
644
|
|
|
|
|
|
|
|
645
|
167
|
|
|
|
|
616
|
my(%arg) = @arg; |
646
|
|
|
|
|
|
|
|
647
|
167
|
|
|
|
|
666
|
for my $key (keys %arg) |
648
|
|
|
|
|
|
|
{ |
649
|
167
|
50
|
|
|
|
578
|
next if ($key =~ /^_/); |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
# Don't update a value if it's the same as the original value. |
652
|
|
|
|
|
|
|
# That way we don't update the last-access-time. |
653
|
|
|
|
|
|
|
# We're effectively testing $x == $y, but we're not testing to ensure: |
654
|
|
|
|
|
|
|
# o undef == undef |
655
|
|
|
|
|
|
|
# o 0 == 0 |
656
|
|
|
|
|
|
|
# o '' == '' |
657
|
|
|
|
|
|
|
# So changing undef to 0 or visa versa, etc, will all be ignored. |
658
|
|
|
|
|
|
|
|
659
|
167
|
100
|
66
|
|
|
969
|
(! $$data{$key} && ! $arg{$key}) && next; |
660
|
|
|
|
|
|
|
|
661
|
127
|
0
|
33
|
|
|
688
|
if ( (! $$data{$key} && $arg{$key}) || ($$data{$key} && ! $arg{$key}) || ($$data{$key} ne $arg{$key}) ) |
|
|
|
0
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
662
|
|
|
|
|
|
|
{ |
663
|
127
|
|
|
|
|
314
|
$$data{$key} = $arg{$key}; |
664
|
|
|
|
|
|
|
|
665
|
127
|
|
|
|
|
534
|
$self -> modified(1); |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
|
669
|
167
|
|
|
|
|
597
|
$self -> session($data); |
670
|
|
|
|
|
|
|
|
671
|
167
|
|
|
|
|
483
|
return 1; |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
} # End of param. |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
# ----------------------------------------------- |
676
|
|
|
|
|
|
|
# Format expected: new(type => 'driver:File;id:MD5;serialize:DataDumper'). |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
sub parse_options |
679
|
|
|
|
|
|
|
{ |
680
|
251
|
|
|
251
|
0
|
917
|
my($self) = @_; |
681
|
251
|
|
50
|
|
|
1618
|
my($options) = $self -> type || ''; |
682
|
|
|
|
|
|
|
|
683
|
251
|
50
|
|
|
|
1036
|
($self -> verbose > 1) && $self -> log("Parsing type '$options'"); |
684
|
|
|
|
|
|
|
|
685
|
251
|
|
|
|
|
1073
|
$options =~ tr/ //d; |
686
|
251
|
|
|
|
|
1881
|
my(%options) = map{split(/:/, $_)} split(/;/, lc $options); # lc! |
|
753
|
|
|
|
|
2411
|
|
687
|
251
|
|
|
|
|
1494
|
my(%default) = |
688
|
|
|
|
|
|
|
( |
689
|
|
|
|
|
|
|
driver => 'File', |
690
|
|
|
|
|
|
|
id => 'MD5', |
691
|
|
|
|
|
|
|
serialize => 'DataDumper', |
692
|
|
|
|
|
|
|
); |
693
|
|
|
|
|
|
|
|
694
|
251
|
|
|
|
|
1196
|
for my $key (keys %options) |
695
|
|
|
|
|
|
|
{ |
696
|
753
|
50
|
|
|
|
1948
|
(! $default{$key}) && die __PACKAGE__ . ". Error in type: Unexpected component '$key'"; |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
251
|
|
|
|
|
634
|
my(%driver) = map{(lc $_ => $_)} @{$self -> my_drivers}; |
|
2008
|
|
|
|
|
5957
|
|
|
251
|
|
|
|
|
922
|
|
700
|
251
|
|
|
|
|
811
|
my(%id_generator) = map{(lc $_ => $_)} @{$self -> my_id_generators}; |
|
2510
|
|
|
|
|
6758
|
|
|
251
|
|
|
|
|
965
|
|
701
|
251
|
|
|
|
|
848
|
my(%serializer) = map{(lc $_ => $_)} @{$self -> my_serializers}; |
|
1255
|
|
|
|
|
3685
|
|
|
251
|
|
|
|
|
764
|
|
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
# The sort is just to make the warnings ($required) appear in alphabetical order. |
704
|
|
|
|
|
|
|
|
705
|
251
|
|
|
|
|
1374
|
for my $required (sort keys %default) |
706
|
|
|
|
|
|
|
{ |
707
|
|
|
|
|
|
|
# Set default if user does not supply the key:value pair. |
708
|
|
|
|
|
|
|
|
709
|
753
|
50
|
|
|
|
2098
|
if (! exists $options{$required}) |
710
|
|
|
|
|
|
|
{ |
711
|
0
|
|
|
|
|
0
|
$options{$required} = $default{$required}; |
712
|
|
|
|
|
|
|
|
713
|
0
|
0
|
|
|
|
0
|
($self -> verbose) && $self -> log("Warning for type: Defaulting '$required' to '$default{$required}'"); |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
# Ensure the value is set. |
717
|
|
|
|
|
|
|
|
718
|
753
|
50
|
|
|
|
1699
|
(! $options{$required}) && die __PACKAGE__ . ". Error in type: Missing value for option '$required'"; |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
# Ensure the case of the value is correct. |
721
|
|
|
|
|
|
|
|
722
|
753
|
100
|
|
|
|
2582
|
if ($required eq 'driver') |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
723
|
|
|
|
|
|
|
{ |
724
|
251
|
50
|
|
|
|
854
|
if ($driver{lc $options{$required} }) |
725
|
|
|
|
|
|
|
{ |
726
|
251
|
|
|
|
|
841
|
$options{$required} = $driver{lc $options{$required} }; |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
else |
729
|
|
|
|
|
|
|
{ |
730
|
0
|
|
|
|
|
0
|
die __PACKAGE__ . ". Unknown driver '$options{$required}'"; |
731
|
|
|
|
|
|
|
} |
732
|
|
|
|
|
|
|
} |
733
|
|
|
|
|
|
|
elsif ($required eq 'id') |
734
|
|
|
|
|
|
|
{ |
735
|
251
|
50
|
|
|
|
766
|
if ($id_generator{lc $options{$required} }) |
736
|
|
|
|
|
|
|
{ |
737
|
251
|
|
|
|
|
705
|
$options{$required} = $id_generator{lc $options{$required} }; |
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
else |
740
|
|
|
|
|
|
|
{ |
741
|
0
|
|
|
|
|
0
|
die __PACKAGE__ . ". Unknown id generator '$options{$required}'"; |
742
|
|
|
|
|
|
|
} |
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
elsif ($required eq 'serialize') |
745
|
|
|
|
|
|
|
{ |
746
|
251
|
50
|
|
|
|
904
|
if ($serializer{lc $options{$required} }) |
747
|
|
|
|
|
|
|
{ |
748
|
251
|
|
|
|
|
857
|
$options{$required} = $serializer{lc $options{$required} }; |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
else |
751
|
|
|
|
|
|
|
{ |
752
|
0
|
|
|
|
|
0
|
die __PACKAGE__ . ". Unknown serialize '$options{$required}'"; |
753
|
|
|
|
|
|
|
} |
754
|
|
|
|
|
|
|
} |
755
|
|
|
|
|
|
|
} |
756
|
|
|
|
|
|
|
|
757
|
251
|
|
|
|
|
1573
|
$self -> driver_option($options{driver}); |
758
|
251
|
|
|
|
|
1224
|
$self -> id_option($options{id}); |
759
|
251
|
|
|
|
|
1001
|
$self -> serializer_option($options{serialize}); |
760
|
251
|
|
|
|
|
958
|
$self -> type(join(';', map{"$_:$options{$_}"} sort keys %default)); |
|
753
|
|
|
|
|
2997
|
|
761
|
|
|
|
|
|
|
|
762
|
251
|
50
|
|
|
|
2362
|
if ($self -> verbose > 1) |
763
|
|
|
|
|
|
|
{ |
764
|
0
|
|
|
|
|
0
|
$self -> log('type: ' . $self -> type); |
765
|
0
|
|
|
|
|
0
|
$self -> log('driver_option: ' . $self -> driver_option); |
766
|
0
|
|
|
|
|
0
|
$self -> log('id_option: ' . $self -> id_option); |
767
|
0
|
|
|
|
|
0
|
$self -> log('serializer_option: ' . $self -> serializer_option); |
768
|
|
|
|
|
|
|
} |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
} # End of parse_options. |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
# ----------------------------------------------- |
773
|
|
|
|
|
|
|
# Warning: Returns a hashref. |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
sub ptime |
776
|
|
|
|
|
|
|
{ |
777
|
1
|
|
|
1
|
1
|
20
|
my($self) = @_; |
778
|
1
|
|
|
|
|
10
|
my($data) = $self -> session; |
779
|
|
|
|
|
|
|
|
780
|
1
|
|
|
|
|
5
|
return $$data{_SESSION_PTIME}; |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
} # End of ptime. |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
# ----------------------------------------------- |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
sub save_param |
787
|
|
|
|
|
|
|
{ |
788
|
40
|
|
|
40
|
1
|
512
|
my($self, $q, $name) = @_; |
789
|
|
|
|
|
|
|
|
790
|
40
|
50
|
|
|
|
173
|
if (! defined $q) |
791
|
|
|
|
|
|
|
{ |
792
|
0
|
|
|
|
|
0
|
$q = $self -> load_query_class; |
793
|
|
|
|
|
|
|
} |
794
|
|
|
|
|
|
|
|
795
|
40
|
|
|
|
|
199
|
my($data) = $self -> session; |
796
|
|
|
|
|
|
|
|
797
|
40
|
50
|
|
|
|
264
|
if (! $name) |
|
|
50
|
|
|
|
|
|
798
|
|
|
|
|
|
|
{ |
799
|
0
|
|
|
|
|
0
|
$name = [$q -> param]; |
800
|
|
|
|
|
|
|
} |
801
|
|
|
|
|
|
|
elsif (ref($name) ne 'ARRAY') |
802
|
|
|
|
|
|
|
{ |
803
|
0
|
|
|
|
|
0
|
$name = [grep{! /^_/} $name]; |
|
0
|
|
|
|
|
0
|
|
804
|
|
|
|
|
|
|
} |
805
|
|
|
|
|
|
|
else |
806
|
|
|
|
|
|
|
{ |
807
|
40
|
|
|
|
|
139
|
$name = [grep{! /^_/} @$name]; |
|
80
|
|
|
|
|
290
|
|
808
|
|
|
|
|
|
|
} |
809
|
|
|
|
|
|
|
|
810
|
40
|
|
|
|
|
137
|
for my $key (@$name) |
811
|
|
|
|
|
|
|
{ |
812
|
80
|
|
|
|
|
253
|
$$data{$key} = $q -> param($key); |
813
|
|
|
|
|
|
|
|
814
|
80
|
|
|
|
|
2302
|
$self -> modified(1); |
815
|
|
|
|
|
|
|
} |
816
|
|
|
|
|
|
|
|
817
|
40
|
|
|
|
|
184
|
$self -> session($data); |
818
|
|
|
|
|
|
|
|
819
|
40
|
|
|
|
|
107
|
return 1; |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
} # End of save_param. |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
# ----------------------------------------------- |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
sub traverse |
826
|
|
|
|
|
|
|
{ |
827
|
1
|
|
|
1
|
1
|
20
|
my($self, $sub) = @_; |
828
|
|
|
|
|
|
|
|
829
|
1
|
|
|
|
|
9
|
return $self -> driver_class -> traverse($sub); |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
} # End of traverse. |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
# ----------------------------------------------- |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
sub user_id |
836
|
|
|
|
|
|
|
{ |
837
|
251
|
|
|
251
|
1
|
805
|
my($self) = @_; |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
# Sources of id: |
840
|
|
|
|
|
|
|
# o User supplied one in $session -> new(id => $id). |
841
|
|
|
|
|
|
|
# o User didn't, so we try $self -> query -> cookie and/or $self -> query -> param. |
842
|
|
|
|
|
|
|
|
843
|
251
|
|
|
|
|
1000
|
my($id) = $self -> id; |
844
|
|
|
|
|
|
|
|
845
|
251
|
100
|
|
|
|
930
|
if (! $id) |
846
|
|
|
|
|
|
|
{ |
847
|
114
|
|
|
|
|
462
|
$self -> load_query_class; |
848
|
|
|
|
|
|
|
|
849
|
114
|
|
|
|
|
511
|
my($name) = $self -> name; |
850
|
114
|
|
|
|
|
405
|
my($q) = $self -> query; |
851
|
|
|
|
|
|
|
|
852
|
114
|
50
|
|
|
|
883
|
if ($q -> can('cookie') ) |
853
|
|
|
|
|
|
|
{ |
854
|
114
|
|
33
|
|
|
573
|
$id = $q -> cookie($name) || $q -> param($name); |
855
|
|
|
|
|
|
|
|
856
|
114
|
50
|
0
|
|
|
17469
|
($self -> verbose > 1) && $self -> log('query can cookie(). id from cookie or param: ' . ($id || '') ); |
857
|
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
|
else |
859
|
|
|
|
|
|
|
{ |
860
|
0
|
|
|
|
|
0
|
$id = $q -> param($name); |
861
|
|
|
|
|
|
|
|
862
|
0
|
0
|
0
|
|
|
0
|
($self -> verbose > 1) && $self -> log("query can't cookie(). id from param: " . ($id || '') ); |
863
|
|
|
|
|
|
|
} |
864
|
|
|
|
|
|
|
|
865
|
114
|
50
|
|
|
|
419
|
if (! $id) |
866
|
|
|
|
|
|
|
{ |
867
|
114
|
|
|
|
|
235
|
$id = 0; |
868
|
|
|
|
|
|
|
} |
869
|
|
|
|
|
|
|
} |
870
|
|
|
|
|
|
|
|
871
|
251
|
|
|
|
|
654
|
return $id; |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
} # End of user_id. |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
# ----------------------------------------------- |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
sub validate_options |
878
|
|
|
|
|
|
|
{ |
879
|
251
|
|
|
251
|
1
|
630
|
my($self) = @_; |
880
|
|
|
|
|
|
|
|
881
|
251
|
50
|
66
|
|
|
1380
|
if ( ($self -> id_option eq 'Static') && ! $self -> id) |
882
|
|
|
|
|
|
|
{ |
883
|
0
|
|
|
|
|
0
|
die __PACKAGE__ . '. When using id:Static, you must provide a (true) id to new(id => ...)'; |
884
|
|
|
|
|
|
|
} |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
} # End of validate_options. |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
# ----------------------------------------------- |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
sub validate_time |
891
|
|
|
|
|
|
|
{ |
892
|
7
|
|
|
7
|
1
|
1058
|
my($self, $time) = @_; |
893
|
|
|
|
|
|
|
|
894
|
7
|
100
|
|
|
|
23
|
(! $time) && return 0; |
895
|
|
|
|
|
|
|
|
896
|
6
|
100
|
|
|
|
51
|
$time = "${time}s" if ($time =~ /\d$/); |
897
|
|
|
|
|
|
|
|
898
|
6
|
50
|
|
|
|
44
|
($time !~ /^([-+]?\d+)([smhdwMy])$/) && die __PACKAGE__ . ". Can't parse time: $time"; |
899
|
|
|
|
|
|
|
|
900
|
6
|
|
|
|
|
44
|
my(%scale) = |
901
|
|
|
|
|
|
|
( |
902
|
|
|
|
|
|
|
s => 1, |
903
|
|
|
|
|
|
|
m => 60, |
904
|
|
|
|
|
|
|
h => 3600, |
905
|
|
|
|
|
|
|
d => 86400, |
906
|
|
|
|
|
|
|
w => 604800, |
907
|
|
|
|
|
|
|
M => 2592000, |
908
|
|
|
|
|
|
|
y => 31536000, |
909
|
|
|
|
|
|
|
); |
910
|
|
|
|
|
|
|
|
911
|
6
|
|
|
|
|
51
|
return $scale{$2} * $1; |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
} # End of validate_time. |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
# ----------------------------------------------- |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
1; |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=pod |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
=head1 NAME |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
Data::Session - Persistent session data management |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
=head1 Synopsis |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
1: A self-contained CGI script (scripts/cgi.demo.cgi): |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
#!/usr/bin/perl |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
use CGI; |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
use Data::Session; |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
use File::Spec; |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
# ---------------------------------------------- |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
sub generate_html |
940
|
|
|
|
|
|
|
{ |
941
|
|
|
|
|
|
|
my($name, $id, $count) = @_; |
942
|
|
|
|
|
|
|
$id ||= ''; |
943
|
|
|
|
|
|
|
my($title) = "CGI demo for Data::Session"; |
944
|
|
|
|
|
|
|
return <
|
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
$title |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
Number of times this script has been run: $count. |
949
|
|
|
|
|
|
|
Current value of $name: $id. |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
EOS |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
} # End of generate_html. |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
# ---------------------------------------------- |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
my($q) = CGI -> new; |
963
|
|
|
|
|
|
|
my($name) = 'sid'; # CGI form field name. |
964
|
|
|
|
|
|
|
my($sid) = $q -> param($name); |
965
|
|
|
|
|
|
|
my($dir_name) = '/tmp'; |
966
|
|
|
|
|
|
|
my($type) = 'driver:File;id:MD5;serialize:JSON'; |
967
|
|
|
|
|
|
|
my($session) = Data::Session -> new |
968
|
|
|
|
|
|
|
( |
969
|
|
|
|
|
|
|
directory => $dir_name, |
970
|
|
|
|
|
|
|
name => $name, |
971
|
|
|
|
|
|
|
query => $q, |
972
|
|
|
|
|
|
|
type => $type, |
973
|
|
|
|
|
|
|
); |
974
|
|
|
|
|
|
|
my($id) = $session -> id; |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
# First entry ever? |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
my($count); |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
if ($sid) # Not $id, which always has a value... |
981
|
|
|
|
|
|
|
{ |
982
|
|
|
|
|
|
|
# No. The CGI form field called sid has a (true) value. |
983
|
|
|
|
|
|
|
# So, this is the code for the second and subsequent entries. |
984
|
|
|
|
|
|
|
# Count the # of times this CGI script has been run. |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
$count = $session -> param('count') + 1; |
987
|
|
|
|
|
|
|
} |
988
|
|
|
|
|
|
|
else |
989
|
|
|
|
|
|
|
{ |
990
|
|
|
|
|
|
|
# Yes. There is no CGI form field called sid (with a true value). |
991
|
|
|
|
|
|
|
# So, this is the code for the first entry ever. |
992
|
|
|
|
|
|
|
# Count the # of times this CGI script has been run. |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
$count = 0; |
995
|
|
|
|
|
|
|
} |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
$session -> param(count => $count); |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
print $q -> header, generate_html($name, $id, $count); |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
# Calling flush() is good practice, rather than hoping 'things just work'. |
1002
|
|
|
|
|
|
|
# In a persistent environment, this call is mandatory... |
1003
|
|
|
|
|
|
|
# But you knew that, because you'd read the docs, right? |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
$session -> flush; |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
2: A basic session. See scripts/sqlite.pl: |
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
# The EXLOCK is for BSD-based systems. |
1010
|
|
|
|
|
|
|
my($directory) = File::Temp::newdir('temp.XXXX', CLEANUP => 1, EXLOCK => 0, TMPDIR => 1); |
1011
|
|
|
|
|
|
|
my($data_source) = 'dbi:SQLite:dbname=' . File::Spec -> catdir($directory, 'sessions.sqlite'); |
1012
|
|
|
|
|
|
|
my($type) = 'driver:SQLite;id:SHA1;serialize:DataDumper'; # Case-sensitive. |
1013
|
|
|
|
|
|
|
my($session) = Data::Session -> new |
1014
|
|
|
|
|
|
|
( |
1015
|
|
|
|
|
|
|
data_source => $data_source, |
1016
|
|
|
|
|
|
|
type => $type, |
1017
|
|
|
|
|
|
|
) || die $Data::Session::errstr; |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
3: Using BerkeleyDB as a cache manager. See scripts/berkeleydb.pl: |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
# The EXLOCK is for BSD-based systems. |
1022
|
|
|
|
|
|
|
my($file_name) = File::Temp -> new(EXLOCK => 0, SUFFIX => '.bdb'); |
1023
|
|
|
|
|
|
|
my($env) = BerkeleyDB::Env -> new |
1024
|
|
|
|
|
|
|
( |
1025
|
|
|
|
|
|
|
Home => File::Spec -> tmpdir, |
1026
|
|
|
|
|
|
|
Flags => DB_CREATE | DB_INIT_CDB | DB_INIT_MPOOL, |
1027
|
|
|
|
|
|
|
); |
1028
|
|
|
|
|
|
|
if (! $env) |
1029
|
|
|
|
|
|
|
{ |
1030
|
|
|
|
|
|
|
print "BerkeleyDB is not responding. \n"; |
1031
|
|
|
|
|
|
|
exit; |
1032
|
|
|
|
|
|
|
} |
1033
|
|
|
|
|
|
|
my($bdb) = BerkeleyDB::Hash -> new(Env => $env, Filename => $file_name, Flags => DB_CREATE); |
1034
|
|
|
|
|
|
|
if (! $bdb) |
1035
|
|
|
|
|
|
|
{ |
1036
|
|
|
|
|
|
|
print "BerkeleyDB is not responding. \n"; |
1037
|
|
|
|
|
|
|
exit; |
1038
|
|
|
|
|
|
|
} |
1039
|
|
|
|
|
|
|
my($type) = 'driver:BerkeleyDB;id:SHA1;serialize:DataDumper'; # Case-sensitive. |
1040
|
|
|
|
|
|
|
my($session) = Data::Session -> new |
1041
|
|
|
|
|
|
|
( |
1042
|
|
|
|
|
|
|
cache => $bdb, |
1043
|
|
|
|
|
|
|
type => $type, |
1044
|
|
|
|
|
|
|
) || die $Data::Session::errstr; |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
4: Using memcached as a cache manager. See scripts/memcached.pl: |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
my($memd) = Cache::Memcached -> new |
1049
|
|
|
|
|
|
|
({ |
1050
|
|
|
|
|
|
|
namespace => 'data.session.id', |
1051
|
|
|
|
|
|
|
servers => ['127.0.0.1:11211'], |
1052
|
|
|
|
|
|
|
}); |
1053
|
|
|
|
|
|
|
my($test) = $memd -> set(time => time); |
1054
|
|
|
|
|
|
|
if (! $test || ($test != 1) ) |
1055
|
|
|
|
|
|
|
{ |
1056
|
|
|
|
|
|
|
print "memcached is not responding. \n"; |
1057
|
|
|
|
|
|
|
exit; |
1058
|
|
|
|
|
|
|
} |
1059
|
|
|
|
|
|
|
$memd -> delete('time'); |
1060
|
|
|
|
|
|
|
my($type) = 'driver:Memcached;id:SHA1;serialize:DataDumper'; # Case-sensitive. |
1061
|
|
|
|
|
|
|
my($session) = Data::Session -> new |
1062
|
|
|
|
|
|
|
( |
1063
|
|
|
|
|
|
|
cache => $memd, |
1064
|
|
|
|
|
|
|
type => $type, |
1065
|
|
|
|
|
|
|
) || die $Data::Session::errstr; |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
5: Using a file to hold the ids. See scripts/file.autoincrement.pl: |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
# The EXLOCK is for BSD-based systems. |
1070
|
|
|
|
|
|
|
my($directory) = File::Temp::newdir('temp.XXXX', CLEANUP => 1, EXLOCK => 0, TMPDIR => 1); |
1071
|
|
|
|
|
|
|
my($file_name) = 'autoinc.session.dat'; |
1072
|
|
|
|
|
|
|
my($id_file) = File::Spec -> catfile($directory, $file_name); |
1073
|
|
|
|
|
|
|
my($type) = 'driver:File;id:AutoIncrement;serialize:DataDumper'; # Case-sensitive. |
1074
|
|
|
|
|
|
|
my($session) = Data::Session -> new |
1075
|
|
|
|
|
|
|
( |
1076
|
|
|
|
|
|
|
id_base => 99, |
1077
|
|
|
|
|
|
|
id_file => $id_file, |
1078
|
|
|
|
|
|
|
id_step => 2, |
1079
|
|
|
|
|
|
|
type => $type, |
1080
|
|
|
|
|
|
|
) || die $Data::Session::errstr; |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
6: Using a file to hold the ids. See scripts/file.sha1.pl (non-CGI context): |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
my($directory) = '/tmp'; |
1085
|
|
|
|
|
|
|
my($file_name) = 'session.%s.dat'; |
1086
|
|
|
|
|
|
|
my($type) = 'driver:File;id:SHA1;serialize:DataDumper'; # Case-sensitive. |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
# Create the session: |
1089
|
|
|
|
|
|
|
my($session) = Data::Session -> new |
1090
|
|
|
|
|
|
|
( |
1091
|
|
|
|
|
|
|
directory => $directory, |
1092
|
|
|
|
|
|
|
file_name => $file_name, |
1093
|
|
|
|
|
|
|
type => $type, |
1094
|
|
|
|
|
|
|
) || die $Data::Session::errstr; |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
# Time passes... |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
# Retrieve the session: |
1099
|
|
|
|
|
|
|
my($id) = $session -> id; |
1100
|
|
|
|
|
|
|
my($session) = Data::Session -> new |
1101
|
|
|
|
|
|
|
( |
1102
|
|
|
|
|
|
|
directory => $directory, |
1103
|
|
|
|
|
|
|
file_name => $file_name, |
1104
|
|
|
|
|
|
|
id => $id, # <== Look! You must supply the id for retrieval. |
1105
|
|
|
|
|
|
|
type => $type, |
1106
|
|
|
|
|
|
|
) || die $Data::Session::errstr; |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
7: As a variation on the above, see scripts/cgi.sha1.pl (CGI context but command line program): |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
# As above (scripts/file.sha1.pl), for creating the session. Then... |
1111
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
# Retrieve the session: |
1113
|
|
|
|
|
|
|
my($q) = CGI -> new; # CGI form data provides the id. |
1114
|
|
|
|
|
|
|
my($session) = Data::Session -> new |
1115
|
|
|
|
|
|
|
( |
1116
|
|
|
|
|
|
|
directory => $directory, |
1117
|
|
|
|
|
|
|
file_name => $file_name, |
1118
|
|
|
|
|
|
|
query => $q, # <== Look! You must supply the id for retrieval. |
1119
|
|
|
|
|
|
|
type => $type, |
1120
|
|
|
|
|
|
|
) || die $Data::Session::errstr; |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
Also, much can be gleaned from t/basic.t and t/Test.pm. See L. |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
=head1 Description |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
L is typically used by a CGI script to preserve state data between runs of the |
1127
|
|
|
|
|
|
|
script. This gives the end user the illusion that the script never exits. |
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
It can also be used to communicate between 2 scripts, as long as they agree beforehand what session |
1130
|
|
|
|
|
|
|
id to use. |
1131
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
See L for an extended discussion of the design changes between |
1133
|
|
|
|
|
|
|
L and L. |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
L stores user data internally in a hashref, and the module reserves key names |
1136
|
|
|
|
|
|
|
starting with '_'. |
1137
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
The current list of reserved keys is documented under L. |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
Of course, the module also has a whole set of methods to help manage state. |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
=head1 Methods |
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
=head2 new() |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
Calling new() returns a object of type L, or - if new() fails - it returns undef. |
1147
|
|
|
|
|
|
|
For details see L. |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
new() takes a hash of key/value pairs, some of which might mandatory. Further, some combinations |
1150
|
|
|
|
|
|
|
might be mandatory. |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
The keys are listed here in alphabetical order. |
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
They are lower-case because they are (also) method names, meaning they can be called to set or get |
1155
|
|
|
|
|
|
|
the value at any time. |
1156
|
|
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
But a warning: In some cases, setting them after this module has used the previous value, will have |
1158
|
|
|
|
|
|
|
no effect. All such cases should be documented. |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
Beginners understandably confused by the quantity of options should consult the L for |
1161
|
|
|
|
|
|
|
example code. |
1162
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
The questions of combinations of options, and which option has priority over other options, |
1164
|
|
|
|
|
|
|
are addressed in the section, L. |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
=over 4 |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
=item o cache => $cache |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
Specifies an object of type L or L to use for storage. |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
Only needed if you use 'type' like 'driver:BerkeleyDB ...' or 'driver:Memcached ...'. |
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
See L and L. |
1175
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
Default: '' (the empty string). |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
=item o data_col_name => $string |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
Specifies the name of the column holding the session data, in the session table. |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
This key is optional. |
1183
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
Default: 'a_session'. |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
=item o data_source => $string |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
Specifies a value to use as the 1st parameter in the call to L's connect() method. |
1189
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
A typical value would be 'dbi:Pg:dbname=project'. |
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
This key is optional. It is only used if you do not supply a value for the 'dbh' key. |
1193
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
Default: '' (the empty string). |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
=item o data_source_attrs => $hashref |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
Specify a hashref of options to use as the last parameter in the call to L's connect() method. |
1199
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
This key is optional. It is only used if you do not supply a value for the 'dbh' key. |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
Default: {AutoCommit => 1, PrintError => 0, RaiseError => 1}. |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
=item o dbh => $dbh |
1205
|
|
|
|
|
|
|
|
1206
|
|
|
|
|
|
|
Specifies a database handle to use to access the session table. |
1207
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
This key is optional. |
1209
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
However, if not specified, you must specify a value for 'data_source', and perhaps also 'username' |
1211
|
|
|
|
|
|
|
and 'password', so that this module can create a database handle. |
1212
|
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
If this module does create a database handle, it will also destroy it, whereas if you supply a database |
1214
|
|
|
|
|
|
|
handle, you are responsible for destroying it. |
1215
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
=item o debug => $Boolean |
1217
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
Specifies that debugging should be turned on (1) or off (0) in L and |
1219
|
|
|
|
|
|
|
L. |
1220
|
|
|
|
|
|
|
|
1221
|
|
|
|
|
|
|
When debug is 1, $! is included in error messages, but because this reveals directory names, it is |
1222
|
|
|
|
|
|
|
0 by default. |
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
This key is optional. |
1225
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
Default: 0. |
1227
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
=item o directory => $string |
1229
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
Specifies the directory in which session files are stored, when each session is stored in a separate |
1231
|
|
|
|
|
|
|
file (by using 'driver:File ...' as the first component of the 'type'). |
1232
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
This key is optional. |
1234
|
|
|
|
|
|
|
|
1235
|
|
|
|
|
|
|
Default: Your temp directory as determined by L. |
1236
|
|
|
|
|
|
|
|
1237
|
|
|
|
|
|
|
See L for details. |
1238
|
|
|
|
|
|
|
|
1239
|
|
|
|
|
|
|
=item o file_name => $string_containing_%s |
1240
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
Specifies the syntax for the names of session files, when each session is stored in a separate file |
1242
|
|
|
|
|
|
|
(by using 'driver:File ...' as the first component of the 'type'). |
1243
|
|
|
|
|
|
|
|
1244
|
|
|
|
|
|
|
This key is optional. |
1245
|
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
Default: 'cgisess_%s', where the %s is replaced at run-time by the session id. |
1247
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
The directory in which these files are stored is specified by the 'directory' option above. |
1249
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
See L for details. |
1251
|
|
|
|
|
|
|
|
1252
|
|
|
|
|
|
|
=item o host => $string |
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
Specifies a host, typically for use with a data_source referring to MySQL. |
1255
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
This key is optional. |
1257
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
Default: '' (the empty string). |
1259
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
=item o id => $string |
1261
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
Specifies an id to retrieve from storage. |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
This key is optional. |
1265
|
|
|
|
|
|
|
|
1266
|
|
|
|
|
|
|
Default: 0. |
1267
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
Note: If you do not provide an id here, the module calls L to determine whether or not |
1269
|
|
|
|
|
|
|
an id is available from a cookie or a form field. |
1270
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
This complex topic is discussed in the section L. |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
=item o id_col_name => $string |
1274
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
Specifies the name of the column holding the session id, in the session table. |
1276
|
|
|
|
|
|
|
|
1277
|
|
|
|
|
|
|
This key is optional. |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
Default: 'id'. |
1280
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
=item o id_base => $integer |
1282
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
Specifies the base from which to start ids when using the '... id:AutoIncrement ...' component in |
1284
|
|
|
|
|
|
|
the 'type'. |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
Note: The first id returned by L will be id_base + id_step. |
1287
|
|
|
|
|
|
|
So, if id_base is 1000 and id_step is 10, then the lowest id will be 1010. |
1288
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
This key is optional. |
1290
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
Default: 0. |
1292
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
=item o id_file => $file_path_and_name |
1294
|
|
|
|
|
|
|
|
1295
|
|
|
|
|
|
|
Specifies the file path and name in which to store the last used id, as calculated from C
|
1296
|
|
|
|
|
|
|
id_step>, when using the '... id:AutoIncrement ...' component in the 'type'. |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
This value must contain a path because the 'directory' option above is only used for session files |
1299
|
|
|
|
|
|
|
(when using L). |
1300
|
|
|
|
|
|
|
|
1301
|
|
|
|
|
|
|
This key is optional. |
1302
|
|
|
|
|
|
|
|
1303
|
|
|
|
|
|
|
Default: File::Spec -> catdir(File::Spec -> tmpdir, 'data.session.id'). |
1304
|
|
|
|
|
|
|
|
1305
|
|
|
|
|
|
|
=item o id_step => $integer |
1306
|
|
|
|
|
|
|
|
1307
|
|
|
|
|
|
|
Specifies the step size between ids when using the '... id:AutoIncrement ...' component of the |
1308
|
|
|
|
|
|
|
'type'. |
1309
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
This key is optional. |
1311
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
Default: 1. |
1313
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
=item o name => $string |
1315
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
Specifies the name of the cookie or form field which holds the session id. |
1317
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
This key is optional. |
1319
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
Default: 'CGISESSID'. |
1321
|
|
|
|
|
|
|
|
1322
|
|
|
|
|
|
|
Usage of 'name' is discussed in the sections L and L. |
1323
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
=item o no_flock => $boolean |
1325
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
Specifies (no_flock => 1) to not use flock() to obtain a lock on a session file before processing |
1327
|
|
|
|
|
|
|
it, or (no_flock => 0) to use flock(). |
1328
|
|
|
|
|
|
|
|
1329
|
|
|
|
|
|
|
This key is optional. |
1330
|
|
|
|
|
|
|
|
1331
|
|
|
|
|
|
|
Default: 0. |
1332
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
This value is used in these cases: |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
=over 4 |
1336
|
|
|
|
|
|
|
|
1337
|
|
|
|
|
|
|
=item o type => 'driver:File ...' |
1338
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
=item o type => '... id:AutoIncrement ...' |
1340
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
=back |
1342
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
=item o no_follow => $boolean |
1344
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
Influences the mode to use when calling sysopen() on session files. |
1346
|
|
|
|
|
|
|
|
1347
|
|
|
|
|
|
|
'Influences' means the value is bit-wise ored with O_RDWR for reading and with O_WRONLY for writing. |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
This key is optional. |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
Default: eval { O_NOFOLLOW } || 0. |
1352
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
This value is used in this case: |
1354
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
=over 4 |
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
=item o type => 'driver:File ...' |
1358
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
=back |
1360
|
|
|
|
|
|
|
|
1361
|
|
|
|
|
|
|
=item o password => $string |
1362
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
Specifies a value to use as the 3rd parameter in the call to L's connect() method. |
1364
|
|
|
|
|
|
|
|
1365
|
|
|
|
|
|
|
This key is optional. It is only used if you do not supply a value for the 'dbh' key. |
1366
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
Default: '' (the empty string). |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
=item o pg_bytea => $boolean |
1370
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
Specifies that you're using a Postgres-specific column type of 'bytea' to hold the session data, |
1372
|
|
|
|
|
|
|
in the session table. |
1373
|
|
|
|
|
|
|
|
1374
|
|
|
|
|
|
|
This key is optional, but see the section, L for how it interacts with |
1375
|
|
|
|
|
|
|
the pg_text key. |
1376
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
Default: 0. |
1378
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
Warning: Columns of type bytea can hold null characters (\x00), whereas columns of type text cannot. |
1380
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
=item o pg_text => $boolean |
1382
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
Specifies that you're using a Postgres-specific column type of 'text' to hold the session data, in |
1384
|
|
|
|
|
|
|
the session table. |
1385
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
This key is optional, but see the section, L for how it interacts with the |
1387
|
|
|
|
|
|
|
pg_bytea key. |
1388
|
|
|
|
|
|
|
|
1389
|
|
|
|
|
|
|
Default: 0. |
1390
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
Warning: Columns of type bytea can hold null characters (\x00), whereas columns of type text cannot. |
1392
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
=item o port => $string |
1394
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
Specifies a port, typically for use with a data_source referring to MySQL. |
1396
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
This key is optional. |
1398
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
Default: '' (the empty string). |
1400
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
=item o query => $q |
1402
|
|
|
|
|
|
|
|
1403
|
|
|
|
|
|
|
Specifies the query object. |
1404
|
|
|
|
|
|
|
|
1405
|
|
|
|
|
|
|
If not specified, the next option - 'query_class' - will be used to create a query object. |
1406
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
Either way, the object will be accessible via the $session -> query() method. |
1408
|
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
This key is optional. |
1410
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
Default: '' (the empty string). |
1412
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
=item o query_class => $class_name |
1414
|
|
|
|
|
|
|
|
1415
|
|
|
|
|
|
|
Specifies the class of query object to create if a value is not provided for the 'query' option. |
1416
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
This key is optional. |
1418
|
|
|
|
|
|
|
|
1419
|
|
|
|
|
|
|
Default: 'CGI'. |
1420
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
=item o socket => $string |
1422
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
Specifies a socket, typically for use with a data_source referring to MySQL. |
1424
|
|
|
|
|
|
|
|
1425
|
|
|
|
|
|
|
The reason this key is called socket and not mysql_socket is in case other drivers permit a socket |
1426
|
|
|
|
|
|
|
option. |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
This key is optional. |
1429
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
Default: '' (the empty string). |
1431
|
|
|
|
|
|
|
|
1432
|
|
|
|
|
|
|
=item o table_name => $string |
1433
|
|
|
|
|
|
|
|
1434
|
|
|
|
|
|
|
Specifies the name of the table holding the session data. |
1435
|
|
|
|
|
|
|
|
1436
|
|
|
|
|
|
|
This key is optional. |
1437
|
|
|
|
|
|
|
|
1438
|
|
|
|
|
|
|
Default: 'sessions'. |
1439
|
|
|
|
|
|
|
|
1440
|
|
|
|
|
|
|
=item o type => $string |
1441
|
|
|
|
|
|
|
|
1442
|
|
|
|
|
|
|
Specifies the type of L object you wish to create. |
1443
|
|
|
|
|
|
|
|
1444
|
|
|
|
|
|
|
This key is optional. |
1445
|
|
|
|
|
|
|
|
1446
|
|
|
|
|
|
|
Default: 'driver:File;id:MD5;serialize:DataDumper'. |
1447
|
|
|
|
|
|
|
|
1448
|
|
|
|
|
|
|
This complex topic is discussed in the section L. |
1449
|
|
|
|
|
|
|
|
1450
|
|
|
|
|
|
|
=item o umask => $octal_number |
1451
|
|
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
Specifies the mode to use when calling sysopen() on session files. |
1453
|
|
|
|
|
|
|
|
1454
|
|
|
|
|
|
|
This value is used in these cases: |
1455
|
|
|
|
|
|
|
|
1456
|
|
|
|
|
|
|
=over 4 |
1457
|
|
|
|
|
|
|
|
1458
|
|
|
|
|
|
|
=item o type => 'driver:File ...' |
1459
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
=item o type => '... id:AutoIncrement ...' |
1461
|
|
|
|
|
|
|
|
1462
|
|
|
|
|
|
|
=back |
1463
|
|
|
|
|
|
|
|
1464
|
|
|
|
|
|
|
Default: 0660 (octal). |
1465
|
|
|
|
|
|
|
|
1466
|
|
|
|
|
|
|
=item o username => $string |
1467
|
|
|
|
|
|
|
|
1468
|
|
|
|
|
|
|
Specifies a value to use as the 2nd parameter in the call to L's connect() method. |
1469
|
|
|
|
|
|
|
|
1470
|
|
|
|
|
|
|
This key is optional. It is only used if you do not supply a value for the 'dbh' key. |
1471
|
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
Default: '' (the empty string). |
1473
|
|
|
|
|
|
|
|
1474
|
|
|
|
|
|
|
=item o verbose => $integer |
1475
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
Print to STDERR more or less information. |
1477
|
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
|
Typical values are 0, 1 and 2. |
1479
|
|
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
This key is optional. |
1481
|
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
Default: 0, meaings nothing is printed. |
1483
|
|
|
|
|
|
|
|
1484
|
|
|
|
|
|
|
See L for what happens when verbose is 2. |
1485
|
|
|
|
|
|
|
|
1486
|
|
|
|
|
|
|
=back |
1487
|
|
|
|
|
|
|
|
1488
|
|
|
|
|
|
|
=head3 Specifying Session Options |
1489
|
|
|
|
|
|
|
|
1490
|
|
|
|
|
|
|
See also L. |
1491
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
The default 'type' string is 'driver:File;id:MD5;serialize:DataDumper'. It consists of 3 optional |
1493
|
|
|
|
|
|
|
components separated by semi-colons. |
1494
|
|
|
|
|
|
|
|
1495
|
|
|
|
|
|
|
Each of those 3 components consists of 2 fields (a key and a value) separated by a colon. |
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
The keys: |
1498
|
|
|
|
|
|
|
|
1499
|
|
|
|
|
|
|
=over 4 |
1500
|
|
|
|
|
|
|
|
1501
|
|
|
|
|
|
|
=item o driver |
1502
|
|
|
|
|
|
|
|
1503
|
|
|
|
|
|
|
This specifies what type of persistent storage you wish to use for session data. |
1504
|
|
|
|
|
|
|
|
1505
|
|
|
|
|
|
|
Values for 'driver': |
1506
|
|
|
|
|
|
|
|
1507
|
|
|
|
|
|
|
=over 4 |
1508
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
=item o BerkeleyDB |
1510
|
|
|
|
|
|
|
|
1511
|
|
|
|
|
|
|
Use L for storage. In this case, you must pass an object of type L |
1512
|
|
|
|
|
|
|
to new() as the value of the 'cache' option. |
1513
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
See L. |
1515
|
|
|
|
|
|
|
|
1516
|
|
|
|
|
|
|
=item o File |
1517
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
The default, 'File', says sessions are each stored in a separate file. |
1519
|
|
|
|
|
|
|
|
1520
|
|
|
|
|
|
|
The directory for these files is specified with the 'directory' option to new(). |
1521
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
If a directory is not specified in that way, L is used to find your temp directory. |
1523
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
The names of the session files are generated from the 'file_name' option to new(). |
1525
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
The default file name (pattern) is 'cgisess_%s', where the %s is replaced by the session id. |
1527
|
|
|
|
|
|
|
|
1528
|
|
|
|
|
|
|
See L. |
1529
|
|
|
|
|
|
|
|
1530
|
|
|
|
|
|
|
=item o Memcached |
1531
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
Use C for storage. In this case, you must pass an object of type L to |
1533
|
|
|
|
|
|
|
new() as the value of the 'cache' option. |
1534
|
|
|
|
|
|
|
|
1535
|
|
|
|
|
|
|
See L. |
1536
|
|
|
|
|
|
|
|
1537
|
|
|
|
|
|
|
=item o mysql |
1538
|
|
|
|
|
|
|
|
1539
|
|
|
|
|
|
|
This says each session is stored in a separate row of a database table using the L |
1540
|
|
|
|
|
|
|
database server. |
1541
|
|
|
|
|
|
|
|
1542
|
|
|
|
|
|
|
These rows have a unique primary id equal to the session id. |
1543
|
|
|
|
|
|
|
|
1544
|
|
|
|
|
|
|
See L. |
1545
|
|
|
|
|
|
|
|
1546
|
|
|
|
|
|
|
=item o ODBC |
1547
|
|
|
|
|
|
|
|
1548
|
|
|
|
|
|
|
This says each session is stored in a separate row of a database table using the L |
1549
|
|
|
|
|
|
|
database connector. |
1550
|
|
|
|
|
|
|
|
1551
|
|
|
|
|
|
|
These rows have a unique primary id equal to the session id. |
1552
|
|
|
|
|
|
|
|
1553
|
|
|
|
|
|
|
See L. |
1554
|
|
|
|
|
|
|
|
1555
|
|
|
|
|
|
|
=item o Oracle |
1556
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
This says each session is stored in a separate row of a database table using the L |
1558
|
|
|
|
|
|
|
database server. |
1559
|
|
|
|
|
|
|
|
1560
|
|
|
|
|
|
|
These rows have a unique primary id equal to the session id. |
1561
|
|
|
|
|
|
|
|
1562
|
|
|
|
|
|
|
See L. |
1563
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
=item o Pg |
1565
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
This says each session is stored in a separate row of a database table using the L database |
1567
|
|
|
|
|
|
|
server. |
1568
|
|
|
|
|
|
|
|
1569
|
|
|
|
|
|
|
These rows have a unique primary id equal to the session id. |
1570
|
|
|
|
|
|
|
|
1571
|
|
|
|
|
|
|
See L. |
1572
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
=item o SQLite |
1574
|
|
|
|
|
|
|
|
1575
|
|
|
|
|
|
|
This says each session is stored in a separate row of a database table using the SQLite database |
1576
|
|
|
|
|
|
|
server. |
1577
|
|
|
|
|
|
|
|
1578
|
|
|
|
|
|
|
These rows have a unique primary id equal to the session id. |
1579
|
|
|
|
|
|
|
|
1580
|
|
|
|
|
|
|
The advantage of SQLite is that a client I are shipped with all recent versions of Perl. |
1581
|
|
|
|
|
|
|
|
1582
|
|
|
|
|
|
|
See L. |
1583
|
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
|
=back |
1585
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
=item o id |
1587
|
|
|
|
|
|
|
|
1588
|
|
|
|
|
|
|
This specifies what type of id generator you wish to use. |
1589
|
|
|
|
|
|
|
|
1590
|
|
|
|
|
|
|
Values for 'id': |
1591
|
|
|
|
|
|
|
|
1592
|
|
|
|
|
|
|
=over 4 |
1593
|
|
|
|
|
|
|
|
1594
|
|
|
|
|
|
|
=item o AutoIncrement |
1595
|
|
|
|
|
|
|
|
1596
|
|
|
|
|
|
|
This says ids are generated starting from a value specified with the 'id_base' option to new(), |
1597
|
|
|
|
|
|
|
and the last-used id is stored in the file name given by the 'id_file' option to new(). |
1598
|
|
|
|
|
|
|
|
1599
|
|
|
|
|
|
|
This file name must include a path, since the 'directory' option to new() is I used here. |
1600
|
|
|
|
|
|
|
|
1601
|
|
|
|
|
|
|
When a new id is required, the value in the file is incremented by the value of the 'id_step' option |
1602
|
|
|
|
|
|
|
to new(), with the new value both written back to the file and returned as the new session id. |
1603
|
|
|
|
|
|
|
|
1604
|
|
|
|
|
|
|
The default value of id_base is 0, and the default value of id_step is 1. Together, the first id |
1605
|
|
|
|
|
|
|
available as a session id is id_base + id_step = 1. |
1606
|
|
|
|
|
|
|
|
1607
|
|
|
|
|
|
|
The sequence starts when the module cannot find the given file, or when its contents are not |
1608
|
|
|
|
|
|
|
numeric. |
1609
|
|
|
|
|
|
|
|
1610
|
|
|
|
|
|
|
See L. |
1611
|
|
|
|
|
|
|
|
1612
|
|
|
|
|
|
|
=item o MD5 |
1613
|
|
|
|
|
|
|
|
1614
|
|
|
|
|
|
|
The default, 'MD5', says ids are to be generated by L. |
1615
|
|
|
|
|
|
|
|
1616
|
|
|
|
|
|
|
See L. |
1617
|
|
|
|
|
|
|
|
1618
|
|
|
|
|
|
|
=item o SHA1 |
1619
|
|
|
|
|
|
|
|
1620
|
|
|
|
|
|
|
This says ids are to be generated by L, using a digest algorithm of 1. |
1621
|
|
|
|
|
|
|
|
1622
|
|
|
|
|
|
|
See L. |
1623
|
|
|
|
|
|
|
|
1624
|
|
|
|
|
|
|
=item o SHA256 |
1625
|
|
|
|
|
|
|
|
1626
|
|
|
|
|
|
|
This says ids are to be generated by L, using a digest algorithm of 256. |
1627
|
|
|
|
|
|
|
|
1628
|
|
|
|
|
|
|
See L. |
1629
|
|
|
|
|
|
|
|
1630
|
|
|
|
|
|
|
=item o SHA512 |
1631
|
|
|
|
|
|
|
|
1632
|
|
|
|
|
|
|
This says ids are to be generated by L, using a digest algorithm of 512. |
1633
|
|
|
|
|
|
|
|
1634
|
|
|
|
|
|
|
See L. |
1635
|
|
|
|
|
|
|
|
1636
|
|
|
|
|
|
|
=item o Static |
1637
|
|
|
|
|
|
|
|
1638
|
|
|
|
|
|
|
This says that the id passed in to new(), as the value of the 'id' option, will be used as the |
1639
|
|
|
|
|
|
|
session id for every session. |
1640
|
|
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
Of course, this id must have a true value. L dies on all values Perl regards as |
1642
|
|
|
|
|
|
|
false. |
1643
|
|
|
|
|
|
|
|
1644
|
|
|
|
|
|
|
See L. |
1645
|
|
|
|
|
|
|
|
1646
|
|
|
|
|
|
|
=item o UUID16 |
1647
|
|
|
|
|
|
|
|
1648
|
|
|
|
|
|
|
This says ids are to be generated by L, to generate a 16 byte long binary UUID. |
1649
|
|
|
|
|
|
|
|
1650
|
|
|
|
|
|
|
See L. |
1651
|
|
|
|
|
|
|
|
1652
|
|
|
|
|
|
|
=item o UUID34 |
1653
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
This says ids are to be generated by L, to generate a 34 byte long string UUID. |
1655
|
|
|
|
|
|
|
|
1656
|
|
|
|
|
|
|
See L. |
1657
|
|
|
|
|
|
|
|
1658
|
|
|
|
|
|
|
=item o UUID36 |
1659
|
|
|
|
|
|
|
|
1660
|
|
|
|
|
|
|
This says ids are to be generated by L, to generate a 36 byte long string UUID. |
1661
|
|
|
|
|
|
|
|
1662
|
|
|
|
|
|
|
See L. |
1663
|
|
|
|
|
|
|
|
1664
|
|
|
|
|
|
|
=item o UUID64 |
1665
|
|
|
|
|
|
|
|
1666
|
|
|
|
|
|
|
This says ids are to be generated by L, to generate a 24 (sic) byte long, base-64 |
1667
|
|
|
|
|
|
|
encoded, UUID. |
1668
|
|
|
|
|
|
|
|
1669
|
|
|
|
|
|
|
See L. |
1670
|
|
|
|
|
|
|
|
1671
|
|
|
|
|
|
|
=back |
1672
|
|
|
|
|
|
|
|
1673
|
|
|
|
|
|
|
See scripts/digest.pl which prints the length of each type of digest. |
1674
|
|
|
|
|
|
|
|
1675
|
|
|
|
|
|
|
=item o serialize |
1676
|
|
|
|
|
|
|
|
1677
|
|
|
|
|
|
|
The specifies what type of mechanism you wish to use to convert the in-memory session data into a |
1678
|
|
|
|
|
|
|
form appropriate for your chosen storage type. |
1679
|
|
|
|
|
|
|
|
1680
|
|
|
|
|
|
|
Values for 'serialize': |
1681
|
|
|
|
|
|
|
|
1682
|
|
|
|
|
|
|
=over 4 |
1683
|
|
|
|
|
|
|
|
1684
|
|
|
|
|
|
|
=item o DataDumper |
1685
|
|
|
|
|
|
|
|
1686
|
|
|
|
|
|
|
Use L to freeze/thaw sessions. |
1687
|
|
|
|
|
|
|
|
1688
|
|
|
|
|
|
|
See L. |
1689
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
=item o FreezeThaw |
1691
|
|
|
|
|
|
|
|
1692
|
|
|
|
|
|
|
Use L to freeze/thaw sessions. |
1693
|
|
|
|
|
|
|
|
1694
|
|
|
|
|
|
|
See L. |
1695
|
|
|
|
|
|
|
|
1696
|
|
|
|
|
|
|
=item o JSON |
1697
|
|
|
|
|
|
|
|
1698
|
|
|
|
|
|
|
Use L to freeze/thaw sessions. |
1699
|
|
|
|
|
|
|
|
1700
|
|
|
|
|
|
|
See L. |
1701
|
|
|
|
|
|
|
|
1702
|
|
|
|
|
|
|
=item o Storable |
1703
|
|
|
|
|
|
|
|
1704
|
|
|
|
|
|
|
Use L to freeze/thaw sessions. |
1705
|
|
|
|
|
|
|
|
1706
|
|
|
|
|
|
|
See L. |
1707
|
|
|
|
|
|
|
|
1708
|
|
|
|
|
|
|
Warning: Storable should be avoided until this problem is fixed: |
1709
|
|
|
|
|
|
|
L. |
1710
|
|
|
|
|
|
|
|
1711
|
|
|
|
|
|
|
=item o YAML |
1712
|
|
|
|
|
|
|
|
1713
|
|
|
|
|
|
|
Use L to freeze/thaw sessions. |
1714
|
|
|
|
|
|
|
|
1715
|
|
|
|
|
|
|
See L. |
1716
|
|
|
|
|
|
|
|
1717
|
|
|
|
|
|
|
=back |
1718
|
|
|
|
|
|
|
|
1719
|
|
|
|
|
|
|
=back |
1720
|
|
|
|
|
|
|
|
1721
|
|
|
|
|
|
|
=head3 Case-sensitive Options |
1722
|
|
|
|
|
|
|
|
1723
|
|
|
|
|
|
|
Just to emphasize: The names of drivers, etc follow the DBD::* (or similar) style of |
1724
|
|
|
|
|
|
|
case-sensitivity. |
1725
|
|
|
|
|
|
|
|
1726
|
|
|
|
|
|
|
The following classes for drivers, id generators and serializers, are shipped with this package. |
1727
|
|
|
|
|
|
|
|
1728
|
|
|
|
|
|
|
Drivers: |
1729
|
|
|
|
|
|
|
|
1730
|
|
|
|
|
|
|
=over 4 |
1731
|
|
|
|
|
|
|
|
1732
|
|
|
|
|
|
|
=item o L |
1733
|
|
|
|
|
|
|
|
1734
|
|
|
|
|
|
|
This name comes from L. |
1735
|
|
|
|
|
|
|
|
1736
|
|
|
|
|
|
|
And yes, the module uses L and not L. |
1737
|
|
|
|
|
|
|
|
1738
|
|
|
|
|
|
|
=item o L |
1739
|
|
|
|
|
|
|
|
1740
|
|
|
|
|
|
|
=item o L |
1741
|
|
|
|
|
|
|
|
1742
|
|
|
|
|
|
|
This name comes from L even though the external program you run is called |
1743
|
|
|
|
|
|
|
memcached. |
1744
|
|
|
|
|
|
|
|
1745
|
|
|
|
|
|
|
=item o L |
1746
|
|
|
|
|
|
|
|
1747
|
|
|
|
|
|
|
=item o L |
1748
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
=item o L |
1750
|
|
|
|
|
|
|
|
1751
|
|
|
|
|
|
|
=item o L |
1752
|
|
|
|
|
|
|
|
1753
|
|
|
|
|
|
|
=item o L |
1754
|
|
|
|
|
|
|
|
1755
|
|
|
|
|
|
|
=back |
1756
|
|
|
|
|
|
|
|
1757
|
|
|
|
|
|
|
ID generators: |
1758
|
|
|
|
|
|
|
|
1759
|
|
|
|
|
|
|
=over 4 |
1760
|
|
|
|
|
|
|
|
1761
|
|
|
|
|
|
|
=item o L |
1762
|
|
|
|
|
|
|
|
1763
|
|
|
|
|
|
|
=item o L |
1764
|
|
|
|
|
|
|
|
1765
|
|
|
|
|
|
|
=item o L |
1766
|
|
|
|
|
|
|
|
1767
|
|
|
|
|
|
|
=item o L |
1768
|
|
|
|
|
|
|
|
1769
|
|
|
|
|
|
|
=item o L |
1770
|
|
|
|
|
|
|
|
1771
|
|
|
|
|
|
|
=item o L |
1772
|
|
|
|
|
|
|
|
1773
|
|
|
|
|
|
|
=item o L |
1774
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
=item o L |
1776
|
|
|
|
|
|
|
|
1777
|
|
|
|
|
|
|
=item o L |
1778
|
|
|
|
|
|
|
|
1779
|
|
|
|
|
|
|
=item o L |
1780
|
|
|
|
|
|
|
|
1781
|
|
|
|
|
|
|
=back |
1782
|
|
|
|
|
|
|
|
1783
|
|
|
|
|
|
|
Serializers: |
1784
|
|
|
|
|
|
|
|
1785
|
|
|
|
|
|
|
=over 4 |
1786
|
|
|
|
|
|
|
|
1787
|
|
|
|
|
|
|
=item o L |
1788
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
=item o L |
1790
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
=item o L |
1792
|
|
|
|
|
|
|
|
1793
|
|
|
|
|
|
|
=item o L |
1794
|
|
|
|
|
|
|
|
1795
|
|
|
|
|
|
|
Warning: Storable should be avoided until this problem is fixed: |
1796
|
|
|
|
|
|
|
L |
1797
|
|
|
|
|
|
|
|
1798
|
|
|
|
|
|
|
=item o L |
1799
|
|
|
|
|
|
|
|
1800
|
|
|
|
|
|
|
=back |
1801
|
|
|
|
|
|
|
|
1802
|
|
|
|
|
|
|
=head3 Specifying an Id |
1803
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
L is called to determine if an id is available from a cookie or a form field. |
1805
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
There are several cases to consider: |
1807
|
|
|
|
|
|
|
|
1808
|
|
|
|
|
|
|
=over 4 |
1809
|
|
|
|
|
|
|
|
1810
|
|
|
|
|
|
|
=item o You specify an id which exists in storage |
1811
|
|
|
|
|
|
|
|
1812
|
|
|
|
|
|
|
You can check this with the call $session -> is_new, which will return 0. |
1813
|
|
|
|
|
|
|
|
1814
|
|
|
|
|
|
|
$session -> id will return the old id. |
1815
|
|
|
|
|
|
|
|
1816
|
|
|
|
|
|
|
=item o You do not specify an id |
1817
|
|
|
|
|
|
|
|
1818
|
|
|
|
|
|
|
The module generates a new session and a new id. |
1819
|
|
|
|
|
|
|
|
1820
|
|
|
|
|
|
|
You can check this with the call $session -> is_new, which will return 1. |
1821
|
|
|
|
|
|
|
|
1822
|
|
|
|
|
|
|
$session -> id will return the new id. |
1823
|
|
|
|
|
|
|
|
1824
|
|
|
|
|
|
|
=item o You specify an id which does not exist in storage |
1825
|
|
|
|
|
|
|
|
1826
|
|
|
|
|
|
|
You can check this with the call $session -> is_new, which will return 1. |
1827
|
|
|
|
|
|
|
|
1828
|
|
|
|
|
|
|
$session -> id will return the old id. |
1829
|
|
|
|
|
|
|
|
1830
|
|
|
|
|
|
|
=back |
1831
|
|
|
|
|
|
|
|
1832
|
|
|
|
|
|
|
So, how to tell the difference between the last 2 cases? Like this: |
1833
|
|
|
|
|
|
|
|
1834
|
|
|
|
|
|
|
if ($session -> id == $session -> user_id) |
1835
|
|
|
|
|
|
|
{ |
1836
|
|
|
|
|
|
|
# New session using user-supplied id. |
1837
|
|
|
|
|
|
|
} |
1838
|
|
|
|
|
|
|
else |
1839
|
|
|
|
|
|
|
{ |
1840
|
|
|
|
|
|
|
# New session with new id. |
1841
|
|
|
|
|
|
|
} |
1842
|
|
|
|
|
|
|
|
1843
|
|
|
|
|
|
|
=head3 Combinations of Options |
1844
|
|
|
|
|
|
|
|
1845
|
|
|
|
|
|
|
See also L, for options-related combinations. |
1846
|
|
|
|
|
|
|
|
1847
|
|
|
|
|
|
|
=over 4 |
1848
|
|
|
|
|
|
|
|
1849
|
|
|
|
|
|
|
=item o dbh |
1850
|
|
|
|
|
|
|
|
1851
|
|
|
|
|
|
|
If you don't specify a value for the 'dbh' key, this module must create a database handle in those |
1852
|
|
|
|
|
|
|
cases when you specify a database driver of some sort in the value for 'type'. |
1853
|
|
|
|
|
|
|
|
1854
|
|
|
|
|
|
|
To create that handle, we needs a value for 'data_source', and that in turn may require values for |
1855
|
|
|
|
|
|
|
'username' and 'password'. |
1856
|
|
|
|
|
|
|
|
1857
|
|
|
|
|
|
|
When using SQLite, just specify a value for 'data_source'. The default values for 'username' and |
1858
|
|
|
|
|
|
|
'password' - empty strings - will work. |
1859
|
|
|
|
|
|
|
|
1860
|
|
|
|
|
|
|
=item o file_name and id_file |
1861
|
|
|
|
|
|
|
|
1862
|
|
|
|
|
|
|
When using new(type => 'driver:File;id:AutoIncrement;...'), then file_name is ignored and id_file is |
1863
|
|
|
|
|
|
|
used. |
1864
|
|
|
|
|
|
|
|
1865
|
|
|
|
|
|
|
If id_file is not supplied, it defaults to File::Spec -> catdir(File::Spec -> tmpdir, |
1866
|
|
|
|
|
|
|
'data.session.id'). |
1867
|
|
|
|
|
|
|
|
1868
|
|
|
|
|
|
|
When using new(type => 'driver:File;id:;...'), then id_file is ignored and |
1869
|
|
|
|
|
|
|
file_name is used. |
1870
|
|
|
|
|
|
|
|
1871
|
|
|
|
|
|
|
If file_name is not supplied, it defaults to 'cgisess_%s'. Note the mandatory %s. |
1872
|
|
|
|
|
|
|
|
1873
|
|
|
|
|
|
|
=item o pg_bytea and pg_text |
1874
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
If you set 'pg_bytea' to 1, then 'pg_text' will be set to 0. |
1876
|
|
|
|
|
|
|
|
1877
|
|
|
|
|
|
|
If you set 'pg_text' to 1, then 'pg_bytea' will be set to 0. |
1878
|
|
|
|
|
|
|
|
1879
|
|
|
|
|
|
|
If you set them both to 0 (i.e. the default), then 'pg_bytea' will be set to 1. |
1880
|
|
|
|
|
|
|
|
1881
|
|
|
|
|
|
|
If you set them both to 1, 'pg_bytea' will be left as 1 and 'pg_text' will be set to 0. |
1882
|
|
|
|
|
|
|
|
1883
|
|
|
|
|
|
|
This choice was made because you really should be using a column type of 'bytea' for a_session |
1884
|
|
|
|
|
|
|
in the sessions table, since the type 'text' does not handle null (\x00) characters. |
1885
|
|
|
|
|
|
|
|
1886
|
|
|
|
|
|
|
=back |
1887
|
|
|
|
|
|
|
|
1888
|
|
|
|
|
|
|
=head2 atime([$atime]) |
1889
|
|
|
|
|
|
|
|
1890
|
|
|
|
|
|
|
The [] indicates an optional parameter. |
1891
|
|
|
|
|
|
|
|
1892
|
|
|
|
|
|
|
Returns the last access time of the session. |
1893
|
|
|
|
|
|
|
|
1894
|
|
|
|
|
|
|
By default, the value comes from calling Perl's time() function, or you may pass in a time, |
1895
|
|
|
|
|
|
|
which is then used to set the last access time of the session. |
1896
|
|
|
|
|
|
|
|
1897
|
|
|
|
|
|
|
This latter alternative is used by L. |
1898
|
|
|
|
|
|
|
|
1899
|
|
|
|
|
|
|
See also L, L and L. |
1900
|
|
|
|
|
|
|
|
1901
|
|
|
|
|
|
|
=head2 check_expiry() |
1902
|
|
|
|
|
|
|
|
1903
|
|
|
|
|
|
|
Checks that there is an expiry time set for the session, and, if (atime + etime) < time(): |
1904
|
|
|
|
|
|
|
|
1905
|
|
|
|
|
|
|
=over 4 |
1906
|
|
|
|
|
|
|
|
1907
|
|
|
|
|
|
|
=item o Deletes the session |
1908
|
|
|
|
|
|
|
|
1909
|
|
|
|
|
|
|
See L for precisely what this means. |
1910
|
|
|
|
|
|
|
|
1911
|
|
|
|
|
|
|
=item o Sets the expired flag |
1912
|
|
|
|
|
|
|
|
1913
|
|
|
|
|
|
|
See L. |
1914
|
|
|
|
|
|
|
|
1915
|
|
|
|
|
|
|
=back |
1916
|
|
|
|
|
|
|
|
1917
|
|
|
|
|
|
|
This is used when the session is loaded, when you call L, and by |
1918
|
|
|
|
|
|
|
scripts/expire.pl. |
1919
|
|
|
|
|
|
|
|
1920
|
|
|
|
|
|
|
=head2 clear([$name]) |
1921
|
|
|
|
|
|
|
|
1922
|
|
|
|
|
|
|
The [] indicates an optional parameter. |
1923
|
|
|
|
|
|
|
|
1924
|
|
|
|
|
|
|
Returns 1. |
1925
|
|
|
|
|
|
|
|
1926
|
|
|
|
|
|
|
Specifies that you wish to delete parameters stored in the session, i.e. stored by previous calls to |
1927
|
|
|
|
|
|
|
param(). |
1928
|
|
|
|
|
|
|
|
1929
|
|
|
|
|
|
|
$name is a parameter name or an arrayref of parameter names. |
1930
|
|
|
|
|
|
|
|
1931
|
|
|
|
|
|
|
If $name is not specified, it is set to the list of all unreserved keys (parameter names) in the |
1932
|
|
|
|
|
|
|
session. |
1933
|
|
|
|
|
|
|
|
1934
|
|
|
|
|
|
|
See L for details. |
1935
|
|
|
|
|
|
|
|
1936
|
|
|
|
|
|
|
=head2 cookie([@arg]) |
1937
|
|
|
|
|
|
|
|
1938
|
|
|
|
|
|
|
The [] indicates an optional parameter. |
1939
|
|
|
|
|
|
|
|
1940
|
|
|
|
|
|
|
Returns a cookie, or '' (the empty string) if the query object does not have a cookie() method. |
1941
|
|
|
|
|
|
|
|
1942
|
|
|
|
|
|
|
Use the @arg parameter to pass any extra parameters to the query object's cookie() method. |
1943
|
|
|
|
|
|
|
|
1944
|
|
|
|
|
|
|
Warning: Parameters which are handled by L, and hence should I be passed in, |
1945
|
|
|
|
|
|
|
are: |
1946
|
|
|
|
|
|
|
|
1947
|
|
|
|
|
|
|
=over 4 |
1948
|
|
|
|
|
|
|
|
1949
|
|
|
|
|
|
|
=item o -expires |
1950
|
|
|
|
|
|
|
|
1951
|
|
|
|
|
|
|
=item o -name |
1952
|
|
|
|
|
|
|
|
1953
|
|
|
|
|
|
|
=item o -value |
1954
|
|
|
|
|
|
|
|
1955
|
|
|
|
|
|
|
=back |
1956
|
|
|
|
|
|
|
|
1957
|
|
|
|
|
|
|
See L and scripts/cookie.pl. |
1958
|
|
|
|
|
|
|
|
1959
|
|
|
|
|
|
|
=head2 ctime() |
1960
|
|
|
|
|
|
|
|
1961
|
|
|
|
|
|
|
Returns the creation time of the session. |
1962
|
|
|
|
|
|
|
|
1963
|
|
|
|
|
|
|
The value comes from calling Perl's time() function when the session was created. |
1964
|
|
|
|
|
|
|
|
1965
|
|
|
|
|
|
|
This is not the creation time of the session I |
1966
|
|
|
|
|
|
|
|
1967
|
|
|
|
|
|
|
See also L, L and L. |
1968
|
|
|
|
|
|
|
|
1969
|
|
|
|
|
|
|
=head2 delete() |
1970
|
|
|
|
|
|
|
|
1971
|
|
|
|
|
|
|
Returns the result of calling the driver's remove() method. |
1972
|
|
|
|
|
|
|
|
1973
|
|
|
|
|
|
|
Specifies that you want to delete the session. Here's what it does: |
1974
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
=over 4 |
1976
|
|
|
|
|
|
|
|
1977
|
|
|
|
|
|
|
=item o Immediately deletes the session from storage |
1978
|
|
|
|
|
|
|
|
1979
|
|
|
|
|
|
|
=item o Calls clear() |
1980
|
|
|
|
|
|
|
|
1981
|
|
|
|
|
|
|
This deletes all non-reserved parameters from the session object, and marks it as modified. |
1982
|
|
|
|
|
|
|
|
1983
|
|
|
|
|
|
|
=item o Marks the session object as deleted |
1984
|
|
|
|
|
|
|
|
1985
|
|
|
|
|
|
|
=back |
1986
|
|
|
|
|
|
|
|
1987
|
|
|
|
|
|
|
The latter step means that when (or if) the session object goes out of scope, it will not be flushed |
1988
|
|
|
|
|
|
|
to storage. |
1989
|
|
|
|
|
|
|
|
1990
|
|
|
|
|
|
|
Likewise, if you call flush(), the call will be ignored. |
1991
|
|
|
|
|
|
|
|
1992
|
|
|
|
|
|
|
Nevertheless, the session object is still fully functional - it just can't be saved or retrieved. |
1993
|
|
|
|
|
|
|
|
1994
|
|
|
|
|
|
|
See also L and L. |
1995
|
|
|
|
|
|
|
|
1996
|
|
|
|
|
|
|
=head2 deleted() |
1997
|
|
|
|
|
|
|
|
1998
|
|
|
|
|
|
|
Returns a Boolean (0/1) indicating whether or not the session has been deleted. |
1999
|
|
|
|
|
|
|
|
2000
|
|
|
|
|
|
|
See also L and L. |
2001
|
|
|
|
|
|
|
|
2002
|
|
|
|
|
|
|
=head2 dump([$heading]) |
2003
|
|
|
|
|
|
|
|
2004
|
|
|
|
|
|
|
The [] indicates an optional parameter. |
2005
|
|
|
|
|
|
|
|
2006
|
|
|
|
|
|
|
Dumps the session's contents to STDERR, with a prefix of '# '. |
2007
|
|
|
|
|
|
|
|
2008
|
|
|
|
|
|
|
The $heading, if any, is written first, on a line by itself, with the same prefix. |
2009
|
|
|
|
|
|
|
|
2010
|
|
|
|
|
|
|
This is especially useful for testing, since it fits in with the L method diag(). |
2011
|
|
|
|
|
|
|
|
2012
|
|
|
|
|
|
|
When verbose is 2, dump is called at these times: |
2013
|
|
|
|
|
|
|
|
2014
|
|
|
|
|
|
|
=over 4 |
2015
|
|
|
|
|
|
|
|
2016
|
|
|
|
|
|
|
=item o When a session is flushed |
2017
|
|
|
|
|
|
|
|
2018
|
|
|
|
|
|
|
=item o As soon as a session is loaded |
2019
|
|
|
|
|
|
|
|
2020
|
|
|
|
|
|
|
=item o As soon as expiry is checked on a just-loaded session |
2021
|
|
|
|
|
|
|
|
2022
|
|
|
|
|
|
|
=item o As soon as parameter expiry is checked on a just-loaded session |
2023
|
|
|
|
|
|
|
|
2024
|
|
|
|
|
|
|
=back |
2025
|
|
|
|
|
|
|
|
2026
|
|
|
|
|
|
|
=head2 etime() |
2027
|
|
|
|
|
|
|
|
2028
|
|
|
|
|
|
|
Returns the expiry time of the session. |
2029
|
|
|
|
|
|
|
|
2030
|
|
|
|
|
|
|
This is the same as calling $session -> expiry(). In fact, this just calls $session -> etime. |
2031
|
|
|
|
|
|
|
|
2032
|
|
|
|
|
|
|
See also L, L and L. |
2033
|
|
|
|
|
|
|
|
2034
|
|
|
|
|
|
|
=head2 expire([@arg]) |
2035
|
|
|
|
|
|
|
|
2036
|
|
|
|
|
|
|
The [] indicates an optional parameter. |
2037
|
|
|
|
|
|
|
|
2038
|
|
|
|
|
|
|
Specifies that you wish to set or retrieve the session's expiry time, or set the expiry times of |
2039
|
|
|
|
|
|
|
session parameters. |
2040
|
|
|
|
|
|
|
|
2041
|
|
|
|
|
|
|
Integer time values ($time below) are assumed to be seconds. The value may be positive or 0 or |
2042
|
|
|
|
|
|
|
negative. |
2043
|
|
|
|
|
|
|
|
2044
|
|
|
|
|
|
|
These expiry times are relative to the session's last access time, not the session's creation time. |
2045
|
|
|
|
|
|
|
|
2046
|
|
|
|
|
|
|
In all cases, a time of 0 disables expiry. |
2047
|
|
|
|
|
|
|
|
2048
|
|
|
|
|
|
|
This affects users of L. See below and L. |
2049
|
|
|
|
|
|
|
|
2050
|
|
|
|
|
|
|
When a session expires, it is deleted from storage. See L for details. |
2051
|
|
|
|
|
|
|
|
2052
|
|
|
|
|
|
|
The test for whether or not a session has expired only takes place when a session is loaded from |
2053
|
|
|
|
|
|
|
storage. |
2054
|
|
|
|
|
|
|
|
2055
|
|
|
|
|
|
|
When a session parameter expires, it is deleted from the session object. See L |
2056
|
|
|
|
|
|
|
for details. |
2057
|
|
|
|
|
|
|
|
2058
|
|
|
|
|
|
|
The test for whether or not a session parameter has expired only takes place when a session is |
2059
|
|
|
|
|
|
|
loaded from storage. |
2060
|
|
|
|
|
|
|
|
2061
|
|
|
|
|
|
|
=over 4 |
2062
|
|
|
|
|
|
|
|
2063
|
|
|
|
|
|
|
=item o $session -> expire() |
2064
|
|
|
|
|
|
|
|
2065
|
|
|
|
|
|
|
Use $session -> expire() to return the session's expiry time. This just calls $session -> etime. |
2066
|
|
|
|
|
|
|
|
2067
|
|
|
|
|
|
|
The default expiry time is 0, meaning the session will never expire. Likewise, by default, session |
2068
|
|
|
|
|
|
|
parameters never expire. |
2069
|
|
|
|
|
|
|
|
2070
|
|
|
|
|
|
|
=item o $session -> expire($time) |
2071
|
|
|
|
|
|
|
|
2072
|
|
|
|
|
|
|
Use $session -> expire($time) to set the session's expiry time. |
2073
|
|
|
|
|
|
|
|
2074
|
|
|
|
|
|
|
Use these suffixes to change the interpretation of the integer you specify: |
2075
|
|
|
|
|
|
|
|
2076
|
|
|
|
|
|
|
+-----------+---------------+ |
2077
|
|
|
|
|
|
|
| Suffix | Meaning | |
2078
|
|
|
|
|
|
|
+-----------+---------------+ |
2079
|
|
|
|
|
|
|
| s | Second | |
2080
|
|
|
|
|
|
|
| m | Minute | |
2081
|
|
|
|
|
|
|
| h | Hour | |
2082
|
|
|
|
|
|
|
| d | Day | |
2083
|
|
|
|
|
|
|
| w | Week | |
2084
|
|
|
|
|
|
|
| M | Month | |
2085
|
|
|
|
|
|
|
| y | Year | |
2086
|
|
|
|
|
|
|
+-----------+---------------+ |
2087
|
|
|
|
|
|
|
|
2088
|
|
|
|
|
|
|
Hence $session -> expire('2h') means expire the session in 2 hours. |
2089
|
|
|
|
|
|
|
|
2090
|
|
|
|
|
|
|
expire($time) calls validate_time($time) to perform the conversion from '2h' to seconds, |
2091
|
|
|
|
|
|
|
so L is available to you too. |
2092
|
|
|
|
|
|
|
|
2093
|
|
|
|
|
|
|
If setting a time like this, expire($time) returns 1. |
2094
|
|
|
|
|
|
|
|
2095
|
|
|
|
|
|
|
Note: The time set here is passed as the 3rd parameter to the storage driver's store() method (for |
2096
|
|
|
|
|
|
|
all types of storage), and from there as the 3rd parameter to the set() method of |
2097
|
|
|
|
|
|
|
L. Of course, this doesn't happen immediately - it only happens when the session |
2098
|
|
|
|
|
|
|
is saved. |
2099
|
|
|
|
|
|
|
|
2100
|
|
|
|
|
|
|
=item o $session -> expire($key_1 => $time_1[, $key_2 => $time_2...]) |
2101
|
|
|
|
|
|
|
|
2102
|
|
|
|
|
|
|
Use $session -> expire($key_1 => $time_1[, $key_2 => $time_2...]) to set the expiry times of |
2103
|
|
|
|
|
|
|
session parameters. |
2104
|
|
|
|
|
|
|
|
2105
|
|
|
|
|
|
|
=back |
2106
|
|
|
|
|
|
|
|
2107
|
|
|
|
|
|
|
Special cases: |
2108
|
|
|
|
|
|
|
|
2109
|
|
|
|
|
|
|
=over 4 |
2110
|
|
|
|
|
|
|
|
2111
|
|
|
|
|
|
|
=item o To expire the session immediately, call delete() |
2112
|
|
|
|
|
|
|
|
2113
|
|
|
|
|
|
|
=item o To expire a session parameter immediately, call clear($key) |
2114
|
|
|
|
|
|
|
|
2115
|
|
|
|
|
|
|
=back |
2116
|
|
|
|
|
|
|
|
2117
|
|
|
|
|
|
|
See also L, L, L, L and |
2118
|
|
|
|
|
|
|
L. |
2119
|
|
|
|
|
|
|
|
2120
|
|
|
|
|
|
|
=head2 expired() |
2121
|
|
|
|
|
|
|
|
2122
|
|
|
|
|
|
|
Returns a Boolean (0/1) indicating whether or not the session has expired. |
2123
|
|
|
|
|
|
|
|
2124
|
|
|
|
|
|
|
See L. |
2125
|
|
|
|
|
|
|
|
2126
|
|
|
|
|
|
|
=head2 flush() |
2127
|
|
|
|
|
|
|
|
2128
|
|
|
|
|
|
|
Returns 1. |
2129
|
|
|
|
|
|
|
|
2130
|
|
|
|
|
|
|
Specifies that you want the session object immediately written to storage. |
2131
|
|
|
|
|
|
|
|
2132
|
|
|
|
|
|
|
If you have previously called delete(), the call to flush() is ignored. |
2133
|
|
|
|
|
|
|
|
2134
|
|
|
|
|
|
|
If the object has not been modified, the call to flush() is ignored. |
2135
|
|
|
|
|
|
|
|
2136
|
|
|
|
|
|
|
Warning: With persistent environments, you object may never go out of scope that way you think it |
2137
|
|
|
|
|
|
|
does.See L for details. |
2138
|
|
|
|
|
|
|
|
2139
|
|
|
|
|
|
|
These reserved session parameters are included in what's written to storage: |
2140
|
|
|
|
|
|
|
|
2141
|
|
|
|
|
|
|
=over 4 |
2142
|
|
|
|
|
|
|
|
2143
|
|
|
|
|
|
|
=item o _SESSION_ATIME |
2144
|
|
|
|
|
|
|
|
2145
|
|
|
|
|
|
|
The session's last access time. |
2146
|
|
|
|
|
|
|
|
2147
|
|
|
|
|
|
|
=item o _SESSION_CTIME |
2148
|
|
|
|
|
|
|
|
2149
|
|
|
|
|
|
|
The session's creation time. |
2150
|
|
|
|
|
|
|
|
2151
|
|
|
|
|
|
|
=item o _SESSION_ETIME |
2152
|
|
|
|
|
|
|
|
2153
|
|
|
|
|
|
|
The session's expiry time. |
2154
|
|
|
|
|
|
|
|
2155
|
|
|
|
|
|
|
A time of 0 means there is no expiry time. |
2156
|
|
|
|
|
|
|
|
2157
|
|
|
|
|
|
|
This affect users of L. See L and |
2158
|
|
|
|
|
|
|
L. |
2159
|
|
|
|
|
|
|
|
2160
|
|
|
|
|
|
|
=item o _SESSION_ID |
2161
|
|
|
|
|
|
|
|
2162
|
|
|
|
|
|
|
The session's id. |
2163
|
|
|
|
|
|
|
|
2164
|
|
|
|
|
|
|
=item o _SESSION_PTIME |
2165
|
|
|
|
|
|
|
|
2166
|
|
|
|
|
|
|
A hashref of session parameter expiry times. |
2167
|
|
|
|
|
|
|
|
2168
|
|
|
|
|
|
|
=back |
2169
|
|
|
|
|
|
|
|
2170
|
|
|
|
|
|
|
=head2 http_header([@arg]) |
2171
|
|
|
|
|
|
|
|
2172
|
|
|
|
|
|
|
The [] indicate an optional parameter. |
2173
|
|
|
|
|
|
|
|
2174
|
|
|
|
|
|
|
Returns a HTTP header. This means it does I print the header. You have to do that, when |
2175
|
|
|
|
|
|
|
appropriate. |
2176
|
|
|
|
|
|
|
|
2177
|
|
|
|
|
|
|
Unlike L, L does I force the document type to be 'text/html'. |
2178
|
|
|
|
|
|
|
|
2179
|
|
|
|
|
|
|
You must pass in a document type to http_header(), as |
2180
|
|
|
|
|
|
|
C<< $session -> http_header('-type' => 'text/html') >>, or use the query object's default. |
2181
|
|
|
|
|
|
|
|
2182
|
|
|
|
|
|
|
Both L and L default to 'text/html'. |
2183
|
|
|
|
|
|
|
|
2184
|
|
|
|
|
|
|
L handles the case where the query object does not have a cookie() method, by calling |
2185
|
|
|
|
|
|
|
$session -> cookie() to generate either a cookie, or '' (the empty string). |
2186
|
|
|
|
|
|
|
|
2187
|
|
|
|
|
|
|
The @arg parameter, if any, is passed to the query object's header() method, after the cookie |
2188
|
|
|
|
|
|
|
parameter, if any. |
2189
|
|
|
|
|
|
|
|
2190
|
|
|
|
|
|
|
=head2 id() |
2191
|
|
|
|
|
|
|
|
2192
|
|
|
|
|
|
|
Returns the id of the session. |
2193
|
|
|
|
|
|
|
|
2194
|
|
|
|
|
|
|
=head2 is_new() |
2195
|
|
|
|
|
|
|
|
2196
|
|
|
|
|
|
|
Returns a Boolean (0/1). |
2197
|
|
|
|
|
|
|
|
2198
|
|
|
|
|
|
|
Specifies you want to know if the session object was created from scratch (1) or was retrieved |
2199
|
|
|
|
|
|
|
from storage (0). |
2200
|
|
|
|
|
|
|
|
2201
|
|
|
|
|
|
|
=head2 load_param([$q][, $name]) |
2202
|
|
|
|
|
|
|
|
2203
|
|
|
|
|
|
|
The [] indicate optional parameters. |
2204
|
|
|
|
|
|
|
|
2205
|
|
|
|
|
|
|
Returns $q. |
2206
|
|
|
|
|
|
|
|
2207
|
|
|
|
|
|
|
Loads (copies) all non-reserved parameters from the session object into the query object. |
2208
|
|
|
|
|
|
|
|
2209
|
|
|
|
|
|
|
L performs the opposite operation. |
2210
|
|
|
|
|
|
|
|
2211
|
|
|
|
|
|
|
$q is a query object, and $name is a parameter name or an arrayref of names. |
2212
|
|
|
|
|
|
|
|
2213
|
|
|
|
|
|
|
If the query object is not specified, generates one by calling $session -> load_query_class, |
2214
|
|
|
|
|
|
|
and stores it in the internal 'query' attribute. |
2215
|
|
|
|
|
|
|
|
2216
|
|
|
|
|
|
|
If you don't provide $q, use undef, don't just omit the parameter. |
2217
|
|
|
|
|
|
|
|
2218
|
|
|
|
|
|
|
If $name is specified, only the session parameters named in the arrayref are processed. |
2219
|
|
|
|
|
|
|
|
2220
|
|
|
|
|
|
|
If $name is not specified, copies all parameters belonging to the query object. |
2221
|
|
|
|
|
|
|
|
2222
|
|
|
|
|
|
|
=head2 load_query_class() |
2223
|
|
|
|
|
|
|
|
2224
|
|
|
|
|
|
|
Returns the query object. |
2225
|
|
|
|
|
|
|
|
2226
|
|
|
|
|
|
|
This calls $session -> query_class -> new if the session object's query object is not defined. |
2227
|
|
|
|
|
|
|
|
2228
|
|
|
|
|
|
|
=head2 load_session() |
2229
|
|
|
|
|
|
|
|
2230
|
|
|
|
|
|
|
Returns a session. |
2231
|
|
|
|
|
|
|
|
2232
|
|
|
|
|
|
|
Note: This method does not take any parameters, and hence does not function in the same way as |
2233
|
|
|
|
|
|
|
load(...) in L. |
2234
|
|
|
|
|
|
|
|
2235
|
|
|
|
|
|
|
Algorithm: |
2236
|
|
|
|
|
|
|
|
2237
|
|
|
|
|
|
|
=over 4 |
2238
|
|
|
|
|
|
|
|
2239
|
|
|
|
|
|
|
=item o If user_id() returns a session id, try to load that session |
2240
|
|
|
|
|
|
|
|
2241
|
|
|
|
|
|
|
If that succeeds, return the session. |
2242
|
|
|
|
|
|
|
|
2243
|
|
|
|
|
|
|
If it fails, generate a new session, and return it. |
2244
|
|
|
|
|
|
|
|
2245
|
|
|
|
|
|
|
You can call is_new() to tell the difference between these 2 cases. |
2246
|
|
|
|
|
|
|
|
2247
|
|
|
|
|
|
|
=item o If user_id() returns 0, generate a new session, and return it |
2248
|
|
|
|
|
|
|
|
2249
|
|
|
|
|
|
|
=back |
2250
|
|
|
|
|
|
|
|
2251
|
|
|
|
|
|
|
=head2 modified() |
2252
|
|
|
|
|
|
|
|
2253
|
|
|
|
|
|
|
Returns a Boolean (0/1) indicating whether or not the session's parameters have been modified. |
2254
|
|
|
|
|
|
|
|
2255
|
|
|
|
|
|
|
However, changing a value from one form of not-defined, e.g. undef, to another form of not-defined, |
2256
|
|
|
|
|
|
|
e.g. 0, is ignored, meaning the modified flag is not set. In such cases, you could set the flag |
2257
|
|
|
|
|
|
|
yourself. |
2258
|
|
|
|
|
|
|
|
2259
|
|
|
|
|
|
|
Note: Loading a session from storage changes the session's last access time, which means the session |
2260
|
|
|
|
|
|
|
has been modified. |
2261
|
|
|
|
|
|
|
|
2262
|
|
|
|
|
|
|
If you wish to stop the session being written to storage, without deleting it, you can reset the |
2263
|
|
|
|
|
|
|
modified flag with $session -> modified(0). |
2264
|
|
|
|
|
|
|
|
2265
|
|
|
|
|
|
|
=head2 param([@arg]) |
2266
|
|
|
|
|
|
|
|
2267
|
|
|
|
|
|
|
The [] indicates an optional parameter. |
2268
|
|
|
|
|
|
|
|
2269
|
|
|
|
|
|
|
Specifies that you wish to retrieve data stored in the session, or you wish to store data in the |
2270
|
|
|
|
|
|
|
session. |
2271
|
|
|
|
|
|
|
|
2272
|
|
|
|
|
|
|
Data is stored in the session object as in a hash, via a set of $key => $value relationships. |
2273
|
|
|
|
|
|
|
|
2274
|
|
|
|
|
|
|
Use $session -> param($key_1 => $value_1[, $key_2 => $value_2...]) to store data in the session. |
2275
|
|
|
|
|
|
|
|
2276
|
|
|
|
|
|
|
If storing data, param() returns 1. |
2277
|
|
|
|
|
|
|
|
2278
|
|
|
|
|
|
|
The values stored in the session may be undef. |
2279
|
|
|
|
|
|
|
|
2280
|
|
|
|
|
|
|
Note: If the value being stored is the same as the pre-existing value, the value in the session is |
2281
|
|
|
|
|
|
|
not updated, which means the last access time does not change. |
2282
|
|
|
|
|
|
|
|
2283
|
|
|
|
|
|
|
Use $session -> param() to return a sorted list of all keys. |
2284
|
|
|
|
|
|
|
|
2285
|
|
|
|
|
|
|
That call returns a list of the keys you have previously stored in the session. |
2286
|
|
|
|
|
|
|
|
2287
|
|
|
|
|
|
|
Use $session -> param('key') to return the value associated with the given key. |
2288
|
|
|
|
|
|
|
|
2289
|
|
|
|
|
|
|
See also L. |
2290
|
|
|
|
|
|
|
|
2291
|
|
|
|
|
|
|
=head2 ptime() |
2292
|
|
|
|
|
|
|
|
2293
|
|
|
|
|
|
|
Returns the hashref of session parameter expiry times. |
2294
|
|
|
|
|
|
|
|
2295
|
|
|
|
|
|
|
Keys are parameter names and values are expiry times in seconds. |
2296
|
|
|
|
|
|
|
|
2297
|
|
|
|
|
|
|
These expiry times are set by calling L. |
2298
|
|
|
|
|
|
|
|
2299
|
|
|
|
|
|
|
See also L, L and L. |
2300
|
|
|
|
|
|
|
|
2301
|
|
|
|
|
|
|
=head2 save_param([$q][, $name]) |
2302
|
|
|
|
|
|
|
|
2303
|
|
|
|
|
|
|
The [] indicate optional parameters. |
2304
|
|
|
|
|
|
|
|
2305
|
|
|
|
|
|
|
Returns 1. |
2306
|
|
|
|
|
|
|
|
2307
|
|
|
|
|
|
|
Loads (copies) all non-reserved parameters from the query object into the session object. |
2308
|
|
|
|
|
|
|
|
2309
|
|
|
|
|
|
|
L performs the opposite operation. |
2310
|
|
|
|
|
|
|
|
2311
|
|
|
|
|
|
|
$q is a query object, and $name is a parameter name or an arrayref of names. |
2312
|
|
|
|
|
|
|
|
2313
|
|
|
|
|
|
|
If the query object is not specified, generates one by calling $session -> load_query_class, |
2314
|
|
|
|
|
|
|
and stores it in the internal 'query' attribute. This means you can retrieve it with |
2315
|
|
|
|
|
|
|
$session -> query. |
2316
|
|
|
|
|
|
|
|
2317
|
|
|
|
|
|
|
If you don't provide $q, use undef, don't just omit the parameter. |
2318
|
|
|
|
|
|
|
|
2319
|
|
|
|
|
|
|
If $name is specified, only the session parameters named in the arrayref are processed. |
2320
|
|
|
|
|
|
|
|
2321
|
|
|
|
|
|
|
If $name is not specified, copies all parameters. |
2322
|
|
|
|
|
|
|
|
2323
|
|
|
|
|
|
|
=head2 traverse($sub) |
2324
|
|
|
|
|
|
|
|
2325
|
|
|
|
|
|
|
Returns 1. |
2326
|
|
|
|
|
|
|
|
2327
|
|
|
|
|
|
|
Specifies that you want the $sub called for each session id found in storage, with one (1) id as |
2328
|
|
|
|
|
|
|
the only parameter in each call. |
2329
|
|
|
|
|
|
|
|
2330
|
|
|
|
|
|
|
Note: traverse($sub) does not load the sessions, and hence has no effect on the session's last |
2331
|
|
|
|
|
|
|
access time. |
2332
|
|
|
|
|
|
|
|
2333
|
|
|
|
|
|
|
See scripts/expire.pl. |
2334
|
|
|
|
|
|
|
|
2335
|
|
|
|
|
|
|
=head2 user_id() |
2336
|
|
|
|
|
|
|
|
2337
|
|
|
|
|
|
|
Returns either a session id, or 0. |
2338
|
|
|
|
|
|
|
|
2339
|
|
|
|
|
|
|
Algorithm: |
2340
|
|
|
|
|
|
|
|
2341
|
|
|
|
|
|
|
=over 4 |
2342
|
|
|
|
|
|
|
|
2343
|
|
|
|
|
|
|
=item o If $session -> id() returns a true value, return that |
2344
|
|
|
|
|
|
|
|
2345
|
|
|
|
|
|
|
E.g. The user supplied one in $session -> new(id => $id). |
2346
|
|
|
|
|
|
|
|
2347
|
|
|
|
|
|
|
Return this id. |
2348
|
|
|
|
|
|
|
|
2349
|
|
|
|
|
|
|
=item o Try to recover an id from the cookie object or the query object. |
2350
|
|
|
|
|
|
|
|
2351
|
|
|
|
|
|
|
If the query object supports the cookie method, call |
2352
|
|
|
|
|
|
|
$self -> query -> cookie and (if that doesn't find an id), $self -> query -> param. |
2353
|
|
|
|
|
|
|
|
2354
|
|
|
|
|
|
|
If the query object does not support the cookie method, just call $self -> query -> param. |
2355
|
|
|
|
|
|
|
|
2356
|
|
|
|
|
|
|
Return any id found, or 0. |
2357
|
|
|
|
|
|
|
|
2358
|
|
|
|
|
|
|
Note: The name of the cookie, and the name of the CGI form field, is passed to new() by the 'name' |
2359
|
|
|
|
|
|
|
option. |
2360
|
|
|
|
|
|
|
|
2361
|
|
|
|
|
|
|
=back |
2362
|
|
|
|
|
|
|
|
2363
|
|
|
|
|
|
|
=head2 validate_options() |
2364
|
|
|
|
|
|
|
|
2365
|
|
|
|
|
|
|
Cross-check a few things. |
2366
|
|
|
|
|
|
|
|
2367
|
|
|
|
|
|
|
E.g. When using type => '... id:Static ...', you must supply a (true) id to new(id => ...'). |
2368
|
|
|
|
|
|
|
|
2369
|
|
|
|
|
|
|
=head2 validate_time($time) |
2370
|
|
|
|
|
|
|
|
2371
|
|
|
|
|
|
|
Dies for an invalid time string, or returns the number of seconds corresponding to $time, |
2372
|
|
|
|
|
|
|
which may be positive or negative. |
2373
|
|
|
|
|
|
|
|
2374
|
|
|
|
|
|
|
See L for details on the time string format. |
2375
|
|
|
|
|
|
|
|
2376
|
|
|
|
|
|
|
=head1 Test Code |
2377
|
|
|
|
|
|
|
|
2378
|
|
|
|
|
|
|
t/basic.ini and t/bulk.ini contain DSNs for BerkeleyDB, File, Memcache, MySQL, Pg and SQLite. |
2379
|
|
|
|
|
|
|
Actually, they're the same file, just with different DSNs activated. |
2380
|
|
|
|
|
|
|
|
2381
|
|
|
|
|
|
|
So, you can use t/basic.t to run minimal tests (with only File and SQLite activated) like this: |
2382
|
|
|
|
|
|
|
|
2383
|
|
|
|
|
|
|
perl -Ilib t/basic.t |
2384
|
|
|
|
|
|
|
|
2385
|
|
|
|
|
|
|
or you can edit t/bulk.ini as desired, and pass it in like this: |
2386
|
|
|
|
|
|
|
|
2387
|
|
|
|
|
|
|
perl -Ilib t/basic.t t/bulk.ini |
2388
|
|
|
|
|
|
|
|
2389
|
|
|
|
|
|
|
Simple instructions for installing L (Oracle and Perl) are in |
2390
|
|
|
|
|
|
|
L. |
2391
|
|
|
|
|
|
|
|
2392
|
|
|
|
|
|
|
Simple instructions for installing L and memcached are in |
2393
|
|
|
|
|
|
|
L. |
2394
|
|
|
|
|
|
|
|
2395
|
|
|
|
|
|
|
=head1 FAQ |
2396
|
|
|
|
|
|
|
|
2397
|
|
|
|
|
|
|
=head2 Guidelines re Sources of Confusion |
2398
|
|
|
|
|
|
|
|
2399
|
|
|
|
|
|
|
This section discusses various issues which confront beginners: |
2400
|
|
|
|
|
|
|
|
2401
|
|
|
|
|
|
|
=over 4 |
2402
|
|
|
|
|
|
|
|
2403
|
|
|
|
|
|
|
=item o 1: Both Data::Session and L have a I method |
2404
|
|
|
|
|
|
|
|
2405
|
|
|
|
|
|
|
Let's say your L script sub-classes L or it's successor L. |
2406
|
|
|
|
|
|
|
|
2407
|
|
|
|
|
|
|
Then inside your sub-class's methods, this works: |
2408
|
|
|
|
|
|
|
|
2409
|
|
|
|
|
|
|
$self -> param(a_key => 'a_value'); |
2410
|
|
|
|
|
|
|
|
2411
|
|
|
|
|
|
|
Time passes... |
2412
|
|
|
|
|
|
|
|
2413
|
|
|
|
|
|
|
my($value) = $self -> param('a_key'); |
2414
|
|
|
|
|
|
|
|
2415
|
|
|
|
|
|
|
because those 2 modules each implement a method called I. Basically, you're storing a value |
2416
|
|
|
|
|
|
|
(via 'param') inside $self. |
2417
|
|
|
|
|
|
|
|
2418
|
|
|
|
|
|
|
But when you store an object of type Data::Session using I, it looks like this: |
2419
|
|
|
|
|
|
|
|
2420
|
|
|
|
|
|
|
$self -> param(session => Data::Session -> new(...) ); |
2421
|
|
|
|
|
|
|
|
2422
|
|
|
|
|
|
|
Now, Data::Session itself I implements a method called I. So, to store something in |
2423
|
|
|
|
|
|
|
the session (but not in $self), you must do: |
2424
|
|
|
|
|
|
|
|
2425
|
|
|
|
|
|
|
$self -> param('session') -> param(a_key => 'a_value'); |
2426
|
|
|
|
|
|
|
|
2427
|
|
|
|
|
|
|
Time passes... |
2428
|
|
|
|
|
|
|
|
2429
|
|
|
|
|
|
|
my($value) = $self -> param('session') -> param('a_key'); |
2430
|
|
|
|
|
|
|
|
2431
|
|
|
|
|
|
|
It should be obvious that confusion can arise here because the 2 objects represented by $self and |
2432
|
|
|
|
|
|
|
$self -> param('session') both have I methods. |
2433
|
|
|
|
|
|
|
|
2434
|
|
|
|
|
|
|
=item o 2: How exactly should a L script save a session? |
2435
|
|
|
|
|
|
|
|
2436
|
|
|
|
|
|
|
The first example in the Synopsis shows a very simple L script doing the right thing by |
2437
|
|
|
|
|
|
|
calling I just before it exits. |
2438
|
|
|
|
|
|
|
|
2439
|
|
|
|
|
|
|
Alternately, if you sub-class L, the call to I is best placed in your |
2440
|
|
|
|
|
|
|
I method, which is where you override L. The point here is that |
2441
|
|
|
|
|
|
|
your I is called automatically at the end of each run mode. |
2442
|
|
|
|
|
|
|
|
2443
|
|
|
|
|
|
|
This important matter is also discussed in L below. |
2444
|
|
|
|
|
|
|
|
2445
|
|
|
|
|
|
|
=item o 3: Storing array and hashes |
2446
|
|
|
|
|
|
|
|
2447
|
|
|
|
|
|
|
Put simply: Don't do that! |
2448
|
|
|
|
|
|
|
|
2449
|
|
|
|
|
|
|
This will fail: |
2450
|
|
|
|
|
|
|
|
2451
|
|
|
|
|
|
|
$self -> param('session') -> param(my_hash => %my_hash); |
2452
|
|
|
|
|
|
|
|
2453
|
|
|
|
|
|
|
Time passes... |
2454
|
|
|
|
|
|
|
|
2455
|
|
|
|
|
|
|
my(%my_hash) = $self -> param('session') -> param('my_hash'); |
2456
|
|
|
|
|
|
|
|
2457
|
|
|
|
|
|
|
Likewise for an array instead of a hash. |
2458
|
|
|
|
|
|
|
|
2459
|
|
|
|
|
|
|
But why? Because the part 'param(my_hash => %my_hash)' is basically assigning a list (%my_hash) to |
2460
|
|
|
|
|
|
|
a scalar (my_hash). Hence, only 1 element of the list (the 'first' key in some unknown order) will |
2461
|
|
|
|
|
|
|
be assigned. |
2462
|
|
|
|
|
|
|
|
2463
|
|
|
|
|
|
|
So, when you try to restore the hash with 'my(%my_hash) ...', all you'll get back is a scalar, which |
2464
|
|
|
|
|
|
|
will generate the classic error message 'Odd number of elements in hash assignment...'. |
2465
|
|
|
|
|
|
|
|
2466
|
|
|
|
|
|
|
The solution is to use arrayrefs and hashrefs: |
2467
|
|
|
|
|
|
|
|
2468
|
|
|
|
|
|
|
$self -> param('session') -> param(my_hash => {%my_hash}); |
2469
|
|
|
|
|
|
|
|
2470
|
|
|
|
|
|
|
Time passes... |
2471
|
|
|
|
|
|
|
|
2472
|
|
|
|
|
|
|
my(%my_hash) = %{$self -> param('session') -> param('my_hash')}; |
2473
|
|
|
|
|
|
|
|
2474
|
|
|
|
|
|
|
Likewise for an array: |
2475
|
|
|
|
|
|
|
|
2476
|
|
|
|
|
|
|
$self -> param('session') -> param(my_ara => [@my_ara]); |
2477
|
|
|
|
|
|
|
|
2478
|
|
|
|
|
|
|
Time passes... |
2479
|
|
|
|
|
|
|
|
2480
|
|
|
|
|
|
|
my(@my_ara) = @{$self -> param('session') -> param('my_ara')}; |
2481
|
|
|
|
|
|
|
|
2482
|
|
|
|
|
|
|
=back |
2483
|
|
|
|
|
|
|
|
2484
|
|
|
|
|
|
|
=head2 General Questions |
2485
|
|
|
|
|
|
|
|
2486
|
|
|
|
|
|
|
=over 4 |
2487
|
|
|
|
|
|
|
|
2488
|
|
|
|
|
|
|
=item o My sessions are not getting written to disk! |
2489
|
|
|
|
|
|
|
|
2490
|
|
|
|
|
|
|
This is because you haven't stored anything in them. You're probably thinking sessions are saved |
2491
|
|
|
|
|
|
|
just because they exist. |
2492
|
|
|
|
|
|
|
|
2493
|
|
|
|
|
|
|
Actually, sessions are only saved if they have at least 1 parameter set. The session id and |
2494
|
|
|
|
|
|
|
access/etc times are not enough to trigger saving. |
2495
|
|
|
|
|
|
|
|
2496
|
|
|
|
|
|
|
Just do something like $session -> param(ok => 1); if you want a session saved just to indicate it |
2497
|
|
|
|
|
|
|
exists. Code like this sets the modified flag on the session, so that flush() actually does the |
2498
|
|
|
|
|
|
|
save. |
2499
|
|
|
|
|
|
|
|
2500
|
|
|
|
|
|
|
Also, see L, below, to understand why flush() must be called explicitly in |
2501
|
|
|
|
|
|
|
persistent environments. |
2502
|
|
|
|
|
|
|
|
2503
|
|
|
|
|
|
|
=item o Why don't the test scripts use L? |
2504
|
|
|
|
|
|
|
|
2505
|
|
|
|
|
|
|
I decided to circumvent it by using L and adopting the wonders of nested |
2506
|
|
|
|
|
|
|
testing. But, since V 1.11, I've replaced that module with L, to reduce dependencies, |
2507
|
|
|
|
|
|
|
and hence to make it easier to get L into Debian. |
2508
|
|
|
|
|
|
|
|
2509
|
|
|
|
|
|
|
See t/basic.t, and in particular this line: subtest $driver => sub. |
2510
|
|
|
|
|
|
|
|
2511
|
|
|
|
|
|
|
=item o Why didn't you use OSSP::uuid as did L? |
2512
|
|
|
|
|
|
|
|
2513
|
|
|
|
|
|
|
Because when I tried to build that module (under Debian), ./configure died, saying I had set 2 |
2514
|
|
|
|
|
|
|
incompatible options, even though I hadn't set either of them. |
2515
|
|
|
|
|
|
|
|
2516
|
|
|
|
|
|
|
=item o What happens when 2 processes write sessions with the same id? |
2517
|
|
|
|
|
|
|
|
2518
|
|
|
|
|
|
|
The last-to-write wins, by overwriting what the first wrote. |
2519
|
|
|
|
|
|
|
|
2520
|
|
|
|
|
|
|
=item o Params::Validate be adopted to validate parameters? |
2521
|
|
|
|
|
|
|
|
2522
|
|
|
|
|
|
|
Not yet. |
2523
|
|
|
|
|
|
|
|
2524
|
|
|
|
|
|
|
=back |
2525
|
|
|
|
|
|
|
|
2526
|
|
|
|
|
|
|
=head1 Troubleshooting |
2527
|
|
|
|
|
|
|
|
2528
|
|
|
|
|
|
|
=head2 Trouble with Errors |
2529
|
|
|
|
|
|
|
|
2530
|
|
|
|
|
|
|
When object construction fails, new() sets $Data::Session::errstr and returns undef. |
2531
|
|
|
|
|
|
|
This means you can use this idiom: |
2532
|
|
|
|
|
|
|
|
2533
|
|
|
|
|
|
|
my($session) = Data::Session -> new(...) || process_error($Data::Session::errstr); |
2534
|
|
|
|
|
|
|
|
2535
|
|
|
|
|
|
|
However, when methods detect errors they die, so after successful object construction, you can do: |
2536
|
|
|
|
|
|
|
|
2537
|
|
|
|
|
|
|
use Try::Tiny; |
2538
|
|
|
|
|
|
|
|
2539
|
|
|
|
|
|
|
try |
2540
|
|
|
|
|
|
|
{ |
2541
|
|
|
|
|
|
|
$session -> some_method_which_may_die; |
2542
|
|
|
|
|
|
|
} |
2543
|
|
|
|
|
|
|
catch |
2544
|
|
|
|
|
|
|
{ |
2545
|
|
|
|
|
|
|
process_error($_); # Because $_ holds the error message. |
2546
|
|
|
|
|
|
|
}; |
2547
|
|
|
|
|
|
|
|
2548
|
|
|
|
|
|
|
=head2 Trouble with Exiting |
2549
|
|
|
|
|
|
|
|
2550
|
|
|
|
|
|
|
If the session object's clean-up code is called, in DESTROY(), the session data is automatically |
2551
|
|
|
|
|
|
|
flushed to storage (except when it's been deleted, or has not been modified). |
2552
|
|
|
|
|
|
|
|
2553
|
|
|
|
|
|
|
However, as explained below, there can be problems with your code (i.e. not with L) |
2554
|
|
|
|
|
|
|
such that this clean-up code is not called, or, if called, it cannot perform as expected. |
2555
|
|
|
|
|
|
|
|
2556
|
|
|
|
|
|
|
The general guideline, then, is that you should explicitly call C on the session object |
2557
|
|
|
|
|
|
|
before your program exits. |
2558
|
|
|
|
|
|
|
|
2559
|
|
|
|
|
|
|
Common traps for beginners: |
2560
|
|
|
|
|
|
|
|
2561
|
|
|
|
|
|
|
=over 4 |
2562
|
|
|
|
|
|
|
|
2563
|
|
|
|
|
|
|
=item o Creating 2 CGI-like objects |
2564
|
|
|
|
|
|
|
|
2565
|
|
|
|
|
|
|
If your code creates an object of type L or similar, but you don't pass that object into |
2566
|
|
|
|
|
|
|
L via the 'query' parameter to new(), this module will create one for you, |
2567
|
|
|
|
|
|
|
which can be very confusing. |
2568
|
|
|
|
|
|
|
|
2569
|
|
|
|
|
|
|
The solution is to always create such a object yourself, and to always pass that into |
2570
|
|
|
|
|
|
|
L. |
2571
|
|
|
|
|
|
|
|
2572
|
|
|
|
|
|
|
In the case that the user of a CGI script runs your code for the first time, there will be no |
2573
|
|
|
|
|
|
|
session id, either from a cookie or from a form field. |
2574
|
|
|
|
|
|
|
|
2575
|
|
|
|
|
|
|
In such a case, L will do what you expect, which is to generate a session id. |
2576
|
|
|
|
|
|
|
|
2577
|
|
|
|
|
|
|
=item o Letting your database handle go out of scope too early |
2578
|
|
|
|
|
|
|
|
2579
|
|
|
|
|
|
|
When your script is exiting, and you're trying to save session data to storage via a database |
2580
|
|
|
|
|
|
|
handle, the save will fail if the handle goes out of scope before the session data is flushed to |
2581
|
|
|
|
|
|
|
storage. |
2582
|
|
|
|
|
|
|
|
2583
|
|
|
|
|
|
|
So, don't do that. |
2584
|
|
|
|
|
|
|
|
2585
|
|
|
|
|
|
|
=item o Assuming your session object goes out of scope when it doesn't |
2586
|
|
|
|
|
|
|
|
2587
|
|
|
|
|
|
|
In persistent environments such as L, FastCGI and mod_perl, your code exits as expected, but |
2588
|
|
|
|
|
|
|
the session object does not go out of scope in the normal way. |
2589
|
|
|
|
|
|
|
|
2590
|
|
|
|
|
|
|
In cases like this, it is mandatory for you to call flush() on the session object before your |
2591
|
|
|
|
|
|
|
code exits, since persistent environments operate in such a way that the session object's clean-up |
2592
|
|
|
|
|
|
|
code does not get called. This means that flush() is not called automatically by DESTROY() as you |
2593
|
|
|
|
|
|
|
would expect, because DESTROY() is not being called. |
2594
|
|
|
|
|
|
|
|
2595
|
|
|
|
|
|
|
=item o Creating circular references anywhere in your code |
2596
|
|
|
|
|
|
|
|
2597
|
|
|
|
|
|
|
In these cases, Perl's clean-up code may not run to completion, which means the session object may |
2598
|
|
|
|
|
|
|
not have its clean-up code called at all. As above, flush() may not get called. |
2599
|
|
|
|
|
|
|
|
2600
|
|
|
|
|
|
|
If you must create circular references, it's vital you debug the exit logic using a module such as |
2601
|
|
|
|
|
|
|
L before assuming the fault is with L. |
2602
|
|
|
|
|
|
|
|
2603
|
|
|
|
|
|
|
=item o Using signal handlers |
2604
|
|
|
|
|
|
|
|
2605
|
|
|
|
|
|
|
Write your code defensively, if you wish to call the session object's flush() method when a signal |
2606
|
|
|
|
|
|
|
might affect program exit logic. |
2607
|
|
|
|
|
|
|
|
2608
|
|
|
|
|
|
|
=back |
2609
|
|
|
|
|
|
|
|
2610
|
|
|
|
|
|
|
=head2 Trouble with IDs |
2611
|
|
|
|
|
|
|
|
2612
|
|
|
|
|
|
|
The module uses code like if (! $self -> id), which means ids must be (Perl) true values, so undef, |
2613
|
|
|
|
|
|
|
0 and '' will not work. |
2614
|
|
|
|
|
|
|
|
2615
|
|
|
|
|
|
|
=head2 Trouble with UUID16 |
2616
|
|
|
|
|
|
|
|
2617
|
|
|
|
|
|
|
While testing with UUID16 as the id generator, I got this message: |
2618
|
|
|
|
|
|
|
... invalid byte sequence for encoding "UTF8" ... |
2619
|
|
|
|
|
|
|
|
2620
|
|
|
|
|
|
|
That's because when I create a database (in Postgres) I use "create database d_name owner d_owner |
2621
|
|
|
|
|
|
|
encoding 'UTF8';" and UUID16 simply produces a 16 byte binary value, which is not guaranteed to be |
2622
|
|
|
|
|
|
|
or contain a valid UTF8 character. |
2623
|
|
|
|
|
|
|
|
2624
|
|
|
|
|
|
|
This also means you should never try to use 'driver:File;id:UUID16 ...', since the ids generated by |
2625
|
|
|
|
|
|
|
this module would rarely if ever be valid as a part of a file name. |
2626
|
|
|
|
|
|
|
|
2627
|
|
|
|
|
|
|
=head2 Trouble with UUID64 |
2628
|
|
|
|
|
|
|
|
2629
|
|
|
|
|
|
|
While testing with UUID64 as the id generator, I got this message: |
2630
|
|
|
|
|
|
|
... Session ids cannot contain \ or / ... |
2631
|
|
|
|
|
|
|
|
2632
|
|
|
|
|
|
|
That's because I was using a File driver, and UUID's encoded in base 64 can contain /. |
2633
|
|
|
|
|
|
|
|
2634
|
|
|
|
|
|
|
So, don't do that. |
2635
|
|
|
|
|
|
|
|
2636
|
|
|
|
|
|
|
=head1 Version Numbers |
2637
|
|
|
|
|
|
|
|
2638
|
|
|
|
|
|
|
Version numbers < 1.00 represent development versions. From 1.00 up, they are production versions. |
2639
|
|
|
|
|
|
|
|
2640
|
|
|
|
|
|
|
=head1 Repository |
2641
|
|
|
|
|
|
|
|
2642
|
|
|
|
|
|
|
L |
2643
|
|
|
|
|
|
|
|
2644
|
|
|
|
|
|
|
=head1 Support |
2645
|
|
|
|
|
|
|
|
2646
|
|
|
|
|
|
|
LBugs should be reported via the CPAN bug tracker at |
2647
|
|
|
|
|
|
|
|
2648
|
|
|
|
|
|
|
L |
2649
|
|
|
|
|
|
|
|
2650
|
|
|
|
|
|
|
=head1 Thanks |
2651
|
|
|
|
|
|
|
|
2652
|
|
|
|
|
|
|
Many thanks are due to all the people who contributed to both L and |
2653
|
|
|
|
|
|
|
L. |
2654
|
|
|
|
|
|
|
|
2655
|
|
|
|
|
|
|
Likewise, many thanks to the implementors of nesting testing. See L. |
2656
|
|
|
|
|
|
|
|
2657
|
|
|
|
|
|
|
=head1 Author |
2658
|
|
|
|
|
|
|
|
2659
|
|
|
|
|
|
|
L was written by Ron Savage Iron@savage.net.auE> in 2010. |
2660
|
|
|
|
|
|
|
|
2661
|
|
|
|
|
|
|
Home page: L. |
2662
|
|
|
|
|
|
|
|
2663
|
|
|
|
|
|
|
=head1 Copyright |
2664
|
|
|
|
|
|
|
|
2665
|
|
|
|
|
|
|
Australian copyright (c) 2010, Ron Savage. |
2666
|
|
|
|
|
|
|
|
2667
|
|
|
|
|
|
|
All Programs of mine are 'OSI Certified Open Source Software'; |
2668
|
|
|
|
|
|
|
you can redistribute them and/or modify them under the terms of |
2669
|
|
|
|
|
|
|
The Artistic License, a copy of which is available at: |
2670
|
|
|
|
|
|
|
http://www.opensource.org/licenses/index.html |
2671
|
|
|
|
|
|
|
|
2672
|
|
|
|
|
|
|
=cut |