lib/Catalyst/Plugin/Session/Test/Store.pm

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