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