X-Git-Url: http://git.shiar.net/perl/plp/.git/blobdiff_plain/693387f6e6cf5efde73b10242253bb38baf1612a..d7fd5b9d9c2a137d73f2c42751011503ec96dd37:/PLP.pm?ds=inline
diff --git a/PLP.pm b/PLP.pm
index c78af41..2cb68ea 100644
--- a/PLP.pm
+++ b/PLP.pm
@@ -1,6 +1,6 @@
package PLP;
-use v5.6;
+use 5.006;
use PLP::Functions ();
use PLP::Fields;
@@ -10,296 +10,255 @@ use PLP::Tie::Print;
use File::Basename ();
use File::Spec;
-use Cwd ();
use strict;
-our $VERSION = '3.15';
+our $VERSION = '3.19';
-# subs in this package:
-# sendheaders Send headers
-# source($path, $level, $linespec) Read and parse .plp files
-# error($error, $type) Handle errors
+# Subs in this package:
# _default_error($plain, $html) Default error handler
# clean Reset variables
-# cgi_init Initialization for CGI
-# mod_perl_init($r) Initialization for mod_perl
-# start Start the initialized PLP script
+# 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
-# Sends the headers waiting in %PLP::Script::header
-sub sendheaders () {
- our $sentheaders = 1;
- print STDOUT "Content-Type: text/plain\n\n" if $PLP::DEBUG & 2;
- print STDOUT map("$_: $PLP::Script::header{$_}\n", keys %PLP::Script::header), "\n";
+# This gets referenced as the initial $PLP::ERROR
+sub _default_error {
+ my ($plain, $html) = @_;
+ print qq{
},
+ qq{Debug information: $html |
};
}
-{
- 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) = @_;
- # $file is displayed, $path is used. $path is constructed from $file if
- # not given.
- $level = 0 if not defined $level;
- $linespec = '1' if not 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];};
- }
-
- our ($inA, $inB, $use_cache);
- $path ||= File::Spec->rel2abs($file);
-
- my $source_start = $level
- ? qq/\cQ;\n#line 1 "$file"\nprint q\cQ/
- : qq/\n#line 1 "$file"\nprint 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 = '';
-
- local *SOURCE;
- 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 =