v3.04 release

[perl/plp/.git] / PLP.pm

diff --git a/PLP.pm b/PLP.pm
index ad4a227883f34ce1f863fa74baa5a22be5b31bd0..52fba51c64b72c8b472fb854a1754fe35aa1f6c2 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.03';
+our $VERSION = '3.04';
 
 use PLP::Functions ();
 use PLP::Fields;
@@ -101,10 +101,11 @@ sub source {
 sub error {
     my ($error, $type) = @_;
     if (not defined $type or $type < 100) {
+       return undef unless $PLP::DEBUG & 1;
+       my $plain = $error;
+       (my $html = $plain) =~ s/([<&>])/'&#' . ord($1) . ';'/ge;
        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>};
+       $PLP::ERROR->($plain, $html);
     } else {
        select STDOUT;
        my ($short, $long) = @{ +{
@@ -118,6 +119,12 @@ sub error {
     }
 }
 
+sub _default_error {
+    my ($plain, $html) = @_; 
+    print qq{<table border=1 class="PLPerror"><tr><td>},
+         qq{<span><b>Debug information:</b><BR>$html</td></tr></table>};
+}
+
 sub start {
     my $file = $ENV{PATH_TRANSLATED};
     $ENV{PLP_NAME} = $ENV{PATH_INFO};
@@ -166,8 +173,10 @@ sub start {
     chdir $dir;
 
     $PLP::code = PLP::source($file, 0);
+
     tie *PLPOUT, 'PLP::Tie::Print';
     select PLPOUT;
+    $PLP::ERROR = \&_default_error;
 }
 
 1;