Compiler-Parser

 view release on metacpan or  search on metacpan

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

                                                                                },
                                                                                function_call { 'is',
                                                                                    args => [
                                                                                        branch { ',',
                                                                                            left => branch { '->',
                                                                                                left => leaf '$res',
                                                                                                right => function_call { 'message',
                                                                                                    args => [
                                                                                                    ],
                                                                                                },
                                                                                            },
                                                                                            right => leaf 'OK',
                                                                                        },
                                                                                    ],
                                                                                },
                                                                                function_call { 'is',
                                                                                    args => [
                                                                                        branch { ',',
                                                                                            left => branch { '->',
                                                                                                left => leaf '$res',
                                                                                                right => function_call { 'header',
                                                                                                    args => [
                                                                                                        leaf 'content_type',
                                                                                                    ],
                                                                                                },
                                                                                            },
                                                                                            right => leaf 'text/plain',
                                                                                        },
                                                                                    ],
                                                                                },
                                                                                function_call { 'is',
                                                                                    args => [
                                                                                        branch { ',',
                                                                                            left => branch { '->',
                                                                                                left => leaf '$res',
                                                                                                right => function_call { 'content',
                                                                                                    args => [
                                                                                                    ],
                                                                                                },
                                                                                            },
                                                                                            right => leaf 'Hello, name=miyagawa',
                                                                                        },
                                                                                    ],
                                                                                },
                                                                            ],
                                                                        },
                                                                    },
                                                                    right => function { 'sub',
                                                                        body => [
                                                                            branch { '=',
                                                                                left => leaf '$env',
                                                                                right => function_call { 'shift',
                                                                                    args => [
                                                                                    ],
                                                                                },
                                                                            },
                                                                            branch { 'or',
                                                                                left => branch { '->',
                                                                                    left => leaf '$env',
                                                                                    right => hash_ref { '{}',
                                                                                        data => leaf 'psgi.streaming',
                                                                                    },
                                                                                },
                                                                                right => Test::Compiler::Parser::return { 'return',
                                                                                    body => array_ref { '[]',
                                                                                        data => branch { ',',
                                                                                            left => branch { ',',
                                                                                                left => leaf '501',
                                                                                                right => array_ref { '[]',
                                                                                                    data => branch { ',',
                                                                                                        left => leaf 'Content-Type',
                                                                                                        right => leaf 'text/plain',
                                                                                                    },
                                                                                                },
                                                                                            },
                                                                                            right => array_ref { '[]',
                                                                                            },
                                                                                        },
                                                                                    },
                                                                                },
                                                                            },
                                                                            Test::Compiler::Parser::return { 'return',
                                                                                body => function { 'sub',
                                                                                    body => [
                                                                                        branch { '=',
                                                                                            left => leaf '$respond',
                                                                                            right => function_call { 'shift',
                                                                                                args => [
                                                                                                ],
                                                                                            },
                                                                                        },
                                                                                        branch { '->',
                                                                                            left => leaf '$respond',
                                                                                            right => list { '()',
                                                                                                data => 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 'Hello, ',
                                                                                                                    right => branch { '->',
                                                                                                                        left => leaf '$env',
                                                                                                                        right => hash_ref { '{}',
                                                                                                                            data => leaf 'QUERY_STRING',
                                                                                                                        },
                                                                                                                    },
                                                                                                                },
                                                                                                            },
                                                                                                        },
                                                                                                    },
                                                                                                },
                                                                                            },
                                                                                        },
                                                                                    ],
                                                                                },
                                                                            },
                                                                        ],
                                                                    },
                                                                },
                                                            },
                                                        },
                                                    },
                                                    right => array_ref { '[]',
                                                        data => branch { ',',
                                                            left => branch { ',',
                                                                left => branch { ',',
                                                                    left => leaf 'coderef streaming',
                                                                    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/?name=miyagawa',
                                                                                            ],
                                                                                        },
                                                                                    },
                                                                                },
                                                                            },
                                                                            if_stmt { 'if',
                                                                                expr => branch { '==',
                                                                                    left => branch { '->',
                                                                                        left => leaf '$res',
                                                                                        right => function_call { 'code',
                                                                                            args => [
                                                                                            ],
                                                                                        },
                                                                                    },
                                                                                    right => leaf '501',
                                                                                },
                                                                                true_stmt => Test::Compiler::Parser::return { 'return',
                                                                                },
                                                                            },
                                                                            function_call { 'is',
                                                                                args => [
                                                                                    branch { ',',
                                                                                        left => branch { '->',
                                                                                            left => leaf '$res',
                                                                                            right => function_call { 'code',
                                                                                                args => [
                                                                                                ],
                                                                                            },
                                                                                        },
                                                                                        right => leaf '200',
                                                                                    },
                                                                                ],
                                                                            },
                                                                            function_call { 'is',
                                                                                args => [
                                                                                    branch { ',',
                                                                                        left => branch { '->',
                                                                                            left => leaf '$res',
                                                                                            right => function_call { 'message',
                                                                                                args => [
                                                                                                ],
                                                                                            },
                                                                                        },
                                                                                        right => leaf 'OK',
                                                                                    },
                                                                                ],
                                                                            },
                                                                            function_call { 'is',
                                                                                args => [
                                                                                    branch { ',',
                                                                                        left => branch { '->',
                                                                                            left => leaf '$res',
                                                                                            right => function_call { 'header',
                                                                                                args => [
                                                                                                    leaf 'content_type',
                                                                                                ],
                                                                                            },
                                                                                        },
                                                                                        right => leaf 'text/plain',
                                                                                    },
                                                                                ],
                                                                            },
                                                                            function_call { 'is',
                                                                                args => [
                                                                                    branch { ',',
                                                                                        left => branch { '->',
                                                                                            left => leaf '$res',
                                                                                            right => function_call { 'content',
                                                                                                args => [
                                                                                                ],
                                                                                            },
                                                                                        },
                                                                                        right => leaf 'Hello, name=miyagawa',
                                                                                    },
                                                                                ],
                                                                            },
                                                                        ],
                                                                    },
                                                                },
                                                                right => function { 'sub',
                                                                    body => [
                                                                        branch { '=',
                                                                            left => leaf '$env',
                                                                            right => function_call { 'shift',
                                                                                args => [
                                                                                ],
                                                                            },
                                                                        },
                                                                        branch { 'or',
                                                                            left => branch { '->',
                                                                                left => leaf '$env',
                                                                                right => hash_ref { '{}',
                                                                                    data => leaf 'psgi.streaming',
                                                                                },
                                                                            },
                                                                            right => Test::Compiler::Parser::return { 'return',
                                                                                body => array_ref { '[]',
                                                                                    data => branch { ',',
                                                                                        left => branch { ',',
                                                                                            left => leaf '501',
                                                                                            right => array_ref { '[]',
                                                                                                data => branch { ',',
                                                                                                    left => leaf 'Content-Type',
                                                                                                    right => leaf 'text/plain',
                                                                                                },
                                                                                            },
                                                                                        },
                                                                                        right => array_ref { '[]',
                                                                                        },
                                                                                    },
                                                                                },
                                                                            },
                                                                        },
                                                                        Test::Compiler::Parser::return { 'return',
                                                                            body => function { 'sub',
                                                                                body => [
                                                                                    branch { '=',
                                                                                        left => leaf '$respond',
                                                                                        right => function_call { 'shift',
                                                                                            args => [
                                                                                            ],
                                                                                        },
                                                                                    },
                                                                                    branch { '=',
                                                                                        left => leaf '$writer',
                                                                                        right => branch { '->',
                                                                                            left => leaf '$respond',
                                                                                            right => list { '()',
                                                                                                data => array_ref { '[]',
                                                                                                    data => branch { ',',
                                                                                                        left => branch { ',',
                                                                                                            left => leaf '200',
                                                                                                            right => array_ref { '[]',
                                                                                                                data => branch { ',',
                                                                                                                    left => branch { '=>',
                                                                                                                        left => leaf 'Content-Type',
                                                                                                                        right => leaf 'text/plain',
                                                                                                                    },
                                                                                                                },
                                                                                                            },
                                                                                                        },
                                                                                                    },
                                                                                                },
                                                                                            },
                                                                                        },
                                                                                    },
                                                                                    branch { '->',
                                                                                        left => leaf '$writer',
                                                                                        right => function_call { 'write',
                                                                                            args => [
                                                                                                leaf 'Hello, ',
                                                                                            ],
                                                                                        },

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

            my $env = shift;
            return [ 200, [ 'Content-Type' => 'text/plain' ], [ $env->{REQUEST_URI} ] ];
        },
    ],
    [
        'filehandle with path()',
        sub {
            my $cb  = shift;
            my $res = $cb->(GET "http://127.0.0.1/foo.jpg");
            is $res->code, 200;
            is $res->message, 'OK';
            is $res->header('content_type'), 'image/jpeg';
            is length $res->content, 4745;
        },
        sub {
            my $env = shift;
            open my $fh, '<', "$share_dir/face.jpg";
            Plack::Util::set_io_path($fh, "$share_dir/face.jpg");
            return [
                200,
                [ 'Content-Type' => 'image/jpeg', 'Content-Length' => -s $fh ],
                $fh
            ];
        },
    ],
    [
        'a big header value > 128 bytes',
        sub {
            my $cb  = shift;
            my $req = GET "http://127.0.0.1/";
            my $v = ("abcdefgh" x 16);
            $req->header('X-Foo' => $v);
            my $res = $cb->($req);
            is $res->code, 200;
            is $res->message, 'OK';
            is $res->content, $v;
        },
        sub {
            my $env = shift;
            return [
                200,
                [ 'Content-Type' => 'text/plain' ],
                [ $env->{HTTP_X_FOO} ],
            ];
        },
    ],
    [
        'coderef res',
        sub {
            my $cb = shift;
            my $res = $cb->(GET "http://127.0.0.1/?name=miyagawa");
            return if $res->code == 501;

            is $res->code, 200;
            is $res->message, 'OK';
            is $res->header('content_type'), 'text/plain';
            is $res->content, 'Hello, name=miyagawa';
        },
        sub {
            my $env = shift;
            $env->{'psgi.streaming'} or return [ 501, ['Content-Type','text/plain'], [] ];
            return sub {
                my $respond = shift;
                $respond->([
                    200,
                    [ 'Content-Type' => 'text/plain', ],
                    [ 'Hello, ' . $env->{QUERY_STRING} ],
                ]);
            }
        },
    ],
    [
        'coderef streaming',
        sub {
            my $cb = shift;
            my $res = $cb->(GET "http://127.0.0.1/?name=miyagawa");
            return if $res->code == 501;

            is $res->code, 200;
            is $res->message, 'OK';
            is $res->header('content_type'), 'text/plain';
            is $res->content, 'Hello, name=miyagawa';
        },
        sub {
            my $env = shift;
            $env->{'psgi.streaming'} or return [ 501, ['Content-Type','text/plain'], [] ];

            return sub {
                my $respond = shift;

                my $writer = $respond->([
                    200,
                    [ 'Content-Type' => 'text/plain', ],
                ]);

                $writer->write("Hello, ");
                $writer->write($env->{QUERY_STRING});
                $writer->close();
            }
        },
    ],
    [
        'CRLF output and FCGI parse bug',
        sub {
            my $cb = shift;
            my $res = $cb->(GET "http://127.0.0.1/");

            is $res->header("Foo"), undef;
            is $res->content, "Foo: Bar\r\n\r\nHello World";
        },
        sub {
            return [ 200, [ "Content-Type", "text/plain" ], [ "Foo: Bar\r\n\r\nHello World" ] ];
        },
    ],
    [
        'newlines',
        sub {
            my $cb = shift;
            my $res = $cb->(GET "http://127.0.0.1/");
            is length($res->content), 7;
        },
        sub {
            return [ 200, [ "Content-Type", "text/plain" ], [ "Bar\nBaz" ] ];
        },
    ],
    [
        'test 404',
        sub {
            my $cb = shift;
            my $res = $cb->(GET "http://127.0.0.1/");
            is $res->code, 404;
            is $res->message, 'Not Found';
            is $res->content, 'Not Found';
        },
        sub {
            return [ 404, [ "Content-Type", "text/plain" ], [ "Not Found" ] ];
        },
    ],
    [
        'request->input seekable',
        sub {
            my $cb = shift;
            my $req = HTTP::Request->new(POST => "http://127.0.0.1/");
            $req->content("body");
            $req->content_type('text/plain');
            $req->content_length(4);



( run in 0.784 second using v1.01-cache-2.11-cpan-39bf76dae61 )