CGI-Application-Plugin-Session
view release on metacpan or search on metacpan
Revision history for Perl extension CGI::Application::Plugin::Session.
1.06 2024-11-25 15:50:21-06:00 America/Chicago
- Fix test fail due to date format changes in CGI::Cookie 4.58
(RT#149959 Slaven Rezić)
- Use tmpdir for test session files
1.05 2013-12-21 11:31:00 America/Chicago
- Stop depending on ->DESTROY to call ->flush (reported by Gareth Tunley)
1.04 2013-11-14 10:48:29 America/Chicago
- Fix hash randomization bug tickled by perl 5.18
(Arthur Axel 'fREW' Schmidt)
t/06_expiry.t
t/07_defaults.t
t/08_notcgipm.t
t/09_options.t
t/10_sessioncookie.t
t/11_sessiondelete.t
t/12_badconfig.t
t/13_sessioncookiename.t
t/TestAppBasic.pm
t/TestAppCGISimple.pm
t/TestAppCookie.pm
t/TestAppDefaults.pm
t/TestAppExpiry.pm
t/TestAppNoCookie.pm
t/TestAppSessionCookie.pm
t/TestAppSessionCookieName.pm
t/TestAppSessionDelete.pm
t/TestAppSid.pm
t/author-pod-coverage.t
t/author-pod-syntax.t
$session->expiry method of CGI::Session takes. Note that it is only
set for new session, not when a session is reloaded from the store.
COOKIE_PARAMS
This allows you to customize the options that are used when creating
the session cookie. For example you could provide an expiry time for
the cookie by passing -expiry => '+24h'. The -name and -value
parameters for the cookie will be added automatically unless you
specifically override them by providing -name and/or -value
parameters. See the CGI::Cookie docs for the exact syntax of the
parameters.
NOTE: 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,
lib/CGI/Application/Plugin/Session.pm view on Meta::CPAN
if (!$self->{__CAP__SESSION_OBJ}) {
# The session object has not been created yet, so make sure we at least call it once
my $tmp = $self->session;
}
## 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() );
}
my $cookie = $self->query->cookie(%options);
lib/CGI/Application/Plugin/Session.pm view on Meta::CPAN
# See if a session cookie has already been set (this will happen if
# this is a new session). We keep all existing cookies except the
# session cookie, which we replace with the timed out session
# cookie
my @keep;
my %headers = $self->header_props;
my $cookies = $headers{'-cookie'} || [];
$cookies = [$cookies] unless ref $cookies eq 'ARRAY';
foreach my $cookie (@$cookies) {
if ( ref($cookie) ne 'CGI::Cookie' || $cookie->name ne $session->name ) {
# keep this cookie
push @keep, $cookie;
}
}
push @keep, $newcookie;
# We have to set the cookies this way, because CGI::Application has
# an annoying interface to the headers (why can't we have
# 'header_set as well as header_add?). The first call replaces all
# cookie headers with the one new cookie header, and the next call
lib/CGI/Application/Plugin/Session.pm view on Meta::CPAN
DEFAULT_EXPIRY option to have a default expiry time set for all newly created sessions.
It takes the same format as the $session->expiry method of L<CGI::Session> takes.
Note that it is only set for new session, not when a session is reloaded from the store.
=item COOKIE_PARAMS
This allows you to customize the options that are used when creating the session cookie.
For example you could provide an expiry time for the cookie by passing -expiry => '+24h'.
The -name and -value parameters for the cookie will be added automatically unless
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: 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
]
t/01_basic.t view on Meta::CPAN
use strict;
$ENV{CGI_APP_RETURN_ONLY} = 1;
use CGI;
use TestAppBasic;
my $t1_obj = TestAppBasic->new(QUERY=>CGI->new());
my $t1_output = $t1_obj->run();
like($t1_output, qr/session created/, 'session created');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
my ($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');
my $session_config = $t1_obj->session_config;
is (ref($session_config), 'HASH', 'Retrieved Session Config');
eval { my $session_config = $t1_obj->session_config(SEND_COOKIE => 1) };
like($@, qr/Calling session_config after the session has already been created/, 'session_config called after session created');
t/01_basic.t view on Meta::CPAN
# Set the Session ID in a parameter
my $t2_obj = TestAppBasic->new(QUERY=>CGI->new({ CGI::Session->name => $id1 }));
my $t2_output = $t2_obj->run();
like($t2_output, qr/session found/, 'session found');
like($t2_output, qr/value=test1/, 'session parameter retrieved');
like($t2_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
undef $t2_obj;
# Set a cookie in $ENV{HTTP_COOKIE}
$ENV{HTTP_COOKIE} = CGI::Session->name.'='.$id1;
my $t3_obj = TestAppBasic->new();
my $t3_output = $t3_obj->run();
like($t3_output, qr/session found/, 'session found');
like($t3_output, qr/value=test1/, 'session parameter retrieved');
unlike($t3_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie not set');
undef $t3_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id1);
# test with an expired cookie
$ENV{HTTP_COOKIE} = CGI::Session->name.'=badsessionid';
my $t4_obj = TestAppBasic->new(QUERY=>CGI->new());
my $t4_output = $t4_obj->run();
like($t4_output, qr/session created/, 'session created');
unlike($t4_output, qr/value=test1/, 'session parameter not found');
like($t4_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
my ($id4) = $t4_output =~ /id=([a-zA-Z0-9]+)/s;
undef $t4_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id4);
t/02_cookie.t view on Meta::CPAN
use Test::More tests => 7;
use File::Spec;
BEGIN { use_ok('CGI::Application::Plugin::Session') };
use lib './t';
use strict;
$ENV{CGI_APP_RETURN_ONLY} = 1;
use CGI;
use TestAppCookie;
my $t1_obj = TestAppCookie->new(QUERY=>CGI->new());
my $t1_output = $t1_obj->run();
like($t1_output, qr/session created/, 'session created');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
my ($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');
# check domain
like($t1_output, qr/domain=mydomain.com;/, 'domain found in cookie');
# check path
like($t1_output, qr/path=\/testpath;/, 'path found in cookie');
t/03_nocookie.t view on Meta::CPAN
use Test::More tests => 4;
use File::Spec;
BEGIN { use_ok('CGI::Application::Plugin::Session') };
use lib './t';
use strict;
$ENV{CGI_APP_RETURN_ONLY} = 1;
use CGI;
use TestAppNoCookie;
my $t1_obj = TestAppNoCookie->new(QUERY=>CGI->new());
my $t1_output = $t1_obj->run();
like($t1_output, qr/session created/, 'session created');
unlike($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie not set');
my ($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');
# Session object will not dissapear and be written
# to disk until it is DESTROYed
undef $t1_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id1);
t/04_cgisimple.t view on Meta::CPAN
plan tests => 12;
$ENV{CGI_APP_RETURN_ONLY} = 1;
use TestAppCGISimple;
my $t1_obj = TestAppCGISimple->new(QUERY=>CGI::Simple->new());
my $t1_output = $t1_obj->run();
like($t1_output, qr/session created/, 'session created');
like($t1_output, qr/query=CGI::Simple/, 'using CGI::Simple');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
my ($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');
# Session object will not dissapear and be written
# to disk until it is DESTROYed
undef $t1_obj;
# Set a cookie in $ENV{HTTP_COOKIE}
$ENV{HTTP_COOKIE} = CGI::Session->name.'='.$id1;
my $t2_obj = TestAppCGISimple->new(QUERY=>CGI::Simple->new());
my $t2_output = $t2_obj->run();
like($t2_output, qr/session found/, 'session found');
like($t2_output, qr/value=test1/, 'session parameter retrieved');
like($t2_output, qr/query=CGI::Simple/, 'using CGI::Simple');
unlike($t2_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie not set');
undef $t2_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id1);
# test with an expired cookie
$ENV{HTTP_COOKIE} = CGI::Session->name.'=badsessionid';
my $t3_obj = TestAppCGISimple->new(QUERY=>CGI::Simple->new());
my $t3_output = $t3_obj->run();
like($t3_output, qr/session created/, 'session created');
unlike($t3_output, qr/value=test1/, 'session parameter not found');
like($t3_output, qr/query=CGI::Simple/, 'using CGI::Simple');
like($t3_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
my ($id3) = $t3_output =~ /id=([a-zA-Z0-9]+)/s;
undef $t3_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id3);
use strict;
$ENV{CGI_APP_RETURN_ONLY} = 1;
use CGI;
use TestAppSid;
my $t1_obj = TestAppSid->new(QUERY=>CGI->new());
my $t1_output = $t1_obj->run();
like($t1_output, qr/session created/, 'session created');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
my ($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');
# Session object will not dissapear and be written
# to disk until it is DESTROYed
undef $t1_obj;
# Set a cookie in $ENV{HTTP_COOKIE}
$ENV{HTTP_COOKIE} = CGI::Session->name.'='.$id1;
my $t2_obj = TestAppSid->new(QUERY=>CGI->new());
my $t2_output = $t2_obj->run();
like($t2_output, qr/session found/, 'session found');
like($t2_output, qr/value=test1/, 'session parameter retrieved');
unlike($t2_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie not set');
undef $t2_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id1);
# test with an expired cookie
$ENV{HTTP_COOKIE} = CGI::Session->name.'=badsessionid';
my $t3_obj = TestAppSid->new(QUERY=>CGI->new());
my $t3_output = $t3_obj->run();
like($t3_output, qr/session created/, 'session created');
unlike($t3_output, qr/value=test1/, 'session parameter not found');
like($t3_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
my ($id3) = $t3_output =~ /id=([a-zA-Z0-9]+)/s;
undef $t3_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id3);
t/06_expiry.t view on Meta::CPAN
$ENV{CGI_APP_RETURN_ONLY} = 1;
use CGI;
use TestAppExpiry;
$ENV{DEFAULT_EXPIRY} = '+1h';
my $t1_obj = TestAppExpiry->new(QUERY=>CGI->new());
my $t1_output = $t1_obj->run();
# Set-Cookie: CGISESSID=d7fc7bab0f9e1301fd21717c556337fe; path=/; expires=Sat, 11-Jun-2005 17:47:28 GMT
like($t1_output, qr/\(3600\)/, 'expiry set correctly');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
like($t1_output, qr/expires=\w{3}, /, 'session cookie expiry set');
my ($year) = $t1_output =~ /\d+[ \-]\w{3}[ \-](\d+) /s;
my ($id1) = $t1_output =~ /CGISESSID=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');
undef $t1_obj;
# Set a cookie in $ENV{HTTP_COOKIE}
$ENV{HTTP_COOKIE} = CGI::Session->name.'='.$id1;
# Change the default expiry
$ENV{DEFAULT_EXPIRY} = '+1y';
$t1_obj = TestAppExpiry->new(QUERY=>CGI->new());
$t1_output = $t1_obj->run();
like($t1_output, qr/\(3600\)/, 'expiry set correctly');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
like($t1_output, qr/expires=\w{3}, /, 'session cookie expiry set');
my ($year2) = $t1_output =~ /\d+[ \-]\w{3}[ \-](\d+) /s;
# This test will fail during the last hour of the year, but I can't be bother to
# test for that :)
is($year2, $year, 'Expiry should not change');
my ($id2) = $t1_output =~ /CGISESSID=([a-zA-Z0-9]+)/s;
ok($id2, 'found session id');
is($id2, $id1, "Session was reused");
t/06_expiry.t view on Meta::CPAN
unlink File::Spec->catdir('t', 'cgisess_'.$id1);
delete $ENV{HTTP_COOKIE};
# Change the default expiry
$ENV{DEFAULT_EXPIRY} = '-1y';
$t1_obj = TestAppExpiry->new();
$t1_output = $t1_obj->run();
like($t1_output, qr/\(\-31536000\)/, 'expiry set correctly');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
like($t1_output, qr/expires=\w{3}, /, 'session cookie expiry set');
($year2) = $t1_output =~ /\d+[ \-]\w{3}[ \-](\d+) /s;
# This test will fail during the last hour of the year, but I can't be bother to
# test for that :)
is($year2, $year-1, 'Expiry should not change');
($id2) = $t1_output =~ /CGISESSID=([a-zA-Z0-9]+)/s;
ok($id2, 'found session id');
t/08_notcgipm.t view on Meta::CPAN
use strict;
$ENV{CGI_APP_RETURN_ONLY} = 1;
use CGI;
use TestAppBasic;
my $t1_obj = TestAppBasic->new(QUERY=>CGI->new());
my $t1_output = $t1_obj->run();
like($t1_output, qr/session created/, 'session created');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
my ($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');
# Session object will not dissapear and be written
# to disk until it is DESTROYed
undef $t1_obj;
{
t/08_notcgipm.t view on Meta::CPAN
};
# Set the Session ID in a parameter
my $t2_obj = TestAppBasic->new(QUERY=>MyCGI->new({ CGI::Session->name => $id1 }));
my $t2_output = $t2_obj->run();
like($t2_output, qr/session found/, 'session found');
like($t2_output, qr/value=test1/, 'session parameter retrieved');
like($t2_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
undef $t2_obj;
# Set a cookie in $ENV{HTTP_COOKIE}
$ENV{HTTP_COOKIE} = CGI::Session->name.'='.$id1;
my $t3_obj = TestAppBasic->new();
my $t3_output = $t3_obj->run();
like($t3_output, qr/session found/, 'session found');
like($t3_output, qr/value=test1/, 'session parameter retrieved');
unlike($t3_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie not set');
undef $t3_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id1);
# test with an expired cookie
$ENV{HTTP_COOKIE} = CGI::Session->name.'=badsessionid';
my $t4_obj = TestAppBasic->new(QUERY=>CGI->new());
my $t4_output = $t4_obj->run();
like($t4_output, qr/session created/, 'session created');
unlike($t4_output, qr/value=test1/, 'session parameter not found');
like($t4_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
my ($id4) = $t4_output =~ /id=([a-zA-Z0-9]+)/s;
undef $t4_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id4);
t/10_sessioncookie.t view on Meta::CPAN
use Test::More tests => 17;
use File::Spec;
BEGIN { use_ok('CGI::Application::Plugin::Session') };
use lib './t';
use strict;
$ENV{CGI_APP_RETURN_ONLY} = 1;
use CGI;
use TestAppSessionCookie;
my $t1_obj = TestAppSessionCookie->new(QUERY=>CGI->new());
my $t1_output = $t1_obj->run();
like($t1_output, qr/session created/, 'session created');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
my ($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');
# check domain
like($t1_output, qr/domain=mydomain.com;/, 'domain found in cookie');
# check path
like($t1_output, qr/path=\/testpath/, 'path found in cookie');
t/10_sessioncookie.t view on Meta::CPAN
unlike($t1_output, qr/expires=/, 'expires not found in cookie');
# Session object will not disappear and be written
# to disk until it is DESTROYed
undef $t1_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id1);
my $query = new CGI({ rm => 'existing_session_cookie' });
$t1_obj = TestAppSessionCookie->new( QUERY => $query );
$t1_output = $t1_obj->run();
unlike($t1_output, qr/Set-Cookie: CGISESSID=test/, 'existing session cookie was deleted');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'new session cookie set');
($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');
undef $t1_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id1);
$query = new CGI({ rm => 'existing_session_cookie_plus_extra_cookie' });
$t1_obj = TestAppSessionCookie->new( QUERY => $query );
$t1_output = $t1_obj->run();
unlike($t1_output, qr/Set-Cookie: CGISESSID=test/, 'existing session cookie was deleted');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'new session cookie set');
like($t1_output, qr/Set-Cookie: TESTCOOKIE=testvalue/, 'existing cookie was not deleted');
($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');
undef $t1_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id1);
$query = new CGI({ rm => 'existing_extra_cookie' });
$t1_obj = TestAppSessionCookie->new( QUERY => $query );
$t1_output = $t1_obj->run();
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'new session cookie set');
like($t1_output, qr/Set-Cookie: TESTCOOKIE=testvalue/, 'existing cookie was not deleted');
($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');
undef $t1_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id1);
t/11_sessiondelete.t view on Meta::CPAN
use strict;
$ENV{CGI_APP_RETURN_ONLY} = 1;
use CGI;
use TestAppSessionDelete;
my $t1_obj = TestAppSessionDelete->new(QUERY=>CGI->new());
my $t1_output = $t1_obj->run();
like($t1_output, qr/session created/, 'session created');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');
my ($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');
my ( $original_expiry ) = $t1_output =~ /expires=(.+)\s+Date/;
# Test Plan ... create a session ... not going to test that, b/c there are
# other tests for that. What we're going to do is now create a new CGI query
# object and call the 'logout' runmode, which will call the new session_delete
# method, which should remove the flat file as well as send a cookie header
t/11_sessiondelete.t view on Meta::CPAN
$ENV{HTTP_COOKIE} = "CGISESSID=$id1";
my $query = new CGI({ rm => 'logout' });
$t1_obj = TestAppSessionDelete->new( QUERY => $query );
$t1_output = $t1_obj->run();
# vanilla output came through ok?
ok( $t1_output =~ /logout finished/, 'vanilla output came through ok' );
# If that didn't pass, then I'm guessing the session wasn't injected properly
# Was the session create cookie in the output? It shouldn't be
unlike($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'new session cookie not in output');
# Was the session delete cookie in the output? It should be
like($t1_output, qr/Set-Cookie: CGISESSID=;/, 'delete session cookie in output');
my ( $new_expiry ) = $t1_output =~ /expires=(.+)\s+Date/;
ok( $original_expiry ne $new_expiry, 'expirations are different' );
# Need to figure out if $new_expiry < $original_expiry and $new_expiry < NOW()
SKIP: {
eval { require Date::Parse; };
skip "Date::Parse not installed", 2 if $@;
Date::Parse->import();
t/11_sessiondelete.t view on Meta::CPAN
undef $t1_obj;
# Is the file gone?
ok( !-e 't/cgisess_'.$id1, 'session_delete wiped the flat file ok' );
# We do the cookie tests again, this time we set some extra custom cookies
# and make sure they don't get clobbered
$ENV{HTTP_COOKIE} = "CGISESSID=$id1";
$query = new CGI({ rm => 'logout' });
$t1_obj = TestAppSessionDelete->new( QUERY => $query );
$t1_obj->header_add( -cookie => [ CGI::Cookie->new( -name => 'test', -value => 'testing' ) ]);
$t1_obj->header_add( -cookie => [ 'test2=testing2; path=/' ]);
$t1_output = $t1_obj->run();
# vanilla output came through ok?
ok( $t1_output =~ /logout finished/, 'vanilla output came through ok' );
# If that didn't pass, then I'm guessing the session wasn't injected properly
# Was the session create cookie in the output? It shouldn't be
unlike($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'new session cookie not in output');
# Was the session delete cookie in the output? It should be
like($t1_output, qr/Set-Cookie: CGISESSID=;/, 'delete session cookie in output');
# Was the test cookie in the output? It should be
like($t1_output, qr/Set-Cookie: test=testing/, 'test cookie in output');
# Was the test cookie in the output? It should be
like($t1_output, qr/Set-Cookie: test2=testing2/, 'second test cookie in output');
# We do the cookie tests one last time, this time we clobber the session cookie
# and set a single new cookie
$ENV{HTTP_COOKIE} = "CGISESSID=$id1";
$query = new CGI({ rm => 'logout' });
$t1_obj = TestAppSessionDelete->new( QUERY => $query );
$t1_obj->session; # this sets the session cookie
$t1_obj->header_add( -cookie => 'test2=testing2; path=/'); # this clobbers the session cookie
$t1_output = $t1_obj->run();
# vanilla output came through ok?
ok( $t1_output =~ /logout finished/, 'vanilla output came through ok' );
# If that didn't pass, then I'm guessing the session wasn't injected properly
# Was the session create cookie in the output? It shouldn't be
unlike($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'new session cookie not in output');
# Was the session delete cookie in the output? It should be
like($t1_output, qr/Set-Cookie: CGISESSID=;/, 'delete session cookie in output');
# Was the test cookie in the output? It should be
like($t1_output, qr/Set-Cookie: test2=testing2/, 'test cookie in output');
t/12_badconfig.t view on Meta::CPAN
CGI_SESSION_OPTIONS => [
"driver:File", '1111', {}, { 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;
t/13_sessioncookiename.t view on Meta::CPAN
use lib qw( t );
use Test::More;
$ENV{CGI_APP_RETURN_ONLY} = 1;
## only run tests on newer CGI:Session versions
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';
}
t/TestAppCookie.pm view on Meta::CPAN
package TestAppCookie;
use strict;
use CGI::Application;
use CGI::Application::Plugin::Session;
@TestAppCookie::ISA = qw(CGI::Application);
sub cgiapp_init {
my $self = shift;
$self->session_config({
CGI_SESSION_OPTIONS => [ "driver:File", $self->query ],
SEND_COOKIE => 0,
COOKIE_PARAMS => {
-name => CGI::Session->name,
-value => '1111',
t/TestAppNoCookie.pm view on Meta::CPAN
package TestAppNoCookie;
use strict;
use CGI::Application;
use CGI::Application::Plugin::Session;
@TestAppNoCookie::ISA = qw(CGI::Application);
sub cgiapp_init {
my $self = shift;
$self->session_config(
CGI_SESSION_OPTIONS => [ "driver:File", $self->query ],
SEND_COOKIE => 0,
);
}
t/TestAppSessionCookie.pm view on Meta::CPAN
package TestAppSessionCookie;
use strict;
use CGI::Application;
use CGI::Application::Plugin::Session;
@TestAppSessionCookie::ISA = qw(CGI::Application);
sub cgiapp_init {
my $self = shift;
$self->session_config({
CGI_SESSION_OPTIONS => [ "driver:File", $self->query ],
SEND_COOKIE => 1,
DEFAULT_EXPIRY => '+1h',
COOKIE_PARAMS => {
-name => CGI::Session->name,
t/TestAppSessionCookieName.pm view on Meta::CPAN
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, {},
{ name => 'foobar' }
],
SEND_COOKIE => 1,
( run in 0.524 second using v1.01-cache-2.11-cpan-e9199f4ba4c )