lib/Plack/Session/State/Cookie.pm

   1 package Plack::Session::State::Cookie;
   2 use strict;
   3 use warnings;
   4
   5 our $VERSION   = '0.11';
   6 our $AUTHORITY = 'cpan:STEVAN';
   7
   8 use parent 'Plack::Session::State';
   9 use Plack::Request;
  10 use Plack::Response;
  11
  12 use Plack::Util::Accessor qw[
  13     path
  14     domain
  15     expires
  16     secure
  17     httponly
  18 ];
  19
  20 sub get_session_id {
  21     my ($self, $env) = @_;
  22     Plack::Request->new($env)->cookies->{$self->session_key};
  23 }
  24
  25 sub merge_options {
  26     my($self, %options) = @_;
  27
  28     delete $options{id};
  29
  30     $options{path}     = $self->path || '/' if !exists $options{path};
  31     $options{domain}   = $self->domain      if !exists $options{domain} && defined $self->domain;
  32     $options{secure}   = $self->secure      if !exists $options{secure} && defined $self->secure;
  33     $options{httponly} = $self->httponly    if !exists $options{httponly} && defined $self->httponly;
  34
  35
  36     if (!exists $options{expires} && defined $self->expires) {
  37         $options{expires} = time + $self->expires;
  38     }
  39
  40     return %options;
  41 }
  42
  43 sub expire_session_id {
  44     my ($self, $id, $res, $options) = @_;
  45     my %opts = $self->merge_options(%$options, expires => time);
  46     $self->_set_cookie($id, $res, %opts);
  47 }
  48
  49 sub finalize {
  50     my ($self, $id, $res, $options) = @_;
  51     my %opts = $self->merge_options(%$options);
  52     $self->_set_cookie($id, $res, %opts);
  53 }
  54
  55 sub _set_cookie {
  56     my($self, $id, $res, %options) = @_;
  57
  58     # TODO: Do not use Plack::Response
  59     my $response = Plack::Response->new(@$res);
  60     $response->cookies->{ $self->session_key } = +{
  61         value => $id,
  62         %options,
  63     };
  64
  65     my $final_r = $response->finalize;
  66     $res->[1] = $final_r->[1]; # headers
  67 }
  68
  69 1;
  70
  71 __END__
  72
  73 =pod
  74
  75 =head1 NAME
  76
  77 Plack::Session::State::Cookie - Basic cookie-based session state
  78
  79 =head1 SYNOPSIS
  80
  81   use Plack::Builder;
  82   use Plack::Middleware::Session;
  83
  84   my $app = sub {
  85       return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello Foo' ] ];
  86   };
  87
  88   builder {
  89       enable 'Session'; # Cookie is the default state
  90       $app;
  91   };
  92
  93 =head1 DESCRIPTION
  94
  95 This is a subclass of L<Plack::Session::State> and implements its
  96 full interface. This is the default state used in
  97 L<Plack::Middleware::Session>.
  98
  99 =head1 METHODS
 100
 101 =over 4
 102
 103 =item B<new ( %params )>
 104
 105 The C<%params> can include I<path>, I<domain>, I<expires>, I<secure>,
 106 and I<httponly> options, as well as all the options accepted by
 107 L<Plack::Session::Store>.
 108
 109 =item B<path>
 110
 111 Path of the cookie, this defaults to "/";
 112
 113 =item B<domain>
 114
 115 Domain of the cookie, if nothing is supplied then it will not
 116 be included in the cookie.
 117
 118 =item B<expires>
 119
 120 Expiration time of the cookie in seconds, if nothing is supplied then
 121 it will not be included in the cookie, which means the session expires
 122 per browser session.
 123
 124 =item B<secure>
 125
 126 Secure flag for the cookie, if nothing is supplied then it will not
 127 be included in the cookie.
 128
 129 =item B<httponly>
 130
 131 HttpOnly flag for the cookie, if nothing is supplied then it will not
 132 be included in the cookie.
 133
 134 =back
 135
 136 =head1 BUGS
 137
 138 All complex software has bugs lurking in it, and this module is no
 139 exception. If you find a bug please either email me, or add the bug
 140 to cpan-RT.
 141
 142 =head1 AUTHOR
 143
 144 Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
 145
 146 =head1 COPYRIGHT AND LICENSE
 147
 148 Copyright 2009, 2010 Infinity Interactive, Inc.
 149
 150 L<http://www.iinteractive.com>
 151
 152 This library is free software; you can redistribute it and/or modify
 153 it under the same terms as Perl itself.
 154
 155 =cut
 156
 157