File: forward_test_tcp.t

package info (click to toggle)
libdancer2-perl 0.152000%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 1,820 kB
  • ctags: 536
  • sloc: perl: 8,034; sh: 51; makefile: 2
file content (85 lines) | stat: -rw-r--r-- 2,798 bytes parent folder | download
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
use strict;
use warnings;
use Test::More;
use Test::TCP;
use LWP::UserAgent;
use Dancer2;

test_tcp(
    server => sub {
        my $port = shift;
        set startup_info => 0;
        get '/'          => sub {
            'home:' . join( ',', params );
        };
        get '/bounce/' => sub {
            return forward '/';
        };
        get '/bounce/:withparams/' => sub {
            return forward '/';
        };
        get '/bounce2/adding_params/' => sub {
            return forward '/', { withparams => 'foo' };
        };
        post '/simple_post_route/' => sub {
            'post:' . join( ',', params );
        };
        get '/go_to_post/' => sub {
            return forward '/simple_post_route/', { foo => 'bar' },
              { method => 'post' };
        };
        post '/'        => sub {'post-home'};
        post '/bounce/' => sub { forward('/') };

        print STDERR "Running on port $port\n";

        # we're overiding a RO attribute only for this test!
        Dancer2->runner->{'port'} = $port;

        print STDERR "Starting\n";
        start;
    },
    client => sub {
        my ( $port, $server_pid ) = @_;
        my $ua  = LWP::UserAgent->new;
        my $res = $ua->get("http://127.0.0.1:$port/");
        is $res->code      => 200;
        like $res->content => qr/home:/;

        $res = $ua->get("http://127.0.0.1:$port/bounce/");
        is $res->code      => 200;
        like $res->content => qr/home:/;

        $res = $ua->get("http://127.0.0.1:$port/bounce/thesethings/");
        is $res->code    => 200;
        is $res->content => 'home:withparams,thesethings';

        $res = $ua->get("http://127.0.0.1:$port/bounce2/adding_params/");
        is $res->code    => 200;
        is $res->content => 'home:withparams,foo';

        $res = $ua->get("http://127.0.0.1:$port/go_to_post/");
        is $res->code    => 200;
        is $res->content => 'post:foo,bar';

        $res = $ua->get("http://127.0.0.1:$port/bounce/");
        is $res->header('Content-Length') => 5;
        is $res->header('Content-Type')   => 'text/html; charset=UTF-8';
        is $res->header('Server')         =>
            "Perl Dancer2 $Dancer2::VERSION, Perl Dancer2 $Dancer2::VERSION";

        $res = $ua->post("http://127.0.0.1:$port/");
        is $res->code    => 200;
        is $res->content => 'post-home';

        $res = $ua->post("http://127.0.0.1:$port/bounce/");
        is $res->code                     => 200;
        is $res->content                  => 'post-home';
        is $res->header('Content-Length') => 9;
        is $res->header('Content-Type')   => 'text/html; charset=UTF-8';
        is $res->header('Server')         =>
            "Perl Dancer2 $Dancer2::VERSION, Perl Dancer2 $Dancer2::VERSION";
    }
);

done_testing;