Commit | Line | Data |
300eb468 |
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 | |
e108bc2c |
9 | use Data::Dumper; |
10 | |
06c621b5 |
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 | |
300eb468 |
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 | |
e108bc2c |
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 ) = @_; |
0ade68bd |
56 | $c->change_session_id; |
e108bc2c |
57 | $c->res->output("session id changed"); |
58 | } |
59 | |
300eb468 |
60 | sub page : Global { |
61 | my ( $self, $c ) = @_; |
e5b2372a |
62 | if ( $c->session_is_valid ) { |
6687905d |
63 | $c->res->output("you are logged in, session expires at " . $c->session_expires); |
45c0711b |
64 | $c->session->{counter}++; |
300eb468 |
65 | } |
66 | else { |
67 | $c->res->output("please login"); |
68 | } |
69 | } |
70 | |
06c621b5 |
71 | sub user_agent : Global { |
72 | my ( $self, $c ) = @_; |
73 | $c->res->output('UA=' . $c->req->user_agent); |
74 | } |
75 | |
300eb468 |
76 | __PACKAGE__->setup; |
77 | |
78 | __PACKAGE__; |
79 | |