1package Plack::Handler::Apache1;
2use strict;
3use Apache::Request;
4use Apache::Constants qw(:common :response);
5
6use Plack::Util;
7use Scalar::Util;
8
9my %apps; # psgi file to $app mapping
10
11sub new { bless {}, shift }
12
13sub preload {
14    my $class = shift;
15    for my $app (@_) {
16        $class->load_app($app);
17    }
18}
19
20sub load_app {
21    my($class, $app) = @_;
22    return $apps{$app} ||= do {
23        # Trick Catalyst, CGI.pm, CGI::Cookie and others that check
24        # for $ENV{MOD_PERL}.
25        #
26        # Note that we delete it instead of just localizing
27        # $ENV{MOD_PERL} because some users may check if the key
28        # exists, and we do it this way because "delete local" is new
29        # in 5.12:
30        # http://perldoc.perl.org/5.12.0/perldelta.html#delete-local
31        local $ENV{MOD_PERL};
32        delete $ENV{MOD_PERL};
33
34        Plack::Util::load_psgi $app;
35    };
36}
37
38sub handler {
39    my $class = __PACKAGE__;
40    my $r     = shift;
41    my $psgi  = $r->dir_config('psgi_app');
42    $class->call_app($r, $class->load_app($psgi));
43}
44
45sub call_app {
46    my ($class, $r, $app) = @_;
47
48    $r->subprocess_env; # let Apache create %ENV for us :)
49
50    my $env = {
51        %ENV,
52        'psgi.version'        => [ 1, 1 ],
53        'psgi.url_scheme'     => ($ENV{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http',
54        'psgi.input'          => $r,
55        'psgi.errors'         => *STDERR,
56        'psgi.multithread'    => Plack::Util::FALSE,
57        'psgi.multiprocess'   => Plack::Util::TRUE,
58        'psgi.run_once'       => Plack::Util::FALSE,
59        'psgi.streaming'      => Plack::Util::TRUE,
60        'psgi.nonblocking'    => Plack::Util::FALSE,
61        'psgix.harakiri'      => Plack::Util::TRUE,
62    };
63
64    if (defined(my $HTTP_AUTHORIZATION = $r->headers_in->{Authorization})) {
65        $env->{HTTP_AUTHORIZATION} = $HTTP_AUTHORIZATION;
66    }
67
68    my $vpath    = $env->{SCRIPT_NAME} . ($env->{PATH_INFO} || '');
69
70    my $location = $r->location || "/";
71       $location =~ s{/$}{};
72    (my $path_info = $vpath) =~ s/^\Q$location\E//;
73
74    $env->{SCRIPT_NAME} = $location;
75    $env->{PATH_INFO}   = $path_info;
76
77    my $res = $app->($env);
78
79    if (ref $res eq 'ARRAY') {
80        _handle_response($r, $res);
81    }
82    elsif (ref $res eq 'CODE') {
83        $res->(sub {
84            _handle_response($r, $_[0]);
85        });
86    }
87    else {
88        die "Bad response $res";
89    }
90
91    if ($env->{'psgix.harakiri.commit'}) {
92        $r->child_terminate;
93    }
94
95    return OK;
96}
97
98sub _handle_response {
99    my ($r, $res) = @_;
100    my ($status, $headers, $body) = @{ $res };
101
102    my $hdrs = ($status >= 200 && $status < 300)
103        ? $r->headers_out : $r->err_headers_out;
104
105    Plack::Util::header_iter($headers, sub {
106        my($h, $v) = @_;
107        if (lc $h eq 'content-type') {
108            $r->content_type($v);
109        } else {
110            $hdrs->add($h => $v);
111        }
112    });
113
114    $r->status($status);
115    $r->send_http_header;
116
117    if (defined $body) {
118        if (Plack::Util::is_real_fh($body)) {
119            $r->send_fd($body);
120        } else {
121            Plack::Util::foreach($body, sub { $r->print(@_) });
122        }
123    }
124    else {
125        return Plack::Util::inline_object
126            write => sub { $r->print(@_) },
127            close => sub { };
128    }
129}
130
1311;
132
133__END__
134
135
136=head1 NAME
137
138Plack::Handler::Apache1 - Apache 1.3.x mod_perl handlers to run PSGI application
139
140=head1 SYNOPSIS
141
142  <Location />
143  SetHandler perl-script
144  PerlHandler Plack::Handler::Apache1
145  PerlSetVar psgi_app /path/to/app.psgi
146  </Location>
147
148  <Perl>
149  use Plack::Handler::Apache1;
150  Plack::Handler::Apache1->preload("/path/to/app.psgi");
151  </Perl>
152
153=head1 DESCRIPTION
154
155This is a mod_perl handler module to run any PSGI application with mod_perl on Apache 1.3.x.
156
157If you want to run PSGI applications I<behind> Apache instead of using
158mod_perl, see L<Plack::Handler::FCGI> to run with FastCGI, or use
159standalone HTTP servers such as L<Starman> or L<Starlet> proxied with
160mod_proxy.
161
162=head1 AUTHOR
163
164Aaron Trevena
165
166Tatsuhiko Miyagawa
167
168=head1 SEE ALSO
169
170L<Plack>
171
172=cut
173
174