Subject: | Update to use instance 'name' attribute of CGI::Session v4.29+ |
The current version of CAP::Session uses the class method 'name' from
CGI::Session. In CGI::Session versions 4.29+, this is
changeable as a constructor parameter for the object instead of for the
whole class.
The attached patch and tests, change over the internal calls to using
the created instance value when possible. The patch also includes code
to try to locate the 'name' constructor parameter for support of some
non-CGI.pm query objects.
The patches include an update for the documentation of the module.
My tests of these patches and tests work with CGI::Session 4.29_2 and 4.20.
Thanks for your time.
Subject: | TestAppSessionCookieName.pm |
package TestAppSessionCookieName;
use warnings;
use strict;
use CGI::Application;
use CGI::Application::Plugin::Session;
@TestAppSessionCookieName::ISA = qw(CGI::Application);
sub cgiapp_init {
my $self = shift;
$self->session_config(
{ CGI_SESSION_OPTIONS =>
[ "driver:File", $self->query, { Directory => 't/' },
{ name => 'foobar' }
],
SEND_COOKIE => 1,
DEFAULT_EXPIRY => '+1h'
}
);
}
sub setup {
my $self = shift;
$self->start_mode( 'test_mode' );
$self->run_modes(
[ qw( test_mode ) ]
);
}
sub test_mode {
my $self = shift;
my $session = $self->session;
return "session: " . $session->id . "\n";
}
1;
Subject: | 13_sessioncookiename.t |
use warnings;
use strict;
use lib qw( t );
use Test::More;
$ENV{CGI_APP_RETURN_ONLY} = 1;
BEGIN {
use_ok 'CGI::Application::Plugin::Session';
}
## only run tests on newer CGI:Session versions
$CGI::Session::VERSION <= 4.20 ?
plan skip_all => "Older version CGI::Session" :
plan tests => 2;
## need for the tests
use CGI;
use TestAppSessionCookieName;
{
my $t1_obj = TestAppSessionCookieName->new( QUERY => CGI->new );
my $t1_out = $t1_obj->run;
like $t1_out, qr/session:/, 'session in output';
like $t1_out, qr/Set-Cookie: foobar=[a-zA-Z0-9]+/, 'session cookie with custom name';
}
Subject: | Session.pm.patch |
--- Orig.Session.pm 2008-03-02 07:52:27.000000000 -0500
+++ Session.pm 2008-04-01 17:05:16.475469000 -0400
@@ -37,10 +37,11 @@
('driver:File', $self->query, {Directory=>File::Spec->tmpdir});
- # CGI::Session only works properly with CGI.pm so extract the sid manually if
- # another module is being used
+ # CGI::Session only works properly with CGI.pm so
+ # extract the sid manually if another module is being used
if (Scalar::Util::blessed($params[1]) && ! $params[1]->isa('CGI')) {
- my $sid = $params[1]->cookie(CGI::Session->name) || $params[1]->param(CGI::Session->name);
+ my $name = __locate_session_name( $self ); ## plugin method call
+ my $sid = $params[1]->cookie($name) || $params[1]->param($name);
$params[1] = $sid;
}
@@ -62,7 +63,10 @@
# or if the session has an expiry set on it
# but don't send it if SEND_COOKIE is set to 0
if (!defined $self->{__CAP__SESSION_CONFIG}->{SEND_COOKIE} || $self->{__CAP__SESSION_CONFIG}->{SEND_COOKIE}) {
- my $cid = $self->query->cookie(CGI::Session->name);
+ my $cid = $self->query->cookie(
+ $self->{__CAP__SESSION_OBJ}->name
+ );
+
if (!$cid || $cid ne $self->{__CAP__SESSION_OBJ}->id || $self->{__CAP__SESSION_OBJ}->expire()) {
session_cookie($self);
}
@@ -128,7 +132,16 @@
my $tmp = $self->session;
}
- $options{'-name'} ||= CGI::Session->name;
+ ## check cookie option -name with session name
+ ## if different these may cause problems/confusion
+ if ( exists $options{'-name'} and
+ $options{'-name'} ne $self->session->name ) {
+ warn sprintf( "Cookie '%s' and Session '%s' name don't match.\n",
+ $options{'-name'}, $self->session->name )
+ }
+
+ ## setup the values for cookie
+ $options{'-name'} ||= $self->session->name;
$options{'-value'} ||= $self->session->id;
if(defined($self->session->expires()) && !defined($options{'-expires'})) {
$options{'-expires'} = _build_exp_time( $self->session->expires() );
@@ -181,7 +194,8 @@
if ( $self->{'__CAP__SESSION_CONFIG'}->{'COOKIE_PARAMS'} ) {
%options = ( %{ $self->{'__CAP__SESSION_CONFIG'}->{'COOKIE_PARAMS'} }, %options );
}
- $options{'name'} ||= CGI::Session->name;
+
+ $options{'name'} ||= $session->name;
$options{'value'} = '';
$options{'-expires'} = '-1d';
my $newcookie = $self->query->cookie(%options);
@@ -195,7 +209,8 @@
my $cookies = $headers{'-cookie'} || [];
$cookies = [$cookies] unless ref $cookies eq 'ARRAY';
foreach my $cookie (@$cookies) {
- if ( ref($cookie) ne 'CGI::Cookie' || $cookie->name ne CGI::Session->name ) {
+ if ( ref($cookie) ne 'CGI::Cookie' ||
+ $cookie->name ne $session->name ) {
# keep this cookie
push @keep, $cookie;
}
@@ -241,6 +256,22 @@
return 1;
}
+## all a hack to adjust for problems with cgi::session and
+## it not playing with non-CGI.pm objects
+sub __locate_session_name {
+ my $self = shift;
+ my $sess_opts = $self->{__CAP__SESSION_CONFIG}->{CGI_SESSION_OPTIONS};
+
+ ## search for 'name' cgi session option
+ if ( $sess_opts and $sess_opts->[4]
+ and ref $sess_opts->[4] eq 'HASH'
+ and exists $sess_opts->[4]->{name} ) {
+ return $sess_opts->[4]->{name};
+ }
+
+ return CGI::Session->name;
+}
+
1;
__END__
@@ -248,7 +279,6 @@
CGI::Application::Plugin::Session - Add CGI::Session support to CGI::Application
-
=head1 SYNOPSIS
use CGI::Application::Plugin::Session;
@@ -331,8 +361,23 @@
you specifically override them by providing -name and/or -value parameters.
See the L<CGI::Cookie> docs for the exact syntax of the parameters.
-NOTE: If you change the name of the cookie by passing a -name parameter, remember to notify
-CGI::Session of the change by calling CGI::Session->name('new_cookie_name').
+NOTE: If you have CGI::Session version 4.29 or newer the '-name' paremeter is not longer necessary. You can do the following to get both the cookie name and the internal name of the CGI::Session object to be changed:
+
+ $self->session_config(
+ CGI_SESSION_OPTIONS => [
+ $driver,
+ $self->query,
+ \%driver_options,
+ { name => 'new_cookie_name' } # change cookie and session name
+ ]
+ );
+
+For older version of CGI::Session, you still change the name of the cookie
+by passing a -name parameter, remember to notify CGI::Session of the change
+by calling CGI::Session->name('new_cookie_name').
+
+Also, if '-name' parameter and 'name' of session don't match a warning will
+be emitted.
=item SEND_COOKIE
Subject: | 12_badconfig.t |
use lib './t';
use Test::More;
BEGIN {
eval { require Test::Exception; Test::Exception->import; };
if ($@) {
plan skip_all => 'These tests require Test::Exception';
}
else {
plan tests => 1;
}
}
{
package TestAppBadConfig;
@TestAppBadConfig::ISA = qw(CGI::Application);
use CGI::Application::Plugin::Session;
};
my $app = TestAppBadConfig->new();
$app->session_config(
CGI_SESSION_OPTIONS => [ "driver:invalid_driver", $app->query ] );
dies_ok( sub { $app->session },
'creation of CGI::Session object fails with a bad config' );
## sub our own testing warn handler
my $warning;
$SIG{'__WARN__'} = sub { $warning = join ' ', @_ };
## mismatch cookie name and session name
my $app2 = TestAppBadConfig->new();
$app2->session_config(
CGI_SESSION_OPTIONS => [
"driver:File", '1111', { Directory => 't/' }, { name => 'foobar' }
],
COOKIE_PARAMS => { -name => 'monkeybeard' }
);
## should generate warning
$app2->session;
ok $warning, "cookie and session name don't match";
like $warning, qr/Cookie.*?Session/;
1;