Commit | Line | Data |
bf2bce67 |
1 | package Catalyst::Plugin::Session::FastMmap; |
2 | |
3 | use strict; |
4 | use base qw/Class::Data::Inheritable Class::Accessor::Fast/; |
5 | use NEXT; |
6 | use Cache::FastMmap; |
7 | use Digest::MD5; |
8 | use URI; |
9 | use URI::Find; |
10 | use File::Temp 'tempdir'; |
11 | |
6905eaeb |
12 | our $VERSION = '0.06'; |
bf2bce67 |
13 | |
14 | __PACKAGE__->mk_classdata('_session'); |
15 | __PACKAGE__->mk_accessors('sessionid'); |
16 | |
17 | =head1 NAME |
18 | |
19 | Catalyst::Plugin::Session::FastMmap - FastMmap sessions for Catalyst |
20 | |
21 | =head1 SYNOPSIS |
22 | |
23 | use Catalyst 'Session::FastMmap'; |
24 | |
25 | $c->session->{foo} = 'bar'; |
26 | print $c->sessionid; |
27 | |
28 | =head1 DESCRIPTION |
29 | |
30 | Fast sessions. |
31 | |
32 | =head2 EXTENDED METHODS |
33 | |
34 | =head3 finalize |
35 | |
36 | =cut |
37 | |
38 | sub finalize { |
39 | my $c = shift; |
ad142f4c |
40 | unless ($c->config->{no_url_rewrite}) { |
41 | my $redirect = $c->response->redirect; |
42 | $c->response->redirect( $c->uri($redirect) ) if $redirect; |
43 | } |
bf2bce67 |
44 | if ( my $sid = $c->sessionid ) { |
45 | $c->_session->set( $sid, $c->session ); |
46 | my $set = 1; |
47 | if ( my $cookie = $c->request->cookies->{session} ) { |
48 | $set = 0 if $cookie->value eq $sid; |
49 | } |
50 | $c->response->cookies->{session} = { value => $sid } if $set; |
58c05d1a |
51 | unless ($c->config->{no_url_rewrite}) { |
52 | my $finder = URI::Find->new( |
53 | sub { |
54 | my ( $uri, $orig ) = @_; |
55 | my $base = $c->request->base; |
56 | return $orig unless $orig =~ /^$base/; |
57 | return $orig if $uri->path =~ /\/-\//; |
58 | return $c->uri($orig); |
59 | } |
60 | ); |
61 | $finder->find( \$c->res->{output} ) if $c->res->output; |
62 | } |
bf2bce67 |
63 | } |
64 | return $c->NEXT::finalize(@_); |
65 | } |
66 | |
67 | =head3 prepare_action |
68 | |
69 | =cut |
70 | |
71 | sub prepare_action { |
72 | my $c = shift; |
73 | if ( $c->request->path =~ /^(.*)\/\-\/(.+)$/ ) { |
74 | $c->request->path($1); |
75 | $c->sessionid($2); |
76 | $c->log->debug(qq/Found sessionid "$2" in path/) if $c->debug; |
77 | } |
78 | if ( my $cookie = $c->request->cookies->{session} ) { |
79 | my $sid = $cookie->value; |
80 | $c->sessionid($sid); |
81 | $c->log->debug(qq/Found sessionid "$sid" in cookie/) if $c->debug; |
82 | } |
83 | $c->NEXT::prepare_action(@_); |
84 | } |
85 | |
86 | sub session { |
87 | my $c = shift; |
88 | return $c->{session} if $c->{session}; |
89 | my $sid = $c->sessionid; |
617a86d6 |
90 | if ( $sid |
91 | && $c->_session |
92 | && ( $c->{session} = $c->_session->get($sid) ) ) |
93 | { |
bf2bce67 |
94 | $c->log->debug(qq/Found session "$sid"/) if $c->debug; |
95 | return $c->{session}; |
96 | } |
97 | else { |
98 | my $sid = Digest::MD5::md5_hex( time, rand, $$, 'catalyst' ); |
99 | $c->sessionid($sid); |
100 | $c->log->debug(qq/Created session "$sid"/) if $c->debug; |
101 | return $c->{session} = {}; |
102 | } |
103 | } |
104 | |
105 | =head3 setup |
106 | |
107 | =cut |
108 | |
109 | sub setup { |
110 | my $self = shift; |
111 | my $cache_root = $self->config->{cache_root} || tempdir; |
112 | my $default_expires_in = $self->config->{default_expires_in} |
113 | || 60 * 60 * 24; |
114 | my $auto_purge_interval = $self->config->{auto_purge_interval} |
115 | || 60 * 60 * 24; |
116 | my $auto_purge_on_set = $self->config->{auto_purge_on_set} || 1; |
117 | $self->_session( |
118 | Cache::FastMmap->new( |
119 | cache_root => $cache_root, |
120 | default_expires_in => $default_expires_in, |
121 | auto_purge_interval => $auto_purge_interval, |
122 | auto_purge_on_set => $auto_purge_on_set |
123 | ) |
124 | ); |
125 | return $self->NEXT::setup(@_); |
126 | } |
127 | |
128 | =head2 METHODS |
129 | |
130 | =head3 session |
131 | |
132 | =head3 uri |
133 | |
134 | Extends an uri with session id if needed. |
135 | |
136 | my $uri = $c->uri('http://localhost/foo'); |
137 | |
138 | =cut |
139 | |
140 | sub uri { |
141 | my ( $c, $uri ) = @_; |
142 | if ( my $sid = $c->sessionid ) { |
143 | $uri = URI->new($uri); |
144 | my $path = $uri->path; |
145 | $path .= '/' unless $path =~ /\/$/; |
146 | $uri->path( $path . "-/$sid" ); |
147 | return $uri->as_string; |
148 | } |
149 | return $uri; |
150 | } |
151 | |
58c05d1a |
152 | =head2 CONFIG OPTIONS |
153 | |
154 | =head3 no_url_rewrite |
155 | |
156 | To disable automatic storing of sessions in the url, |
157 | you can disable the url rewriting for session by setting |
158 | this to a true value. |
159 | |
160 | =head3 cache_root |
161 | |
162 | The root directory for the session cache. defaults to a |
163 | tempdir. |
164 | |
165 | =head3 default_expires_in |
166 | |
167 | how many seconds until the session expires. defaults to 1 day |
168 | |
169 | =head3 auto_purge_interval |
170 | |
171 | How often should the system purge sessions. Defaults to 1 time |
172 | per day. |
173 | |
6905eaeb |
174 | =head3 auto_purge_on_set |
58c05d1a |
175 | |
176 | Is auto purge enabled? defaults to true. |
177 | |
bf2bce67 |
178 | =head1 SEE ALSO |
179 | |
58c05d1a |
180 | L<Catalyst> L<Cache::FastMmap>. |
bf2bce67 |
181 | |
182 | =head1 AUTHOR |
183 | |
184 | Sebastian Riedel, C<sri@cpan.org> |
0c806459 |
185 | Marcus Ramberg C<mramberg@cpan.org> |
bf2bce67 |
186 | |
187 | =head1 COPYRIGHT |
188 | |
189 | This program is free software, you can redistribute it and/or modify it under |
190 | the same terms as Perl itself. |
191 | |
192 | =cut |
193 | |
194 | 1; |