/usr/share/perl5/Catalyst/Plugin/Session/Test/Store.pm is in libcatalyst-plugin-session-perl 0.40-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 | #!/usr/bin/perl
package Catalyst::Plugin::Session::Test::Store;
use strict;
use warnings;
use utf8;
use Test::More;
use File::Temp;
use File::Spec;
use Catalyst ();
sub import {
shift;
my %args = @_;
plan tests => 19 + ($args{extra_tests} || 0);
my $backend = $args{backend};
my $cfg = $args{config};
my $p = "Session::Store::$backend";
use_ok( my $m = "Catalyst::Plugin::$p" );
isa_ok( bless( {}, $m ), "Catalyst::Plugin::Session::Store" );
{
package # Hide from PAUSE
Catalyst::Plugin::SessionStateTest;
use base qw/Catalyst::Plugin::Session::State/;
no strict 'refs';
sub get_session_id {
my $c = shift;
${ ref($c) . "::session_id" };
}
sub set_session_id {
my ( $c, $sid ) = @_;
${ ref($c) . "::session_id" } = $sid;
}
sub delete_session_id {
my $c = shift;
undef ${ ref($c) . "::session_id" };
}
}
{
package # Hide from PAUSE
SessionStoreTest;
use Catalyst qw/Session SessionStateTest/;
push our (@ISA), $m;
our $VERSION = "123"; # Do not remove
use strict;
use warnings;
use Test::More;
sub create_session : Global {
my ( $self, $c ) = @_;
ok( !$c->session_is_valid, "no session id yet" );
ok( $c->session, "session created" );
ok( $c->session_is_valid, "with a session id" );
$c->session->{magic} = "møøse";
}
sub recover_session : Global {
my ( $self, $c ) = @_;
ok( $c->session_is_valid, "session id exists" );
is( $c->sessionid, our $session_id,
"and is the one we saved in the last action" );
ok( $c->session, "a session exists" );
is( $c->session->{magic},
"møøse",
"and it contains what we put in on the last attempt" );
$c->delete_session("user logout");
}
sub after_session : Global {
my ( $self, $c ) = @_;
ok( !$c->session_is_valid, "no session id" );
ok( !$c->session->{magic}, "session data not restored" );
ok( !$c->session_delete_reason, "no reason for deletion" );
}
@{ __PACKAGE__->config->{'Plugin::Session'} }{ keys %$cfg } = values %$cfg;
{ __PACKAGE__->setup; }; # Extra block here is an INSANE HACK to get inlined constructor
# (i.e. to make B::Hooks::EndOfScope fire)
}
{
package # Hide from PAUSE
SessionStoreTest2;
use Catalyst qw/Session SessionStateTest/;
push our (@ISA), $m;
our $VERSION = "123";
use Test::More;
sub create_session : Global {
my ( $self, $c ) = @_;
$c->session->{magic} = "møøse";
}
sub recover_session : Global {
my ( $self, $c ) = @_;
ok( !$c->session_is_valid, "session is gone" );
is(
$c->session_delete_reason,
"session expired",
"reason is that the session expired"
);
ok( !$c->session->{magic}, "no saved data" );
}
__PACKAGE__->config->{'Plugin::Session'}{expires} = 0;
@{ __PACKAGE__->config->{'Plugin::Session'} }{ keys %$cfg } = values %$cfg;
{ __PACKAGE__->setup; }; # INSANE HACK (the block - as above)
}
use Test::More;
can_ok( $m, "get_session_data" );
can_ok( $m, "store_session_data" );
can_ok( $m, "delete_session_data" );
can_ok( $m, "delete_expired_sessions" );
{
package # Hide from PAUSE
t1;
use Catalyst::Test "SessionStoreTest";
# idiotic void context warning workaround
my $x = get("/create_session");
$x = get("/recover_session");
$x = get("/after_session");
}
{
package # Hide fram PAUSE
t2;
use Catalyst::Test "SessionStoreTest2";
my $x = get("/create_session");
sleep 1; # let the session expire
$x = get("/recover_session");
}
}
__PACKAGE__;
__END__
=pod
=head1 NAME
Catalyst::Plugin::Session::Test::Store - Reusable sanity for session storage
engines.
=head1 SYNOPSIS
#!/usr/bin/perl
use Catalyst::Plugin::Session::Test::Store (
backend => "FastMmap",
config => {
storage => "/tmp/foo",
},
);
=head1 DESCRIPTION
=cut
|