From 6fc33d2b5bd84a3bfb1c8d393cf57e1081fcd623 Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sat, 31 Mar 2007 04:56:50 +0200 Subject: [PATCH] seperate modules for backend-specific code Split out initialization and other specifics for CGI and mod_perl (Apache). --- PLP.pm | 82 +++------------------------------------------------ PLP/Apache.pm | 43 +++++++++++++++++++++++++++ PLP/CGI.pm | 52 ++++++++++++++++++++++++++++++++ 3 files changed, 99 insertions(+), 78 deletions(-) create mode 100644 PLP/Apache.pm create mode 100644 PLP/CGI.pm diff --git a/PLP.pm b/PLP.pm index 8e6d188..2cb68ea 100644 --- a/PLP.pm +++ b/PLP.pm @@ -17,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 @@ -40,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 = (); @@ -123,16 +82,18 @@ sub error { # This is run by the CGI script. (#!perl \n use PLP; PLP::everything;) sub everything { + require PLP::CGI; clean(); - cgi_init(); + PLP::CGI::init(); start(); } # This is the mod_perl handler. sub handler { + require PLP::Apache; require Apache::Constants; clean(); - if (my $ret = mod_perl_init($_[0])) { + if (my $ret = PLP::Apache::init($_[0])) { return $ret; } #S start($_[0]); @@ -141,41 +102,6 @@ sub handler { 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(@_); -} - # Sends the headers waiting in %PLP::Script::header sub sendheaders () { $PLP::sentheaders ||= [ caller 1 ? (caller 1)[1, 2] : (caller)[1, 2] ]; diff --git a/PLP/Apache.pm b/PLP/Apache.pm new file mode 100644 index 0000000..217546f --- /dev/null +++ b/PLP/Apache.pm @@ -0,0 +1,43 @@ +package PLP::Apache; + +use strict; + +our $VERSION = '1.00'; + +# mod_perl initializer: returns 0 on success, Apache error code on failure +sub init { + our $r = shift; + + $PLP::print = 'PLP::Apache::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 print { + return unless grep length, @_; + PLP::sendheaders() unless $PLP::sentheaders; + $PLP::Apache::r->print(@_); +} + +1; + diff --git a/PLP/CGI.pm b/PLP/CGI.pm new file mode 100644 index 0000000..1e4d7de --- /dev/null +++ b/PLP/CGI.pm @@ -0,0 +1,52 @@ +package PLP::CGI; + +use strict; + +our $VERSION = '1.00'; + +# CGI initializer: parses PATH_TRANSLATED +sub 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 is run by the CGI script. (#!perl \n use PLP; PLP::everything;) +#sub everything { +# clean(); +# cgi_init(); +# start(); +#} + +1; + -- 2.30.0