package PLP;
use 5.006;
use PLP::Functions ();
use PLP::Fields;
use PLP::Tie::Headers;
use PLP::Tie::Delay;
use PLP::Tie::Print;
use File::Basename ();
use File::Spec;
use strict;
use warnings;
our $VERSION = '3.23';
# Subs in this package:
# _default_error($plain, $html) Default error handler
# clean Reset variables
# error($error, $type) Handle errors
# everything Do everything: CGI
# handler($r) Do everything: mod_perl
# sendheaders Send headers
# source($path, $level, $linespec) Read and parse .plp files
# start Start the initialized PLP script
# The _init subs do the following:
# Set $PLP::code to the initial code
# Set $ENV{PLP_*} and make PATH_INFO if needed
# Change the CWD
# This gets referenced as the initial $PLP::ERROR
sub _default_error {
my ($plain, $html) = @_;
print qq{
},
qq{Debug information: $html
};
}
# This cleans up from previous requests, and sets the default $PLP::DEBUG
sub clean {
@PLP::END = ();
$PLP::code = '';
$PLP::sentheaders = 0;
$PLP::DEBUG = 1;
$PLP::print = '';
delete @ENV{ grep /^PLP_/, keys %ENV };
}
# Handles errors, uses subref $PLP::ERROR (default: \&_default_error)
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::ERROR->($plain, $html);
} 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";
print $ENV{SERVER_SIGNATURE} if $ENV{SERVER_SIGNATURE};
print "