File Coverage

blib/lib/Catalyst/Plugin/Session/State/Cookie.pm
Criterion Covered Total %
statement 51 63 81.0
branch 15 30 50.0
condition 1 3 33.3
subroutine 13 16 81.2
pod 3 11 27.3
total 83 123 67.5


line stmt bran cond sub pod time code
1             package Catalyst::Plugin::Session::State::Cookie;
2 2     2   33 use base qw/Catalyst::Plugin::Session::State/;
  2         29  
  2         40  
3              
4 2     2   201 use strict;
  2         18  
  2         30  
5 2     2   31 use warnings;
  2         18  
  2         65  
6              
7 2     2   94 use NEXT;
  2         20  
  2         114  
8 2     2   397 use Catalyst::Utils ();
  2         39  
  2         31  
9              
10             our $VERSION = "0.06";
11              
12             sub setup_session {
13 1     1 1 54     my $c = shift;
14              
15 1         24     $c->NEXT::setup_session(@_);
16              
17 1   33     265     $c->config->{session}{cookie_name}
18                     ||= Catalyst::Utils::appprefix($c) . '_session';
19             }
20              
21             sub extend_session_id {
22 0     0 0 0     my ( $c, $sid, $expires ) = @_;
23              
24 0 0       0     if ( my $cookie = $c->get_session_cookie ) {
25 0         0         $c->update_session_cookie( $c->make_session_cookie( $sid ) );
26                 }
27              
28 0         0     $c->NEXT::extend_session_id( $sid, $expires );
29             }
30              
31             sub set_session_id {
32 2     2 0 20     my ( $c, $sid ) = @_;
33              
34 2         33     $c->update_session_cookie( $c->make_session_cookie( $sid ) );
35              
36 2         45     return $c->NEXT::set_session_id($sid);
37             }
38              
39             sub update_session_cookie {
40 2     2 1 19     my ( $c, $updated ) = @_;
41                 
42 2 50       31     unless ( $c->cookie_is_rejecting( $updated ) ) {
43 2         23         my $cookie_name = $c->config->{session}{cookie_name};
44 2         53         $c->response->cookies->{$cookie_name} = $updated;
45                 }
46             }
47              
48             sub cookie_is_rejecting {
49 4     4 0 38     my ( $c, $cookie ) = @_;
50                 
51 4 100       45     if ( $cookie->{path} ) {
52 2 100       28         return 1 if index '/'.$c->request->path, $cookie->{path};
53                 }
54                 
55 3         45     return 0;
56             }
57              
58             sub make_session_cookie {
59 2     2 1 21     my ( $c, $sid, %attrs ) = @_;
60              
61 2         53     my $cfg = $c->config->{session};
62 2 50       62     my $cookie = {
    50          
63                     value => $sid,
64                     ( $cfg->{cookie_domain} ? ( domain => $cfg->{cookie_domain} ) : () ),
65                     ( $cfg->{cookie_path} ? ( path => $cfg->{cookie_path} ) : () ),
66                     %attrs,
67                 };
68              
69 2 50       25     unless ( exists $cookie->{expires} ) {
70 2         33         $cookie->{expires} = $c->calculate_session_cookie_expires();
71                 }
72              
73 2 50       54     $cookie->{secure} = 1 if $cfg->{cookie_secure};
74              
75 2         41     return $cookie;
76             }
77              
78             sub calc_expiry { # compat
79 0     0 0 0     my $c = shift;
80 0 0       0     $c->NEXT::calc_expiry( @_ ) || $c->calculate_session_cookie_expires( @_ );
81             }
82              
83             sub calculate_session_cookie_expires {
84 2     2 0 19     my $c = shift;
85 2         23     my $cfg = $c->config->{session};
86              
87 2         65     my $value = $c->NEXT::calculate_session_cookie_expires(@_);
88 2 50       489     return $value if $value;
89              
90 2 50       24     if ( exists $cfg->{cookie_expires} ) {
91 0 0       0         if ( $cfg->{cookie_expires} > 0 ) {
92 0         0             return time() + $cfg->{cookie_expires};
93                     }
94                     else {
95 0         0             return undef;
96                     }
97                 }
98                 else {
99 2         24         return $c->session_expires;
100                 }
101             }
102              
103             sub get_session_cookie {
104 2     2 0 20     my $c = shift;
105              
106 2         23     my $cookie_name = $c->config->{session}{cookie_name};
107              
108 2         178     return $c->request->cookies->{$cookie_name};
109             }
110              
111             sub get_session_id {
112 2     2 0 65     my $c = shift;
113              
114 2 100       32     if ( my $cookie = $c->get_session_cookie ) {
115 1         20         my $sid = $cookie->value;
116 1 50       14         $c->log->debug(qq/Found sessionid "$sid" in cookie/) if $c->debug;
117 1 50       77         return $sid if $sid;
118                 }
119              
120 1         28     $c->NEXT::get_session_id(@_);
121             }
122              
123             sub delete_session_id {
124 0     0 0       my ( $c, $sid ) = @_;
125              
126 0               $c->update_session_cookie( $c->make_session_cookie( $sid, expires => 0 ) );
127              
128 0               $c->NEXT::delete_session_id($sid);
129             }
130              
131             __PACKAGE__
132              
133             __END__
134            
135             =pod
136            
137             =head1 NAME
138            
139             Catalyst::Plugin::Session::State::Cookie - Maintain session IDs using cookies.
140            
141             =head1 SYNOPSIS
142            
143             use Catalyst qw/Session Session::State::Cookie Session::Store::Foo/;
144            
145             =head1 DESCRIPTION
146            
147             In order for L<Catalyst::Plugin::Session> to work the session ID needs to be
148             stored on the client, and the session data needs to be stored on the server.
149            
150             This plugin stores the session ID on the client using the cookie mechanism.
151            
152             =head1 METHODS
153            
154             =over 4
155            
156             =item make_session_cookie
157            
158             Returns a hash reference with the default values for new cookies.
159            
160             =item update_session_cookie $hash_ref
161            
162             Sets the cookie based on C<cookie_name> in the response object.
163            
164             =back
165            
166             =head1 EXTENDED METHODS
167            
168             =over 4
169            
170             =item prepare_cookies
171            
172             Will restore if an appropriate cookie is found.
173            
174             =item finalize_cookies
175            
176             Will set a cookie called C<session> if it doesn't exist or if it's value is not
177             the current session id.
178            
179             =item setup_session
180            
181             Will set the C<cookie_name> parameter to it's default value if it isn't set.
182            
183             =back
184            
185             =head1 CONFIGURATION
186            
187             =over 4
188            
189             =item cookie_name
190            
191             The name of the cookie to store (defaults to C<Catalyst::Utils::apprefix($c) . '_session'>).
192            
193             =item cookie_domain
194            
195             The name of the domain to store in the cookie (defaults to current host)
196            
197             =item cookie_expires
198            
199             Number of seconds from now you want to elapse before cookie will expire.
200             Set to 0 to create a session cookie, ie one which will die when the
201             user's browser is shut down.
202            
203             =item cookie_secure
204            
205             If this attribute set true, the cookie will only be sent via HTTPS.
206            
207             =item cookie_path
208            
209             The path of the request url where cookie should be baked.
210            
211             =back
212            
213             =head1 CAVEATS
214            
215             Sessions have to be created before the first write to be saved. For example:
216            
217             sub action : Local {
218             my ( $self, $c ) = @_;
219             $c->res->write("foo");
220             $c->session( ... );
221             ...
222             }
223            
224             Will cause a session ID to not be set, because by the time a session is
225             actually created the headers have already been sent to the client.
226            
227             =head1 SEE ALSO
228            
229             L<Catalyst>, L<Catalyst::Plugin::Session>.
230            
231             =head1 AUTHORS
232            
233             This module is derived from L<Catalyst::Plugin::Session::FastMmap> code, and
234             has been heavily modified since.
235            
236             Andrew Ford
237             Andy Grundman
238             Christian Hansen
239             Yuval Kogman, C<nothingmuch@woobling.org>
240             Marcus Ramberg
241             Sebastian Riedel
242            
243             =head1 COPYRIGHT
244            
245             This program is free software, you can redistribute it and/or modify it
246             under the same terms as Perl itself.
247            
248             =cut
249            
250             1;
251