#!/usr/local/bin/perl use v5.6.0; use PLP; die 'Wrong module version' if $PLP::VERSION ne '3.00'; use vars qw($DEBUG); use strict; { $PLP::code = ''; $PLP::sentheaders = 0; $PLP::inA = 0; $PLP::inB = 0; } $DEBUG = 1; our $mod_perl = exists $ENV{MOD_PERL}; { my $file = $ENV{PATH_TRANSLATED}; $ENV{PLP_NAME} = $ENV{PATH_INFO}; my $path_info; while (not -f $file) { if (not $file =~ s/(\/+[^\/]*)$//) { $ENV{REDIRECT_STATUS} = '404'; print STDERR "PLP: Not found: $file\n"; if ($mod_perl) { Apache->request->uri($ENV{REQUEST_URI}); print STDOUT "Status: 404 Not Found"; Apache::exit(); } else { print STDOUT "Status: 404 Not Found\n\nNot found: $ENV{REQUEST_URI}"; exit; } } my $pi = $1; $ENV{PLP_NAME} =~ s/\Q$pi\E$//; $path_info = $pi . $path_info; } if ($mod_perl) { Apache->request->uri($ENV{REQUEST_URI}); } if (not -r $file) { if (exists $ENV{MOD_PERL}) { print STDOUT "Status: 403 Forbidden"; Apache::exit(); } else { print STDOUT "Status: 403 Forbidden\n\nForbidden: $ENV{REQUEST_URI}"; 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} = $file; (my $dir = $file) =~ s{/[^/]+$}[]; chdir $dir; $PLP::code = PLP::source($file, 0); tie *PLPOUT, 'PLP::Tie::Print'; select PLPOUT; } { no strict; PLP::Fields::doit(); { package PLP::Script; *headers = \%header; *cookies = \%cookie; PLP::Functions->import(); eval qq{package PLP::Script; $PLP::code}; } select STDOUT; undef *{"PLP::Script::$_"} for keys %PLP::Script::; PLP::SendHeaders() unless $PLP::sentheaders; if ($@ && $DEBUG & 1){ print $header{'Content-Type'} =~ m!^text/html!i ? ("
Debug
", Entity($@)) : ("[Debug]\n", $@); } }