X-Git-Url: http://git.shiar.nl/perl/plp/.git/blobdiff_plain/a5521fb1820cc67ab3d7c0fe728ef36b0b379a3f..2a96ba1295fd6613aefec51be9efa0fa443fb29d:/PLP.pm diff --git a/PLP.pm b/PLP.pm index 6fa79be..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,65 +17,24 @@ 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 # The _init subs do the following: # Set $PLP::code to the initial code -# Set $ENV{PLP_*} and makes PATH_INFO if needed +# Set $ENV{PLP_*} and make PATH_INFO if needed # Change the CWD # This gets referenced as the initial $PLP::ERROR sub _default_error { my ($plain, $html) = @_; print qq{
}, - 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); + qq{Debug information:
$html}; } # This cleans up from previous requests, and sets the default $PLP::DEBUG @@ -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) @@ -422,7 +334,7 @@ Includes a dynamic expression in your document. The expression is evaluated in list context. Please note that the expression should not end a statement: avoid semi-colons. No whitespace may be between C<< <: >> and the equal sign. -C<< foo <:= $bar :> $baz >> is like C<< <: print 'foo ', $bar, ' baz'; :> >>. +C<< foo <:= $bar :> $baz >> is like C<< <: print 'foo ', $bar, ' $baz'; :> >>. =item C<< <(filename)> >> @@ -513,7 +425,7 @@ else. Because the interpreter that mod_perl uses never ends, C blocks won't work properly. You should use C instead. Note that this is a not a built-in construct, so it needs proper termination with a semi-colon (as do - and ). +C and C). Under mod_perl, modules are loaded only once. A good modular design can improve performance because of this, but you will have to B the modules