# Not to be used without the CGI script;
-our $VERSION = '3.00';
+our $VERSION = '3.01';
use PLP::Functions ();
use PLP::Fields;
};
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
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 = <SOURCE>)) {
$linenr++;
for (;;) {
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{<table border=1 class="PLPerror"><tr><td>},
+ qq{<span><b>Debug information:</b><BR>$error</td></tr></table>};
+ } 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{<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">\n},
+ "<html><head>\n<title>--$type $short</title>\n</head></body>\n",
+ "<h1>$short</h1>\n$long<p>\n<hr>\n$ENV{SERVER_SIGNATURE}</body></html>";
+ }
+}
+
1;
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 ($) {
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);
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;
}
}
}
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;
}
}
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
- ? ("<hr><b>Debug</b><br>", Entity($@))
- : ("[Debug]\n", $@);
- }
}