view release on metacpan or  search on metacpan

t/app/Plack/Handler/Apache2.t  view on Meta::CPAN

                                                                        },
                                                                        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 => leaf '$r',
                                                                    },
                                                                },
                                                                right => branch { '=>',
                                                                    left => leaf 'psgi.errors',
                                                                    right => single_term_operator { '*',
                                                                        expr => handle { 'STDERR',
                                                                        },
                                                                    },
                                                                },
                                                            },
                                                            right => branch { '=>',
                                                                left => leaf 'psgi.multithread',
                                                                right => function_call { 'Plack::Util::FALSE',
                                                                    args => [
                                                                    ],
                                                                },
                                                            },
                                                        },
                                                        right => branch { '=>',
                                                            left => leaf 'psgi.multiprocess',
                                                            right => function_call { 'Plack::Util::TRUE',
                                                                args => [
                                                                ],
                                                            },
                                                        },
                                                    },
                                                    right => branch { '=>',
                                                        left => leaf 'psgi.run_once',
                                                        right => function_call { 'Plack::Util::FALSE',
                                                            args => [
                                                            ],
                                                        },
                                                    },
                                                },
                                                right => branch { '=>',
                                                    left => leaf 'psgi.streaming',
                                                    right => function_call { 'Plack::Util::TRUE',
                                                        args => [
                                                        ],
                                                    },
                                                },
                                            },
                                            right => branch { '=>',
                                                left => leaf 'psgi.nonblocking',
                                                right => function_call { 'Plack::Util::FALSE',
                                                    args => [
                                                    ],
                                                },
                                            },
                                        },
                                        right => branch { '=>',
                                            left => leaf 'psgix.harakiri',
                                            right => function_call { 'Plack::Util::TRUE',
                                                args => [
                                                ],
                                            },
                                        },
                                    },
                                    right => branch { '=>',
                                        left => leaf 'psgix.cleanup',
                                        right => function_call { 'Plack::Util::TRUE',
                                            args => [
                                            ],
                                        },
                                    },
                                },
                                right => branch { '=>',
                                    left => leaf 'psgix.cleanup.handlers',
                                    right => array_ref { '[]',
                                    },
                                },
                            },
                        },
                    },
                },
                if_stmt { 'if',
                    expr => function_call { 'defined',
                        args => [
                            branch { '=',
                                left => leaf '$HTTP_AUTHORIZATION',
                                right => branch { '->',
                                    left => branch { '->',
                                        left => leaf '$r',
                                        right => function_call { 'headers_in',
                                            args => [
                                            ],
                                        },
                                    },
                                    right => hash_ref { '{}',
                                        data => leaf 'Authorization',
                                    },
                                },
                            },
                        ],
                    },
                    true_stmt => branch { '=',

t/app/Plack/Handler/Apache2.t  view on Meta::CPAN

__DATA__
package Plack::Handler::Apache2;
use strict;
use warnings;
use Apache2::RequestRec;
use Apache2::RequestIO;
use Apache2::RequestUtil;
use Apache2::Response;
use Apache2::Const -compile => qw(OK);
use Apache2::Log;
use APR::Table;
use IO::Handle;
use Plack::Util;
use Scalar::Util;
use URI;
use URI::Escape;

my %apps; # psgi file to $app mapping

sub new { bless {}, shift }

sub preload {
    my $class = shift;
    for my $app (@_) {
        $class->load_app($app);
    }
}

sub load_app {
    my($class, $app) = @_;
    return $apps{$app} ||= do {
        # Trick Catalyst, CGI.pm, CGI::Cookie and others that check
        # for $ENV{MOD_PERL}.
        #
        # Note that we delete it instead of just localizing
        # $ENV{MOD_PERL} because some users may check if the key
        # exists, and we do it this way because "delete local" is new
        # in 5.12:
        # http://perldoc.perl.org/5.12.0/perldelta.html#delete-local
        local $ENV{MOD_PERL};
        delete $ENV{MOD_PERL};

        Plack::Util::load_psgi $app;
    };
}

sub call_app {
    my ($class, $r, $app) = @_;

    $r->subprocess_env; # let Apache create %ENV for us :)

    my $env = {
        %ENV,
        'psgi.version'           => [ 1, 1 ],
        'psgi.url_scheme'        => ($ENV{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http',
        'psgi.input'             => $r,
        'psgi.errors'            => *STDERR,
        'psgi.multithread'       => Plack::Util::FALSE,
        'psgi.multiprocess'      => Plack::Util::TRUE,
        'psgi.run_once'          => Plack::Util::FALSE,
        'psgi.streaming'         => Plack::Util::TRUE,
        'psgi.nonblocking'       => Plack::Util::FALSE,
        'psgix.harakiri'         => Plack::Util::TRUE,
        'psgix.cleanup'          => Plack::Util::TRUE,
        'psgix.cleanup.handlers' => [],
    };

    if (defined(my $HTTP_AUTHORIZATION = $r->headers_in->{Authorization})) {
        $env->{HTTP_AUTHORIZATION} = $HTTP_AUTHORIZATION;
    }

    # If you supply more than one Content-Length header Apache will
    # happily concat the values with ", ", e.g. "72, 72". This
    # violates the PSGI spec so fix this up and just take the first
    # one.
    if (exists $env->{CONTENT_LENGTH} && $env->{CONTENT_LENGTH} =~ /,/) {
        no warnings qw(numeric);
        $env->{CONTENT_LENGTH} = int $env->{CONTENT_LENGTH};
    }

    # Actually, we can not trust PATH_INFO from mod_perl because mod_perl squeezes multiple slashes into one slash.
    my $uri = URI->new("http://".$r->hostname.$r->unparsed_uri);

    $env->{PATH_INFO} = uri_unescape($uri->path);

    $class->fixup_path($r, $env);

    my $res = $app->($env);

    if (ref $res eq 'ARRAY') {
        _handle_response($r, $res);
    }
    elsif (ref $res eq 'CODE') {
        $res->(sub {
            _handle_response($r, $_[0]);
        });
    }
    else {
        die "Bad response $res";
    }

    if (@{ $env->{'psgix.cleanup.handlers'} }) {
        $r->push_handlers(
            PerlCleanupHandler => sub {
                for my $cleanup_handler (@{ $env->{'psgix.cleanup.handlers'} }) {
                    $cleanup_handler->($env);
                }

                if ($env->{'psgix.harakiri.commit'}) {
                    $r->child_terminate;
                }
            },
        );
    } else {
        if ($env->{'psgix.harakiri.commit'}) {
            $r->child_terminate;
        }
    }

    return Apache2::Const::OK;
}