File Coverage

blib/lib/Hub/Webapp/Session.pm
Criterion Covered Total %
statement 15 37 40.5
branch 0 10 0.0
condition 0 5 0.0
subroutine 5 6 83.3
pod 1 1 100.0
total 21 59 35.5


line stmt bran cond sub pod time code
1             package Hub::Webapp::Session;
2 1     1   7 use strict;
  1         3  
  1         60  
3 1     1   4133 use CGI qw(:standard);
  1         17332  
  1         8  
4 1     1   23091 use CGI::Cookie;
  1         3302  
  1         34  
5 1     1   41 use Hub qw(:lib);
  1         4  
  1         13  
6             our $VERSION = '4.00043';
7             our @EXPORT = qw//;
8             our @EXPORT_OK = qw/
9             COOKIE_SID
10             SESSION_FILENAME
11             /;
12              
13             use constant {
14 1         583 COOKIE_SID => "SID",
15             SESSION_FILENAME => "session.hf",
16 1     1   10 };
  1         3  
17              
18             our @ISA = qw/Hub::Data::HashFile/;
19              
20             sub new {
21 0     0 1   my $sid = $_[1];
22 0 0         unless ($sid) {
23 0           $sid = Hub::checksum(Hub::random_id());
24 0           my $cookie = new CGI::Cookie(
25             -name => COOKIE_SID,
26             -value => $sid,
27             -expires=> '+1M',
28             -path => '/'
29             );
30 0   0       $$Hub{'/sys/response/headers'} ||= [];
31 0           unshift @{$$Hub{'/sys/response/headers'}}, "Set-Cookie: $cookie";
  0            
32             }
33 0           my $path = $$Hub{'/conf/session/directory'};
34 0           $path = Hub::secpath($path);
35 0 0         mkdir $path unless -e $path;
36 0 0         die "Session directory '$path' is not a directory"
37             unless -d $path;
38 0           $path .= Hub::SEPARATOR . $sid . Hub::SEPARATOR . SESSION_FILENAME;
39 0 0 0       if (-e $path && $$Hub{'/conf/session/timeout'}) {
40 0           my $stats = stat($path);
41 0           my $delta = $$Hub{'/conf/session/timeout'} - (time - $stats->mtime());
42 0 0         Hub::rmfile($path) if $delta < 0;
43             }
44 0           Hub::mkabsdir(Hub::getpath($path));
45 0           Hub::touch($path);
46 0           my $self = $_[0]->SUPER::new($path);
47 0           $$self{'directory'} = Hub::getpath($path);
48 0           $$self{+COOKIE_SID} = $sid;
49 0           return $self;
50             }#new
51              
52             1;