view release on metacpan or  search on metacpan

t/app/Plack/Test/Suite.t  view on Meta::CPAN

                                                                                                                                                                            left => branch { '=>',
                                                                                                                                                                                left => leaf 'Content-Type',
                                                                                                                                                                                right => leaf 'text/plain',
                                                                                                                                                                            },
                                                                                                                                                                        },
                                                                                                                                                                    },
                                                                                                                                                                },
                                                                                                                                                                right => array_ref { '[]',
                                                                                                                                                                    data => leaf '$body',
                                                                                                                                                                },
                                                                                                                                                            },
                                                                                                                                                        },
                                                                                                                                                    },
                                                                                                                                                },
                                                                                                                                            ],
                                                                                                                                        },
                                                                                                                                    },
                                                                                                                                },
                                                                                                                            },
                                                                                                                        },
                                                                                                                        right => array_ref { '[]',
                                                                                                                            data => branch { ',',
                                                                                                                                left => branch { ',',
                                                                                                                                    left => branch { ',',
                                                                                                                                        left => leaf '% encoding in PATH_INFO',
                                                                                                                                        right => function { 'sub',
                                                                                                                                            body => [
                                                                                                                                                branch { '=',
                                                                                                                                                    left => leaf '$cb',
                                                                                                                                                    right => function_call { 'shift',
                                                                                                                                                        args => [
                                                                                                                                                        ],
                                                                                                                                                    },
                                                                                                                                                },
                                                                                                                                                branch { '=',
                                                                                                                                                    left => leaf '$res',
                                                                                                                                                    right => branch { '->',
                                                                                                                                                        left => leaf '$cb',
                                                                                                                                                        right => list { '()',
                                                                                                                                                            data => function_call { 'GET',
                                                                                                                                                                args => [
                                                                                                                                                                    leaf 'http://127.0.0.1/foo/bar%2cbaz',
                                                                                                                                                                ],
                                                                                                                                                            },
                                                                                                                                                        },
                                                                                                                                                    },
                                                                                                                                                },
                                                                                                                                                function_call { 'is',
                                                                                                                                                    args => [
                                                                                                                                                        branch { ',',
                                                                                                                                                            left => branch { ',',
                                                                                                                                                                left => branch { '->',
                                                                                                                                                                    left => leaf '$res',
                                                                                                                                                                    right => function_call { 'content',
                                                                                                                                                                        args => [
                                                                                                                                                                        ],
                                                                                                                                                                    },
                                                                                                                                                                },
                                                                                                                                                                right => leaf '/foo/bar,baz',
                                                                                                                                                            },
                                                                                                                                                            right => leaf 'PATH_INFO should be decoded per RFC 3875',
                                                                                                                                                        },
                                                                                                                                                    ],
                                                                                                                                                },
                                                                                                                                            ],
                                                                                                                                        },
                                                                                                                                    },
                                                                                                                                    right => function { 'sub',
                                                                                                                                        body => [
                                                                                                                                            branch { '=',
                                                                                                                                                left => leaf '$env',
                                                                                                                                                right => function_call { 'shift',
                                                                                                                                                    args => [
                                                                                                                                                    ],
                                                                                                                                                },
                                                                                                                                            },
                                                                                                                                            Test::Compiler::Parser::return { 'return',
                                                                                                                                                body => array_ref { '[]',
                                                                                                                                                    data => branch { ',',
                                                                                                                                                        left => branch { ',',
                                                                                                                                                            left => branch { ',',
                                                                                                                                                                left => leaf '200',
                                                                                                                                                                right => array_ref { '[]',
                                                                                                                                                                    data => branch { ',',
                                                                                                                                                                        left => branch { '=>',
                                                                                                                                                                            left => leaf 'Content-Type',
                                                                                                                                                                            right => leaf 'text/plain',
                                                                                                                                                                        },
                                                                                                                                                                    },
                                                                                                                                                                },
                                                                                                                                                            },
                                                                                                                                                            right => array_ref { '[]',
                                                                                                                                                                data => branch { '->',
                                                                                                                                                                    left => leaf '$env',
                                                                                                                                                                    right => hash_ref { '{}',
                                                                                                                                                                        data => leaf 'PATH_INFO',
                                                                                                                                                                    },
                                                                                                                                                                },
                                                                                                                                                            },
                                                                                                                                                        },
                                                                                                                                                    },
                                                                                                                                                },
                                                                                                                                            },
                                                                                                                                        ],
                                                                                                                                    },
                                                                                                                                },
                                                                                                                            },
                                                                                                                        },
                                                                                                                    },
                                                                                                                    right => array_ref { '[]',
                                                                                                                        data => branch { ',',
                                                                                                                            left => branch { ',',
                                                                                                                                left => branch { ',',
                                                                                                                                    left => leaf '% double encoding in PATH_INFO',
                                                                                                                                    right => function { 'sub',
                                                                                                                                        body => [
                                                                                                                                            branch { '=',
                                                                                                                                                left => leaf '$cb',
                                                                                                                                                right => function_call { 'shift',
                                                                                                                                                    args => [
                                                                                                                                                    ],
                                                                                                                                                },
                                                                                                                                            },
                                                                                                                                            branch { '=',
                                                                                                                                                left => leaf '$res',
                                                                                                                                                right => branch { '->',
                                                                                                                                                    left => leaf '$cb',
                                                                                                                                                    right => list { '()',
                                                                                                                                                        data => function_call { 'GET',
                                                                                                                                                            args => [
                                                                                                                                                                leaf 'http://127.0.0.1/foo/bar%252cbaz',
                                                                                                                                                            ],
                                                                                                                                                        },
                                                                                                                                                    },
                                                                                                                                                },
                                                                                                                                            },
                                                                                                                                            function_call { 'is',
                                                                                                                                                args => [
                                                                                                                                                    branch { ',',
                                                                                                                                                        left => branch { ',',
                                                                                                                                                            left => branch { '->',
                                                                                                                                                                left => leaf '$res',
                                                                                                                                                                right => function_call { 'content',
                                                                                                                                                                    args => [
                                                                                                                                                                    ],
                                                                                                                                                                },
                                                                                                                                                            },
                                                                                                                                                            right => leaf '/foo/bar%2cbaz',
                                                                                                                                                        },
                                                                                                                                                        right => leaf 'PATH_INFO should be decoded only once, per RFC 3875',
                                                                                                                                                    },
                                                                                                                                                ],
                                                                                                                                            },
                                                                                                                                        ],
                                                                                                                                    },
                                                                                                                                },
                                                                                                                                right => function { 'sub',
                                                                                                                                    body => [
                                                                                                                                        branch { '=',
                                                                                                                                            left => leaf '$env',
                                                                                                                                            right => function_call { 'shift',
                                                                                                                                                args => [
                                                                                                                                                ],
                                                                                                                                            },
                                                                                                                                        },
                                                                                                                                        Test::Compiler::Parser::return { 'return',
                                                                                                                                            body => array_ref { '[]',
                                                                                                                                                data => branch { ',',
                                                                                                                                                    left => branch { ',',
                                                                                                                                                        left => branch { ',',
                                                                                                                                                            left => leaf '200',
                                                                                                                                                            right => array_ref { '[]',
                                                                                                                                                                data => branch { ',',
                                                                                                                                                                    left => branch { '=>',
                                                                                                                                                                        left => leaf 'Content-Type',
                                                                                                                                                                        right => leaf 'text/plain',
                                                                                                                                                                    },
                                                                                                                                                                },
                                                                                                                                                            },
                                                                                                                                                        },
                                                                                                                                                        right => array_ref { '[]',
                                                                                                                                                            data => branch { '->',
                                                                                                                                                                left => leaf '$env',
                                                                                                                                                                right => hash_ref { '{}',
                                                                                                                                                                    data => leaf 'PATH_INFO',
                                                                                                                                                                },
                                                                                                                                                            },
                                                                                                                                                        },
                                                                                                                                                    },
                                                                                                                                                },
                                                                                                                                            },
                                                                                                                                        },
                                                                                                                                    ],
                                                                                                                                },
                                                                                                                            },
                                                                                                                        },
                                                                                                                    },
                                                                                                                },
                                                                                                                right => array_ref { '[]',
                                                                                                                    data => branch { ',',
                                                                                                                        left => branch { ',',
                                                                                                                            left => branch { ',',
                                                                                                                                left => leaf '% encoding in PATH_INFO (outside of URI characters)',
                                                                                                                                right => function { 'sub',
                                                                                                                                    body => [
                                                                                                                                        branch { '=',
                                                                                                                                            left => leaf '$cb',
                                                                                                                                            right => function_call { 'shift',
                                                                                                                                                args => [
                                                                                                                                                ],

t/app/Plack/Test/Suite.t  view on Meta::CPAN

            my $env = shift;
            return [
                200,
                [ 'Content-Type' => 'text/plain', ],
                [$env->{HTTP_FOO}],
            ];
        },
    ],
    [
        'handle HTTP-Cookie',
        sub {
            my $cb  = shift;
            my $res = $cb->(GET "http://127.0.0.1/foo/?dankogai=kogaidan", Cookie => "foo");
            is $res->code, 200;
            is $res->message, 'OK';
            is $res->header('content_type'), 'text/plain';
            is $res->content, 'foo';
        },
        sub {
            my $env = shift;
            return [
                200,
                [ 'Content-Type' => 'text/plain', ],
                [$env->{HTTP_COOKIE}],
            ];
        },
    ],
    [
        'validate env',
        sub {
            my $cb  = shift;
            my $res = $cb->(GET "http://127.0.0.1/foo/?dankogai=kogaidan");
            is $res->code, 200;
            is $res->message, 'OK';
            is $res->header('content_type'), 'text/plain';
            is $res->content, join("\n",
                'REQUEST_METHOD:GET',
                "SCRIPT_NAME:$ENV{PLACK_TEST_SCRIPT_NAME}",
                'PATH_INFO:/foo/',
                'QUERY_STRING:dankogai=kogaidan',
                'SERVER_NAME:127.0.0.1',
                "SERVER_PORT:" . $res->request->uri->port,
            )."\n";
        },
        sub {
            my $env = shift;
            my $body;
            $body .= $_ . ':' . $env->{$_} . "\n" for qw/REQUEST_METHOD SCRIPT_NAME PATH_INFO QUERY_STRING SERVER_NAME SERVER_PORT/;
            return [
                200,
                [ 'Content-Type' => 'text/plain', ],
                [$body],
            ];
        },
    ],
    [
        '% encoding in PATH_INFO',
        sub {
            my $cb  = shift;
            my $res = $cb->(GET "http://127.0.0.1/foo/bar%2cbaz");
            is $res->content, "/foo/bar,baz", "PATH_INFO should be decoded per RFC 3875";
        },
        sub {
            my $env = shift;
            return [
                200,
                [ 'Content-Type' => 'text/plain', ],
                [ $env->{PATH_INFO} ],
            ];
        },
    ],
    [
        '% double encoding in PATH_INFO',
        sub {
            my $cb  = shift;
            my $res = $cb->(GET "http://127.0.0.1/foo/bar%252cbaz");
            is $res->content, "/foo/bar%2cbaz", "PATH_INFO should be decoded only once, per RFC 3875";
        },
        sub {
            my $env = shift;
            return [
                200,
                [ 'Content-Type' => 'text/plain', ],
                [ $env->{PATH_INFO} ],
            ];
        },
    ],
    [
        '% encoding in PATH_INFO (outside of URI characters)',
        sub {
            my $cb  = shift;
            my $res = $cb->(GET "http://127.0.0.1/foo%E3%81%82");
            is $res->content, "/foo\x{e3}\x{81}\x{82}";
        },
        sub {
            my $env = shift;
            return [
                200,
                [ 'Content-Type' => 'text/plain', ],
                [ $env->{PATH_INFO} ],
            ];
        },
    ],
    [
        'SERVER_PROTOCOL is required',
        sub {
            my $cb  = shift;
            my $res = $cb->(GET "http://127.0.0.1/foo/?dankogai=kogaidan");
            is $res->code, 200;
            is $res->message, 'OK';
            is $res->header('content_type'), 'text/plain';
            like $res->content, qr{^HTTP/1\.[01]$};
        },
        sub {
            my $env = shift;
            return [
                200,
                [ 'Content-Type' => 'text/plain', ],
                [$env->{SERVER_PROTOCOL}],
            ];
        },
    ],
    [
        'SCRIPT_NAME should not be undef',
        sub {
            my $cb  = shift;
            my $res = $cb->(GET "http://127.0.0.1/foo/?dankogai=kogaidan");
            is $res->content, 1;
        },
        sub {
            my $env = shift;
            my $cont = defined $env->{'SCRIPT_NAME'};
            return [
                200,
                [ 'Content-Type' => 'text/plain', ],
                [$cont],
            ];