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