File Coverage

blib/lib/Catalyst/Plugin/Session.pm
Criterion Covered Total %
statement 106 241 44.0
branch 17 84 20.2
condition 15 48 31.2
subroutine 28 55 50.9
pod 21 31 67.7
total 187 459 40.7


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Catalyst::Plugin::Session;
4 3     3   150 use base qw/Class::Accessor::Fast/;
  3         44  
  3         57  
5              
6 3     3   54 use strict;
  3         27  
  3         42  
7 3     3   48 use warnings;
  3         30  
  3         46  
8              
9 3     3   158 use NEXT;
  3         33  
  3         79  
10 3     3   111 use Catalyst::Exception ();
  3         907  
  3         36  
11 3     3   163 use Digest ();
  3         32  
  3         30  
12 3     3   101 use overload ();
  3         28  
  3         33  
13 3     3   296 use Object::Signature ();
  3         31  
  3         31  
14              
15             our $VERSION = "0.14";
16              
17             my @session_data_accessors; # used in delete_session
18             BEGIN {
19 3     3   99     __PACKAGE__->mk_accessors(
20                     "_session_delete_reason",
21                     @session_data_accessors = qw/
22             _sessionid
23             _session
24             _session_expires
25             _extended_session_expires
26             _session_data_sig
27             _flash
28             _flash_keep_keys
29             _flash_key_hashes
30             _tried_loading_session_id
31             _tried_loading_session_data
32             _tried_loading_session_expires
33             _tried_loading_flash_data
34             /
35                 );
36             }
37              
38             sub setup {
39 5     5 1 229     my $c = shift;
40              
41 5         97     $c->NEXT::setup(@_);
42              
43 5         1554     $c->check_session_plugin_requirements;
44 2         33     $c->setup_session;
45              
46 2         477     return $c;
47             }
48              
49             sub check_session_plugin_requirements {
50 5     5 1 50     my $c = shift;
51              
52 5 100 100     59     unless ( $c->isa("Catalyst::Plugin::Session::State")
53                     && $c->isa("Catalyst::Plugin::Session::Store") )
54                 {
55 3         4037         my $err =
56                       ( "The Session plugin requires both Session::State "
57                           . "and Session::Store plugins to be used as well." );
58              
59 3         61         $c->log->fatal($err);
60 3         781         Catalyst::Exception->throw($err);
61                 }
62             }
63              
64             sub setup_session {
65 2     2 1 19     my $c = shift;
66              
67 2   100     23     my $cfg = ( $c->config->{session} ||= {} );
68              
69 2         54     %$cfg = (
70                     expires => 7200,
71                     verify_address => 0,
72                     %$cfg,
73                 );
74              
75 2         42     $c->NEXT::setup_session();
76             }
77              
78             sub prepare_action {
79 1     1 1 338     my $c = shift;
80              
81 1 50 33     20     if ( $c->config->{session}{flash_to_stash}
      33        
82                     and $c->sessionid
83                     and my $flash_data = $c->flash )
84                 {
85 1         26         @{ $c->stash }{ keys %$flash_data } = values %$flash_data;
  1         15  
86                 }
87              
88 1         216     $c->NEXT::prepare_action(@_);
89             }
90              
91             sub finalize {
92 6     6 1 243     my $c = shift;
93              
94 6         79     $c->finalize_session;
95                 
96 6         1642     $c->NEXT::finalize(@_);
97             }
98              
99             sub finalize_session {
100 6     6 1 51     my $c = shift;
101              
102 6         114     $c->NEXT::finalize_session;
103              
104 6         1674     $c->_save_session_id;
105 6         78     $c->_save_session;
106 6         211     $c->_save_flash;
107 6         2196     $c->_save_session_expires;
108              
109 6         235     $c->_clear_session_instance_data;
110             }
111              
112             sub _save_session_id {
113 6     6   58     my $c = shift;
114              
115             # we already called set when allocating
116             # no need to tell the state plugins anything new
117             }
118              
119             sub _save_session_expires {
120 6     6   54     my $c = shift;
121              
122 6 50       85     if ( defined($c->_session_expires) ) {
123 0         0         my $expires = $c->session_expires; # force extension
124              
125 0         0         my $sid = $c->sessionid;
126 0         0         $c->store_session_data( "expires:$sid" => $expires );
127                 }
128             }
129              
130             sub _save_session {
131 6     6   51     my $c = shift;
132              
133 6 50       143     if ( my $session_data = $c->_session ) {
134              
135 3     3   115         no warnings 'uninitialized';
  3         29  
  3         46  
136 0 0       0         if ( Object::Signature::signature($session_data) ne
137                         $c->_session_data_sig )
138                     {
139 0         0             $session_data->{__updated} = time();
140 0         0             my $sid = $c->sessionid;
141 0         0             $c->store_session_data( "session:$sid" => $session_data );
142                     }
143                 }
144             }
145              
146             sub _save_flash {
147 6     6   51     my $c = shift;
148              
149 6 50       72     if ( my $flash_data = $c->_flash ) {
150              
151 6   50     200         my $hashes = $c->_flash_key_hashes || {};
152 6   100     151         my $keep = $c->_flash_keep_keys || {};
153 6         152         foreach my $key ( keys %$hashes ) {
154 2 50 33     38             if ( !exists $keep->{$key} and Object::Signature::signature( \$flash_data->{$key} ) eq $hashes->{$key} ) {
155 2         25                 delete $flash_data->{$key};
156                         }
157                     }
158                     
159 6         88         my $sid = $c->sessionid;
160              
161 6 100       983         if (%$flash_data) {
162 4         51             $c->store_session_data( "flash:$sid", $flash_data );
163                     }
164                     else {
165 2         29             $c->delete_session_data("flash:$sid");
166                     }
167                 }
168             }
169              
170             sub _load_session_expires {
171 0     0   0     my $c = shift;
172 0 0       0     return $c->_session_expires if $c->_tried_loading_session_expires;
173 0         0     $c->_tried_loading_session_expires(1);
174              
175 0 0       0     if ( my $sid = $c->sessionid ) {
176 0   0     0         my $expires = $c->get_session_data("expires:$sid") || 0;
177              
178 0 0       0         if ( $expires >= time() ) {
179 0         0             $c->_session_expires( $expires );
180 0         0             return $expires;
181                     } else {
182 0         0             $c->delete_session( "session expired" );
183 0         0             return 0;
184                     }
185                 }
186              
187 0         0     return;
188             }
189              
190             sub _load_session {
191 0     0   0     my $c = shift;
192 0 0       0     return $c->_session if $c->_tried_loading_session_data;
193 0         0     $c->_tried_loading_session_data(1);
194              
195 0 0       0     if ( my $sid = $c->sessionid ) {
196 0 0       0         if ( $c->_load_session_expires ) { # > 0
197              
198 0   0     0             my $session_data = $c->get_session_data("session:$sid") || return;
199 0         0             $c->_session($session_data);
200              
201 3     3   68             no warnings 'uninitialized'; # ne __address
  3         34  
  3         45  
202 0 0 0     0             if ( $c->config->{session}{verify_address}
203                             && $session_data->{__address} ne $c->request->address )
204                         {
205 0         0                 $c->log->warn(
206                                     "Deleting session $sid due to address mismatch ("
207                                   . $session_data->{__address} . " != "
208                                   . $c->request->address . ")"
209                             );
210 0         0                 $c->delete_session("address mismatch");
211 0         0                 return;
212                         }
213              
214 0 0       0             $c->log->debug(qq/Restored session "$sid"/) if $c->debug;
215 0 0       0             $c->_session_data_sig( Object::Signature::signature($session_data) ) if $session_data;
216 0         0             $c->_expire_session_keys;
217              
218 0         0             return $session_data;
219                     }
220                 }
221              
222 0         0     return;
223             }
224              
225             sub _load_flash {
226 6     6   155     my $c = shift;
227 6 50       76     return $c->_flash if $c->_tried_loading_flash_data;
228 6         168     $c->_tried_loading_flash_data(1);
229              
230 6 50       154     if ( my $sid = $c->sessionid ) {
231 6 50 33     5660         if ( my $flash_data = $c->_flash
232                         || $c->_flash( $c->get_session_data("flash:$sid") ) )
233                     {
234 6         2146             $c->_flash_key_hashes({ map { $_ => Object::Signature::signature( \$flash_data->{$_} ) } keys %$flash_data });
  3         45  
235                         
236 6         217             return $flash_data;
237                     }
238                 }
239              
240 0         0     return;
241             }
242              
243             sub _expire_session_keys {
244 0     0   0     my ( $c, $data ) = @_;
245              
246 0         0     my $now = time;
247              
248 0   0     0     my $expire_times = ( $data || $c->_session || {} )->{__expire_keys} || {};
      0        
      0        
249 0         0     foreach my $key ( grep { $expire_times->{$_} < $now } keys %$expire_times ) {
  0         0  
250 0         0         delete $c->_session->{$key};
251 0         0         delete $expire_times->{$key};
252                 }
253             }
254              
255             sub _clear_session_instance_data {
256 6     6   55     my $c = shift;
257 6         47     $c->$_(undef) for @session_data_accessors;
  6         85  
258 6         150     $c->NEXT::_clear_session_instance_data; # allow other plugins to hook in on this
259             }
260              
261             sub delete_session {
262 0     0 1 0     my ( $c, $msg ) = @_;
263              
264 0 0       0     $c->log->debug("Deleting session" . ( defined($msg) ? "($msg)" : '(no reason given)') ) if $c->debug;
    0          
265              
266             # delete the session data
267 0 0       0     if ( my $sid = $c->sessionid ) {
268 0         0         $c->delete_session_data("${_}:${sid}") for qw/session expires flash/;
  0         0  
269 0         0         $c->delete_session_id($sid);
270                 }
271              
272             # reset the values in the context object
273             # see the BEGIN block
274 0         0     $c->_clear_session_instance_data;
275              
276 0         0     $c->_session_delete_reason($msg);
277             }
278              
279             sub session_delete_reason {
280 0     0 1 0     my $c = shift;
281              
282 0         0     $c->session_is_valid; # check that it was loaded
283              
284 0         0     $c->_session_delete_reason(@_);
285             }
286              
287             sub session_expires {
288 0     0 1 0     my $c = shift;
289              
290 0 0       0     if ( defined( my $expires = $c->_extended_session_expires ) ) {
    0          
291 0         0         return $expires;
292                 } elsif ( defined( $expires = $c->_load_session_expires ) ) {
293 0         0         return $c->extend_session_expires( $expires );
294                 } else {
295 0         0         return 0;
296                 }
297             }
298              
299             sub extend_session_expires {
300 0     0 0 0     my ( $c, $expires ) = @_;
301 0         0     $c->_extended_session_expires( my $updated = $c->calculate_extended_session_expires( $expires ) );
302 0         0     $c->extend_session_id( $c->sessionid, $updated );
303 0         0     return $updated;
304             }
305              
306             sub calculate_initial_session_expires {
307 0     0 0 0     my $c = shift;
308 0         0     return ( time() + $c->config->{session}{expires} );
309             }
310              
311             sub calculate_extended_session_expires {
312 0     0 0 0     my ( $c, $prev ) = @_;
313 0         0     $c->calculate_initial_session_expires;
314             }
315