File Coverage

blib/lib/CGI/Session/Serialize/sql_abstract.pm
Criterion Covered Total %
statement 33 33 100.0
branch 6 8 75.0
condition 4 5 80.0
subroutine 5 5 100.0
pod 0 2 0.0
total 48 53 90.5


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;