1#!/usr/bin/env perl
2
3use strict;
4use warnings;
5
6use Test::More 0.96 import => ["!pass"];
7use File::Temp;
8use HTTP::Date qw/str2time/;
9
10plan skip_all => "Plack::Test required" unless eval {
11    require Plack::Test;
12};
13
14plan skip_all => "HTTP::Cookies required" unless eval {
15    require HTTP::Cookies;
16};
17
18# available from Plack::Test
19require HTTP::Request::Common;
20
21my $tempdir = File::Temp->newdir;
22
23my $app = Plack::Test->create( build_app() );
24
25# Two different browsers
26my @jars = map HTTP::Cookies->new, 1 .. 2;
27
28sub mk_request {
29    my ( $app, $jar, $url, $check_ok ) = @_;
30    defined $check_ok or $check_ok = 1;
31    my $req = HTTP::Request::Common::GET("http://localhost$url");
32    $jar->add_cookie_header($req);
33    my $res = $app->request($req);
34    $jar->extract_cookies($res);
35    $check_ok and ok( $res->is_success, "GET $url" );
36    return $res;
37}
38
39# Set foo to one and two respectively
40{
41    mk_request( $app, $jars[0], '/?foo=one' );
42    mk_request( $app, $jars[1], '/?foo=two' );
43}
44
45# Retrieve both stored
46{
47    my $res = mk_request( $app, $jars[0], '/' );
48    is( $res->content, 'one', 'Correct content' );
49}
50
51{
52    my $res = mk_request( $app, $jars[1], '/' );
53    is( $res->content, 'two', 'Correct content' );
54}
55
56{
57    my $res = mk_request( $app, $jars[0], '/die', 0 );
58    is( $res->code, 500, 'we died' );
59}
60
61{
62    my $res = mk_request( $app, $jars[1], '/' );
63    is( $res->content, 'two', 'Two received after first died' );
64}
65
66sub build_app {
67    package MyApp;
68
69    use Dancer ':tests', ':syntax';
70
71    set apphandler          => 'PSGI';
72    set appdir              => $tempdir;
73    set access_log          => 0;           # quiet startup banner
74
75    set session_cookie_key => "John has a long mustache";
76    set session            => "cookie";
77    set show_traces        => 1;
78    set warnings           => 1;
79    set show_errors        => 1;
80
81    get '/die' => sub {
82        die 'Bad route';
83    };
84
85    get '/' => sub {
86        if (my $foo = param('foo')) {
87            session(foo => $foo);
88        }
89        return session('foo');
90    };
91
92    dance;
93}
94
95done_testing;
96