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