Checking in changes prior to tagging of version 0.09_02. Changelog diff is:
[catagits/Web-Session.git] / lib / Plack / Session / State / Cookie.pm
CommitLineData
bd992981 1package Plack::Session::State::Cookie;
2use strict;
3use warnings;
4
98f62fd7 5our $VERSION = '0.09_02';
30cc0a71 6our $AUTHORITY = 'cpan:STEVAN';
7
bd992981 8use parent 'Plack::Session::State';
92edbddf 9use Plack::Request;
10use Plack::Response;
bd992981 11
ac4892f4 12use Plack::Util::Accessor qw[
13 path
14 domain
15 expires
16 secure
442b79a8 17 httponly
ac4892f4 18];
bd992981 19
4a0cb5a0 20sub get_session_id {
92edbddf 21 my ($self, $env) = @_;
2c5f34e8 22 Plack::Request->new($env)->cookies->{$self->session_key};
bd992981 23}
24
442b79a8 25sub 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
caf3bd90 42sub expire_session_id {
92edbddf 43 my ($self, $id, $res, $options) = @_;
442b79a8 44 my %opts = $self->merge_options(%$options, expires => time);
45 $self->_set_cookie($id, $res, %opts);
caf3bd90 46}
47
bd992981 48sub finalize {
92edbddf 49 my ($self, $id, $res, $options) = @_;
442b79a8 50 my %opts = $self->merge_options(%$options);
51 $self->_set_cookie($id, $res, %opts);
92edbddf 52}
53
54sub _set_cookie {
55 my($self, $id, $res, %options) = @_;
56
57 # TODO: Do not use Plack::Response
8e447333 58 my $response = Plack::Response->new(@$res);
bd992981 59 $response->cookies->{ $self->session_key } = +{
60 value => $id,
92edbddf 61 %options,
bd992981 62 };
92edbddf 63
64 my $final_r = $response->finalize;
65 $res->[1] = $final_r->[1]; # headers
bd992981 66}
67
fe1bfe7d 681;
ac4892f4 69
70__END__
71
72=pod
73
74=head1 NAME
75
76Plack::Session::State::Cookie - Basic cookie-based session state
77
3d92cf47 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
ac4892f4 92=head1 DESCRIPTION
93
43f34c01 94This is a subclass of L<Plack::Session::State> and implements it's
3d92cf47 95full interface. This is the default state used in
96L<Plack::Middleware::Session>.
43f34c01 97
ac4892f4 98=head1 METHODS
99
100=over 4
101
102=item B<new ( %params )>
103
3d92cf47 104The C<%params> can include I<path>, I<domain>, I<expires> and
105I<secure> options, as well as all the options accepted by
106L<Plack::Session::Store>.
107
ac4892f4 108=item B<path>
109
3d92cf47 110Path of the cookie, this defaults to "/";
111
ac4892f4 112=item B<domain>
113
3d92cf47 114Domain of the cookie, if nothing is supplied then it will not
115be included in the cookie.
116
ac4892f4 117=item B<expires>
118
ee51674d 119Expiration time of the cookie in seconds, if nothing is supplied then
120it will not be included in the cookie, which means the session expires
121per browser session.
3d92cf47 122
ac4892f4 123=item B<secure>
124
3d92cf47 125Secure flag for the cookie, if nothing is supplied then it will not
126be included in the cookie.
127
ac4892f4 128=back
129
ac4892f4 130=head1 BUGS
131
132All complex software has bugs lurking in it, and this module is no
133exception. If you find a bug please either email me, or add the bug
134to cpan-RT.
135
136=head1 AUTHOR
137
138Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
139
140=head1 COPYRIGHT AND LICENSE
141
000c696e 142Copyright 2009, 2010 Infinity Interactive, Inc.
ac4892f4 143
144L<http://www.iinteractive.com>
145
146This library is free software; you can redistribute it and/or modify
147it under the same terms as Perl itself.
148
149=cut
150
151