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