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