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