git.shiar.nl / perl / plp / .git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 0f5e78a)
v3.01 release
authorJuerd Waalboer <juerd@cpan.org>
Wed, 10 Apr 2002 07:50:25 +0000 (07:50 +0000)
committerMischa POSLAWSKY <perl@shiar.org>
Tue, 18 Mar 2008 08:21:41 +0000 (08:21 +0000)
PLP.pm patch | blob | history
PLP/Functions.pm patch | blob | history
plp.cgi patch | blob | history

diff --git a/PLP.pm b/PLP.pm
index 7d3bf99f5a3ba97d1f14fa1539664d5f936f4a89..704870c8f697fc5557d3f09e3c8d63b8e6892168 100644 (file)
--- 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 = <SOURCE>)) {
        $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{<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;
 
diff --git a/PLP/Functions.pm b/PLP/Functions.pm
index 9d7b33c1c5d3a1a229e50dd1aa08e8d234dbb359..99aa27b1ffc1dd12a19fca30a8c2fe52dfb5a20a 100644 (file)
--- 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 6dbcee9f01abdd30336a0738f27d2e86b5d91c6b..85d82100b55441ddd7ff00fd5437413f1fc79172 100755 (executable)
--- 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
-             ? ("<hr><b>Debug</b><br>", Entity($@))
-             : ("[Debug]\n", $@);
-    }
 }
 
PLP - Perl in HTML pages