Commit | Line | Data |
bd992981 |
1 | package Plack::Session::State::Cookie; |
2 | use strict; |
3 | use warnings; |
4 | |
91b87895 |
5 | our $VERSION = '0.09_01'; |
30cc0a71 |
6 | our $AUTHORITY = 'cpan:STEVAN'; |
7 | |
bd992981 |
8 | use parent 'Plack::Session::State'; |
92edbddf |
9 | use Plack::Request; |
10 | use Plack::Response; |
bd992981 |
11 | |
ac4892f4 |
12 | use Plack::Util::Accessor qw[ |
13 | path |
14 | domain |
15 | expires |
16 | secure |
442b79a8 |
17 | httponly |
ac4892f4 |
18 | ]; |
bd992981 |
19 | |
4a0cb5a0 |
20 | sub get_session_id { |
92edbddf |
21 | my ($self, $env) = @_; |
2c5f34e8 |
22 | Plack::Request->new($env)->cookies->{$self->session_key}; |
bd992981 |
23 | } |
24 | |
442b79a8 |
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 | |
caf3bd90 |
42 | sub 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 |
48 | sub 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 | |
54 | sub _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 |
68 | 1; |
ac4892f4 |
69 | |
70 | __END__ |
71 | |
72 | =pod |
73 | |
74 | =head1 NAME |
75 | |
76 | Plack::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 |
94 | This is a subclass of L<Plack::Session::State> and implements it's |
3d92cf47 |
95 | full interface. This is the default state used in |
96 | L<Plack::Middleware::Session>. |
43f34c01 |
97 | |
ac4892f4 |
98 | =head1 METHODS |
99 | |
100 | =over 4 |
101 | |
102 | =item B<new ( %params )> |
103 | |
3d92cf47 |
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 | |
ac4892f4 |
108 | =item B<path> |
109 | |
3d92cf47 |
110 | Path of the cookie, this defaults to "/"; |
111 | |
ac4892f4 |
112 | =item B<domain> |
113 | |
3d92cf47 |
114 | Domain of the cookie, if nothing is supplied then it will not |
115 | be included in the cookie. |
116 | |
ac4892f4 |
117 | =item B<expires> |
118 | |
ee51674d |
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. |
3d92cf47 |
122 | |
ac4892f4 |
123 | =item B<secure> |
124 | |
3d92cf47 |
125 | Secure flag for the cookie, if nothing is supplied then it will not |
126 | be included in the cookie. |
127 | |
ac4892f4 |
128 | =back |
129 | |
ac4892f4 |
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 | |
000c696e |
142 | Copyright 2009, 2010 Infinity Interactive, Inc. |
ac4892f4 |
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 | |