13 use File::Basename ();
19 our $VERSION = '3.15';
21 # subs in this package:
22 # sendheaders Send headers
23 # source($path, $level, $linespec) Read and parse .plp files
24 # error($error, $type) Handle errors
25 # _default_error($plain, $html) Default error handler
26 # clean Reset variables
27 # cgi_init Initialization for CGI
28 # mod_perl_init($r) Initialization for mod_perl
29 # start Start the initialized PLP script
30 # everything Do everything: CGI
31 # handler($r) Do everything: mod_perl
34 # Sends the headers waiting in %PLP::Script::header
37 print STDOUT "Content-Type: text/plain\n\n" if $PLP::DEBUG & 2;
38 print STDOUT map("$_: $PLP::Script::header{$_}\n", keys %PLP::Script::header), "\n";
41 # Given a filename and optional level (level should be 0 if the caller isn't
42 # source() itself), and optional linespec (used by PLP::Functions::Include),
43 # this function parses a PLP file and returns Perl code, ready to be eval'ed
45 my %cached; # Conceal cached sources
49 # [ dependency, dependency, dependency ], # <(...)>
56 my ($file, $level, $linespec, $path) = @_;
57 $level = 0 if not defined $level;
58 $linespec = '1' if not defined $linespec;
63 ? qq{\cQ; die qq[Include recursion detected]; print q\cQ}
64 : qq{\n#line $linespec\ndie qq[Include recursion detected];};
67 our ($inA, $inB, $use_cache);
68 $path ||= File::Spec->rel2abs($file);
70 my $source_start = $level
71 ? qq/\cQ;\n#line 1 "$file"\nprint q\cQ/
72 : qq/\n#line 1 "$file"\nprint q\cQ/;
74 if ($use_cache and exists $cached{$path}) {
76 my @checkstack = ($path);
79 while (defined(my $item = shift @checkstack)) {
80 next if $checked{$item};
81 last BREAKOUT if $cached{$item}[2] > -M $item;
83 push @checkstack, @{ $cached{$item}[0] }
84 if @{ $cached{$item}[0] };
87 ? $source_start . $cached{$path}[1]
88 : $source_start . $cached{$path}[1] . "\cQ";
92 $cached{$path} = [ [ ], undef, undef ] if $use_cache;
98 open SOURCE, '<', $path or return $level
99 ? qq{\cQ; die qq[Can't open "\Q$path\E" (\Q$!\E)]; print q\cQ}
100 : qq{\n#line $linespec\ndie qq[Can't open "\Q$path\E" (\Q$!\E)];};
103 while (defined (my $line = <SOURCE>)) {
107 \G # Begin where left off
109 | <:=? | :> # PLP tags <:= ... :> <: ... :>
110 | <\(.*?\)> # Include tags <(...)>
111 | <[^:(][^<:]* # Normal text
112 | :[^>][^<:]* # Normal text
113 | [^<:]* # Normal text
116 next LINE unless length $1;
118 if ($part eq '<:=' and not $inA || $inB) {
121 } elsif ($part eq '<:' and not $inA || $inB) {
124 } elsif ($part eq ':>' and $inA) {
127 } elsif ($part eq ':>' and $inB) {
129 $source .= "; print q\cQ";
130 } elsif ($part =~ /^<\((.*?)\)>\z/ and not $inA || $inB) {
131 my $ipath = File::Spec->rel2abs($1);
132 $source .= source($1, $level + 1, undef, $ipath) .
133 qq/\cQ, \n#line $linenr "$file"\nq\cQ/;
134 push @{ $cached{$path}[0] }, $ipath;
136 $part =~ s/\\/\\\\/ if not $inA || $inB;
143 $cached{$path}[1] = $source;
144 $cached{$path}[2] = -M $path;
148 ? $source_start . $source
149 : $source_start . $source . "\cQ";
153 # Handles errors, uses the sub reference $PLP::ERROR that gets two arguments:
154 # the error message in plain text, and the error message with html entities
156 my ($error, $type) = @_;
157 if (not defined $type or $type < 100) {
158 return undef unless $PLP::DEBUG & 1;
160 (my $html = $plain) =~ s/([<&>])/'&#' . ord($1) . ';'/ge;
161 PLP::sendheaders unless $PLP::sentheaders;
162 $PLP::ERROR->($plain, $html);
165 my ($short, $long) = @{
169 "The requested URL $ENV{REQUEST_URI} was not found on this server."
173 "You don't have permission to access $ENV{REQUEST_URI} on this server."
177 print "Status: $type\nContent-Type: text/html\n\n",
178 qq{<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">\n},
179 "<html><head>\n<title>--$type $short</title>\n</head></body>\n",
180 "<h1>$short</h1>\n$long<p>\n<hr>\n$ENV{SERVER_SIGNATURE}</body></html>";
184 # This gets referenced as the initial $PLP::ERROR
186 my ($plain, $html) = @_;
187 print qq{<table border=1 class="PLPerror"><tr><td>},
188 qq{<span><b>Debug information:</b><BR>$html</td></tr></table>};
191 # This cleans up from previous requests, and sets the default $PLP::DEBUG
195 $PLP::sentheaders = 0;
199 delete @ENV{ grep /^PLP_/, keys %ENV };
202 # The *_init subs do the following:
203 # o Set $PLP::code to the initial code
204 # o Set $ENV{PLP_*} and makes PATH_INFO if needed
207 # This sub is meant for CGI requests only, and takes apart PATH_TRANSLATED
210 my $path = $ENV{PATH_TRANSLATED};
211 $ENV{PLP_NAME} = $ENV{PATH_INFO};
213 while (not -f $path) {
214 if (not $path =~ s/(\/+[^\/]*)$//) {
215 print STDERR "PLP: Not found: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
216 PLP::error(undef, 404);
220 $ENV{PLP_NAME} =~ s/\Q$pi\E$//;
221 $path_info = $pi . $path_info;
225 print STDERR "PLP: Can't read: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
226 PLP::error(undef, 403);
231 qw(PATH_TRANSLATED SCRIPT_NAME SCRIPT_FILENAME PATH_INFO),
232 grep { /^REDIRECT_/ } keys %ENV
235 $ENV{PATH_INFO} = $path_info if defined $path_info;
236 $ENV{PLP_FILENAME} = $path;
237 my ($file, $dir) = File::Basename::fileparse($path);
240 $PLP::code = PLP::source($file, 0, undef, $path);
243 # This is the mod_perl initializer.
244 # Returns 0 on success.
248 $ENV{PLP_FILENAME} = my $filename = $r->filename;
250 unless (-f $filename) {
251 return Apache::Constants::NOT_FOUND();
254 return Apache::Constants::FORBIDDEN();
257 $ENV{PLP_NAME} = $r->uri;
259 our $use_cache = $r->dir_config('PLPcache') !~ /^off$/i;
260 my $path = $r->filename();
261 my ($file, $dir) = File::Basename::fileparse($path);
264 $PLP::code = PLP::source($file, 0, undef, $path);
269 # Let the games begin!
270 # No lexicals may exist at this point.
273 tie *PLPOUT, 'PLP::Tie::Print';
275 $PLP::ERROR = \&_default_error;
280 use vars qw(%headers %header %cookies %cookie %get %post %fields);
283 PLP::Functions->import();
284 # No lexicals may exist at this point.
285 eval qq{ package PLP::Script; $PLP::code; };
286 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
287 eval { package PLP::Script; $_->() for reverse @PLP::END };
288 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
290 PLP::sendheaders() unless $PLP::sentheaders;
292 undef *{"PLP::Script::$_"} for keys %PLP::Script::;
293 # Symbol::delete_package('PLP::Script');
294 # The above does not work. TODO - find out why not.
297 # This is run by the CGI script.
298 # The CGI script is just:
308 # This is the mod_perl handler.
310 require Apache::Constants;
312 if (my $ret = mod_perl_init(shift)) {
317 return Apache::Constants::OK();
324 PLP - Perl in HTML pages
328 =head2 mod_perl installation
332 =item * httpd.conf (for mod_perl setup)
335 SetHandler perl-script
338 PerlSetVar PLPcache On
341 # Who said CGI was easier to set up? :)
345 =head2 CGI installation
349 =item * /foo/bar/plp.cgi (local filesystem address)
355 =item * httpd.conf (for CGI setup)
357 ScriptAlias /foo/bar/ /PLP_COMMON/
358 <Directory /foo/bar/>
364 AddHandler plp-document plp
365 Action plp-document /PLP_COMMON/plp.cgi
369 =head2 Test script (test.plp)
373 print "Hurrah, it works!<br>" for 1..10;
379 PLP is yet another Perl embedder, primarily for HTML documents. Unlike with
380 other Perl embedders, there is no need to learn a meta-syntax or object
381 model: one can just use the normal Perl constructs. PLP runs under mod_perl
382 for speeds comparable to those of PHP, but can also be run as a CGI script.
388 =item C<< <: perl_code(); :> >>
390 With C<< <: >> and C<< :> >>, you can add Perl code to your document. This is
391 what PLP is all about. All code outside of these tags is printed. It is
392 possible to mix perl language constructs with normal HTML parts of the document:
394 <: unless ($ENV{REMOTE_USER}) { :>
395 You are not logged in.
398 C<< :> >> always stops a code block, even when it is found in a string literal.
400 =item C<< <:= $expression :> >>
402 Includes a dynamic expression in your document. The expression is evaluated in
403 list context. Please note that the expression should not end a statement: avoid
404 semi-colons. No whitespace may be between C<< <: >> and the equal sign.
406 C<< foo <:= $bar :> $baz >> is like C<< <: print 'foo ', $bar, ' baz'; :> >>.
408 =item C<< <(filename)> >>
410 Includes another file before the PLP code is executed. The file is included
411 literally, so it shares lexical variables. Because this is a compile-time tag,
412 it's fast, but you can't use a variable as the filename. You can create
413 recursive includes, so beware! (PLP will catch simple recursion: the maximum
414 depth is 128.) Whitespace in the filename is not ignored so C<< <( foo.txt)> >>
415 includes the file named C< foo.txt>, including the space in its name. A
416 compile-time alternative is include(), which is described in L<PLP::Functions>.
422 These are described in L<PLP::Functions>.
430 The URI of the PLP document, without the query string. (Example: C</foo.plp>)
432 =item $ENV{PLP_FILENAME}
434 The filename of the PLP document. (Example: C</var/www/index.plp>)
442 Controls debugging output, and should be treated as a bitmask. The least
443 significant bit (1) controls if run-time error messages are reported to the
444 browser, the second bit (2) controls if headers are sent twice, so they get
445 displayed in the browser. A value of 3 means both features are enabled. The
450 Contains a reference to the code that is used to report run-time errors. You
451 can override this to have it in your own design, and you could even make it
452 report errors by e-mail. The sub reference gets two arguments: the error message
453 as plain text and the error message with special characters encoded with HTML
456 =item %header, %cookie, %get, %post, %fields
458 These are described in L<PLP::Fields>.
462 =head2 (mod_perl only) PerlSetVar configuration directives
468 Sets caching B<On>/B<Off>. When caching, PLP saves your script in memory and
469 doesn't re-read and re-parse it if it hasn't changed. PLP will use more memory,
470 but will also run 50% faster.
472 B<On> is default, anything that isn't =~ /^off$/i is considered On.
476 =head2 Things that you should know about
478 Not only syntax is important, you should also be aware of some other important
479 features. Your script runs inside the package C<PLP::Script> and shouldn't
480 leave it. This is because when your script ends, all global variables in the
481 C<PLP::Script> package are destroyed, which is very important if you run under
482 mod_perl (they would retain their values if they weren't explicitly destroyed).
484 Until your first output, you are printing to a tied filehandle C<PLPOUT>. On
485 first output, headers are sent to the browser and C<STDOUT> is selected for
486 efficiency. To set headers, you must assign to C<$header{ $header_name}> before
487 any output. This means the opening C<< <: >> have to be the first characters in
488 your document, without any whitespace in front of them. If you start output and
489 try to set headers later, an error message will appear telling you on which
490 line your output started.
492 Because the interpreter that mod_perl uses never ends, C<END { }> blocks won't
493 work properly. You should use C<PLP_END { };> instead. Note that this is a not
494 a built-in construct, so it needs proper termination with a semi-colon (as do
497 Under mod_perl, modules are loaded only once. A good modular design can improve
498 performance because of this, but you will have to B<reload> the modules
499 yourself when there are newer versions.
501 The special hashes are tied hashes and do not always behave the way you expect,
502 especially when mixed with modules that expect normal CGI environments, like
503 CGI.pm. Read L<PLP::Fields> for information more about this.
507 A lot of questions are asked often, so before asking yours, please read the
512 No warranty, no guarantees. Use PLP at your own risk, as I disclaim all
517 Juerd Waalboer <juerd@juerd.nl>
521 L<PLP::Functions>, L<PLP::Fields>, L<PLP::FAQ>