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->res->output("session id changed");
  58 }
  59
  60 sub page : Global {
  61     my ( $self, $c ) = @_;
  62     if ( $c->session_is_valid ) {
  63         $c->res->output("you are logged in, session expires at " . $c->session_expires);
  64         $c->session->{counter}++;
  65     }
  66     else {
  67         $c->res->output("please login");
  68     }
  69 }
  70
  71 sub user_agent : Global {
  72     my ( $self, $c ) = @_;
  73     $c->res->output('UA=' . $c->req->user_agent);
  74 }
  75
  76 __PACKAGE__->setup;
  77
  78 __PACKAGE__;
  79