use strict;
use warnings;
use Test::More;
use Compiler::Lexer;
use Compiler::Parser;
use Compiler::Parser::AST::Renderer;
use Test::Compiler::Parser;

subtest 'parse Plack/Handler/CGI.pm' => sub {
    my $script = do { local $/; <DATA> };
    my $tokens = Compiler::Lexer->new('')->tokenize($script);
    my $ast = Compiler::Parser->new->parse($tokens);
    Compiler::Parser::AST::Renderer->new->render($ast);
    node_ok($ast->root, [
        Test::Compiler::Parser::package { 'Plack::Handler::CGI',
        },
        module { 'strict',
        },
        module { 'warnings',
        },
        module { 'IO::Handle',
        },
        branch { '=',
            left => leaf '%StatusCode',
            right => list { '()',
                data => branch { ',',
                    left => branch { ',',
                        left => branch { ',',
                            left => branch { ',',
                                left => branch { ',',
                                    left => branch { ',',
                                        left => branch { ',',
                                            left => branch { ',',
                                                left => branch { ',',
                                                    left => branch { ',',
                                                        left => branch { ',',
                                                            left => branch { ',',
                                                                left => branch { ',',
                                                                    left => branch { ',',
                                                                        left => branch { ',',
                                                                            left => branch { ',',
                                                                                left => branch { ',',
                                                                                    left => branch { ',',
                                                                                        left => branch { ',',
                                                                                            left => branch { ',',
                                                                                                left => branch { ',',
                                                                                                    left => branch { ',',
                                                                                                        left => branch { ',',
                                                                                                            left => branch { ',',
                                                                                                                left => branch { ',',
                                                                                                                    left => branch { ',',
                                                                                                                        left => branch { ',',
                                                                                                                            left => branch { ',',
                                                                                                                                left => branch { ',',
                                                                                                                                    left => branch { ',',
                                                                                                                                        left => branch { ',',
                                                                                                                                            left => branch { ',',
                                                                                                                                                left => branch { ',',
                                                                                                                                                    left => branch { ',',
                                                                                                                                                        left => branch { ',',
                                                                                                                                                            left => branch { ',',
                                                                                                                                                                left => branch { ',',
                                                                                                                                                                    left => branch { ',',
                                                                                                                                                                        left => branch { ',',
                                                                                                                                                                            left => branch { ',',
                                                                                                                                                                                left => branch { ',',
                                                                                                                                                                                    left => branch { ',',
                                                                                                                                                                                        left => branch { ',',
                                                                                                                                                                                            left => branch { ',',
                                                                                                                                                                                                left => branch { ',',
                                                                                                                                                                                                    left => branch { ',',
                                                                                                                                                                                                        left => branch { ',',
                                                                                                                                                                                                            left => branch { ',',
                                                                                                                                                                                                                left => branch { ',',
                                                                                                                                                                                                                    left => branch { ',',
                                                                                                                                                                                                                        left => branch { ',',
                                                                                                                                                                                                                            left => branch { ',',
                                                                                                                                                                                                                                left => branch { '=>',
                                                                                                                                                                                                                                    left => leaf '100',
                                                                                                                                                                                                                                    right => leaf 'Continue',
                                                                                                                                                                                                                                },
                                                                                                                                                                                                                                right => branch { '=>',
                                                                                                                                                                                                                                    left => leaf '101',
                                                                                                                                                                                                                                    right => leaf 'Switching Protocols',
                                                                                                                                                                                                                                },
                                                                                                                                                                                                                            },
                                                                                                                                                                                                                            right => branch { '=>',
                                                                                                                                                                                                                                left => leaf '102',
                                                                                                                                                                                                                                right => leaf 'Processing',
                                                                                                                                                                                                                            },
                                                                                                                                                                                                                        },
                                                                                                                                                                                                                        right => branch { '=>',
                                                                                                                                                                                                                            left => leaf '200',
                                                                                                                                                                                                                            right => leaf 'OK',
                                                                                                                                                                                                                        },
                                                                                                                                                                                                                    },
                                                                                                                                                                                                                    right => branch { '=>',
                                                                                                                                                                                                                        left => leaf '201',
                                                                                                                                                                                                                        right => leaf 'Created',
                                                                                                                                                                                                                    },
                                                                                                                                                                                                                },
                                                                                                                                                                                                                right => branch { '=>',
                                                                                                                                                                                                                    left => leaf '202',
                                                                                                                                                                                                                    right => leaf 'Accepted',
                                                                                                                                                                                                                },
                                                                                                                                                                                                            },
                                                                                                                                                                                                            right => branch { '=>',
                                                                                                                                                                                                                left => leaf '203',
                                                                                                                                                                                                                right => leaf 'Non-Authoritative Information',
                                                                                                                                                                                                            },
                                                                                                                                                                                                        },
                                                                                                                                                                                                        right => branch { '=>',
                                                                                                                                                                                                            left => leaf '204',
                                                                                                                                                                                                            right => leaf 'No Content',
                                                                                                                                                                                                        },
                                                                                                                                                                                                    },
                                                                                                                                                                                                    right => branch { '=>',
                                                                                                                                                                                                        left => leaf '205',
                                                                                                                                                                                                        right => leaf 'Reset Content',
                                                                                                                                                                                                    },
                                                                                                                                                                                                },
                                                                                                                                                                                                right => branch { '=>',
                                                                                                                                                                                                    left => leaf '206',
                                                                                                                                                                                                    right => leaf 'Partial Content',
                                                                                                                                                                                                },
                                                                                                                                                                                            },
                                                                                                                                                                                            right => branch { '=>',
                                                                                                                                                                                                left => leaf '207',
                                                                                                                                                                                                right => leaf 'Multi-Status',
                                                                                                                                                                                            },
                                                                                                                                                                                        },
                                                                                                                                                                                        right => branch { '=>',
                                                                                                                                                                                            left => leaf '300',
                                                                                                                                                                                            right => leaf 'Multiple Choices',
                                                                                                                                                                                        },
                                                                                                                                                                                    },
                                                                                                                                                                                    right => branch { '=>',
                                                                                                                                                                                        left => leaf '301',
                                                                                                                                                                                        right => leaf 'Moved Permanently',
                                                                                                                                                                                    },
                                                                                                                                                                                },
                                                                                                                                                                                right => branch { '=>',
                                                                                                                                                                                    left => leaf '302',
                                                                                                                                                                                    right => leaf 'Found',
                                                                                                                                                                                },
                                                                                                                                                                            },
                                                                                                                                                                            right => branch { '=>',
                                                                                                                                                                                left => leaf '303',
                                                                                                                                                                                right => leaf 'See Other',
                                                                                                                                                                            },
                                                                                                                                                                        },
                                                                                                                                                                        right => branch { '=>',
                                                                                                                                                                            left => leaf '304',
                                                                                                                                                                            right => leaf 'Not Modified',
                                                                                                                                                                        },
                                                                                                                                                                    },
                                                                                                                                                                    right => branch { '=>',
                                                                                                                                                                        left => leaf '305',
                                                                                                                                                                        right => leaf 'Use Proxy',
                                                                                                                                                                    },
                                                                                                                                                                },
                                                                                                                                                                right => branch { '=>',
                                                                                                                                                                    left => leaf '307',
                                                                                                                                                                    right => leaf 'Temporary Redirect',
                                                                                                                                                                },
                                                                                                                                                            },
                                                                                                                                                            right => branch { '=>',
                                                                                                                                                                left => leaf '400',
                                                                                                                                                                right => leaf 'Bad Request',
                                                                                                                                                            },
                                                                                                                                                        },
                                                                                                                                                        right => branch { '=>',
                                                                                                                                                            left => leaf '401',
                                                                                                                                                            right => leaf 'Unauthorized',
                                                                                                                                                        },
                                                                                                                                                    },
                                                                                                                                                    right => branch { '=>',
                                                                                                                                                        left => leaf '402',
                                                                                                                                                        right => leaf 'Payment Required',
                                                                                                                                                    },
                                                                                                                                                },
                                                                                                                                                right => branch { '=>',
                                                                                                                                                    left => leaf '403',
                                                                                                                                                    right => leaf 'Forbidden',
                                                                                                                                                },
                                                                                                                                            },
                                                                                                                                            right => branch { '=>',
                                                                                                                                                left => leaf '404',
                                                                                                                                                right => leaf 'Not Found',
                                                                                                                                            },
                                                                                                                                        },
                                                                                                                                        right => branch { '=>',
                                                                                                                                            left => leaf '405',
                                                                                                                                            right => leaf 'Method Not Allowed',
                                                                                                                                        },
                                                                                                                                    },
                                                                                                                                    right => branch { '=>',
                                                                                                                                        left => leaf '406',
                                                                                                                                        right => leaf 'Not Acceptable',
                                                                                                                                    },
                                                                                                                                },
                                                                                                                                right => branch { '=>',
                                                                                                                                    left => leaf '407',
                                                                                                                                    right => leaf 'Proxy Authentication Required',
                                                                                                                                },
                                                                                                                            },
                                                                                                                            right => branch { '=>',
                                                                                                                                left => leaf '408',
                                                                                                                                right => leaf 'Request Timeout',
                                                                                                                            },
                                                                                                                        },
                                                                                                                        right => branch { '=>',
                                                                                                                            left => leaf '409',
                                                                                                                            right => leaf 'Conflict',
                                                                                                                        },
                                                                                                                    },
                                                                                                                    right => branch { '=>',
                                                                                                                        left => leaf '410',
                                                                                                                        right => leaf 'Gone',
                                                                                                                    },
                                                                                                                },
                                                                                                                right => branch { '=>',
                                                                                                                    left => leaf '411',
                                                                                                                    right => leaf 'Length Required',
                                                                                                                },
                                                                                                            },
                                                                                                            right => branch { '=>',
                                                                                                                left => leaf '412',
                                                                                                                right => leaf 'Precondition Failed',
                                                                                                            },
                                                                                                        },
                                                                                                        right => branch { '=>',
                                                                                                            left => leaf '413',
                                                                                                            right => leaf 'Request Entity Too Large',
                                                                                                        },
                                                                                                    },
                                                                                                    right => branch { '=>',
                                                                                                        left => leaf '414',
                                                                                                        right => leaf 'Request-URI Too Large',
                                                                                                    },
                                                                                                },
                                                                                                right => branch { '=>',
                                                                                                    left => leaf '415',
                                                                                                    right => leaf 'Unsupported Media Type',
                                                                                                },
                                                                                            },
                                                                                            right => branch { '=>',
                                                                                                left => leaf '416',
                                                                                                right => leaf 'Request Range Not Satisfiable',
                                                                                            },
                                                                                        },
                                                                                        right => branch { '=>',
                                                                                            left => leaf '417',
                                                                                            right => leaf 'Expectation Failed',
                                                                                        },
                                                                                    },
                                                                                    right => branch { '=>',
                                                                                        left => leaf '422',
                                                                                        right => leaf 'Unprocessable Entity',
                                                                                    },
                                                                                },
                                                                                right => branch { '=>',
                                                                                    left => leaf '423',
                                                                                    right => leaf 'Locked',
                                                                                },
                                                                            },
                                                                            right => branch { '=>',
                                                                                left => leaf '424',
                                                                                right => leaf 'Failed Dependency',
                                                                            },
                                                                        },
                                                                        right => branch { '=>',
                                                                            left => leaf '425',
                                                                            right => leaf 'No code',
                                                                        },
                                                                    },
                                                                    right => branch { '=>',
                                                                        left => leaf '426',
                                                                        right => leaf 'Upgrade Required',
                                                                    },
                                                                },
                                                                right => branch { '=>',
                                                                    left => leaf '449',
                                                                    right => leaf 'Retry with',
                                                                },
                                                            },
                                                            right => branch { '=>',
                                                                left => leaf '500',
                                                                right => leaf 'Internal Server Error',
                                                            },
                                                        },
                                                        right => branch { '=>',
                                                            left => leaf '501',
                                                            right => leaf 'Not Implemented',
                                                        },
                                                    },
                                                    right => branch { '=>',
                                                        left => leaf '502',
                                                        right => leaf 'Bad Gateway',
                                                    },
                                                },
                                                right => branch { '=>',
                                                    left => leaf '503',
                                                    right => leaf 'Service Unavailable',
                                                },
                                            },
                                            right => branch { '=>',
                                                left => leaf '504',
                                                right => leaf 'Gateway Timeout',
                                            },
                                        },
                                        right => branch { '=>',
                                            left => leaf '505',
                                            right => leaf 'HTTP Version Not Supported',
                                        },
                                    },
                                    right => branch { '=>',
                                        left => leaf '506',
                                        right => leaf 'Variant Also Negotiates',
                                    },
                                },
                                right => branch { '=>',
                                    left => leaf '507',
                                    right => leaf 'Insufficient Storage',
                                },
                            },
                            right => branch { '=>',
                                left => leaf '509',
                                right => leaf 'Bandwidth Limit Exceeded',
                            },
                        },
                        right => branch { '=>',
                            left => leaf '510',
                            right => leaf 'Not Extended',
                        },
                    },
                },
            },
        },
        function { 'new',
            body => function_call { 'bless',
                args => [
                    branch { ',',
                        left => hash_ref { '{}',
                        },
                        right => function_call { 'shift',
                            args => [
                            ],
                        },
                    },
                ],
            },
        },
        function { 'run',
            body => [
                branch { '=',
                    left => list { '()',
                        data => branch { ',',
                            left => leaf '$self',
                            right => leaf '$app',
                        },
                    },
                    right => leaf '@_',
                },
                branch { '=',
                    left => leaf '$env',
                    right => branch { '->',
                        left => leaf '$self',
                        right => function_call { 'setup_env',
                            args => [
                                list { '()',
                                },
                            ],
                        },
                    },
                },
                branch { '=',
                    left => leaf '$res',
                    right => branch { '->',
                        left => leaf '$app',
                        right => list { '()',
                            data => leaf '$env',
                        },
                    },
                },
                if_stmt { 'if',
                    expr => branch { 'eq',
                        left => function_call { 'ref',
                            args => [
                                leaf '$res',
                            ],
                        },
                        right => leaf 'ARRAY',
                    },
                    true_stmt => branch { '->',
                        left => leaf '$self',
                        right => function_call { '_handle_response',
                            args => [
                                leaf '$res',
                            ],
                        },
                    },
                    false_stmt => if_stmt { 'elsif',
                        expr => branch { 'eq',
                            left => function_call { 'ref',
                                args => [
                                    leaf '$res',
                                ],
                            },
                            right => leaf 'CODE',
                        },
                        true_stmt => branch { '->',
                            left => leaf '$res',
                            right => list { '()',
                                data => function { 'sub',
                                    body => branch { '->',
                                        left => leaf '$self',
                                        right => function_call { '_handle_response',
                                            args => [
                                                array { '$_',
                                                    idx => array_ref { '[]',
                                                        data => leaf '0',
                                                    },
                                                },
                                            ],
                                        },
                                    },
                                },
                            },
                        },
                        false_stmt => else_stmt { 'else',
                            stmt => function_call { 'die',
                                args => [
                                    leaf 'Bad response $res',
                                ],
                            },
                        },
                    },
                },
            ],
        },
        function { 'setup_env',
            body => [
                branch { '=',
                    left => list { '()',
                        data => branch { ',',
                            left => leaf '$self',
                            right => leaf '$override_env',
                        },
                    },
                    right => leaf '@_',
                },
                branch { '||=',
                    left => leaf '$override_env',
                    right => hash_ref { '{}',
                    },
                },
                function_call { 'binmode',
                    args => [
                        handle { 'STDIN',
                        },
                    ],
                },
                function_call { 'binmode',
                    args => [
                        handle { 'STDERR',
                        },
                    ],
                },
                branch { '=',
                    left => leaf '$env',
                    right => hash_ref { '{}',
                        data => branch { ',',
                            left => branch { ',',
                                left => branch { ',',
                                    left => branch { ',',
                                        left => branch { ',',
                                            left => branch { ',',
                                                left => branch { ',',
                                                    left => branch { ',',
                                                        left => branch { ',',
                                                            left => branch { ',',
                                                                left => branch { ',',
                                                                    left => leaf '%ENV',
                                                                    right => branch { '=>',
                                                                        left => leaf 'psgi.version',
                                                                        right => array_ref { '[]',
                                                                            data => branch { ',',
                                                                                left => leaf '1',
                                                                                right => leaf '1',
                                                                            },
                                                                        },
                                                                    },
                                                                },
                                                                right => branch { '=>',
                                                                    left => leaf 'psgi.url_scheme',
                                                                    right => three_term_operator { '?',
                                                                        cond => branch { '=~',
                                                                            left => branch { '||',
                                                                                left => hash { '$ENV',
                                                                                    key => hash_ref { '{}',
                                                                                        data => leaf 'HTTPS',
                                                                                    },
                                                                                },
                                                                                right => leaf 'off',
                                                                            },
                                                                            right => regexp { '^(?:on|1)$',
                                                                                option => leaf 'i',
                                                                            },
                                                                        },
                                                                        true_expr => leaf 'https',
                                                                        false_expr => leaf 'http',
                                                                    },
                                                                },
                                                            },
                                                            right => branch { '=>',
                                                                left => leaf 'psgi.input',
                                                                right => single_term_operator { '*',
                                                                    expr => handle { 'STDIN',
                                                                    },
                                                                },
                                                            },
                                                        },
                                                        right => branch { '=>',
                                                            left => leaf 'psgi.errors',
                                                            right => single_term_operator { '*',
                                                                expr => handle { 'STDERR',
                                                                },
                                                            },
                                                        },
                                                    },
                                                    right => branch { '=>',
                                                        left => leaf 'psgi.multithread',
                                                        right => leaf '0',
                                                    },
                                                },
                                                right => branch { '=>',
                                                    left => leaf 'psgi.multiprocess',
                                                    right => leaf '1',
                                                },
                                            },
                                            right => branch { '=>',
                                                left => leaf 'psgi.run_once',
                                                right => leaf '1',
                                            },
                                        },
                                        right => branch { '=>',
                                            left => leaf 'psgi.streaming',
                                            right => leaf '1',
                                        },
                                    },
                                    right => branch { '=>',
                                        left => leaf 'psgi.nonblocking',
                                        right => leaf '1',
                                    },
                                },
                                right => dereference { '%{',
                                    expr => leaf '$override_env',
                                },
                            },
                        },
                    },
                },
                function_call { 'delete',
                    args => [
                        branch { '->',
                            left => leaf '$env',
                            right => hash_ref { '{}',
                                data => leaf 'HTTP_CONTENT_TYPE',
                            },
                        },
                    ],
                },
                function_call { 'delete',
                    args => [
                        branch { '->',
                            left => leaf '$env',
                            right => hash_ref { '{}',
                                data => leaf 'HTTP_CONTENT_LENGTH',
                            },
                        },
                    ],
                },
                branch { '||=',
                    left => branch { '->',
                        left => leaf '$env',
                        right => hash_ref { '{}',
                            data => leaf 'HTTP_COOKIE',
                        },
                    },
                    right => hash { '$ENV',
                        key => hash_ref { '{}',
                            data => leaf 'COOKIE',
                        },
                    },
                },
                if_stmt { 'if',
                    expr => single_term_operator { '!',
                        expr => function_call { 'exists',
                            args => [
                                branch { '->',
                                    left => leaf '$env',
                                    right => hash_ref { '{}',
                                        data => leaf 'PATH_INFO',
                                    },
                                },
                            ],
                        },
                    },
                    true_stmt => branch { '=',
                        left => branch { '->',
                            left => leaf '$env',
                            right => hash_ref { '{}',
                                data => leaf 'PATH_INFO',
                            },
                        },
                        right => leaf '',
                    },
                },
                if_stmt { 'if',
                    expr => branch { 'eq',
                        left => branch { '->',
                            left => leaf '$env',
                            right => hash_ref { '{}',
                                data => leaf 'SCRIPT_NAME',
                            },
                        },
                        right => leaf '/',
                    },
                    true_stmt => [
                        branch { '=',
                            left => branch { '->',
                                left => leaf '$env',
                                right => hash_ref { '{}',
                                    data => leaf 'SCRIPT_NAME',
                                },
                            },
                            right => leaf '',
                        },
                        branch { '=',
                            left => branch { '->',
                                left => leaf '$env',
                                right => hash_ref { '{}',
                                    data => leaf 'PATH_INFO',
                                },
                            },
                            right => branch { '.',
                                left => leaf '/',
                                right => branch { '->',
                                    left => leaf '$env',
                                    right => hash_ref { '{}',
                                        data => leaf 'PATH_INFO',
                                    },
                                },
                            },
                        },
                    ],
                },
                Test::Compiler::Parser::return { 'return',
                    body => leaf '$env',
                },
            ],
        },
        function { '_handle_response',
            body => [
                branch { '=',
                    left => list { '()',
                        data => branch { ',',
                            left => leaf '$self',
                            right => leaf '$res',
                        },
                    },
                    right => leaf '@_',
                },
                branch { '->',
                    left => single_term_operator { '*',
                        expr => handle { 'STDOUT',
                        },
                    },
                    right => function_call { 'autoflush',
                        args => [
                            leaf '1',
                        ],
                    },
                },
                function_call { 'binmode',
                    args => [
                        handle { 'STDOUT',
                        },
                    ],
                },
                leaf '$hdrs',
                branch { '=',
                    left => leaf '$message',
                    right => hash { '$StatusCode',
                        key => hash_ref { '{}',
                            data => branch { '->',
                                left => leaf '$res',
                                right => array_ref { '[]',
                                    data => leaf '0',
                                },
                            },
                        },
                    },
                },
                branch { '=',
                    left => leaf '$hdrs',
                    right => leaf 'Status: $res->[0] $message\015\012',
                },
                branch { '=',
                    left => leaf '$headers',
                    right => branch { '->',
                        left => leaf '$res',
                        right => array_ref { '[]',
                            data => leaf '1',
                        },
                    },
                },
                while_stmt { 'while',
                    expr => branch { '=',
                        left => list { '()',
                            data => branch { ',',
                                left => leaf '$k',
                                right => leaf '$v',
                            },
                        },
                        right => function_call { 'splice',
                            args => [
                                list { '()',
                                    data => branch { ',',
                                        left => branch { ',',
                                            left => dereference { '@$headers',
                                                expr => leaf '@$headers',
                                            },
                                            right => leaf '0',
                                        },
                                        right => leaf '2',
                                    },
                                },
                            ],
                        },
                    },
                    true_stmt => branch { '.=',
                        left => leaf '$hdrs',
                        right => leaf '$k: $v\015\012',
                    },
                },
                branch { '.=',
                    left => leaf '$hdrs',
                    right => leaf '\015\012',
                },
                function_call { 'print',
                    args => [
                        handle { 'STDOUT',
                        },
                        leaf '$hdrs',
                    ],
                },
                branch { '=',
                    left => leaf '$body',
                    right => branch { '->',
                        left => leaf '$res',
                        right => array_ref { '[]',
                            data => leaf '2',
                        },
                    },
                },
                branch { '=',
                    left => leaf '$cb',
                    right => function { 'sub',
                        body => function_call { 'print',
                            args => [
                                handle { 'STDOUT',
                                    expr => array { '$_',
                                        idx => array_ref { '[]',
                                            data => leaf '0',
                                        },
                                    },
                                },
                            ],
                        },
                    },
                },
                if_stmt { 'if',
                    expr => branch { 'eq',
                        left => function_call { 'ref',
                            args => [
                                leaf '$body',
                            ],
                        },
                        right => leaf 'ARRAY',
                    },
                    true_stmt => foreach_stmt { 'for',
                        cond => dereference { '@$body',
                            expr => leaf '@$body',
                        },
                        true_stmt => if_stmt { 'if',
                            expr => function_call { 'length',
                                args => [
                                    leaf '$line',
                                ],
                            },
                            true_stmt => branch { '->',
                                left => leaf '$cb',
                                right => list { '()',
                                    data => leaf '$line',
                                },
                            },
                        },
                        itr => leaf '$line',
                    },
                    false_stmt => if_stmt { 'elsif',
                        expr => function_call { 'defined',
                            args => [
                                leaf '$body',
                            ],
                        },
                        true_stmt => [
                            if_stmt { 'unless',
                                expr => function_call { 'ref',
                                    args => [
                                        leaf '$/',
                                    ],
                                },
                                true_stmt => branch { '=',
                                    left => leaf '$/',
                                    right => single_term_operator { '\\',
                                        expr => leaf '65536',
                                    },
                                },
                            },
                            while_stmt { 'while',
                                expr => function_call { 'defined',
                                    args => [
                                        branch { '=',
                                            left => leaf '$line',
                                            right => branch { '->',
                                                left => leaf '$body',
                                                right => function_call { 'getline',
                                                    args => [
                                                    ],
                                                },
                                            },
                                        },
                                    ],
                                },
                                true_stmt => if_stmt { 'if',
                                    expr => function_call { 'length',
                                        args => [
                                            leaf '$line',
                                        ],
                                    },
                                    true_stmt => branch { '->',
                                        left => leaf '$cb',
                                        right => list { '()',
                                            data => leaf '$line',
                                        },
                                    },
                                },
                            },
                            branch { '->',
                                left => leaf '$body',
                                right => function_call { 'close',
                                    args => [
                                    ],
                                },
                            },
                        ],
                        false_stmt => else_stmt { 'else',
                            stmt => Test::Compiler::Parser::return { 'return',
                                body => branch { '->',
                                    left => leaf 'Plack::Handler::CGI::Writer',
                                    right => function_call { 'new',
                                        args => [
                                        ],
                                    },
                                },
                            },
                        },
                    },
                },
            ],
        },
        Test::Compiler::Parser::package { 'Plack::Handler::CGI::Writer',
        },
        function { 'new',
            body => function_call { 'bless',
                args => [
                    branch { ',',
                        left => single_term_operator { '\\',
                            expr => do_stmt { 'do',
                                stmt => leaf '$x',
                            },
                        },
                        right => array { '$_',
                            idx => array_ref { '[]',
                                data => leaf '0',
                            },
                        },
                    },
                ],
            },
        },
        function { 'write',
            body => function_call { 'print',
                args => [
                    handle { 'STDOUT',
                        expr => array { '$_',
                            idx => array_ref { '[]',
                                data => leaf '1',
                            },
                        },
                    },
                ],
            },
        },
        function { 'close',
        },
        Test::Compiler::Parser::package { 'Plack::Handler::CGI',
        },
        leaf '1',
    ]);
};

done_testing;

__DATA__
package Plack::Handler::CGI;
use strict;
use warnings;
use IO::Handle;

# copied from HTTP::Status
my %StatusCode = (
    100 => 'Continue',
    101 => 'Switching Protocols',
    102 => 'Processing',                      # RFC 2518 (WebDAV)
    200 => 'OK',
    201 => 'Created',
    202 => 'Accepted',
    203 => 'Non-Authoritative Information',
    204 => 'No Content',
    205 => 'Reset Content',
    206 => 'Partial Content',
    207 => 'Multi-Status',                    # RFC 2518 (WebDAV)
    300 => 'Multiple Choices',
    301 => 'Moved Permanently',
    302 => 'Found',
    303 => 'See Other',
    304 => 'Not Modified',
    305 => 'Use Proxy',
    307 => 'Temporary Redirect',
    400 => 'Bad Request',
    401 => 'Unauthorized',
    402 => 'Payment Required',
    403 => 'Forbidden',
    404 => 'Not Found',
    405 => 'Method Not Allowed',
    406 => 'Not Acceptable',
    407 => 'Proxy Authentication Required',
    408 => 'Request Timeout',
    409 => 'Conflict',
    410 => 'Gone',
    411 => 'Length Required',
    412 => 'Precondition Failed',
    413 => 'Request Entity Too Large',
    414 => 'Request-URI Too Large',
    415 => 'Unsupported Media Type',
    416 => 'Request Range Not Satisfiable',
    417 => 'Expectation Failed',
    422 => 'Unprocessable Entity',            # RFC 2518 (WebDAV)
    423 => 'Locked',                          # RFC 2518 (WebDAV)
    424 => 'Failed Dependency',               # RFC 2518 (WebDAV)
    425 => 'No code',                         # WebDAV Advanced Collections
    426 => 'Upgrade Required',                # RFC 2817
    449 => 'Retry with',                      # unofficial Microsoft
    500 => 'Internal Server Error',
    501 => 'Not Implemented',
    502 => 'Bad Gateway',
    503 => 'Service Unavailable',
    504 => 'Gateway Timeout',
    505 => 'HTTP Version Not Supported',
    506 => 'Variant Also Negotiates',         # RFC 2295
    507 => 'Insufficient Storage',            # RFC 2518 (WebDAV)
    509 => 'Bandwidth Limit Exceeded',        # unofficial
    510 => 'Not Extended',                    # RFC 2774
);

sub new { bless {}, shift }

sub run {
    my ($self, $app) = @_;

    my $env = $self->setup_env();

    my $res = $app->($env);
    if (ref $res eq 'ARRAY') {
        $self->_handle_response($res);
    }
    elsif (ref $res eq 'CODE') {
        $res->(sub {
            $self->_handle_response($_[0]);
        });
    }
    else {
        die "Bad response $res";
    }
}

sub setup_env {
    my ( $self, $override_env ) = @_;

    $override_env ||= {};

    binmode STDIN;
    binmode STDERR;

    my $env = {
        %ENV,
        'psgi.version'    => [ 1, 1 ],
        'psgi.url_scheme' => ($ENV{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http',
        'psgi.input'      => *STDIN,
        'psgi.errors'     => *STDERR,
        'psgi.multithread'  => 0,
        'psgi.multiprocess' => 1,
        'psgi.run_once'     => 1,
        'psgi.streaming'    => 1,
        'psgi.nonblocking'  => 1,
        %{ $override_env },
    };

    delete $env->{HTTP_CONTENT_TYPE};
    delete $env->{HTTP_CONTENT_LENGTH};
    $env->{'HTTP_COOKIE'} ||= $ENV{COOKIE}; # O'Reilly server bug

    if (!exists $env->{PATH_INFO}) {
        $env->{PATH_INFO} = '';
    }

    if ($env->{SCRIPT_NAME} eq '/') {
        $env->{SCRIPT_NAME} = '';
        $env->{PATH_INFO}   = '/' . $env->{PATH_INFO};
    }

    return $env;
}



sub _handle_response {
    my ($self, $res) = @_;

    *STDOUT->autoflush(1);
    binmode STDOUT;

    my $hdrs;
    my $message = $StatusCode{$res->[0]};
    $hdrs = "Status: $res->[0] $message\015\012";

    my $headers = $res->[1];
    while (my ($k, $v) = splice(@$headers, 0, 2)) {
        $hdrs .= "$k: $v\015\012";
    }
    $hdrs .= "\015\012";

    print STDOUT $hdrs;

    my $body = $res->[2];
    my $cb = sub { print STDOUT $_[0] };

    # inline Plack::Util::foreach here
    if (ref $body eq 'ARRAY') {
        for my $line (@$body) {
            $cb->($line) if length $line;
        }
    }
    elsif (defined $body) {
        local $/ = \65536 unless ref $/;
        while (defined(my $line = $body->getline)) {
            $cb->($line) if length $line;
        }
        $body->close;
    }
    else {
        return Plack::Handler::CGI::Writer->new;
    }
}

package Plack::Handler::CGI::Writer;
sub new   { bless \do { my $x }, $_[0] }
sub write { print STDOUT $_[1] }
sub close { }

package Plack::Handler::CGI;

1;
__END__

=head1 NAME

Plack::Handler::CGI - CGI handler for Plack

=head1 SYNOPSIS

Want to run PSGI application as a CGI script? Rename .psgi to .cgi and
change the shebang line like:

  #!/usr/bin/env plackup
  # rest of the file can be the same as other .psgi file

You can alternatively create a .cgi file that contains something like:

  #!/usr/bin/perl
  use Plack::Loader;
  my $app = Plack::Util::load_psgi("/path/to/app.psgi");
  Plack::Loader->auto->run($app);

This will auto-recognize the CGI environment variable to load this class.

If you really want to explicitly load the CGI handler, you can. For instance
you might do this when you want to embed a PSGI application server built into
CGI-compatible perl-based web server:

  use Plack::Handler::CGI;
  Plack::Handler::CGI->new->run($app);

=head1 DESCRIPTION

This is a handler module to run any PSGI application as a CGI script.

=head1 UTILITY METHODS

=head2 setup_env()

  my $env = Plack::Handler::CGI->setup_env();
  my $env = Plack::Handler::CGI->setup_env(\%override_env);

Sets up the PSGI environment hash for a CGI request from C<< %ENV >>> and returns it.
You can can provide a hashref of key/value pairs to override the defaults if you would like.

=head1 SEE ALSO

L<Plack>

=cut



