PLP
view release on metacpan or search on metacpan
qq{<b>Debug information:</b><br>$html</td></tr></table>};
}
# 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{<!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";
print $ENV{SERVER_SIGNATURE} if $ENV{SERVER_SIGNATURE};
print "</body></html>";
}
}
# Wrap old request handlers.
sub everything {
require PLP::Backend::CGI;
PLP::Backend::CGI->everything();
}
sub handler {
require PLP::Backend::Apache;
PLP::Backend::Apache::handler(@_);
}
# Sends the headers waiting in %PLP::Script::header
sub sendheaders () {
local $\; # reset print behaviour if triggered by say()
$PLP::sentheaders ||= [ caller 1 ? (caller 1)[1, 2] : (caller)[1, 2] ];
print STDOUT "Content-Type: text/plain\n\n" if $PLP::DEBUG & 2;
while (my ($header, $values) = each %PLP::Script::header) {
print STDOUT "$header: $_\n" for split /\n/, $values;
}
print STDOUT "\n";
}
{
my %cached; # Conceal cached sources: ( path => [ [ deps ], source, -M ] )
# Given a filename and optional level (level should be 0 if the caller isn't
# source() itself), and optional linespec (used by PLP::Functions::Include),
# this function parses a PLP file and returns Perl code, ready to be eval'ed
sub source {
my ($file, $level, $linespec, $path) = @_;
our $use_cache;
# $file is displayed, $path is used. $path is constructed from $file if
# not given.
$level = 0 unless defined $level;
$linespec = '1' unless defined $linespec;
if ($level > 128) {
%cached = ();
return $level
? qq{\cQ; die qq[Include recursion detected]; print q\cQ}
: qq{\n#line $linespec\ndie qq[Include recursion detected];};
}
my $in_block = 0; # 1 => "<:", 2 => "<:="
$path ||= File::Spec->rel2abs($file);
my $source_start = $level
? qq/\cQ;\n#line 1 "$file"\n$PLP::print q\cQ/
: qq/\n#line 1 "$file"\n$PLP::print q\cQ/;
if ($use_cache and exists $cached{$path}) {
BREAKOUT: {
my @checkstack = ($path);
my $item;
my %checked;
while (defined(my $item = shift @checkstack)) {
next if $checked{$item};
last BREAKOUT if $cached{$item}[2] > -M $item;
$checked{$item} = 1;
push @checkstack, @{ $cached{$item}[0] }
if @{ $cached{$item}[0] };
}
return $level
? $source_start . $cached{$path}[1]
: $source_start . $cached{$path}[1] . "\cQ";
}
}
$cached{$path} = [ [ ], undef, undef ] if $use_cache;
my $linenr = 0;
my $source = '';
( run in 1.160 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )