FastMmap.pm

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