[Catalyst-commits] r10216 - in
Catalyst-Plugin-Session/0.00/branches: . high_performance
high_performance/lib high_performance/lib/Catalyst
high_performance/lib/Catalyst/Plugin
high_performance/lib/Catalyst/Plugin/SessionHP
high_performance/lib/Catalyst/Plugin/SessionHP/State
high_performance/t high_performance/t/lib
evdb at dev.catalyst.perl.org
evdb at dev.catalyst.perl.org
Wed May 20 15:40:11 GMT 2009
Author: evdb
Date: 2009-05-20 15:40:11 +0000 (Wed, 20 May 2009)
New Revision: 10216
Added:
Catalyst-Plugin-Session/0.00/branches/high_performance/
Catalyst-Plugin-Session/0.00/branches/high_performance/Changes
Catalyst-Plugin-Session/0.00/branches/high_performance/MANIFEST
Catalyst-Plugin-Session/0.00/branches/high_performance/MANIFEST.SKIP
Catalyst-Plugin-Session/0.00/branches/high_performance/Makefile.PL
Catalyst-Plugin-Session/0.00/branches/high_performance/README
Catalyst-Plugin-Session/0.00/branches/high_performance/lib/
Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/
Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/
Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP.pm
Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP/
Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP/State.pm
Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP/State/
Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP/State/Cookie.pm
Catalyst-Plugin-Session/0.00/branches/high_performance/requirements.txt
Catalyst-Plugin-Session/0.00/branches/high_performance/t/
Catalyst-Plugin-Session/0.00/branches/high_performance/t/00_basic_sanity.t
Catalyst-Plugin-Session/0.00/branches/high_performance/t/01_setup.t
Catalyst-Plugin-Session/0.00/branches/high_performance/t/01use.t
Catalyst-Plugin-Session/0.00/branches/high_performance/t/03_flash.t
Catalyst-Plugin-Session/0.00/branches/high_performance/t/05_semi_persistent_flash.t
Catalyst-Plugin-Session/0.00/branches/high_performance/t/99_pod.t
Catalyst-Plugin-Session/0.00/branches/high_performance/t/99_podcoverage.t
Catalyst-Plugin-Session/0.00/branches/high_performance/t/basic.t
Catalyst-Plugin-Session/0.00/branches/high_performance/t/lib/
Catalyst-Plugin-Session/0.00/branches/high_performance/t/lib/FlashTestApp.pm
Catalyst-Plugin-Session/0.00/branches/high_performance/t/lib/SessionTestApp.pm
Catalyst-Plugin-Session/0.00/branches/high_performance/t/live_app_cookie.t
Catalyst-Plugin-Session/0.00/branches/high_performance/t/live_app_session.t
Catalyst-Plugin-Session/0.00/branches/high_performance/t/live_simple_session.t
Log:
Added high performance version of the Sessions code as a branch
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/Changes
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/Changes (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/Changes 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,11 @@
+0.01:
+ * initial (internal) release
+
+0.02:
+ * check '$c->session->{__limit_session_to_this_visit}' before setting an
+ expiration time for the cookie.
+
+0.03:
+ * don't send No-Cache header over https - shouldn't be needed and break
+ document downloads on IE due to IE bug.
+
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/Changes
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/MANIFEST
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/MANIFEST (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/MANIFEST 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,21 @@
+Changes
+lib/Catalyst/Plugin/SessionHP.pm
+lib/Catalyst/Plugin/SessionHP/State.pm
+lib/Catalyst/Plugin/SessionHP/State/Cookie.pm
+Makefile.PL
+MANIFEST
+README
+requirements.txt
+t/00_basic_sanity.t
+t/01use.t
+t/01_setup.t
+t/03_flash.t
+t/05_semi_persistent_flash.t
+t/99_pod.t
+t/99_podcoverage.t
+t/basic.t
+t/lib/FlashTestApp.pm
+t/lib/SessionTestApp.pm
+t/live_app_cookie.t
+t/live_app_session.t
+t/live_simple_session.t
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/MANIFEST
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/MANIFEST.SKIP
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/MANIFEST.SKIP (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/MANIFEST.SKIP 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,38 @@
+# 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$
+
+# Module::Bane
+\bBuild.PL$
+
+# Shipit conf
+.shipit
+
+.DS_Store
+Catalyst-Plugin-SessionHP
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/MANIFEST.SKIP
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/Makefile.PL
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/Makefile.PL (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/Makefile.PL 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,32 @@
+use strict;
+use ExtUtils::MakeMaker;
+
+use strict;
+use warnings;
+
+WriteMakefile(
+ NAME => 'Catalyst-Plugin-SessionHP',
+ VERSION_FROM => 'lib/Catalyst/Plugin/SessionHP.pm',
+ PREREQ_PM => {
+
+ 'Catalyst::Runtime' => '5.7010',
+ 'Catalyst::Plugin::Authentication' => '0.10011',
+
+ 'Digest::SHA1' => 0,
+ 'File::Spec' => 0,
+ 'File::Temp' => 0,
+ 'Object::Signature' => 0,
+ 'MRO::Compat' => 0,
+ 'Clone' => 0,
+ 'Carp' => 0,
+
+ # an indirect dep. needs a certain version.
+ 'Tie::RefHash' => '1.34',
+
+ 'Test::More' => 0,
+ 'Test::Deep' => 0,
+ 'Test::Exception' => 0,
+ 'Test::MockObject' => '1.01',
+ },
+);
+
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/Makefile.PL
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/README
===================================================================
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/README
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP/State/Cookie.pm
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP/State/Cookie.pm (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP/State/Cookie.pm 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,92 @@
+package Catalyst::Plugin::SessionHP::State::Cookie;
+use base qw/Catalyst::Plugin::SessionHP::State Class::Accessor::Fast/;
+
+use strict;
+use warnings;
+
+use MRO::Compat;
+use Catalyst::Utils ();
+
+our $VERSION = "0.10";
+
+BEGIN { __PACKAGE__->mk_accessors(qw/_deleted_session_id/) }
+
+sub setup_session {
+ my $c = shift;
+
+ $c->maybe::next::method(@_);
+
+ $c->config->{session}{cookie_name}
+ ||= Catalyst::Utils::appprefix($c) . '_session';
+
+}
+
+sub _session_cookie_name {
+ my $c = shift;
+ return $c->config->{session}{cookie_name};
+}
+
+sub finalize_session {
+ my $c = shift;
+
+ # we want to run after the other finalizing has been done
+ $c->maybe::next::method(@_);
+
+ # If there is no session_id then we should not do anything
+ return unless $c->_session_id;
+
+ # create the cookie
+ my $cookie = { value => $c->_session_id, };
+
+ # set the expriation time
+ # get the cookie expiry time and add a little buffer for testing
+ unless ( $c->session->{__session_limit_to_this_visit} ) {
+ $cookie->{expires} = $c->_session_expiry_time + 60;
+ }
+
+ $cookie->{secure} = 1 if $c->config->{session}{cookie_secure};
+
+ # add the cookie to the headers
+ $c->response->cookies->{ $c->_session_cookie_name } = $cookie;
+
+ # Also ensure that at the least the cookie is not cached. Other caching is
+ # upto the app to implement. Don't apply to secure connections as it leads
+ # to a bug where IE will not download files.
+ # (http://support.microsoft.com/kb/812935/en-us)
+ $c->response->header( 'Cache-control' => 'no-cache="set-cookie"' )
+ unless $c->req->secure;
+}
+
+sub get_sesson_id_from_state {
+ my $c = shift;
+
+ # get _request_ cookie
+ my $cookie = $c->request->cookies->{ $c->_session_cookie_name };
+
+ if ($cookie) {
+ my $sid = $cookie->value;
+ $c->log->debug(qq/Found sessionid "$sid" in cookie/) if $c->debug;
+ return $sid if $sid;
+ }
+
+ # If we could not find the id pass on to the next state
+ $c->maybe::next::method(@_);
+}
+
+sub delete_session {
+ my ( $c, $msg ) = @_;
+
+ # create the cookie
+ my $cookie = {
+ value => '',
+ expires => 0,
+ };
+ $cookie->{secure} = 1 if $c->config->{session}{cookie_secure};
+
+ # add the cookie to the headers
+ $c->response->cookies->{ $c->_session_cookie_name } = $cookie;
+
+ $c->maybe::next::method($msg);
+}
+
+1;
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP/State/Cookie.pm
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP/State.pm
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP/State.pm (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP/State.pm 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,59 @@
+#!/usr/bin/perl
+
+package Catalyst::Plugin::SessionHP::State;
+
+use strict;
+use warnings;
+
+__PACKAGE__;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::Plugin::SessionHP::State - Base class for session state
+preservation plugins.
+
+=head1 SYNOPSIS
+
+ package Catalyst::Plugin::SessionHP::State::MyBackend;
+ use base qw/Catalyst::Plugin::SessionHP::State/;
+
+=head1 DESCRIPTION
+
+This class doesn't actually provide any functionality, but when the
+C<Catalyst::Plugin::SessionHP> module sets up it will check to see that
+C<< YourApp->isa("Catalyst::Plugin::SessionHP::State") >>.
+
+When you write a session state plugin you should subclass this module this
+reason only.
+
+=head1 WRITING STATE PLUGINS
+
+To write a session state plugin you usually need to extend two methods:
+
+=over 4
+
+=item prepare_(action|cookies|whatever)
+
+Set C<session_id> (accessor) at B<prepare> time using data in the request.
+
+Note that this must happen B<before> other C<prepare_action> instances, in
+order to get along with L<Catalyst::Plugin::SessionHP>. Overriding
+C<prepare_cookies> is probably the stablest approach.
+
+=item finalize
+
+Modify the response at to include the session ID if C<session_id> is defined,
+using whatever scheme you use. For example, set a cookie,
+
+=back
+
+=cut
+
+
+
+
+
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP/State.pm
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP.pm
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP.pm (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP.pm 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,503 @@
+#!/usr/bin/perl
+
+package Catalyst::Plugin::SessionHP;
+use base qw/Class::Accessor::Fast /;
+
+use strict;
+use warnings;
+
+use MRO::Compat;
+use Catalyst::Exception ();
+use Digest::SHA1 qw(sha1_hex);
+use overload ();
+use Object::Signature ();
+use Carp;
+use Clone;
+
+use Data::Dumper;
+local $Data::Dumper::Sortkeys = 1;
+
+our $VERSION = '0.03';
+
+my @session_data_accessors; # used in delete_session
+
+BEGIN {
+ __PACKAGE__->mk_accessors(
+ "_session_delete_reason",
+ @session_data_accessors = (
+
+ '_session',
+ '_session_source', # where did the current session come from
+ '_session_stored_data_signature', # what is currently in the store
+ '_session_id', # the current session id
+ '_session_expiry_time', # when the current session should expire
+
+ '_flash', # the current flash hashref
+ '_original_flash', # the original flash hashref (cloned)
+
+ )
+ );
+}
+
+sub setup {
+ my $c = shift;
+ $c->maybe::next::method(@_);
+ $c->check_session_plugin_requirements;
+ $c->setup_session;
+ return $c;
+}
+
+sub check_session_plugin_requirements {
+ my $c = shift;
+
+ unless ( $c->isa("Catalyst::Plugin::SessionHP::State")
+ && $c->isa("Catalyst::Plugin::Session::Store") )
+ {
+ my $err = ( "The Session plugin requires both Session::State "
+ . "and Session::Store plugins to be used as well." );
+
+ $c->log->fatal($err);
+ Catalyst::Exception->throw($err);
+ }
+}
+
+sub setup_session {
+ my $c = shift;
+ my $hour = 60 * 60;
+
+ my $cfg = ( $c->config->{session} ||= {} );
+
+ %$cfg = (
+ max_lifetime => $hour * 2,
+ min_lifetime => $hour * 1,
+
+ %$cfg,
+ );
+
+ $c->maybe::next::method();
+}
+
+###########################################################################
+
+sub finalize_headers {
+ my $c = shift;
+ $c->finalize_session;
+ return $c->maybe::next::method(@_);
+}
+
+sub finalize_body {
+ my $c = shift;
+
+ # Have to call this now - it has the side effect of actually causing the
+ # session data to be written to the database in
+ # Catalyst::Plugin::Session::Store::Delegate
+ $c->_clear_session_instance_data;
+
+ return $c->maybe::next::method(@_);
+}
+
+#############################################################################
+
+sub session {
+ my $c = shift;
+
+ return $c->_session
+ || $c->_load_session #
+ || $c->_create_new_session; #
+}
+
+sub session_expires {
+ my $c = shift;
+ return $c->_session_expiry_time || 0;
+}
+
+sub finalize_session {
+ my $c = shift;
+ $c->_save_flash_to_session;
+ $c->_save_session;
+ $c->maybe::next::method(@_);
+}
+
+sub _create_new_session {
+ my $c = shift;
+
+ # get new settings
+ my $id = $c->generate_session_id;
+ my $expiry_time = time() + $c->config->{session}{max_lifetime};
+
+ # create a new session
+ $c->_session_source('new');
+ $c->_session_id($id);
+ $c->_session_expiry_time($expiry_time);
+ $c->_session_stored_data_signature('');
+ $c->_session( {} );
+
+ return $c->_session();
+}
+
+my $session_hash_seed_counter = 0;
+
+sub generate_session_id {
+ my $c = shift;
+
+ # create a string that will be hard to guess
+ my $session_hash_seed = join "",
+ $session_hash_seed_counter++,
+ time, rand, $$, {}, overload::StrVal($c);
+
+ # turn the random string into a hex string
+ my $new_id = sha1_hex($session_hash_seed);
+
+ return $new_id;
+}
+
+sub validate_session_id {
+ my ( $c, $sid ) = @_;
+
+ return $sid
+ && $sid =~ m{ \A [a-f0-9]{40} \z }x; # match SHA1 hexdigest
+}
+
+sub _save_session {
+ my $c = shift;
+
+ # Get the session data
+ my $session_data = $c->_session;
+
+ # if there is no session data then there is nothing to store
+ return unless $session_data;
+
+ # Check that the session either exists or has contents.
+ if ($c->_session_source ne 'new' # already in store
+ || %$session_data # contains something
+ )
+ {
+
+ my $sid = $c->session_id;
+ my $cfg = $c->config->{session};
+
+ # check to see if the session has changed at all
+ if ( Object::Signature::signature($session_data) ne
+ $c->_session_stored_data_signature )
+ {
+ $session_data->{__created} ||= time();
+ $session_data->{__updated} = time();
+ $c->store_session_data( "session:$sid" => $session_data );
+ }
+
+ # check to see if the expiry should be extended
+ my $current_expiry_time = $c->_session_expiry_time;
+ my $current_lifetime = $current_expiry_time - time();
+ my $new_expiry_time #
+ = $current_lifetime < $cfg->{min_lifetime}
+ ? time() + $cfg->{max_lifetime}
+ : $current_expiry_time;
+
+ # save the expiry if it is a new session or time has changed
+ if ( $current_expiry_time != $new_expiry_time
+ || $c->_session_source eq 'new' )
+ {
+ $c->store_session_data( "expires:$sid" => $new_expiry_time );
+ $c->_session_expiry_time($new_expiry_time);
+ }
+
+ } else {
+
+ # there was no session worth saving - clear it
+ $c->_clear_session_instance_data;
+ }
+}
+
+sub _clear_session_instance_data {
+ my $c = shift;
+ $c->maybe::next::method(@_); # allow other plugins to hook in on this
+ $c->$_(undef) for @session_data_accessors;
+}
+
+sub _load_session {
+ my $c = shift;
+
+ # try to retrieve a session_id from the state
+ my $id = $c->session_id #
+ || return;
+
+ # check that the id is valid
+ if ( !$c->validate_session_id($id) ) {
+ $c->delete_session('invalid session key');
+ return;
+ }
+
+ # get the expiry time and session data
+ my $expiry_time = $c->get_session_data("expires:$id") || 0;
+ my $session_data = $c->get_session_data("session:$id") || undef;
+
+ # check that the session is good (has data and has not expired)
+ if ( $session_data && $expiry_time > time() ) {
+
+ # store all the bits retrieved
+ $c->_session_source('store');
+ $c->_session_id($id);
+ $c->_session_expiry_time($expiry_time);
+ $c->_session($session_data);
+ $c->_session_stored_data_signature(
+ Object::Signature::signature($session_data) );
+
+ $c->log->debug(qq/Restored session "$id"/) if $c->debug;
+
+ } else {
+
+ # we set the session_id so that it is available to the state and store.
+ $c->_session_id($id);
+
+ # call delete session so that the state and store can clean up.
+ $c->delete_session('session expired');
+ }
+
+ return $session_data;
+}
+
+sub delete_session {
+ my ( $c, $msg ) = @_;
+
+ $c->session_delete_reason($msg);
+
+ # let others delete first
+ $c->maybe::next::method($msg);
+
+ $c->log->debug( "Deleting session"
+ . ( defined($msg) ? "($msg)" : '(no reason given)' ) )
+ if $c->debug;
+
+ # delete the session data
+ if ( my $sid = $c->session_id ) {
+ $c->delete_session_data("${_}:${sid}") for qw/session expires flash/;
+ }
+
+ # reset the values in the context object
+ # see the BEGIN block
+ $c->_clear_session_instance_data;
+}
+
+sub session_delete_reason {
+ my $c = shift;
+ $c->_session_delete_reason(@_);
+}
+
+# sub session_expires {
+# my $c = shift;
+#
+# if ( defined( my $expires = $c->_extended_session_expires ) ) {
+# return $expires;
+# } elsif ( defined( $expires = $c->_load_session_expires ) ) {
+# return $c->extend_session_expires($expires);
+# } else {
+# return 0;
+# }
+# }
+#
+# sub extend_session_expires {
+# my ( $c, $expires ) = @_;
+# $c->_extended_session_expires( my $updated
+# = $c->calculate_extended_session_expires($expires) );
+# $c->extend_session_id( $c->session_id, $updated );
+# return $updated;
+# }
+#
+# sub calculate_initial_session_expires {
+# my $c = shift;
+# return ( time() + $c->config->{session}{expires} );
+# }
+#
+# sub calculate_extended_session_expires {
+# my ( $c, $prev ) = @_;
+# $c->calculate_initial_session_expires;
+# }
+#
+# sub reset_session_expires {
+# my ( $c, $sid ) = @_;
+#
+# my $exp = $c->calculate_initial_session_expires;
+# $c->_session_expires($exp);
+# $c->_extended_session_expires($exp);
+# $exp;
+# }
+
+sub session_id {
+ my $c = shift;
+
+ return
+ $c->_session_id
+ || $c->_session_id( $c->get_sesson_id_from_state )
+ || '';
+}
+
+# sub _load_session_id {
+# my $c = shift;
+# return if $c->_tried_loading_session_id;
+# $c->_tried_loading_session_id(1);
+#
+# if ( defined( my $sid = $c->get_session_id ) ) {
+# if ( $c->validate_session_id($sid) ) {
+#
+# # temporarily set the inner key, so that validation will work
+# $c->_session_id($sid);
+# return $sid;
+# } else {
+# my $err = "Tried to set invalid session ID '$sid'";
+# $c->log->error($err);
+# Catalyst::Exception->throw($err);
+# }
+# }
+#
+# return;
+# }
+#
+# sub session_is_valid {
+# my $c = shift;
+#
+# # force a check for expiry, but also __address, etc
+# if ( $c->_load_session ) {
+# return 1;
+# } else {
+# return;
+# }
+# }
+#
+# sub validate_session_id {
+# my ( $c, $sid ) = @_;
+#
+# $sid and $sid =~ /^[a-f\d]+$/i;
+# }
+#
+#
+#
+#
+# sub dump_these {
+# my $c = shift;
+#
+# ( $c->maybe::next::method(),
+#
+# $c->session_id
+# ? ( [ "Session ID" => $c->session_id ],
+# [ Session => $c->session ],
+# )
+# : ()
+# );
+# }
+#
+# sub get_session_id { shift->maybe::next::method(@_) }
+# sub set_session_id { shift->maybe::next::method(@_) }
+# sub delete_session_id { shift->maybe::next::method(@_) }
+# sub extend_session_id { shift->maybe::next::method(@_) }
+
+# Flash related subs
+
+sub _save_flash_to_session {
+ my $c = shift;
+
+ my $current_flash = $c->_flash #
+ || return;
+
+ my $original_flash = $c->_original_flash || {};
+
+ # check that each existing key is different to the original one
+ foreach my $key ( keys %$current_flash ) {
+
+ # next if there was no entry before
+ next if !exists $original_flash->{$key};
+
+ # get a signature of both
+ my $current_sig
+ = Object::Signature::signature( \$current_flash->{$key} );
+ my $original_sig
+ = Object::Signature::signature( \$original_flash->{$key} );
+
+ # if sigs are the same delete
+ delete $current_flash->{$key}
+ if $current_sig eq $original_sig;
+
+ }
+
+ if (%$current_flash) {
+ my $session_data = $c->session;
+ $session_data->{__flash} = $current_flash;
+ } else {
+ my $session_data = $c->_session;
+ delete $session_data->{__flash} if $session_data;
+ }
+
+ # clear the flash so that we reload from session if needed
+ $c->_flash(undef);
+ $c->_original_flash(undef);
+
+ return 1;
+}
+
+sub flash {
+ my $c = shift;
+
+ return
+ $c->_flash
+ || $c->_load_flash
+ || $c->_create_new_flash;
+}
+
+sub _load_flash {
+ my $c = shift;
+ my $flash = $c->session->{__flash};
+
+ return unless $flash;
+
+ $c->_original_flash( Clone::clone $flash);
+ $c->_flash($flash);
+}
+
+sub _create_new_flash {
+ my $c = shift;
+
+ $c->_original_flash( {} );
+ $c->_flash( {} );
+
+ return $c->_flash;
+}
+
+sub keep_flash {
+ my ( $c, @keys ) = @_;
+ my $original = $c->_original_flash;
+
+ # deleting from the original flash will cause current values to be kept
+ delete $original->{$_} for @keys;
+
+ return 1;
+}
+
+sub clear_flash {
+ my $c = shift;
+ $c->_flash( {} );
+}
+
+###################################################################
+# compatability shims
+
+sub create_session_id_if_needed {
+ return 1;
+
+ # my $c = shift;
+ # if ( my $id = $c->session_id ) {
+ # return $id;
+ # }
+ #
+ # $c->_create_new_session;
+ # return $c->session_id;
+}
+
+sub sessionid {
+ my $c = shift;
+ return $c->session_id;
+}
+
+sub session_is_valid {
+ return 1;
+}
+
+1;
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/lib/Catalyst/Plugin/SessionHP.pm
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/requirements.txt
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/requirements.txt (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/requirements.txt 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,14 @@
+
+
+__REQUIREMENTS__
+
+
+ * do not expend any server side resources for empty sessions
+
+ * don't create a session cookie unless there is a session
+
+ * be reluctant to write to the database (updating expiry etc)
+
+ * allow us to distinguish between secure sessions and insecure ones.
+
+ * allow us to store flash in memcache only
\ No newline at end of file
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/requirements.txt
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/t/00_basic_sanity.t
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/t/00_basic_sanity.t (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/t/00_basic_sanity.t 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+
+my $m; BEGIN { use_ok($m = "Catalyst::Plugin::SessionHP") }
+
+can_ok($m, $_) for qw/session_id session session_delete_reason/;
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/t/00_basic_sanity.t
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/t/01_setup.t
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/t/01_setup.t (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/t/01_setup.t 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,74 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 10;
+use Test::MockObject;
+use Test::Deep;
+
+my $m;
+BEGIN { use_ok( $m = "Catalyst::Plugin::SessionHP" ) }
+
+my %config;
+my $log = Test::MockObject->new;
+my @mock_isa = ();
+
+$log->set_true("fatal");
+
+{
+
+ package MockCxt;
+ use MRO::Compat;
+ use base $m;
+ sub new { bless {}, $_[0] }
+ sub config { \%config }
+ sub log { $log }
+
+ sub isa {
+ my $self = shift;
+ my $class = shift;
+ grep { $_ eq $class } @mock_isa or $self->SUPER::isa($class);
+ }
+}
+
+can_ok( $m, "setup" );
+
+eval { MockCxt->new->setup }; # throws OK is not working with NEXT
+like(
+ $@,
+ qr/requires.*((?:State|Store).*){2}/i,
+ "can't setup an object that doesn't use state/store plugins"
+);
+
+$log->called_ok( "fatal", "fatal error logged" );
+
+ at mock_isa = qw/Catalyst::Plugin::SessionHP::State/;
+eval { MockCxt->new->setup };
+like( $@, qr/requires.*(?:Store)/i,
+ "can't setup an object that doesn't use state/store plugins" );
+
+ at mock_isa = qw/Catalyst::Plugin::Session::Store/;
+eval { MockCxt->new->setup };
+like( $@, qr/requires.*(?:State)/i,
+ "can't setup an object that doesn't use state/store plugins" );
+
+$log->clear;
+
+ at mock_isa =
+ qw/Catalyst::Plugin::SessionHP::State Catalyst::Plugin::Session::Store/;
+eval { MockCxt->new->setup };
+ok( !$@, "setup() lives with state/store plugins in use" );
+ok( !$log->called("fatal"), "no fatal error logged either" );
+
+cmp_deeply(
+ [ keys %{ $config{session} } ],
+ bag(qw/min_lifetime max_lifetime/),
+ "default values for config were populated in successful setup",
+);
+
+%config = ( session => { expires => 1234 } );
+MockCxt->new->setup;
+is( $config{session}{expires},
+ 1234, "user values are not overwritten in config" );
+
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/t/01_setup.t
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/t/01use.t
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/t/01use.t (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/t/01use.t 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,4 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN { use_ok('Catalyst::Plugin::SessionHP::State::Cookie') }
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/t/01use.t
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/t/03_flash.t
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/t/03_flash.t (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/t/03_flash.t 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,84 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+use Test::MockObject::Extends;
+use Test::Exception;
+use Test::Deep;
+
+my $m;
+BEGIN { use_ok( $m = "Catalyst::Plugin::SessionHP" ) }
+
+my $c = Test::MockObject::Extends->new($m);
+
+my $flash = {};
+$c->mock(
+ get_session_data => sub {
+ my ( $c, $key ) = @_;
+ return $key =~ /expire/ ? time() + 1000 : $flash;
+ },
+);
+$c->mock( "debug" => sub {0} );
+$c->mock( "store_session_data" => sub { $flash = $_[2] } );
+$c->mock( "delete_session_data" => sub { $flash = {} } );
+$c->set_always( _session_id => "deadbeef" );
+$c->set_always(
+ config => { session => { max_lifetime => 1000, min_lifetime => 500 } } );
+$c->set_always( stash => {} );
+
+# check that start state is as expected
+is_deeply( $c->session, {}, "nothing in session" );
+is_deeply( $c->flash, {}, "nothing in flash" );
+
+# set a value in the flash and check it gets to the flash
+pass "--- add one value to the flash ---";
+$c->flash->{foo} = "moose";
+is_deeply( $c->flash, { foo => "moose" }, "one key in flash" );
+$c->finalize_headers;
+
+
+cmp_deeply(
+ $c->session,
+ { __updated => re('^\d+$'),
+ __created => re('^\d+$'),
+ __flash => { foo => "moose" },
+ },
+ "session has __flash with flash data"
+);
+
+pass "--- add second value to flash ---";
+$c->flash->{bar} = "gorch";
+is_deeply(
+ $c->flash,
+ { foo => "moose", bar => "gorch" },
+ "two keys in flash"
+);
+
+$c->finalize_headers;
+
+is_deeply( $c->flash, { bar => "gorch" }, "one key in flash" );
+
+$c->finalize_headers;
+
+$c->flash->{test} = 'clear_flash';
+
+$c->finalize_headers;
+
+$c->clear_flash();
+
+is_deeply( $c->flash, {}, "nothing in flash after clear_flash" );
+
+$c->finalize_headers;
+
+is_deeply( $c->flash, {},
+ "nothing in flash after finalize after clear_flash" );
+
+cmp_deeply(
+ $c->session,
+ { __updated => re('^\d+$'), __created => re('^\d+$'), },
+ "session has empty __flash after clear_flash + finalize"
+);
+
+$c->flash->{bar} = "gorch";
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/t/03_flash.t
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/t/05_semi_persistent_flash.t
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/t/05_semi_persistent_flash.t (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/t/05_semi_persistent_flash.t 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,40 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More;
+
+BEGIN {
+
+ eval { require Test::WWW::Mechanize::Catalyst }
+ or plan skip_all =>
+ 'Test::WWW::Mechanize::Catalyst is required for this test';
+
+ plan tests => '10';
+
+}
+
+use lib "t/lib";
+use Test::WWW::Mechanize::Catalyst 'FlashTestApp';
+
+my $ua = Test::WWW::Mechanize::Catalyst->new;
+
+# flash absent for initial request
+$ua->get_ok("http://localhost/first");
+$ua->content_contains( "flash is not set", "not set" );
+
+# present for 1st req.
+$ua->get_ok("http://localhost/second");
+$ua->content_contains( "flash set first time", "set first" );
+
+# should be the same 2nd req.
+$ua->get_ok("http://localhost/third");
+$ua->content_contains( "flash set second time", "set second" );
+
+# and the third request, flash->{is_set} has the same value as 2nd.
+$ua->get_ok("http://localhost/fourth");
+$ua->content_contains( "flash set 3rd time, same val as prev.", "set third" );
+
+# and should be absent again for the 4th req.
+$ua->get_ok("http://localhost/fifth");
+$ua->content_contains( "flash is not", "flash has gone" );
+
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/t/05_semi_persistent_flash.t
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/t/99_pod.t
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/t/99_pod.t (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/t/99_pod.t 2009-05-20 15:40:11 UTC (rev 10216)
@@ -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();
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/t/99_pod.t
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/t/99_podcoverage.t
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/t/99_podcoverage.t (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/t/99_podcoverage.t 2009-05-20 15:40:11 UTC (rev 10216)
@@ -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();
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/t/99_podcoverage.t
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/t/basic.t
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/t/basic.t (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/t/basic.t 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+use Test::MockObject;
+use Test::MockObject::Extends;
+
+my $m;
+BEGIN { use_ok( $m = "Catalyst::Plugin::SessionHP::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::SessionHP::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 $session_id;
+$cxt->mock( session_id => sub { shift; $session_id = shift if @_; $session_id } );
+
+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_sesson_id_from_state" );
+
+ok( !$cxt->get_sesson_id_from_state, "no session id yet");
+
+$cxt->clear;
+
+%req_cookies = ( session => $cookie );
+
+is( $cxt->get_sesson_id_from_state, "the session id", "session ID was restored from cookie" );
+
+$cxt->clear;
+$res->clear;
+
+
+# can_ok( $m, "cookie_is_rejecting" );
+# %req_cookies = ( path => '/foo' );
+# $req->set_always( path => '' );
+# ok( $cxt->cookie_is_rejecting(\%req_cookies), "cookie is rejecting" );
+# $req->set_always( path => 'foo/bar' );
+# ok( !$cxt->cookie_is_rejecting(\%req_cookies), "cookie is not rejecting" );
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/t/basic.t
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/t/lib/FlashTestApp.pm
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/t/lib/FlashTestApp.pm (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/t/lib/FlashTestApp.pm 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,61 @@
+#!/usr/bin/perl -w
+
+package FlashTestApp;
+use Catalyst qw/SessionHP Session::Store::Dummy SessionHP::State::Cookie/;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+sub default : Private {
+ my ($self, $c) = @_;
+ $c->session;
+}
+
+
+sub first : Global {
+ my ( $self, $c ) = @_;
+ if ( ! $c->flash->{is_set}) {
+ $c->stash->{message} = "flash is not set";
+ $c->flash->{is_set} = 1;
+ }
+}
+
+sub second : Global {
+ my ( $self, $c ) = @_;
+ if ($c->flash->{is_set} == 1){
+ $c->stash->{message} = "flash set first time";
+ $c->flash->{is_set}++;
+ }
+}
+
+sub third : Global {
+ my ( $self, $c ) = @_;
+ if ($c->flash->{is_set} == 2) {
+ $c->stash->{message} = "flash set second time";
+ $c->keep_flash("is_set");
+ }
+}
+
+sub fourth : Global {
+ my ( $self, $c ) = @_;
+ if ($c->flash->{is_set} == 2) {
+ $c->stash->{message} = "flash set 3rd time, same val as prev."
+ }
+}
+
+sub fifth : Global {
+ my ( $self, $c ) = @_;
+ $c->forward('/first');
+}
+
+sub end : Private {
+ my ($self, $c) = @_;
+ $c->res->output($c->stash->{message});
+}
+
+
+__PACKAGE__->setup;
+
+__PACKAGE__;
+
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/t/lib/FlashTestApp.pm
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/t/lib/SessionTestApp.pm
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/t/lib/SessionTestApp.pm (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/t/lib/SessionTestApp.pm 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+
+package SessionTestApp;
+use Catalyst ( #
+ 'SessionHP', #
+ 'Session::Store::Dummy', #
+ 'SessionHP::State::Cookie'
+);
+
+use strict;
+use warnings;
+
+my $max_lifetime = 6;
+my $min_lifetime = 3;
+
+__PACKAGE__->config(
+ session => {
+ max_lifetime => $max_lifetime,
+ min_lifetime => $min_lifetime,
+ }
+);
+
+sub login : Global {
+ my ( $self, $c ) = @_;
+ $c->session->{logged_in} = 1;
+ $c->res->output("logged in");
+}
+
+sub logout : Global {
+ my ( $self, $c ) = @_;
+ $c->res->output(
+ "logged out after " . $c->session->{counter} . " requests" );
+ $c->delete_session("logout");
+}
+
+sub page : Global {
+ my ( $self, $c ) = @_;
+ if ( $c->session->{logged_in} ) {
+ $c->res->output(
+ "you are logged in, session expires at " . $c->session_expires );
+ $c->session->{counter}++;
+ } else {
+ $c->res->output("please login");
+ }
+}
+
+# This action inspects the session which will cause it to be auto_vivified into
+# a hash. However we should not create a session because of this.
+sub inspect_session : Global {
+ my ( $self, $c ) = @_;
+
+ my $logged_in = $c->session->{logged_in};
+ $logged_in = 'undef' if !defined $logged_in;
+
+ $c->res->output("value of logged_in is '$logged_in'");
+}
+
+__PACKAGE__->setup;
+
+__PACKAGE__;
+
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/t/lib/SessionTestApp.pm
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/t/live_app_cookie.t
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/t/live_app_cookie.t (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/t/live_app_cookie.t 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,87 @@
+#!/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 skip_all => 'Test::WWW::Mechanize::Catalyst >= 0.40 required' if $Test::WWW::Mechanize::Catalyst::VERSION < 0.40;
+ 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);
+ }
+
+ sub deleteme : Local {
+ my ( $self, $c ) = @_;
+ my $id = $c->get_session_id;
+ $c->delete_session;
+ my $id2 = $c->get_session_id;
+ $c->res->body( $id ne ( $id2 || '' ) );
+ }
+
+ __PACKAGE__->setup;
+}
+
+use Test::WWW::Mechanize::Catalyst qw/CookieTestApp/;
+
+my $m = Test::WWW::Mechanize::Catalyst->new;
+
+$m->get_ok( "http://localhost/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://localhost/page", "get page" );
+$m->content_contains( "hit number 2", "session data restored" );
+
+$m->get_ok( "http://localhost/stream", "get stream" );
+$m->content_contains( "hit number 3", "session data restored" );
+
+sleep 1;
+
+$m->get_ok( "http://localhost/stream", "get page" );
+$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" );
+
+$expired = $m->cookie_jar->scan( sub { $expired = $_[8] } );
+$m->get_ok( "http://localhost/page", "get page again");
+$m->content_contains( "hit number 5", "session data restored (blah)" );
+
+sleep 1;
+
+$m->get_ok( "http://localhost/stream", "get stream" );
+$m->content_contains( "hit number 6", "session data restored" );
+
+$m->cookie_jar->scan( sub { $updated_expired = $_[8]; } );
+cmp_ok( $expired, "<", $updated_expired, "streaming also extends cookie" );
+
+$m->get_ok( "http://localhost/deleteme", "get page" );
+$m->content_is( 1, 'session id changed' );
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/t/live_app_cookie.t
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/t/live_app_session.t
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/t/live_app_session.t (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/t/live_app_session.t 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,88 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Data::Dumper;
+local $Data::Dumper::Sortkeys = 1;
+
+BEGIN {
+ eval {
+ require Catalyst::Plugin::Session::State::Cookie;
+ Catalyst::Plugin::Session::State::Cookie->VERSION(0.03);
+ }
+ or plan skip_all =>
+ "Catalyst::Plugin::Session::State::Cookie 0.03 or higher is required for this test";
+
+ eval { require Test::WWW::Mechanize::Catalyst }
+ or plan skip_all =>
+ "Test::WWW::Mechanize::Catalyst is required for this test";
+
+ plan tests => 42;
+}
+
+use lib "t/lib";
+use Test::WWW::Mechanize::Catalyst "SessionTestApp";
+
+my $ua1 = Test::WWW::Mechanize::Catalyst->new;
+my $ua2 = Test::WWW::Mechanize::Catalyst->new;
+
+$_->get_ok( "http://localhost/page", "initial get" ) for $ua1, $ua2;
+
+$ua1->content_contains( "please login", "ua1 not logged in" );
+$ua2->content_contains( "please login", "ua2 not logged in" );
+
+$_->get_ok( "http://localhost/inspect_session", "check for value in session" )
+ for $ua1, $ua2;
+
+$ua1->content_contains( "value of logged_in is 'undef'",
+ "check ua1 'logged_in' val" );
+$ua2->content_contains( "value of logged_in is 'undef'",
+ "check ua2 'logged_in' val" );
+
+$_->get_ok( "http://localhost/page", "initial get" ) for $ua1, $ua2;
+
+$ua1->content_contains( "please login", "ua1 not logged in" );
+$ua2->content_contains( "please login", "ua2 not logged in" );
+
+$ua1->get_ok( "http://localhost/login", "log ua1 in" );
+$ua1->content_contains( "logged in", "ua1 logged in" );
+
+$_->get_ok( "http://localhost/page", "get main page" ) for $ua1, $ua2;
+
+$ua1->content_contains( "you are logged in", "ua1 logged in" );
+$ua2->content_contains( "please login", "ua2 not logged in" );
+
+$ua2->get_ok( "http://localhost/login", "get main page" );
+$ua2->content_contains( "logged in", "log ua2 in" );
+
+$_->get_ok( "http://localhost/page", "get main page" ) for $ua1, $ua2;
+
+$ua1->content_contains( "you are logged in", "ua1 logged in" );
+$ua2->content_contains( "you are logged in", "ua2 logged in" );
+
+$_->get_ok( "http://localhost/page", "get main page" ) for $ua1, $ua2;
+$ua1->content_contains( "you are logged in", "ua1 logged in" );
+$ua2->content_contains( "you are logged in", "ua2 logged in" );
+
+$ua2->get_ok( "http://localhost/logout", "log ua2 out" );
+$ua2->content_like( qr/logged out/, "ua2 logged out" );
+$ua2->content_like( qr/after 2 request/,
+ "ua2 made 2 requests for page in the session" );
+
+$_->get_ok( "http://localhost/page", "get main page" ) for $ua1, $ua2;
+
+$ua1->content_contains( "you are logged in", "ua1 logged in" );
+$ua2->content_contains( "please login", "ua2 not logged in" );
+
+$ua1->get_ok( "http://localhost/logout", "log ua1 out" );
+$ua1->content_like( qr/logged out/, "ua1 logged out" );
+$ua1->content_like( qr/after 4 requests/,
+ "ua1 made 4 request for page in the session" );
+
+$_->get_ok( "http://localhost/page", "get main page" ) for $ua1, $ua2;
+
+$ua1->content_contains( "please login", "ua1 not logged in" );
+$ua2->content_contains( "please login", "ua2 not logged in" );
+
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/t/live_app_session.t
___________________________________________________________________
Name: svn:executable
+ *
Added: Catalyst-Plugin-Session/0.00/branches/high_performance/t/live_simple_session.t
===================================================================
--- Catalyst-Plugin-Session/0.00/branches/high_performance/t/live_simple_session.t (rev 0)
+++ Catalyst-Plugin-Session/0.00/branches/high_performance/t/live_simple_session.t 2009-05-20 15:40:11 UTC (rev 10216)
@@ -0,0 +1,180 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Data::Dumper;
+local $Data::Dumper::Sortkeys = 1;
+use Clone;
+
+BEGIN {
+
+ eval { require Test::WWW::Mechanize::Catalyst }
+ or plan skip_all =>
+ "Test::WWW::Mechanize::Catalyst is required for this test";
+
+ plan tests => 36;
+}
+
+use lib "t/lib";
+use Test::WWW::Mechanize::Catalyst "SessionTestApp";
+
+my $ua = Test::WWW::Mechanize::Catalyst->new;
+
+# initial request - should not set cookie
+$ua->get_ok( "http://localhost/page", "initial get" );
+$ua->content_contains( "please login", "ua not logged in" );
+is_deeply get_cookie(), undef, "no cookies yet";
+
+# request that checks the session - should not set cookie
+$ua->get_ok( "http://localhost/inspect_session",
+ "check for value in session" );
+$ua->content_contains( "value of logged_in is 'undef'",
+ "check ua 'logged_in' val" );
+is_deeply get_cookie(), undef, "no cookies yet";
+
+# Login - should create a session
+$ua->get_ok( "http://localhost/login", "log ua in" );
+$ua->content_contains( "logged in", "ua logged in" );
+
+# check that the session cookie created
+my $session_id = get_cookie()->{val};
+ok $session_id, "found a session cookie ($session_id)";
+
+# check session loaded from store
+$ua->get_ok( "http://localhost/page", "get main page" );
+$ua->content_contains( "you are logged in", "ua logged in" );
+is get_cookie()->{val}, $session_id, "session id has not changed";
+
+# check that the expires time is updated
+{
+ my $min_lifetime
+ = SessionTestApp->config->{session}{min_lifetime};
+ my $max_lifetime
+ = SessionTestApp->config->{session}{max_lifetime};
+
+ # do some requests until the expires changes
+ my $original_expiry = get_cookie()->{expires};
+
+ for ( 1 .. 10 ) {
+ sleep 1;
+ $ua->get("http://localhost/inspect_session");
+ my $new_expiry = get_cookie()->{expires};
+ next if $new_expiry == $original_expiry;
+ $original_expiry = $new_expiry;
+ last;
+ }
+
+ # expiry just updated - check it stays the same
+ $ua->get_ok(
+ "http://localhost/inspect_session",
+ "get page to see expiry not changed"
+ );
+ is get_cookie()->{expires}, $original_expiry,
+ "expiry is still '$original_expiry'";
+ is get_cookie()->{val}, $session_id, "session id has not changed";
+
+ # sleep so that we go past the min lifetime
+ ok sleep $_, "sleep $_ so expires get extended"
+ for $max_lifetime - $min_lifetime + 1;
+
+ # expiry just updated - check it stays the same
+ $ua->get_ok(
+ "http://localhost/inspect_session",
+ "get page to see expiry has changed"
+ );
+ my $new_expiry = get_cookie()->{expires};
+ cmp_ok $new_expiry, '>', $original_expiry,
+ "expiry updated to '$new_expiry'";
+ is get_cookie()->{val}, $session_id, "session id has not changed";
+
+ # sleep beyond the lifetime and see that the session gets expired
+ ok sleep $_, "sleep $_ so session is too old" for $max_lifetime + 2;
+ $ua->get_ok(
+ "http://localhost/inspect_session",
+ "get page to see session expired"
+ );
+ is get_cookie(), undef, "Cookie has been reset";
+
+}
+
+# check that a session that is not in the db is deleted
+
+my @session_ids_to_test = (
+ 'a' x 40, # valid session id
+ 'This is not valid @#$%^&', # bad value
+);
+
+foreach my $new_session_id (@session_ids_to_test) {
+
+ pass "--- Testing session_id '$new_session_id' ---";
+
+ $ua->get_ok( "http://localhost/login", "log ua in" );
+ $ua->content_contains( "logged in", "ua logged in" );
+
+ my $session_id = get_cookie()->{val};
+ ok $session_id, "have session_id '$session_id'";
+
+ # change the value in the cookie to a valid value
+ ok set_cookie_val($new_session_id),
+ "change cookie value to '$new_session_id'";
+
+ # check that the cookie gets deleted
+ $ua->get_ok(
+ "http://localhost/inspect_session",
+ "get page to see if session is deleted"
+ );
+ is get_cookie(), undef, "Cookie has been reset";
+
+}
+
+#############################################################################
+
+sub get_cookie {
+ my $cookie_jar = $ua->cookie_jar;
+
+ my $cookie_data = undef;
+
+ $cookie_jar->scan(
+ sub {
+ my ($version, $key, $val, $path,
+ $domain, $port, $path_spec, $secure,
+ $expires, $discard, $hash
+ ) = @_;
+
+ # warn "cookie key: $key";
+
+ if ( $key eq 'sessiontestapp_session' ) {
+ $cookie_data = {
+ val => $val,
+ expires => $expires,
+ };
+ }
+ }
+ );
+
+ return $cookie_data;
+}
+
+sub set_cookie_val {
+ my $new_val = shift;
+ my $cookie_jar = $ua->cookie_jar;
+
+ $cookie_jar->scan(
+ sub {
+ my ( $version, $key, $val, $path, $domain ) = @_;
+
+ # warn "cookie key: $key";
+
+ if ( $key eq 'sessiontestapp_session' ) {
+
+ $cookie_jar->set_cookie( $version, $key, $new_val, $path,
+ $domain );
+
+ }
+ }
+ );
+
+ return 1;
+}
Property changes on: Catalyst-Plugin-Session/0.00/branches/high_performance/t/live_simple_session.t
___________________________________________________________________
Name: svn:executable
+ *
More information about the Catalyst-commits
mailing list