X-Git-Url: http://git.shiar.nl/perl/plp/.git/blobdiff_plain/27b0c16f2bdec1feb77ff34f6dd3aaca9a0fb6f3..52b63e9e0c0e3d3019a2751158f59cae036b6fe4:/PLP.pm diff --git a/PLP.pm b/PLP.pm index fd9b262..5899af3 100644 --- a/PLP.pm +++ b/PLP.pm @@ -10,7 +10,6 @@ use PLP::Tie::Print; use File::Basename (); use File::Spec; -#use Cwd (); use strict; @@ -18,13 +17,10 @@ our $VERSION = '3.19'; # Subs in this package: # _default_error($plain, $html) Default error handler -# cgi_init Initialization for CGI # clean Reset variables # error($error, $type) Handle errors # everything Do everything: CGI # handler($r) Do everything: mod_perl -# mod_perl_init($r) Initialization for mod_perl -# mod_perl_print Faster printing for mod_perl # sendheaders Send headers # source($path, $level, $linespec) Read and parse .plp files # start Start the initialized PLP script @@ -41,44 +37,6 @@ sub _default_error { qq{Debug information:
$html}; } -# CGI initializer: parses PATH_TRANSLATED -sub cgi_init { - - $PLP::print = 'print'; - - my $path = $ENV{PATH_TRANSLATED}; - $ENV{PLP_NAME} = $ENV{PATH_INFO}; - my $path_info; - while (not -f $path) { - if (not $path =~ s/(\/+[^\/]*)$//) { - print STDERR "PLP: Not found: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n"; - PLP::error(undef, 404); - exit; - } - my $pi = $1; - $ENV{PLP_NAME} =~ s/\Q$pi\E$//; - $path_info = $pi . $path_info; - } - - if (not -r $path) { - print STDERR "PLP: Can't read: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n"; - PLP::error(undef, 403); - exit; - } - - delete @ENV{ - qw(PATH_TRANSLATED SCRIPT_NAME SCRIPT_FILENAME PATH_INFO), - grep /^REDIRECT_/, keys %ENV - }; - - $ENV{PATH_INFO} = $path_info if defined $path_info; - $ENV{PLP_FILENAME} = $path; - my ($file, $dir) = File::Basename::fileparse($path); - chdir $dir; - - $PLP::code = PLP::source($file, 0, undef, $path); -} - # This cleans up from previous requests, and sets the default $PLP::DEBUG sub clean { @PLP::END = (); @@ -86,7 +44,6 @@ sub clean { $PLP::sentheaders = 0; $PLP::DEBUG = 1; $PLP::print = ''; - $PLP::r = undef; delete @ENV{ grep /^PLP_/, keys %ENV }; } @@ -122,59 +79,14 @@ sub error { } } -# This is run by the CGI script. (#!perl \n use PLP; PLP::everything;) +# Wrap old request handlers. sub everything { - clean(); - cgi_init(); - start(); + require PLP::CGI; + PLP::CGI::everything(); } - -# This is the mod_perl handler. sub handler { - require Apache::Constants; - clean(); - if (my $ret = mod_perl_init($_[0])) { - return $ret; - } - #S start($_[0]); - start(); - no strict 'subs'; - return Apache::Constants::OK(); -} - -# mod_perl initializer: returns 0 on success, Apache error code on failure -sub mod_perl_init { - our $r = shift; - - $PLP::print = 'PLP::mod_perl_print'; - - $ENV{PLP_FILENAME} = my $filename = $r->filename; - - unless (-f $filename) { - return Apache::Constants::NOT_FOUND(); - } - unless (-r _) { - return Apache::Constants::FORBIDDEN(); - } - - $ENV{PLP_NAME} = $r->uri; - - our $use_cache = $r->dir_config('PLPcache') !~ /^off$/i; -#S our $use_safe = $r->dir_config('PLPsafe') =~ /^on$/i; - my $path = $r->filename(); - my ($file, $dir) = File::Basename::fileparse($path); - chdir $dir; - - $PLP::code = PLP::source($file, 0, undef, $path); - - return 0; # OK -} - -# FAST printing under mod_perl -sub mod_perl_print { - return unless grep length, @_; - PLP::sendheaders() unless $PLP::sentheaders; - $PLP::r->print(@_); + require PLP::Apache; + PLP::Apache::handler(@_); } # Sends the headers waiting in %PLP::Script::header @@ -352,7 +264,7 @@ PLP - Perl in HTML pages SetHandler perl-script - PerlHandler PLP + PerlHandler PLP::Apache PerlSendHeader On PerlSetVar PLPcache On @@ -368,8 +280,8 @@ PLP - Perl in HTML pages =item * /foo/bar/plp.cgi (local filesystem address) #!/usr/bin/perl - use PLP; - PLP::everything(); + use PLP::CGI; + PLP::CGI::everything(); =item * httpd.conf (for CGI setup)