t/lib/SessionTestApp.pm

   1 #!/usr/bin/perl
   2
   3 package SessionTestApp;
   4 use Catalyst qw/Session Session::Store::Dummy Session::State::Cookie/;
   5
   6 use strict;
   7 use warnings;
   8
   9 use Data::Dumper;
  10
  11 __PACKAGE__->config->{session} = {
  12     # needed for live_verify_user_agent.t; should be harmless for other tests
  13     verify_user_agent => 1,
  14 };
  15
  16 sub login : Global {
  17     my ( $self, $c ) = @_;
  18     $c->session;
  19     $c->res->output("logged in");
  20 }
  21
  22 sub logout : Global {
  23     my ( $self, $c ) = @_;
  24     $c->res->output(
  25         "logged out after " . $c->session->{counter} . " requests" );
  26     $c->delete_session("logout");
  27 }
  28
  29 sub set_session_variable : Global {
  30     my ( $self, $c, $var, $val ) = @_;
  31     $c->session->{$var} = $val;
  32     $c->res->output("session variable set");
  33 }
  34
  35 sub get_session_variable : Global {
  36     my ( $self, $c, $var ) = @_;
  37     my $val = $c->session->{$var} || 'n.a.';
  38     $c->res->output("VAR_$var=$val");
  39 }
  40
  41 sub get_sessid : Global {
  42     my ( $self, $c ) = @_;
  43     my $sid = $c->sessionid || 'n.a.';
  44     $c->res->output("SID=$sid");
  45 }
  46
  47 sub dump_session : Global {
  48     my ( $self, $c ) = @_;
  49     my $sid = $c->sessionid || 'n.a.';
  50     my $dump = Dumper($c->session || 'n.a.');
  51     $c->res->output("[SID=$sid]\n$dump");
  52 }
  53
  54 sub change_sessid : Global {
  55     my ( $self, $c ) = @_;
  56     #$c->change_session_id;
  57     $c->create_session_id;
  58     $c->res->output("session id changed");
  59 }
  60
  61 sub page : Global {
  62     my ( $self, $c ) = @_;
  63     if ( $c->session_is_valid ) {
  64         $c->res->output("you are logged in, session expires at " . $c->session_expires);
  65         $c->session->{counter}++;
  66     }
  67     else {
  68         $c->res->output("please login");
  69     }
  70 }
  71
  72 sub user_agent : Global {
  73     my ( $self, $c ) = @_;
  74     $c->res->output('UA=' . $c->req->user_agent);
  75 }
  76
  77 __PACKAGE__->setup;
  78
  79 __PACKAGE__;
  80