lib/Plack/Session/State/Cookie.pm

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