line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package CGI::Session::Serialize::sql_abstract; |
2
|
|
|
|
|
|
|
require CGI::Session::ErrorHandler; |
3
|
1
|
|
|
1
|
|
26218
|
use vars qw(@ISA $VERSION); |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
82
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
@ISA = qw( CGI::Session::ErrorHandler ); |
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
637
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
$VERSION = 0.70; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# here's the kind of Perl -> SQL that's happening here |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# _SESSION_ID => session_id |
14
|
|
|
|
|
|
|
# _SESSION_CTIME (seconds since epoch) => creation_time (as timestamp) |
15
|
|
|
|
|
|
|
# _SESSION_ATIME (seconds since epoch) => last_access_time (as timestamp) |
16
|
|
|
|
|
|
|
# _SESSION_ETIME (seconds) => duration (as interval) |
17
|
|
|
|
|
|
|
# _SESSION_REMOTE_ADDR => remote_addr |
18
|
|
|
|
|
|
|
# _SESSION_EXPIRE_LIST => { |
19
|
|
|
|
|
|
|
# field_name => $seconds => field_name_exp_secs |
20
|
|
|
|
|
|
|
# ... |
21
|
|
|
|
|
|
|
# }, |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub freeze { |
25
|
2
|
|
|
2
|
0
|
621
|
my ($self,$data) = @_; |
26
|
2
|
50
|
|
|
|
7
|
return undef unless ref $data; |
27
|
|
|
|
|
|
|
|
28
|
2
|
|
66
|
|
|
7
|
my %sql = ( |
29
|
|
|
|
|
|
|
session_id => $data->{_SESSION_ID}, |
30
|
|
|
|
|
|
|
creation_time => _time_to_iso8601($data->{_SESSION_CTIME}), |
31
|
|
|
|
|
|
|
last_access_time => _time_to_iso8601($data->{_SESSION_ATIME}), |
32
|
|
|
|
|
|
|
# 'ETIME' was such a bad name, we rename it to 'duration' |
33
|
|
|
|
|
|
|
# I mean, ATIME and CTIMES are *times*, wouldn't you expect ETIME to be a time, too? |
34
|
|
|
|
|
|
|
# Instead, it's a duration until expiration, it seconds |
35
|
|
|
|
|
|
|
duration => ($data->{_SESSION_ETIME} && "$data->{_SESSION_ETIME} seconds"), |
36
|
|
|
|
|
|
|
remote_addr => $data->{_SESSION_REMOTE_ADDR}, |
37
|
|
|
|
|
|
|
); |
38
|
|
|
|
|
|
|
|
39
|
2
|
|
|
|
|
5
|
for my $field (keys %{ $data->{_SESSION_EXPIRE_LIST} }) { |
|
2
|
|
|
|
|
7
|
|
40
|
2
|
|
|
|
|
10
|
$sql{$field.'_exp_secs'} = $data->{_SESSION_EXPIRE_LIST}->{$field}; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# pass the rest through unchanged |
44
|
2
|
|
|
|
|
7
|
for (grep {!/^_SESSION/} keys %$data) { |
|
12
|
|
|
|
|
31
|
|
45
|
2
|
|
|
|
|
7
|
$sql{$_} = $data->{$_}; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
2
|
|
|
|
|
8
|
return \%sql; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# convert from seconds-from-epoch to ISO 8601 standard time format |
53
|
|
|
|
|
|
|
sub _time_to_iso8601 { |
54
|
6
|
|
100
|
6
|
|
35
|
my $time = shift || return undef; |
55
|
5
|
|
|
|
|
992
|
require Date::Calc; |
56
|
5
|
|
|
|
|
45801
|
import Date::Calc (qw/Localtime/); |
57
|
|
|
|
|
|
|
# import Date::Calc (qw/Time_to_Date/); |
58
|
|
|
|
|
|
|
|
59
|
5
|
|
|
|
|
18
|
my ($y,$M,$d,$h,$m,$s) = Localtime($time); |
60
|
|
|
|
|
|
|
# my ($y,$M,$d,$h,$m,$s) = Time_to_Date($time); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# Sometimes bad dates return answers near the Epoch. |
63
|
|
|
|
|
|
|
# Since this is a session handling module, sessions |
64
|
|
|
|
|
|
|
# should never have dates over 30 years in the past... |
65
|
5
|
100
|
|
|
|
288
|
if ($y <= 1970 ) { |
66
|
2
|
|
|
|
|
29
|
return undef; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
else { |
69
|
|
|
|
|
|
|
# 'YYYY-MM-DD HH:mm:SS' |
70
|
3
|
|
|
|
|
28
|
return sprintf ('%04d-%02d-%02d %02d:%02d:%02d', $y,$M,$d,$h,$m,$s ); |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# convert from the database format back to CGI::Session format |
79
|
|
|
|
|
|
|
sub thaw { |
80
|
1
|
|
|
1
|
0
|
410
|
my ($self,$data) = @_; |
81
|
1
|
50
|
|
|
|
6
|
return undef unless ref $data; |
82
|
|
|
|
|
|
|
|
83
|
1
|
|
|
|
|
7
|
my %out = ( |
84
|
|
|
|
|
|
|
_SESSION_ID => $data->{session_id}, |
85
|
|
|
|
|
|
|
_SESSION_CTIME => $data->{creation_time}, # Times from DB should be in Epoch fmt already |
86
|
|
|
|
|
|
|
_SESSION_ATIME => $data->{last_access_time}, |
87
|
|
|
|
|
|
|
_SESSION_ETIME => $data->{end_time}, |
88
|
|
|
|
|
|
|
_SESSION_REMOTE_ADDR => $data->{remote_addr}, |
89
|
|
|
|
|
|
|
); |
90
|
1
|
|
|
|
|
5
|
for (keys %$data) { |
91
|
7
|
100
|
|
|
|
18
|
if (/(.*)_exp_secs$/) { |
92
|
1
|
|
|
|
|
6
|
$out{_SESSION_EXPIRE_LIST}->{$1} = $data->{$_}; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
# pass the rest through unchanged |
97
|
1
|
|
|
|
|
5
|
for (grep {!/^(session_id|creation_time|last_access_time|end_time|remote_addr)$|_exp_secs$/} keys %$data) { |
|
7
|
|
|
|
|
24
|
|
98
|
1
|
|
|
|
|
4
|
$out{$_} = $data->{$_}; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
1
|
|
|
|
|
5
|
return \%out; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
1; |