Commit | Line | Data |
bd992981 |
1 | package Plack::Session::State::Cookie; |
2 | use strict; |
3 | use warnings; |
4 | |
69c28b0e |
5 | our $VERSION = '0.10'; |
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 | |
c42534a7 |
30 | $options{path} = $self->path || '/' if !exists $options{path}; |
442b79a8 |
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 | |
c42534a7 |
35 | |
442b79a8 |
36 | if (!exists $options{expires} && defined $self->expires) { |
37 | $options{expires} = time + $self->expires; |
38 | } |
39 | |
40 | return %options; |
41 | } |
42 | |
caf3bd90 |
43 | sub expire_session_id { |
92edbddf |
44 | my ($self, $id, $res, $options) = @_; |
442b79a8 |
45 | my %opts = $self->merge_options(%$options, expires => time); |
46 | $self->_set_cookie($id, $res, %opts); |
caf3bd90 |
47 | } |
48 | |
bd992981 |
49 | sub finalize { |
92edbddf |
50 | my ($self, $id, $res, $options) = @_; |
442b79a8 |
51 | my %opts = $self->merge_options(%$options); |
52 | $self->_set_cookie($id, $res, %opts); |
92edbddf |
53 | } |
54 | |
55 | sub _set_cookie { |
56 | my($self, $id, $res, %options) = @_; |
57 | |
58 | # TODO: Do not use Plack::Response |
8e447333 |
59 | my $response = Plack::Response->new(@$res); |
bd992981 |
60 | $response->cookies->{ $self->session_key } = +{ |
61 | value => $id, |
92edbddf |
62 | %options, |
bd992981 |
63 | }; |
92edbddf |
64 | |
65 | my $final_r = $response->finalize; |
66 | $res->[1] = $final_r->[1]; # headers |
bd992981 |
67 | } |
68 | |
fe1bfe7d |
69 | 1; |
ac4892f4 |
70 | |
71 | __END__ |
72 | |
73 | =pod |
74 | |
75 | =head1 NAME |
76 | |
77 | Plack::Session::State::Cookie - Basic cookie-based session state |
78 | |
3d92cf47 |
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 | |
ac4892f4 |
93 | =head1 DESCRIPTION |
94 | |
43f34c01 |
95 | This is a subclass of L<Plack::Session::State> and implements it's |
3d92cf47 |
96 | full interface. This is the default state used in |
97 | L<Plack::Middleware::Session>. |
43f34c01 |
98 | |
ac4892f4 |
99 | =head1 METHODS |
100 | |
101 | =over 4 |
102 | |
103 | =item B<new ( %params )> |
104 | |
3d92cf47 |
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 | |
ac4892f4 |
109 | =item B<path> |
110 | |
3d92cf47 |
111 | Path of the cookie, this defaults to "/"; |
112 | |
ac4892f4 |
113 | =item B<domain> |
114 | |
3d92cf47 |
115 | Domain of the cookie, if nothing is supplied then it will not |
116 | be included in the cookie. |
117 | |
ac4892f4 |
118 | =item B<expires> |
119 | |
ee51674d |
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. |
3d92cf47 |
123 | |
ac4892f4 |
124 | =item B<secure> |
125 | |
3d92cf47 |
126 | Secure flag for the cookie, if nothing is supplied then it will not |
127 | be included in the cookie. |
128 | |
ac4892f4 |
129 | =back |
130 | |
ac4892f4 |
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 | |
000c696e |
143 | Copyright 2009, 2010 Infinity Interactive, Inc. |
ac4892f4 |
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 | |