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> and
 106 I<secure> 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 =back
 130
 131 =head1 BUGS
 132
 133 All complex software has bugs lurking in it, and this module is no
 134 exception. If you find a bug please either email me, or add the bug
 135 to cpan-RT.
 136
 137 =head1 AUTHOR
 138
 139 Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
 140
 141 =head1 COPYRIGHT AND LICENSE
 142
 143 Copyright 2009, 2010 Infinity Interactive, Inc.
 144
 145 L<http://www.iinteractive.com>
 146
 147 This library is free software; you can redistribute it and/or modify
 148 it under the same terms as Perl itself.
 149
 150 =cut
 151
 152