File: session_engines.t

package info (click to toggle)
libdancer2-perl 0.400001%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 2,580 kB
  • sloc: perl: 8,461; makefile: 9
file content (117 lines) | stat: -rw-r--r-- 3,212 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
use strict;
use warnings;
use Test::More;
use YAML;
use Plack::Test;
use HTTP::Cookies;
use HTTP::Request::Common;

use File::Spec;
use File::Basename 'dirname';

my $SESSION_DIR;
BEGIN {
    $SESSION_DIR = File::Spec->catfile( dirname(__FILE__), 'sessions' );
}

{
    package App;
    use Dancer2;
    my @to_destroy;

    set engines => { session => { YAML => { session_dir => $SESSION_DIR } } };

    hook 'engine.session.before_destroy' => sub {
        my $session = shift;
        push @to_destroy, $session;
    };

    get '/set_session/*' => sub {
        my ($name) = splat;
        session name => $name;
    };

    get '/read_session' => sub {
        my $name = session('name') || '';
        "name='$name'";
    };

    get '/clear_session' => sub {
        session name => undef;
        return exists( session->data->{'name'} ) ? "failed" : "cleared";
    };

    get '/cleanup' => sub {
        app->destroy_session;
        return scalar(@to_destroy);
    };

    setting session => 'Simple';

    set(
        show_stacktrace  => 1,
        environment      => 'production',
    );
}

my $url  = "http://localhost";
my $test = Plack::Test->create( App->to_app );
my $app = Dancer2->runner->apps->[0];

my @clients = qw(one two three);

for my $engine ( qw(YAML Simple) ) {
    # clear current session engine, and rebuild for the test
    # This is *really* messy, playing in object hashrefs..
    delete $app->{session_engine};
    $app->config->{session} = $engine;
    $app->session_engine; # trigger a build

    # run the tests for this engine
    for my $client (@clients) {
        my $jar = HTTP::Cookies->new;

        subtest "[$engine][$client] Empty session" => sub {
            my $res = $test->request( GET "$url/read_session" );
            like $res->content, qr/name=''/,
              "empty session for client $client";
            $jar->extract_cookies($res);
        };

        subtest "[$engine][$client] set_session" => sub {
            my $req = GET "$url/set_session/$client";
            $jar->add_cookie_header($req);
            my $res = $test->request($req);
            ok( $res->is_success, "set_session for client $client" );
            $jar->extract_cookies($res);
        };

        subtest "[$engine][$client] session for client" => sub {
            my $req = GET "$url/read_session";
            $jar->add_cookie_header($req);
            my $res = $test->request($req);
            like $res->content, qr/name='$client'/,
              "session looks good for client $client";
            $jar->extract_cookies($res);
        };

        subtest "[$engine][$client] delete session" => sub {
            my $req = GET "$url/clear_session";
            $jar->add_cookie_header($req);
            my $res = $test->request($req);
            like $res->content, qr/cleared/, "deleted session key";
        };

        subtest "[$engine][$client] cleanup" => sub {
            my $req = GET "$url/cleanup";
            $jar->add_cookie_header($req);
            my $res = $test->request($req);
            ok( $res->is_success, "cleanup done for $client" );
            ok( $res->content, "session hook triggered" );
        };
    }
}



done_testing;