File: request_params.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 (153 lines) | stat: -rw-r--r-- 4,629 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
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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
use Test::More;
use strict;
use warnings FATAL => 'all';
use Dancer2::Core::Request;

diag "If you want extra speed, install URL::Encode::XS"
  if !$Dancer2::Core::Request::XS_URL_DECODE;
diag "If you want extra speed, install CGI::Deurl::XS"
  if !$Dancer2::Core::Request::XS_PARSE_QUERY_STRING;

sub run_test {
    {

        # 1. - get params
        note "get params";

        $ENV{REQUEST_METHOD} = 'GET';
        $ENV{PATH_INFO}      = '/';

        for my $separator ( '&', ';' ) {
            note "testing separator $separator";

            $ENV{QUERY_STRING} = join(
                $separator,
                (   'name=Alexis%20Sukrieh', 'IRC%20Nickname=sukria',
                    'Project=Perl+Dancer2',  'hash=2',
                    'hash=4',                'int1=1',
                    'int2=0'
                )
            );

            my $expected_params = {
                'name'         => 'Alexis Sukrieh',
                'IRC Nickname' => 'sukria',
                'Project'      => 'Perl Dancer2',
                'hash'         => [ 2, 4 ],
                int1           => 1,
                int2           => 0,
            };

            my $req = Dancer2::Core::Request->new( env => \%ENV );
            is $req->path,   '/',   'path is set';
            is $req->method, 'GET', 'method is set';
            ok $req->is_get, "request method is GET";
            is_deeply scalar( $req->params ), $expected_params,
              'params are OK';
            is $req->params->{'name'}, 'Alexis Sukrieh',
              'params accessor works';

            my %params = $req->params;
            is_deeply scalar( $req->params ), \%params,
              'params wantarray works';
        }
    }

    {

        # 2. - post params
        note "post params";

        my $body = 'foo=bar&name=john&hash=2&hash=4&hash=6&';
        open my $in, '<', \$body;

        my $env = {
            CONTENT_LENGTH => length($body),
            CONTENT_TYPE   => 'application/x-www-form-urlencoded',
            REQUEST_METHOD => 'POST',
            SCRIPT_NAME    => '/',
            'psgi.input'   => $in,
        };

        my $expected_params = {
            name => 'john',
            foo  => 'bar',
            hash => [ 2, 4, 6 ],
        };

        my $req = Dancer2::Core::Request->new( env => $env );
        is $req->path,   '/',    'path is set';
        is $req->method, 'POST', 'method is set';
        ok $req->is_post, 'method is post';
        my $request_to_string = $req->to_string;
        like $request_to_string, qr{\[#\d+\] POST /};

        is_deeply scalar( $req->params ), $expected_params, 'params are OK';
        is $req->params->{'name'}, 'john', 'params accessor works';

        my %params = $req->params;
        is_deeply scalar( $req->params ), \%params, 'params wantarray works';

    }

    {

        # 3. - mixed params
        my $body = 'x=1&meth=post';
        open my $in, '<', \$body;

        my $env = {
            CONTENT_LENGTH => length($body),
            CONTENT_TYPE   => 'application/x-www-form-urlencoded',
            QUERY_STRING   => 'y=2&meth=get',
            REQUEST_METHOD => 'POST',
            SCRIPT_NAME    => '/',
            'psgi.input'   => $in,
        };

        my $mixed_params = {
            meth => 'post',
            x    => 1,
            y    => 2,
        };

        my $get_params = {
            y    => 2,
            meth => 'get',
        };

        my $post_params = {
            x    => 1,
            meth => 'post',
        };

        my $req = Dancer2::Core::Request->new( env => $env );
        is $req->path,   '/',    'path is set';
        is $req->method, 'POST', 'method is set';

        is_deeply scalar( $req->params ), $mixed_params, 'params are OK';
        is_deeply scalar( $req->params('body') ), $post_params,
          'body params are OK';
        is_deeply scalar( $req->params('query') ), $get_params,
          'query params are OK';
    }
}

diag "Run test with XS_URL_DECODE" if $Dancer2::Core::Request::XS_URL_DECODE;
diag "Run test with XS_PARSE_QUERY_STRING"
  if $Dancer2::Core::Request::XS_PARSE_QUERY_STRING;
run_test();
if ($Dancer2::Core::Request::XS_PARSE_QUERY_STRING) {
    diag "Run test without XS_PARSE_QUERY_STRING";
    $Dancer2::Core::Request::XS_PARSE_QUERY_STRING = 0;
    $Dancer2::Core::Request::_count                = 0;
    run_test();
}
if ($Dancer2::Core::Request::XS_URL_DECODE) {
    diag "Run test without XS_URL_DECODE";
    $Dancer2::Core::Request::XS_URL_DECODE = 0;
    $Dancer2::Core::Request::_count        = 0;
    run_test();
}

done_testing;