11 use File::Basename ();
17 our $VERSION = '3.22_02';
19 # Subs in this package:
20 # _default_error($plain, $html) Default error handler
21 # clean Reset variables
22 # error($error, $type) Handle errors
23 # everything Do everything: CGI
24 # handler($r) Do everything: mod_perl
25 # sendheaders Send headers
26 # source($path, $level, $linespec) Read and parse .plp files
27 # start Start the initialized PLP script
29 # The _init subs do the following:
30 # Set $PLP::code to the initial code
31 # Set $ENV{PLP_*} and make PATH_INFO if needed
34 # This gets referenced as the initial $PLP::ERROR
36 my ($plain, $html) = @_;
37 print qq{<table border=1 class="PLPerror"><tr><td>},
38 qq{<b>Debug information:</b><br>$html</td></tr></table>};
41 # This cleans up from previous requests, and sets the default $PLP::DEBUG
45 $PLP::sentheaders = 0;
48 delete @ENV{ grep /^PLP_/, keys %ENV };
51 # Handles errors, uses subref $PLP::ERROR (default: \&_default_error)
53 my ($error, $type) = @_;
54 if (not defined $type or $type < 100) {
55 return undef unless $PLP::DEBUG & 1;
57 (my $html = $plain) =~ s/([<&>])/'&#' . ord($1) . ';'/ge;
58 PLP::sendheaders() unless $PLP::sentheaders;
59 $PLP::ERROR->($plain, $html);
62 my ($short, $long) = @{
66 "The requested URL $ENV{REQUEST_URI} was not found " .
71 "You don't have permission to access $ENV{REQUEST_URI} " .
76 print "Status: $type\nContent-Type: text/html\n\n",
77 qq{<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">\n<html>},
78 "<head>\n<title>$type $short</title>\n</head></body>\n<h1>$short",
79 "</h1>\n$long<p>\n<hr>\n";
80 print $ENV{SERVER_SIGNATURE} if $ENV{SERVER_SIGNATURE};
81 print "</body></html>";
85 # Wrap old request handlers.
87 require PLP::Backend::CGI;
88 PLP::Backend::CGI->everything();
91 require PLP::Backend::Apache;
92 PLP::Backend::Apache::handler(@_);
95 # Sends the headers waiting in %PLP::Script::header
97 $PLP::sentheaders ||= [ caller 1 ? (caller 1)[1, 2] : (caller)[1, 2] ];
98 print STDOUT "Content-Type: text/plain\n\n" if $PLP::DEBUG & 2;
99 while (my ($header, $values) = each %PLP::Script::header) {
100 print STDOUT "$header: $_\n" for split /\n/, $values;
106 my %cached; # Conceal cached sources: ( path => [ [ deps ], source, -M ] )
108 # Given a filename and optional level (level should be 0 if the caller isn't
109 # source() itself), and optional linespec (used by PLP::Functions::Include),
110 # this function parses a PLP file and returns Perl code, ready to be eval'ed
112 my ($file, $level, $linespec, $path) = @_;
115 # $file is displayed, $path is used. $path is constructed from $file if
118 $level = 0 unless defined $level;
119 $linespec = '1' unless defined $linespec;
124 ? qq{\cQ; die qq[Include recursion detected]; print q\cQ}
125 : qq{\n#line $linespec\ndie qq[Include recursion detected];};
128 my $in_block = 0; # 1 => "<:", 2 => "<:="
130 $path ||= File::Spec->rel2abs($file);
132 my $source_start = $level
133 ? qq/\cQ;\n#line 1 "$file"\n$PLP::print q\cQ/
134 : qq/\n#line 1 "$file"\n$PLP::print q\cQ/;
136 if ($use_cache and exists $cached{$path}) {
138 my @checkstack = ($path);
141 while (defined(my $item = shift @checkstack)) {
142 next if $checked{$item};
143 last BREAKOUT if $cached{$item}[2] > -M $item;
145 push @checkstack, @{ $cached{$item}[0] }
146 if @{ $cached{$item}[0] };
149 ? $source_start . $cached{$path}[1]
150 : $source_start . $cached{$path}[1] . "\cQ";
154 $cached{$path} = [ [ ], undef, undef ] if $use_cache;
160 open SOURCE, '<', $path or return $level
161 ? qq{\cQ; die qq[Can't open "\Q$path\E" (\Q$!\E)]; print q\cQ}
162 : qq{\n#line $linespec\ndie qq[Can't open "\Q$path\E" (\Q$!\E)];};
165 while (defined (my $line = <SOURCE>)) {
169 \G # Begin where left off
171 | <:=? | :> # PLP tags <:= ... :> <: ... :>
172 | <\([^)]*\)> # Include tags <(...)>
173 | <[^:(][^<:]* # Normal text
174 | :[^>][^<:]* # Normal text
175 | [^<:]* # Normal text
178 next LINE unless length $1;
180 if ($part eq '<:=' and not $in_block) {
183 } elsif ($part eq '<:' and not $in_block) {
186 } elsif ($part eq ':>' and $in_block) {
190 : "; $PLP::print q\cQ" # 1
193 } elsif ($part =~ /^<\((.*?)\)>\z/ and not $in_block) {
194 my $ipath = File::Spec->rel2abs(
195 $1, File::Basename::dirname($path)
197 $source .= source($1, $level + 1, undef, $ipath) .
198 qq/\cQ, \n#line $linenr "$file"\nq\cQ/;
199 push @{ $cached{$path}[0] }, $ipath;
201 $part =~ s/\\/\\\\/ unless $in_block;
211 : "; $PLP::print q\cQ" # 1
216 $cached{$path}[1] = $source;
217 $cached{$path}[2] = -M $path;
221 ? $source_start . $source
222 : $source_start . $source . "\cQ";
227 # Let the games begin! No lexicals may exist at this point.
230 tie *PLPOUT, 'PLP::Tie::Print';
232 $PLP::ERROR = \&_default_error;
237 use vars qw(%headers %header %cookies %cookie %get %post %fields);
240 PLP::Functions->import();
242 # No lexicals may exist at this point.
244 eval qq{ package PLP::Script; no warnings; $PLP::code; };
245 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
247 eval { package PLP::Script; no warnings; $_->() for reverse @PLP::END };
248 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
250 PLP::sendheaders() unless $PLP::sentheaders;
252 undef *{"PLP::Script::$_"} for keys %PLP::Script::;
253 # Symbol::delete_package('PLP::Script');
254 # The above does not work. TODO - find out why not.
261 PLP - Perl in HTML pages
265 =head2 Lighttpd installation
267 F<lighttpd.conf> configuration using L<mod_fastcgi|PLP::Backend::FastCGI>:
269 server.modules += ("mod_fastcgi")
270 fastcgi.server += (".plp" => ((
271 "bin-path" => "/usr/bin/perl -MPLP::Backend::FastCGI",
272 "socket" => "/tmp/fcgi-plp.socket",
275 =head2 Apache installation
277 F<httpd.conf> for a L<mod_perl|PLP::Backend::Apache> setup:
280 SetHandler perl-script
281 PerlHandler PLP::Backend::Apache
285 =head2 Test script (test.plp)
289 print "Hurrah, it works!<br>" for 1..10;
295 PLP is yet another Perl embedder, primarily for HTML documents. Unlike with
296 other Perl embedders, there is no need to learn a meta-syntax or object
297 model: one can just use the normal Perl constructs. PLP runs under
298 L<FastCGI|PLP::Backend::FastCGI> and L<mod_perl|PLP::Backend::Apache>
299 for speeds comparable to those of PHP, but can also be run as a standard
300 L<CGI|PLP::Backend::CGI> script.
305 L<CGI|PLP::Backend::CGI>,
306 L<FastCGI|PLP::Backend::FastCGI> (recommended)
307 or L<Apache|PLP::Backend::Apache>.
308 At least the following servers are supported:
314 With L<mod_fastcgi|PLP::Backend::FastCGI> or L<mod_cgi|PLP::Backend::CGI>.
318 Either version 1 or 2. Using
319 L<mod_fcgid, mod_fastcgi|PLP::Backend::FastCGI>,
320 L<mod_perl|PLP::Backend::Apache>,
321 or L<mod_action|PLP::Backend::CGI>.
329 =item C<< <: perl_code(); :> >>
331 With C<< <: >> and C<< :> >>, you can add Perl code to your document. This is
332 what PLP is all about. All code outside of these tags is printed. It is
333 possible to mix perl language constructs with normal HTML parts of the document:
335 <: unless ($ENV{REMOTE_USER}) { :>
336 You are not logged in.
339 C<< :> >> always stops a code block, even when it is found in a string literal.
341 =item C<< <:= $expression :> >>
343 Includes a dynamic expression in your document. The expression is evaluated in
344 list context. Please note that the expression should not end a statement: avoid
345 semi-colons. No whitespace may be between C<< <: >> and the equal sign.
347 C<< foo <:= $bar :> $baz >> is like C<< <: print 'foo ', $bar, ' $baz'; :> >>.
349 =item C<< <(filename)> >>
351 Includes another file before the PLP code is executed. The file is included
352 literally, so it shares lexical variables. Because this is a compile-time tag,
353 it's fast, but you can't use a variable as the filename. You can create
354 recursive includes, so beware! (PLP will catch simple recursion: the maximum
355 depth is 128.) Whitespace in the filename is not ignored so C<< <( foo.txt)> >>
356 includes the file named C< foo.txt>, including the space in its name. A
357 compile-time alternative is include(), which is described in L<PLP::Functions>.
363 These are described in L<PLP::Functions>.
369 =item $ENV{SCRIPT_NAME}
371 The URI of the PLP document, without the query string. (Example: C</foo.plp>)
373 Used to be renamed to C<$ENV{PLP_NAME}>, which is still provided but deprecated.
375 =item $ENV{SCRIPT_FILENAME}
377 The filename of the PLP document. (Example: C</var/www/index.plp>)
379 C<$ENV{PLP_SCRIPT}> also still provided but deprecated.
387 Controls debugging output, and should be treated as a bitmask. The least
388 significant bit (1) controls if run-time error messages are reported to the
389 browser, the second bit (2) controls if headers are sent twice, so they get
390 displayed in the browser. A value of 3 means both features are enabled. The
395 Contains a reference to the code that is used to report run-time errors. You
396 can override this to have it in your own design, and you could even make it
397 report errors by e-mail. The sub reference gets two arguments: the error message
398 as plain text and the error message with special characters encoded with HTML
401 =item %header, %cookie, %get, %post, %fields
403 These are described in L<PLP::Fields>.
407 =head2 Things that you should know about
409 Not only syntax is important, you should also be aware of some other important
410 features. Your script runs inside the package C<PLP::Script> and shouldn't
411 leave it. This is because when your script ends, all global variables in the
412 C<PLP::Script> package are destroyed, which is very important if you run a
413 persistent backend (they would retain their values if they weren't explicitly
416 Until your first output, you are printing to a tied filehandle C<PLPOUT>. On
417 first output, headers are sent to the browser and C<STDOUT> is selected for
418 efficiency. To set headers, you must assign to C<$header{ $header_name}> before
419 any output. This means the opening C<< <: >> have to be the first characters in
420 your document, without any whitespace in front of them. If you start output and
421 try to set headers later, an error message will appear telling you on which
422 line your output started. An alternative way of setting headers is using Perl's
423 BEGIN blocks. BEGIN blocks are executed as soon as possible, before anything
426 Unless you're running as CGI, the interpreter won't exit after processing a page,
427 so C<END { }> blocks won't work properly. You should use C<PLP_END { };> instead.
428 Note that this is a not a built-in construct, so it needs proper termination
429 with a semi-colon (as do C<eval> and C<do>).
431 When run persistently, modules are loaded only once. A good modular design can
432 improve performance because of this, but you will have to B<reload> the modules
433 yourself when there are newer versions.
435 The special hashes are tied hashes and do not always behave the way you expect,
436 especially when mixed with modules that expect normal CGI environments, like
437 CGI.pm. Read L<PLP::Fields> for information more about this.
441 A lot of questions are asked often, so before asking yours, please read the
442 FAQ at L<PLP::FAQ>. Some examples can be found at L<PLP::HowTo>.
446 Currently maintained by Mischa POSLAWSKY <perl@shiar.org>
448 Originally by Juerd Waalboer <juerd@cpan.org>
452 Copyright (c) 2000-2002 Juerd Waalboer, 2005-2008 Mischa POSLAWSKY.
455 This software is free software;
456 you can redistribute and/or modify it under the terms of the MIT/X11 license.
460 L<PLP::Functions>, L<PLP::Fields>, L<PLP::FAQ>, L<PLP::HowTo>
466 # About the #S lines:
467 # I wanted to implement Safe.pm so that scripts were run inside a
468 # configurable compartment. This needed for XS modules to be pre-loaded,
469 # hence the PLPsafe_* Apache directives. However, $safe->reval() lets
470 # Apache segfault. End of fun. The lines are still here so that I can
471 # s/^#S //g to re-implement them whenever this has been fixed.
473 #S # For PLPsafe scripts
475 #S my ($r, $code) = @_;
476 #S $r->send_http_header('text/plain');
478 #S unless ($PLP::safe) {
479 #S $PLP::safe = Safe->new('PLP::Script');
480 #S for ( map split, $r->dir_config->get('PLPsafe_module') ) {
481 #S $PLP::safe->share('*' . $_ . '::');
483 #S require $_ . '.pm';
485 #S $PLP::safe->permit(Opcode::full_opset());
486 #S $PLP::safe->deny(Opcode::opset(':dangerous'));
488 #S $PLP::safe->reval($code);
493 #S if ($PLP::use_safe) {
494 #S PLP::safe_eval($r, $PLP::code);
496 # eval qq{ package PLP::Script; $PLP::code; };
498 # PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
499 #S if ($PLP::use_safe) {
500 #S PLP::safe_eval($r, '$_->() for reverse @PLP::END');
502 # eval { package PLP::Script; $_->() for reverse @PLP::END };
504 # PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;