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         } 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 EXTENDED METHODS
  93
  94 =over 4
  95
  96 =item prepare_cookies
  97
  98 Will restore if an appropriate cookie is found.
  99
 100 =item finalize_cookies
 101
 102 Will set a cookie called C<session> if it doesn't exist or if it's value is not
 103 the current session id.
 104
 105 =item setup_session
 106
 107 Will set the C<cookie_name> parameter to it's default value if it isn't set.
 108
 109 =back
 110
 111 =head1 CONFIGURATION
 112
 113 =over 4
 114
 115 =item cookie_name
 116
 117 The name of the cookie to store (defaults to C<session>).
 118
 119 =item cookie_domain
 120
 121 The name of the domain to store in the cookie (defaults to current host)
 122
 123 =back
 124
 125 =item CAVEATS
 126
 127 Sessions have to be created before the first write to be saved. For example:
 128
 129         sub action : Local {
 130                 my ( $self, $c ) = @_;
 131                 $c->res->write("foo");
 132                 $c->session( ... );
 133                 ...
 134         }
 135
 136 Will cause a session ID to not be set, because by the time a session is
 137 actually created the headers have already been sent to the client.
 138
 139 =head1 SEE ALSO
 140
 141 L<Catalyst>, L<Catalyst::Plugin::Session>.
 142
 143 =head1 AUTHOR
 144
 145 Sebastian Riedel E<lt>C<sri@cpan.org>E<gt>,
 146 Marcus Ramberg E<lt>C<mramberg@cpan.org>E<gt>,
 147 Andrew Ford E<lt>C<andrewf@cpan.org>E<gt>,
 148 Yuval Kogman E<lt>C<nothingmuch@woobling.org>E<gt>
 149
 150 =head1 COPYRIGHT
 151
 152 This program is free software, you can redistribute it and/or modify it
 153 under the same terms as Perl itself.
 154
 155 =cut
 156
 157 1;