11 use File::Basename ();
17 our $VERSION = '3.22_01';
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 local $\; # reset print behaviour if triggered by say()
98 $PLP::sentheaders ||= [ caller 1 ? (caller 1)[1, 2] : (caller)[1, 2] ];
99 print STDOUT "Content-Type: text/plain\n\n" if $PLP::DEBUG & 2;
100 while (my ($header, $values) = each %PLP::Script::header) {
101 print STDOUT "$header: $_\n" for split /\n/, $values;
107 my %cached; # Conceal cached sources: ( path => [ [ deps ], source, -M ] )
109 # Given a filename and optional level (level should be 0 if the caller isn't
110 # source() itself), and optional linespec (used by PLP::Functions::Include),
111 # this function parses a PLP file and returns Perl code, ready to be eval'ed
113 my ($file, $level, $linespec, $path) = @_;
116 # $file is displayed, $path is used. $path is constructed from $file if
119 $level = 0 unless defined $level;
120 $linespec = '1' unless defined $linespec;
125 ? qq{\cQ; die qq[Include recursion detected]; print q\cQ}
126 : qq{\n#line $linespec\ndie qq[Include recursion detected];};
129 my $in_block = 0; # 1 => "<:", 2 => "<:="
131 $path ||= File::Spec->rel2abs($file);
133 my $source_start = $level
134 ? qq/\cQ;\n#line 1 "$file"\n$PLP::print q\cQ/
135 : qq/\n#line 1 "$file"\n$PLP::print q\cQ/;
137 if ($use_cache and exists $cached{$path}) {
139 my @checkstack = ($path);
142 while (defined(my $item = shift @checkstack)) {
143 next if $checked{$item};
144 last BREAKOUT if $cached{$item}[2] > -M $item;
146 push @checkstack, @{ $cached{$item}[0] }
147 if @{ $cached{$item}[0] };
150 ? $source_start . $cached{$path}[1]
151 : $source_start . $cached{$path}[1] . "\cQ";
155 $cached{$path} = [ [ ], undef, undef ] if $use_cache;
161 open SOURCE, '<', $path or return $level
162 ? qq{\cQ; die qq[Can't open "\Q$path\E" (\Q$!\E)]; print q\cQ}
163 : qq{\n#line $linespec\ndie qq[Can't open "\Q$path\E" (\Q$!\E)];};
166 while (defined (my $line = <SOURCE>)) {
170 \G # Begin where left off
172 | <:=? | :> # PLP tags <:= ... :> <: ... :>
173 | <\([^)]*\)> # Include tags <(...)>
174 | <[^:(][^<:]* # Normal text
175 | :[^>][^<:]* # Normal text
176 | [^<:]* # Normal text
179 next LINE unless length $1;
181 if ($part eq '<:=' and not $in_block) {
184 } elsif ($part eq '<:' and not $in_block) {
187 } elsif ($part eq ':>' and $in_block) {
191 : "; $PLP::print q\cQ" # 1
194 } elsif ($part =~ /^<\((.*?)\)>\z/ and not $in_block) {
195 my $ipath = File::Spec->rel2abs(
196 $1, File::Basename::dirname($path)
198 $source .= source($1, $level + 1, undef, $ipath) .
199 qq/\cQ, \n#line $linenr "$file"\nq\cQ/;
200 push @{ $cached{$path}[0] }, $ipath;
202 $part =~ s/\\/\\\\/ unless $in_block;
212 : "; $PLP::print q\cQ" # 1
217 $cached{$path}[1] = $source;
218 $cached{$path}[2] = -M $path;
222 ? $source_start . $source
223 : $source_start . $source . "\cQ";
228 # Let the games begin! No lexicals may exist at this point.
231 tie *PLPOUT, 'PLP::Tie::Print';
233 $PLP::ERROR = \&_default_error;
238 use vars qw(%headers %header %cookies %cookie %get %post %fields);
241 PLP::Functions->import();
243 # No lexicals may exist at this point.
245 eval qq{ package PLP::Script; no warnings; $PLP::code; };
246 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
248 eval { package PLP::Script; no warnings; $_->() for reverse @PLP::END };
249 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
251 PLP::sendheaders() unless $PLP::sentheaders;
253 undef *{"PLP::Script::$_"} for keys %PLP::Script::;
254 # Symbol::delete_package('PLP::Script');
255 # The above does not work. TODO - find out why not.
262 PLP - Perl in HTML pages
266 =head2 Lighttpd installation
268 F<lighttpd.conf> configuration using L<mod_fastcgi|PLP::Backend::FastCGI>:
270 server.modules += ("mod_fastcgi")
271 fastcgi.server += (".plp" => ((
272 "bin-path" => "/usr/bin/perl -MPLP::Backend::FastCGI",
273 "socket" => "/tmp/fcgi-plp.socket",
276 =head2 Apache installation
278 F<httpd.conf> for a L<mod_perl|PLP::Backend::Apache> setup:
281 SetHandler perl-script
282 PerlHandler PLP::Backend::Apache
286 =head2 Test script (test.plp)
290 print "Hurrah, it works!<br>" for 1..10;
296 PLP is yet another Perl embedder, primarily for HTML documents. Unlike with
297 other Perl embedders, there is no need to learn a meta-syntax or object
298 model: one can just use the normal Perl constructs. PLP runs under
299 L<FastCGI|PLP::Backend::FastCGI> and L<mod_perl|PLP::Backend::Apache>
300 for speeds comparable to those of PHP, but can also be run as a standard
301 L<CGI|PLP::Backend::CGI> script.
306 L<CGI|PLP::Backend::CGI>,
307 L<FastCGI|PLP::Backend::FastCGI> (recommended)
308 or L<Apache|PLP::Backend::Apache>.
309 At least the following servers are supported:
315 With L<mod_fastcgi|PLP::Backend::FastCGI> or L<mod_cgi|PLP::Backend::CGI>.
319 Either version 1 or 2. Using
320 L<mod_fcgid, mod_fastcgi|PLP::Backend::FastCGI>,
321 L<mod_perl|PLP::Backend::Apache>,
322 or L<mod_action|PLP::Backend::CGI>.
330 =item C<< <: perl_code(); :> >>
332 With C<< <: >> and C<< :> >>, you can add Perl code to your document. This is
333 what PLP is all about. All code outside of these tags is printed. It is
334 possible to mix perl language constructs with normal HTML parts of the document:
336 <: unless ($ENV{REMOTE_USER}) { :>
337 You are not logged in.
340 C<< :> >> always stops a code block, even when it is found in a string literal.
342 =item C<< <:= $expression :> >>
344 Includes a dynamic expression in your document. The expression is evaluated in
345 list context. Please note that the expression should not end a statement: avoid
346 semi-colons. No whitespace may be between C<< <: >> and the equal sign.
348 C<< foo <:= $bar :> $baz >> is like C<< <: print 'foo ', $bar, ' $baz'; :> >>.
350 =item C<< <(filename)> >>
352 Includes another file before the PLP code is executed. The file is included
353 literally, so it shares lexical variables. Because this is a compile-time tag,
354 it's fast, but you can't use a variable as the filename. You can create
355 recursive includes, so beware! (PLP will catch simple recursion: the maximum
356 depth is 128.) Whitespace in the filename is not ignored so C<< <( foo.txt)> >>
357 includes the file named C< foo.txt>, including the space in its name. A
358 compile-time alternative is include(), which is described in L<PLP::Functions>.
364 These are described in L<PLP::Functions>.
370 =item $ENV{SCRIPT_NAME}
372 The URI of the PLP document, without the query string. (Example: C</foo.plp>)
374 Used to be renamed to C<$ENV{PLP_NAME}>, which is still provided but deprecated.
376 =item $ENV{SCRIPT_FILENAME}
378 The filename of the PLP document. (Example: C</var/www/index.plp>)
380 C<$ENV{PLP_SCRIPT}> also still provided but deprecated.
388 Controls debugging output, and should be treated as a bitmask. The least
389 significant bit (1) controls if run-time error messages are reported to the
390 browser, the second bit (2) controls if headers are sent twice, so they get
391 displayed in the browser. A value of 3 means both features are enabled. The
396 Contains a reference to the code that is used to report run-time errors. You
397 can override this to have it in your own design, and you could even make it
398 report errors by e-mail. The sub reference gets two arguments: the error message
399 as plain text and the error message with special characters encoded with HTML
402 =item %header, %cookie, %get, %post, %fields
404 These are described in L<PLP::Fields>.
408 =head2 Things that you should know about
410 Not only syntax is important, you should also be aware of some other important
411 features. Your script runs inside the package C<PLP::Script> and shouldn't
412 leave it. This is because when your script ends, all global variables in the
413 C<PLP::Script> package are destroyed, which is very important if you run a
414 persistent backend (they would retain their values if they weren't explicitly
417 Until your first output, you are printing to a tied filehandle C<PLPOUT>. On
418 first output, headers are sent to the browser and C<STDOUT> is selected for
419 efficiency. To set headers, you must assign to C<$header{ $header_name}> before
420 any output. This means the opening C<< <: >> have to be the first characters in
421 your document, without any whitespace in front of them. If you start output and
422 try to set headers later, an error message will appear telling you on which
423 line your output started. An alternative way of setting headers is using Perl's
424 BEGIN blocks. BEGIN blocks are executed as soon as possible, before anything
427 Unless you're running as CGI, the interpreter won't exit after processing a page,
428 so C<END { }> blocks won't work properly. You should use C<PLP_END { };> instead.
429 Note that this is a not a built-in construct, so it needs proper termination
430 with a semi-colon (as do C<eval> and C<do>).
432 When run persistently, modules are loaded only once. A good modular design can
433 improve performance because of this, but you will have to B<reload> the modules
434 yourself when there are newer versions.
436 The special hashes are tied hashes and do not always behave the way you expect,
437 especially when mixed with modules that expect normal CGI environments, like
438 CGI.pm. Read L<PLP::Fields> for information more about this.
442 A lot of questions are asked often, so before asking yours, please read the
443 FAQ at L<PLP::FAQ>. Some examples can be found at L<PLP::HowTo>.
447 Currently maintained by Mischa POSLAWSKY <perl@shiar.org>
449 Originally by Juerd Waalboer <juerd@cpan.org>
453 Copyright (c) 2000-2002 Juerd Waalboer, 2005-2008 Mischa POSLAWSKY.
456 This software is free software;
457 you can redistribute and/or modify it under the terms of the MIT/X11 license.
461 L<PLP::Functions>, L<PLP::Fields>, L<PLP::FAQ>, L<PLP::HowTo>
467 # About the #S lines:
468 # I wanted to implement Safe.pm so that scripts were run inside a
469 # configurable compartment. This needed for XS modules to be pre-loaded,
470 # hence the PLPsafe_* Apache directives. However, $safe->reval() lets
471 # Apache segfault. End of fun. The lines are still here so that I can
472 # s/^#S //g to re-implement them whenever this has been fixed.
474 #S # For PLPsafe scripts
476 #S my ($r, $code) = @_;
477 #S $r->send_http_header('text/plain');
479 #S unless ($PLP::safe) {
480 #S $PLP::safe = Safe->new('PLP::Script');
481 #S for ( map split, $r->dir_config->get('PLPsafe_module') ) {
482 #S $PLP::safe->share('*' . $_ . '::');
484 #S require $_ . '.pm';
486 #S $PLP::safe->permit(Opcode::full_opset());
487 #S $PLP::safe->deny(Opcode::opset(':dangerous'));
489 #S $PLP::safe->reval($code);
494 #S if ($PLP::use_safe) {
495 #S PLP::safe_eval($r, $PLP::code);
497 # eval qq{ package PLP::Script; $PLP::code; };
499 # PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
500 #S if ($PLP::use_safe) {
501 #S PLP::safe_eval($r, '$_->() for reverse @PLP::END');
503 # eval { package PLP::Script; $_->() for reverse @PLP::END };
505 # PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;