--- /dev/null
+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;
+
--- /dev/null
+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.
--- /dev/null
+# 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$
--- /dev/null
+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;
--- /dev/null
+use strict;
+use Test::More tests => 1;
+
+BEGIN { use_ok('Catalyst::Plugin::Session::State::Cookie') }
--- /dev/null
+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();
--- /dev/null
+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();
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::Prereq::Build;
+prereq_ok();
+
--- /dev/null
+#!/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"
+);
--- /dev/null
+#!/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" );