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