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.02";
  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 finalize_cookies {
  22     my $c = shift;
  23
  24     if ( my $cookie = $c->get_session_cookie ) {
  25         $c->update_session_cookie( $c->make_session_cookie( $cookie->value ) );
  26     }
  27
  28     $c->NEXT::finalize_cookies( @_ );
  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         %attrs,
  52         ( $cfg->{cookie_domain} ? ( domain => $cfg->{cookie_domain} ) : () ),
  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 = shift;
 111     $c->NEXT::delete_session_id();
 112     delete $c->response->cookies->{ $c->config->{session}{cookie_name} };
 113 }
 114
 115 __PACKAGE__
 116
 117 __END__
 118
 119 =pod
 120
 121 =head1 NAME
 122
 123 Catalyst::Plugin::Session::State::Cookie - Maintain session IDs using cookies.
 124
 125 =head1 SYNOPSIS
 126
 127     use Catalyst qw/Session Session::State::Cookie Session::Store::Foo/;
 128
 129 =head1 DESCRIPTION
 130
 131 In order for L<Catalyst::Plugin::Session> to work the session ID needs to be
 132 stored on the client, and the session data needs to be stored on the server.
 133
 134 This plugin stores the session ID on the client using the cookie mechanism.
 135
 136 =head1 METHODS
 137
 138 =over 4
 139
 140 =item make_session_cookie
 141
 142 Returns a hash reference with the default values for new cookies.
 143
 144 =item update_session_cookie $hash_ref
 145
 146 Sets the cookie based on C<cookie_name> in the response object.
 147
 148 =back
 149
 150 =head1 EXTENDED METHODS
 151
 152 =over 4
 153
 154 =item prepare_cookies
 155
 156 Will restore if an appropriate cookie is found.
 157
 158 =item finalize_cookies
 159
 160 Will set a cookie called C<session> if it doesn't exist or if it's value is not
 161 the current session id.
 162
 163 =item setup_session
 164
 165 Will set the C<cookie_name> parameter to it's default value if it isn't set.
 166
 167 =back
 168
 169 =head1 CONFIGURATION
 170
 171 =over 4
 172
 173 =item cookie_name
 174
 175 The name of the cookie to store (defaults to C<Catalyst::Utils::apprefix($c) . '_session'>).
 176
 177 =item cookie_domain
 178
 179 The name of the domain to store in the cookie (defaults to current host)
 180
 181 =item cookie_expires
 182
 183 Number of seconds from now you want to elapse before cookie will expire.
 184 Set to 0 to create a session cookie, ie one which will die when the
 185 user's browser is shut down.
 186
 187 =item cookie_secure
 188
 189 If this attribute set true, the cookie will only be sent via HTTPS.
 190
 191 =back
 192
 193 =head1 CAVEATS
 194
 195 Sessions have to be created before the first write to be saved. For example:
 196
 197         sub action : Local {
 198                 my ( $self, $c ) = @_;
 199                 $c->res->write("foo");
 200                 $c->session( ... );
 201                 ...
 202         }
 203
 204 Will cause a session ID to not be set, because by the time a session is
 205 actually created the headers have already been sent to the client.
 206
 207 =head1 SEE ALSO
 208
 209 L<Catalyst>, L<Catalyst::Plugin::Session>.
 210
 211 =head1 AUTHORS
 212
 213 This module is derived from L<Catalyst::Plugin::Session::FastMmap> code, and
 214 has been heavily modified since.
 215
 216 Andrew Ford
 217 Andy Grundman
 218 Christian Hansen
 219 Yuval Kogman, C<nothingmuch@woobling.org>
 220 Marcus Ramberg
 221 Sebastian Riedel
 222
 223 =head1 COPYRIGHT
 224
 225 This program is free software, you can redistribute it and/or modify it
 226 under the same terms as Perl itself.
 227
 228 =cut
 229
 230 1;