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