git.shiar.nl
/
perl
/
plp
/
.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
v3.06 release
[perl/plp/.git]
/
PLP.pm
diff --git
a/PLP.pm
b/PLP.pm
index 78e0dacf85f2db4e9eb9a4174c2ca16c59b0b871..03b5b92a69bd57583e43883b96b4e3ddea6fee2b 100644
(file)
--- a/
PLP.pm
+++ b/
PLP.pm
@@
-2,7
+2,7
@@
package PLP;
# Not to be used without the CGI script;
# Not to be used without the CGI script;
-our $VERSION = '3.0
2
';
+our $VERSION = '3.0
6
';
use PLP::Functions ();
use PLP::Fields;
use PLP::Functions ();
use PLP::Fields;
@@
-55,7
+55,7
@@
sub source {
: qq/\n#line 1 "$file"\nprint q\cQ/;
my $linenr = 0;
local *SOURCE;
: qq/\n#line 1 "$file"\nprint q\cQ/;
my $linenr = 0;
local *SOURCE;
- open SOURCE, $path or return $level
+ open SOURCE,
'<',
$path or return $level
? qq{\cQ; die qq[Can't open "\Q$path\E" (\Q$!\E)]; print q\cQ}
: qq{\n#line $linespec\ndie qq[Can't open "\Q$path\E" (\Q$!\E)];};
LINE: while (defined (my $line = <SOURCE>)) {
? qq{\cQ; die qq[Can't open "\Q$path\E" (\Q$!\E)]; print q\cQ}
: qq{\n#line $linespec\ndie qq[Can't open "\Q$path\E" (\Q$!\E)];};
LINE: while (defined (my $line = <SOURCE>)) {
@@
-101,10
+101,11
@@
sub source {
sub error {
my ($error, $type) = @_;
if (not defined $type or $type < 100) {
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;
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) = @{ +{
} 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};
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);
chdir $dir;
$PLP::code = PLP::source($file, 0);
+
tie *PLPOUT, 'PLP::Tie::Print';
select PLPOUT;
tie *PLPOUT, 'PLP::Tie::Print';
select PLPOUT;
+ $PLP::ERROR = \&_default_error;
}
1;
}
1;