initial import of catalyst.
Marcus Ramberg [Mon, 28 Feb 2005 19:24:51 +0000 (19:24 +0000)]
Changes [new file with mode: 0644]
FastMmap.pm [new file with mode: 0644]
Makefile.PL [new file with mode: 0644]
README [new file with mode: 0644]
test.pl [new file with mode: 0644]

diff --git a/Changes b/Changes
new file mode 100644 (file)
index 0000000..75553f7
--- /dev/null
+++ b/Changes
@@ -0,0 +1,13 @@
+Revision history for Perl extension Catalyst::Plugin::Session::FastMmap.
+
+0.04  Wed Feb 16 22:00:00 2005
+        - added tempdir support (Marcus Ramberg)
+
+0.03  Wed Feb 16 22:00:00 2005
+        - added config parameters (Marcus Ramberg)
+
+0.02  Tue Feb 01 02:00:00 2005
+        - better url rewriting
+
+0.01  Fri Jan 28 22:00:00 2005
+        - first release
diff --git a/FastMmap.pm b/FastMmap.pm
new file mode 100644 (file)
index 0000000..5b5e460
--- /dev/null
@@ -0,0 +1,160 @@
+package Catalyst::Plugin::Session::FastMmap;
+
+use strict;
+use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
+use NEXT;
+use Cache::FastMmap;
+use Digest::MD5;
+use URI;
+use URI::Find;
+use File::Temp 'tempdir';
+
+our $VERSION = '0.04';
+
+__PACKAGE__->mk_classdata('_session');
+__PACKAGE__->mk_accessors('sessionid');
+
+=head1 NAME
+
+Catalyst::Plugin::Session::FastMmap - FastMmap sessions for Catalyst
+
+=head1 SYNOPSIS
+
+    use Catalyst 'Session::FastMmap';
+
+    $c->session->{foo} = 'bar';
+    print $c->sessionid;
+
+=head1 DESCRIPTION
+
+Fast sessions.
+
+=head2 EXTENDED METHODS
+
+=head3 finalize
+
+=cut
+
+sub finalize {
+    my $c        = shift;
+    my $redirect = $c->response->redirect;
+    $c->response->redirect( $c->uri($redirect) ) if $redirect;
+    if ( my $sid = $c->sessionid ) {
+        $c->_session->set( $sid, $c->session );
+        my $set = 1;
+        if ( my $cookie = $c->request->cookies->{session} ) {
+            $set = 0 if $cookie->value eq $sid;
+        }
+        $c->response->cookies->{session} = { value => $sid } if $set;
+        my $finder = URI::Find->new(
+            sub {
+                my ( $uri, $orig ) = @_;
+                my $base = $c->request->base;
+                return $orig unless $orig =~ /^$base/;
+                return $orig if $uri->path =~ /\/-\//;
+                return $c->uri($orig);
+            }
+        );
+        $finder->find( \$c->response->{output} );
+    }
+    return $c->NEXT::finalize(@_);
+}
+
+=head3 prepare_action
+
+=cut
+
+sub prepare_action {
+    my $c = shift;
+    if ( $c->request->path =~ /^(.*)\/\-\/(.+)$/ ) {
+        $c->request->path($1);
+        $c->sessionid($2);
+        $c->log->debug(qq/Found sessionid "$2" in path/) if $c->debug;
+    }
+    if ( my $cookie = $c->request->cookies->{session} ) {
+        my $sid = $cookie->value;
+        $c->sessionid($sid);
+        $c->log->debug(qq/Found sessionid "$sid" in cookie/) if $c->debug;
+    }
+    $c->NEXT::prepare_action(@_);
+}
+
+sub session {
+    my $c = shift;
+    return $c->{session} if $c->{session};
+    my $sid = $c->sessionid;
+    if ( $sid && ( $c->{session} = $c->_session->get($sid) ) ) {
+        $c->log->debug(qq/Found session "$sid"/) if $c->debug;
+        return $c->{session};
+    }
+    else {
+        my $sid = Digest::MD5::md5_hex( time, rand, $$, 'catalyst' );
+        $c->sessionid($sid);
+        $c->log->debug(qq/Created session "$sid"/) if $c->debug;
+        return $c->{session} = {};
+    }
+}
+
+=head3 setup
+
+=cut
+
+sub setup {
+    my $self               = shift;
+    my $cache_root         = $self->config->{cache_root} || tempdir;
+    my $default_expires_in = $self->config->{default_expires_in}
+      || 60 * 60 * 24;
+    my $auto_purge_interval = $self->config->{auto_purge_interval}
+      || 60 * 60 * 24;
+    my $auto_purge_on_set = $self->config->{auto_purge_on_set} || 1;
+    $self->_session(
+        Cache::FastMmap->new(
+            cache_root          => $cache_root,
+            default_expires_in  => $default_expires_in,
+            auto_purge_interval => $auto_purge_interval,
+            auto_purge_on_set   => $auto_purge_on_set
+        )
+    );
+    return $self->NEXT::setup(@_);
+}
+
+=head2 METHODS
+
+=head3 session
+
+=head3 uri
+
+Extends an uri with session id if needed.
+
+    my $uri = $c->uri('http://localhost/foo');
+
+=cut
+
+sub uri {
+    my ( $c, $uri ) = @_;
+    if ( my $sid = $c->sessionid ) {
+        $uri = URI->new($uri);
+        my $path = $uri->path;
+        $path .= '/' unless $path =~ /\/$/;
+        $uri->path( $path . "-/$sid" );
+        return $uri->as_string;
+    }
+    return $uri;
+}
+
+=head1 SEE ALSO
+
+L<Catalyst>.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@cpan.org>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644 (file)
index 0000000..36fb483
--- /dev/null
@@ -0,0 +1,17 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME      => 'Catalyst::Plugin::Session::FastMmap',
+    AUTHOR    => 'Sebastian Riedel (sri@oook.de)',
+    PREREQ_PM => {
+        Catalyst                 => '2.99',
+        Cache::FastMmap          => 0,
+        Class::Accessor::Fast    => 0,
+        Class::Data::Inheritable => 0,
+        Digest::MD5              => 0,
+        URI                      => 0,
+        URI::Find                => 0,
+        File::Temp               => 0
+    },
+    VERSION_FROM => 'FastMmap.pm'
+);
diff --git a/README b/README
new file mode 100644 (file)
index 0000000..daaceee
--- /dev/null
+++ b/README
@@ -0,0 +1,31 @@
+NAME
+    Catalyst::Plugin::Session::FastMmap - FastMmap sessions for Catalyst
+
+SYNOPSIS
+        use Catalyst 'Session::FastMmap';
+
+        $c->session->{foo} = 'bar';
+        print $c->sessionid;
+
+DESCRIPTION
+  EXTENDED METHODS
+   finalize
+   prepare_action
+   setup
+  METHODS
+   session
+   uri
+    Extends an uri with session id if needed.
+
+        my $uri = $c->uri('http://localhost/foo');
+
+SEE ALSO
+    Catalyst.
+
+AUTHOR
+    Sebastian Riedel, "sri@cpan.org"
+
+COPYRIGHT
+    This program is free software, you can redistribute it and/or modify it
+    under the same terms as Perl itself.
+
diff --git a/test.pl b/test.pl
new file mode 100644 (file)
index 0000000..09d7023
--- /dev/null
+++ b/test.pl
@@ -0,0 +1,4 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN { use_ok('Catalyst::Plugin::Session::FastMmap') }