From: Yuval Kogman <nothingmuch@woobling.org>
Date: Mon, 31 Jul 2006 11:20:03 +0000 (+0000)
Subject: - tagged Catalyst-Plugin-Session-State-Cookie-0.03
X-Git-Tag: v0.03^0
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Plugin-Session-State-Cookie.git;a=commitdiff_plain;h=refs%2Ftags%2Fv0.03

- tagged Catalyst-Plugin-Session-State-Cookie-0.03
---

diff --git a/Catalyst-Plugin-Session-State-Cookie/Build.PL b/Catalyst-Plugin-Session-State-Cookie/Build.PL
new file mode 100644
index 0000000..9644e8d
--- /dev/null
+++ b/Catalyst-Plugin-Session-State-Cookie/Build.PL
@@ -0,0 +1,16 @@
+use strict;
+use Module::Build;
+
+my $build = Module::Build->new(
+    create_makefile_pl => 'traditional',
+    license            => 'perl',
+    module_name        => 'Catalyst::Plugin::Session::State::Cookie',
+    requires           => {
+        'Catalyst::Plugin::Session' => '0.06',
+        'Test::MockObject'          => '1.01',
+    },
+    create_readme => 1,
+    sign          => 1,
+);
+$build->create_build_script;
+
diff --git a/Catalyst-Plugin-Session-State-Cookie/Changes b/Catalyst-Plugin-Session-State-Cookie/Changes
new file mode 100644
index 0000000..8b4b8f8
--- /dev/null
+++ b/Catalyst-Plugin-Session-State-Cookie/Changes
@@ -0,0 +1,18 @@
+Revision history for Perl extension Catalyst::Plugin::Session::State::Cookie
+
+0.04
+        - Depend on a higher version of C::P::Session
+
+0.03 
+        - refactored make_session_cookie to separate calc_expiry, and made
+	      that easily overloadable.
+        - updated for the new state API (get_session_id, set_session_id, etc)
+
+0.02    2005-12-28 13:51:00
+        - Fixed cookie_expires to support browser session cookies.
+        - Renamed default cookie name from just 'session' to
+          'yourapp_session' to allow several applications on the same domain
+          to exist without conflict (LTJake)
+
+0.01    2005-11-14 12:45:00
+        - Initial release.
diff --git a/Catalyst-Plugin-Session-State-Cookie/MANIFEST.SKIP b/Catalyst-Plugin-Session-State-Cookie/MANIFEST.SKIP
new file mode 100644
index 0000000..2fb8e56
--- /dev/null
+++ b/Catalyst-Plugin-Session-State-Cookie/MANIFEST.SKIP
@@ -0,0 +1,29 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+
+# Avoid Makemaker generated and utility files.
+\bMakefile$
+\bblib
+\bMakeMaker-\d
+\bpm_to_blib$
+\bblibdirs$
+^MANIFEST\.SKIP$
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build
+
+# Avoid temp and backup files.
+~$
+\.tmp$
+\.old$
+\.bak$
+\#$
+\b\.#
+^..*\.sw[po]$
+
+# prereq tests may fail due to optionals
+99_prereq\.t$
diff --git a/Catalyst-Plugin-Session-State-Cookie/lib/Catalyst/Plugin/Session/State/Cookie.pm b/Catalyst-Plugin-Session-State-Cookie/lib/Catalyst/Plugin/Session/State/Cookie.pm
new file mode 100644
index 0000000..7fbde70
--- /dev/null
+++ b/Catalyst-Plugin-Session-State-Cookie/lib/Catalyst/Plugin/Session/State/Cookie.pm
@@ -0,0 +1,232 @@
+package Catalyst::Plugin::Session::State::Cookie;
+use base qw/Catalyst::Plugin::Session::State/;
+
+use strict;
+use warnings;
+
+use NEXT;
+use Catalyst::Utils ();
+
+our $VERSION = "0.04";
+
+sub setup_session {
+    my $c = shift;
+
+    $c->NEXT::setup_session(@_);
+
+    $c->config->{session}{cookie_name}
+        ||= Catalyst::Utils::appprefix($c) . '_session';
+}
+
+sub extend_session_id {
+    my ( $c, $sid, $expires ) = @_;
+
+    if ( my $cookie = $c->get_session_cookie ) {
+        $c->update_session_cookie( $c->make_session_cookie( $sid ) );
+    }
+
+    $c->NEXT::extend_session_id( @_ );
+}
+
+sub set_session_id {
+    my ( $c, $sid ) = @_;
+
+    $c->update_session_cookie( $c->make_session_cookie( $sid ) );
+
+    return $c->NEXT::set_session_id(@_);
+}
+
+sub update_session_cookie {
+    my ( $c, $updated ) = @_;
+    my $cookie_name = $c->config->{session}{cookie_name};
+    $c->response->cookies->{$cookie_name} = $updated;
+}
+
+sub make_session_cookie {
+    my ( $c, $sid, %attrs ) = @_;
+
+    my $cfg    = $c->config->{session};
+    my $cookie = {
+        value => $sid,
+        ( $cfg->{cookie_domain} ? ( domain => $cfg->{cookie_domain} ) : () ),
+        %attrs,
+    };
+
+    unless ( exists $cookie->{expires} ) {
+        $cookie->{expires} = $c->calculate_session_cookie_expires();
+    }
+
+    $cookie->{secure} = 1 if $cfg->{cookie_secure};
+
+    return $cookie;
+}
+
+sub calc_expiry { # compat
+    my $c = shift;
+    $c->NEXT::calc_expiry( @_ ) || $c->calculate_session_cookie_expires( @_ );
+}
+
+sub calculate_session_cookie_expires {
+    my $c   = shift;
+    my $cfg = $c->config->{session};
+
+    my $value = $c->NEXT::calculate_session_cookie_expires(@_);
+    return $value if $value;
+
+    if ( exists $cfg->{cookie_expires} ) {
+        if ( $cfg->{cookie_expires} > 0 ) {
+            return time() + $cfg->{cookie_expires};
+        }
+        else {
+            return undef;
+        }
+    }
+    else {
+        return $c->session_expires;
+    }
+}
+
+sub get_session_cookie {
+    my $c = shift;
+
+    my $cookie_name = $c->config->{session}{cookie_name};
+
+    return $c->request->cookies->{$cookie_name};
+}
+
+sub get_session_id {
+    my $c = shift;
+
+    if ( my $cookie = $c->get_session_cookie  ) { 
+        my $sid = $cookie->value;
+        $c->log->debug(qq/Found sessionid "$sid" in cookie/) if $c->debug;
+        return $sid if $sid;
+    }
+
+    $c->NEXT::get_session_id(@_);
+}
+
+sub delete_session_id {
+    my ( $c, $sid ) = @_;
+
+    $c->update_session_cookie( $c->make_session_cookie( $sid, expires => 0 ) );
+
+    $c->NEXT::delete_session_id($sid);
+}
+
+__PACKAGE__
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::Plugin::Session::State::Cookie - Maintain session IDs using cookies.
+
+=head1 SYNOPSIS
+
+    use Catalyst qw/Session Session::State::Cookie Session::Store::Foo/;
+
+=head1 DESCRIPTION
+
+In order for L<Catalyst::Plugin::Session> to work the session ID needs to be
+stored on the client, and the session data needs to be stored on the server.
+
+This plugin stores the session ID on the client using the cookie mechanism.
+
+=head1 METHODS
+
+=over 4
+
+=item make_session_cookie
+
+Returns a hash reference with the default values for new cookies.
+
+=item update_session_cookie $hash_ref
+
+Sets the cookie based on C<cookie_name> in the response object.
+
+=back
+
+=head1 EXTENDED METHODS
+
+=over 4
+
+=item prepare_cookies
+
+Will restore if an appropriate cookie is found.
+
+=item finalize_cookies
+
+Will set a cookie called C<session> if it doesn't exist or if it's value is not
+the current session id.
+
+=item setup_session
+
+Will set the C<cookie_name> parameter to it's default value if it isn't set.
+
+=back
+
+=head1 CONFIGURATION
+
+=over 4
+
+=item cookie_name
+
+The name of the cookie to store (defaults to C<Catalyst::Utils::apprefix($c) . '_session'>).
+
+=item cookie_domain
+
+The name of the domain to store in the cookie (defaults to current host)
+
+=item cookie_expires
+
+Number of seconds from now you want to elapse before cookie will expire. 
+Set to 0 to create a session cookie, ie one which will die when the 
+user's browser is shut down.
+
+=item cookie_secure
+
+If this attribute set true, the cookie will only be sent via HTTPS.
+
+=back
+
+=head1 CAVEATS
+
+Sessions have to be created before the first write to be saved. For example:
+
+	sub action : Local {
+		my ( $self, $c ) = @_;
+		$c->res->write("foo");
+		$c->session( ... );
+		...
+	}
+
+Will cause a session ID to not be set, because by the time a session is
+actually created the headers have already been sent to the client.
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<Catalyst::Plugin::Session>.
+
+=head1 AUTHORS
+
+This module is derived from L<Catalyst::Plugin::Session::FastMmap> code, and
+has been heavily modified since.
+
+Andrew Ford
+Andy Grundman
+Christian Hansen
+Yuval Kogman, C<nothingmuch@woobling.org>
+Marcus Ramberg
+Sebastian Riedel
+
+=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/Catalyst-Plugin-Session-State-Cookie/t/01use.t b/Catalyst-Plugin-Session-State-Cookie/t/01use.t
new file mode 100644
index 0000000..dd9d90c
--- /dev/null
+++ b/Catalyst-Plugin-Session-State-Cookie/t/01use.t
@@ -0,0 +1,4 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN { use_ok('Catalyst::Plugin::Session::State::Cookie') }
diff --git a/Catalyst-Plugin-Session-State-Cookie/t/02pod.t b/Catalyst-Plugin-Session-State-Cookie/t/02pod.t
new file mode 100644
index 0000000..1647794
--- /dev/null
+++ b/Catalyst-Plugin-Session-State-Cookie/t/02pod.t
@@ -0,0 +1,7 @@
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => 'Test::Pod 1.14 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_files_ok();
diff --git a/Catalyst-Plugin-Session-State-Cookie/t/03podcoverage.t b/Catalyst-Plugin-Session-State-Cookie/t/03podcoverage.t
new file mode 100644
index 0000000..d91be5e
--- /dev/null
+++ b/Catalyst-Plugin-Session-State-Cookie/t/03podcoverage.t
@@ -0,0 +1,7 @@
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_coverage_ok();
diff --git a/Catalyst-Plugin-Session-State-Cookie/t/99_prereq.t b/Catalyst-Plugin-Session-State-Cookie/t/99_prereq.t
new file mode 100644
index 0000000..bcfb392
--- /dev/null
+++ b/Catalyst-Plugin-Session-State-Cookie/t/99_prereq.t
@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::Prereq::Build;
+prereq_ok();
+
diff --git a/Catalyst-Plugin-Session-State-Cookie/t/basic.t b/Catalyst-Plugin-Session-State-Cookie/t/basic.t
new file mode 100644
index 0000000..9620451
--- /dev/null
+++ b/Catalyst-Plugin-Session-State-Cookie/t/basic.t
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 10;
+use Test::MockObject;
+use Test::MockObject::Extends;
+
+my $m;
+BEGIN { use_ok( $m = "Catalyst::Plugin::Session::State::Cookie" ) }
+
+my $cookie = Test::MockObject->new;
+$cookie->set_always( value => "the session id" );
+
+my $req = Test::MockObject->new;
+my %req_cookies;
+$req->set_always( cookies => \%req_cookies );
+
+my $res = Test::MockObject->new;
+my %res_cookies;
+$res->set_always( cookies => \%res_cookies );
+
+my $cxt =
+  Test::MockObject::Extends->new("Catalyst::Plugin::Session::State::Cookie");
+
+$cxt->set_always( config   => {} );
+$cxt->set_always( request  => $req );
+$cxt->set_always( response => $res );
+$cxt->set_always( session  => { } );
+$cxt->set_always( session_expires => 123 );
+$cxt->set_false("debug");
+my $sessionid;
+$cxt->mock( sessionid => sub { shift; $sessionid = shift if @_; $sessionid } );
+
+can_ok( $m, "setup_session" );
+
+$cxt->setup_session;
+
+like( $cxt->config->{session}{cookie_name},
+    qr/_session$/, "default cookie name is set" );
+
+$cxt->config->{session}{cookie_name} = "session";
+
+can_ok( $m, "get_session_id" );
+
+ok( !$cxt->get_session_id, "no session id yet");
+
+$cxt->clear;
+
+%req_cookies = ( session => $cookie );
+
+is( $cxt->get_session_id, "the session id", "session ID was restored from cookie" );
+
+$cxt->clear;
+$res->clear;
+
+can_ok( $m, "set_session_id" );
+$cxt->set_session_id("moose");
+
+$res->called_ok( "cookies", "created a cookie on set" );
+
+$cxt->clear;
+$res->clear;
+
+$cxt->set_session_id($sessionid);
+
+$res->called_ok( "cookies", "response cookie was set when sessionid changed" );
+is_deeply(
+    \%res_cookies,
+    { session => { value => $sessionid, expires => 123 } },
+    "cookie was set correctly"
+);
diff --git a/Catalyst-Plugin-Session-State-Cookie/t/live_app.t b/Catalyst-Plugin-Session-State-Cookie/t/live_app.t
new file mode 100644
index 0000000..ac1fc59
--- /dev/null
+++ b/Catalyst-Plugin-Session-State-Cookie/t/live_app.t
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+    eval { require Test::WWW::Mechanize::Catalyst };
+    plan skip_all =>
+      "This test requires Test::WWW::Mechanize::Catalyst in order to run"
+      if $@;
+    plan 'no_plan';
+}
+
+{
+
+    package CookieTestApp;
+    use Catalyst qw/
+      Session
+      Session::Store::Dummy
+      Session::State::Cookie
+      /;
+
+    sub page : Local {
+        my ( $self, $c ) = @_;
+        $c->res->body( "Hi! hit number " . ++$c->session->{counter} );
+    }
+
+    sub stream : Local {
+        my ( $self, $c ) = @_;
+        my $count = ++$c->session->{counter};
+        $c->res->write("hit number ");
+        $c->res->write($count);
+    }
+
+    __PACKAGE__->setup;
+}
+
+use Test::WWW::Mechanize::Catalyst qw/CookieTestApp/;
+
+my $m = Test::WWW::Mechanize::Catalyst->new;
+
+$m->get_ok( "http://foo.com/stream", "get page" );
+$m->content_contains( "hit number 1", "session data created" );
+
+my $expired;
+$m->cookie_jar->scan( sub { $expired = $_[8] } );
+
+$m->get_ok( "http://foo.com/page", "get page" );
+$m->content_contains( "hit number 2", "session data restored" );
+
+$m->get_ok( "http://foo.com/stream", "get stream" );
+$m->content_contains( "hit number 3", "session data restored" );
+
+sleep 2;
+
+$m->get_ok( "http://foo.com/page", "get stream" );
+$m->content_contains( "hit number 4", "session data restored" );
+
+my $updated_expired;
+$m->cookie_jar->scan( sub { $updated_expired = $_[8] } );
+
+cmp_ok( $expired, "<", $updated_expired, "cookie expiration was extended" );