lib/Catalyst/Plugin/Session/State/Cookie.pm

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