From: Juerd Waalboer Date: Wed, 10 Apr 2002 07:50:25 +0000 (+0000) Subject: v3.01 release X-Git-Tag: 3.06~5 X-Git-Url: http://git.shiar.net/perl/plp/.git/commitdiff_plain/6fb22c399428a8e7cac088cab5603e75a87016fa v3.01 release --- diff --git a/PLP.pm b/PLP.pm index 7d3bf99..704870c 100644 --- a/PLP.pm +++ b/PLP.pm @@ -2,7 +2,7 @@ package PLP; # Not to be used without the CGI script; -our $VERSION = '3.00'; +our $VERSION = '3.01'; use PLP::Functions (); use PLP::Fields; @@ -17,7 +17,9 @@ sub SendHeaders () { }; sub source { - my ($path, $level) = @_; + my ($path, $level, $linespec) = @_; + $level = 0 if not defined $level; + $linespec = '1' if not defined $linespec; our ($inA, $inB); (my $file = $path) =~ s[.*/][]; my $source = $level @@ -27,7 +29,7 @@ sub source { local *SOURCE; open SOURCE, $path or return $level ? qq{\cQ; die qq[Can't open "\Q$path\E" (\Q$!\E)]; print q\cQ} - : qq{\ndie qq[Can't open "\Q$path\e" (\Q$!\E)];}; + : qq{\n#line $linespec\ndie qq[Can't open "\Q$path\E" (\Q$!\E)];}; LINE: while (defined (my $line = )) { $linenr++; for (;;) { @@ -68,5 +70,25 @@ sub source { return $source; } +sub error { + my ($error, $type) = @_; + if (not defined $type or $type < 100) { + PLP::sendheaders unless $PLP::sentheaders; + $error =~ s/([<&>])/'&#' . ord($1) . ';'/ge; + print qq{
}, + qq{Debug information:
$error
}; + } else { + select STDOUT; + my ($short, $long) = @{ +{ + 404 => [ 'Not Found', "The requested URL $ENV{REQUEST_URI} was not found on this server." ], + 403 => [ 'Forbidden', "You don't have permission to access $ENV{REQUEST_URI} on this server." ], + }->{$type} }; + print "Status: $type\nContent-Type: text/html\n\n", + qq{\n}, + "\n--$type $short\n\n", + "

$short

\n$long

\n

\n$ENV{SERVER_SIGNATURE}"; + } +} + 1; diff --git a/PLP/Functions.pm b/PLP/Functions.pm index 9d7b33c..99aa27b 100644 --- a/PLP/Functions.pm +++ b/PLP/Functions.pm @@ -8,10 +8,13 @@ our @EXPORT = qw/HiddenFields Entity DecodeURI EncodeURI Entity include AddCookie ReadFile WriteFile AutoURL Counter Include/; sub Include ($) { - my ($file) = $_[0]; + no strict; + $PLP::file = $_[0]; $PLP::inA = 0; $PLP::inB = 0; - eval PLP::source($file, 0); + local $@; + eval 'package PLP::Script; ' . PLP::source($PLP::file, 0, join ' ', (caller)[2,1]); + PLP::error($@, 1) if $@; } sub include ($) { diff --git a/plp.cgi b/plp.cgi index 6dbcee9..85d8210 100755 --- a/plp.cgi +++ b/plp.cgi @@ -2,7 +2,7 @@ use v5.6.0; use PLP; -die 'Wrong module version' if $PLP::VERSION ne '3.00'; +die 'Wrong module version' if $PLP::VERSION ne '3.01'; use vars qw($DEBUG); @@ -23,15 +23,14 @@ our $mod_perl = exists $ENV{MOD_PERL}; my $path_info; while (not -f $file) { if (not $file =~ s/(\/+[^\/]*)$//) { - $ENV{REDIRECT_STATUS} = '404'; - print STDERR "PLP: Not found: $file\n"; + print STDERR "PLP: Not found: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\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}"; + PLP::error(undef, 404); exit; } } @@ -45,11 +44,12 @@ our $mod_perl = exists $ENV{MOD_PERL}; } if (not -r $file) { + print STDERR "PLP: Can't read: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n"; if (exists $ENV{MOD_PERL}) { print STDOUT "Status: 403 Forbidden"; Apache::exit(); } else { - print STDOUT "Status: 403 Forbidden\n\nForbidden: $ENV{REQUEST_URI}"; + PLP::error(undef, 403); exit; } } @@ -79,13 +79,9 @@ our $mod_perl = exists $ENV{MOD_PERL}; PLP::Functions->import(); eval qq{package PLP::Script; $PLP::code}; } + PLP::error($@, 1) if $@; 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", $@); - } }