11 use File::Basename ();
16 our $VERSION = '3.20';
18 # Subs in this package:
19 # _default_error($plain, $html) Default error handler
20 # clean Reset variables
21 # error($error, $type) Handle errors
22 # everything Do everything: CGI
23 # handler($r) Do everything: mod_perl
24 # sendheaders Send headers
25 # source($path, $level, $linespec) Read and parse .plp files
26 # start Start the initialized PLP script
28 # The _init subs do the following:
29 # Set $PLP::code to the initial code
30 # Set $ENV{PLP_*} and make PATH_INFO if needed
33 # This gets referenced as the initial $PLP::ERROR
35 my ($plain, $html) = @_;
36 print qq{<table border=1 class="PLPerror"><tr><td>},
37 qq{<b>Debug information:</b><br>$html</td></tr></table>};
40 # This cleans up from previous requests, and sets the default $PLP::DEBUG
44 $PLP::sentheaders = 0;
47 delete @ENV{ grep /^PLP_/, keys %ENV };
50 # Handles errors, uses subref $PLP::ERROR (default: \&_default_error)
52 my ($error, $type) = @_;
53 if (not defined $type or $type < 100) {
54 return undef unless $PLP::DEBUG & 1;
56 (my $html = $plain) =~ s/([<&>])/'&#' . ord($1) . ';'/ge;
57 PLP::sendheaders() unless $PLP::sentheaders;
58 $PLP::ERROR->($plain, $html);
61 my ($short, $long) = @{
65 "The requested URL $ENV{REQUEST_URI} was not found " .
70 "You don't have permission to access $ENV{REQUEST_URI} " .
75 print "Status: $type\nContent-Type: text/html\n\n",
76 qq{<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">\n<html>},
77 "<head>\n<title>$type $short</title>\n</head></body>\n<h1>$short",
78 "</h1>\n$long<p>\n<hr>\n$ENV{SERVER_SIGNATURE}</body></html>";
82 # Wrap old request handlers.
84 require PLP::Backend::CGI;
85 PLP::Backend::CGI::everything();
88 require PLP::Backend::Apache;
89 PLP::Backend::Apache::handler(@_);
92 # Sends the headers waiting in %PLP::Script::header
94 $PLP::sentheaders ||= [ caller 1 ? (caller 1)[1, 2] : (caller)[1, 2] ];
95 print STDOUT "Content-Type: text/plain\n\n" if $PLP::DEBUG & 2;
96 print STDOUT map("$_: $PLP::Script::header{$_}\n", keys %PLP::Script::header), "\n";
100 my %cached; # Conceal cached sources: ( path => [ [ deps ], source, -M ] )
102 # Given a filename and optional level (level should be 0 if the caller isn't
103 # source() itself), and optional linespec (used by PLP::Functions::Include),
104 # this function parses a PLP file and returns Perl code, ready to be eval'ed
106 my ($file, $level, $linespec, $path) = @_;
109 # $file is displayed, $path is used. $path is constructed from $file if
112 $level = 0 unless defined $level;
113 $linespec = '1' unless defined $linespec;
118 ? qq{\cQ; die qq[Include recursion detected]; print q\cQ}
119 : qq{\n#line $linespec\ndie qq[Include recursion detected];};
122 my $in_block = 0; # 1 => "<:", 2 => "<:="
124 $path ||= File::Spec->rel2abs($file);
126 my $source_start = $level
127 ? qq/\cQ;\n#line 1 "$file"\n$PLP::print q\cQ/
128 : qq/\n#line 1 "$file"\n$PLP::print q\cQ/;
130 if ($use_cache and exists $cached{$path}) {
132 my @checkstack = ($path);
135 while (defined(my $item = shift @checkstack)) {
136 next if $checked{$item};
137 last BREAKOUT if $cached{$item}[2] > -M $item;
139 push @checkstack, @{ $cached{$item}[0] }
140 if @{ $cached{$item}[0] };
143 ? $source_start . $cached{$path}[1]
144 : $source_start . $cached{$path}[1] . "\cQ";
148 $cached{$path} = [ [ ], undef, undef ] if $use_cache;
154 open SOURCE, '<', $path or return $level
155 ? qq{\cQ; die qq[Can't open "\Q$path\E" (\Q$!\E)]; print q\cQ}
156 : qq{\n#line $linespec\ndie qq[Can't open "\Q$path\E" (\Q$!\E)];};
159 while (defined (my $line = <SOURCE>)) {
163 \G # Begin where left off
165 | <:=? | :> # PLP tags <:= ... :> <: ... :>
166 | <\([^)]*\)> # Include tags <(...)>
167 | <[^:(][^<:]* # Normal text
168 | :[^>][^<:]* # Normal text
169 | [^<:]* # Normal text
172 next LINE unless length $1;
174 if ($part eq '<:=' and not $in_block) {
177 } elsif ($part eq '<:' and not $in_block) {
180 } elsif ($part eq ':>' and $in_block) {
184 : "; $PLP::print q\cQ" # 1
187 } elsif ($part =~ /^<\((.*?)\)>\z/ and not $in_block) {
188 my $ipath = File::Spec->rel2abs(
189 $1, File::Basename::dirname($path)
191 $source .= source($1, $level + 1, undef, $ipath) .
192 qq/\cQ, \n#line $linenr "$file"\nq\cQ/;
193 push @{ $cached{$path}[0] }, $ipath;
195 $part =~ s/\\/\\\\/ unless $in_block;
205 : "; $PLP::print q\cQ" # 1
210 $cached{$path}[1] = $source;
211 $cached{$path}[2] = -M $path;
215 ? $source_start . $source
216 : $source_start . $source . "\cQ";
221 # Let the games begin! No lexicals may exist at this point.
224 tie *PLPOUT, 'PLP::Tie::Print';
226 $PLP::ERROR = \&_default_error;
231 use vars qw(%headers %header %cookies %cookie %get %post %fields);
234 PLP::Functions->import();
236 # No lexicals may exist at this point.
238 eval qq{ package PLP::Script; $PLP::code; };
239 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
241 eval { package PLP::Script; $_->() for reverse @PLP::END };
242 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
244 PLP::sendheaders() unless $PLP::sentheaders;
246 undef *{"PLP::Script::$_"} for keys %PLP::Script::;
247 # Symbol::delete_package('PLP::Script');
248 # The above does not work. TODO - find out why not.
255 PLP - Perl in HTML pages
259 =head2 Lighttpd installation
261 F<lighttpd.conf> configuration using L<mod_fastcgi|PLP::Backend::FastCGI>:
263 server.modules += ("mod_fastcgi")
264 fastcgi.server += (".plp" => ((
265 "bin-path" => "/usr/bin/perl -MPLP::Backend::FastCGI",
266 "socket" => "/tmp/fcgi-plp.socket",
269 =head2 Apache installation
271 F<httpd.conf> for a L<mod_perl|PLP::Backend::Apache> setup:
274 SetHandler perl-script
275 PerlHandler PLP::Backend::Apache
279 =head2 Test script (test.plp)
283 print "Hurrah, it works!<br>" for 1..10;
289 PLP is yet another Perl embedder, primarily for HTML documents. Unlike with
290 other Perl embedders, there is no need to learn a meta-syntax or object
291 model: one can just use the normal Perl constructs. PLP runs under
292 L<FastCGI|PLP::Backend::FastCGI> and L<mod_perl|PLP::Backend::Apache>
293 for speeds comparable to those of PHP, but can also be run as a standard
294 L<CGI|PLP::Backend::CGI> script.
299 L<CGI|PLP::Backend::CGI>,
300 L<FastCGI|PLP::Backend::FastCGI> (recommended)
301 or L<Apache|PLP::Backend::Apache>.
302 At least the following servers are supported:
308 With L<mod_fastcgi|PLP::Backend::FastCGI> or L<mod_cgi|PLP::Backend::CGI>.
312 Either version 1 or 2. Using
313 L<mod_fcgid, mod_fastcgi|PLP::Backend::FastCGI>,
314 L<mod_perl|PLP::Backend::Apache>,
315 or L<mod_action|PLP::Backend::CGI>.
323 =item C<< <: perl_code(); :> >>
325 With C<< <: >> and C<< :> >>, you can add Perl code to your document. This is
326 what PLP is all about. All code outside of these tags is printed. It is
327 possible to mix perl language constructs with normal HTML parts of the document:
329 <: unless ($ENV{REMOTE_USER}) { :>
330 You are not logged in.
333 C<< :> >> always stops a code block, even when it is found in a string literal.
335 =item C<< <:= $expression :> >>
337 Includes a dynamic expression in your document. The expression is evaluated in
338 list context. Please note that the expression should not end a statement: avoid
339 semi-colons. No whitespace may be between C<< <: >> and the equal sign.
341 C<< foo <:= $bar :> $baz >> is like C<< <: print 'foo ', $bar, ' $baz'; :> >>.
343 =item C<< <(filename)> >>
345 Includes another file before the PLP code is executed. The file is included
346 literally, so it shares lexical variables. Because this is a compile-time tag,
347 it's fast, but you can't use a variable as the filename. You can create
348 recursive includes, so beware! (PLP will catch simple recursion: the maximum
349 depth is 128.) Whitespace in the filename is not ignored so C<< <( foo.txt)> >>
350 includes the file named C< foo.txt>, including the space in its name. A
351 compile-time alternative is include(), which is described in L<PLP::Functions>.
357 These are described in L<PLP::Functions>.
363 =item $ENV{SCRIPT_NAME}
365 The URI of the PLP document, without the query string. (Example: C</foo.plp>)
367 Used to be renamed to C<$ENV{PLP_NAME}>, which is still provided but deprecated.
369 =item $ENV{SCRIPT_FILENAME}
371 The filename of the PLP document. (Example: C</var/www/index.plp>)
373 C<$ENV{PLP_SCRIPT}> also still provided but deprecated.
381 Controls debugging output, and should be treated as a bitmask. The least
382 significant bit (1) controls if run-time error messages are reported to the
383 browser, the second bit (2) controls if headers are sent twice, so they get
384 displayed in the browser. A value of 3 means both features are enabled. The
389 Contains a reference to the code that is used to report run-time errors. You
390 can override this to have it in your own design, and you could even make it
391 report errors by e-mail. The sub reference gets two arguments: the error message
392 as plain text and the error message with special characters encoded with HTML
395 =item %header, %cookie, %get, %post, %fields
397 These are described in L<PLP::Fields>.
401 =head2 Things that you should know about
403 Not only syntax is important, you should also be aware of some other important
404 features. Your script runs inside the package C<PLP::Script> and shouldn't
405 leave it. This is because when your script ends, all global variables in the
406 C<PLP::Script> package are destroyed, which is very important if you run under
407 mod_perl (they would retain their values if they weren't explicitly destroyed).
409 Until your first output, you are printing to a tied filehandle C<PLPOUT>. On
410 first output, headers are sent to the browser and C<STDOUT> is selected for
411 efficiency. To set headers, you must assign to C<$header{ $header_name}> before
412 any output. This means the opening C<< <: >> have to be the first characters in
413 your document, without any whitespace in front of them. If you start output and
414 try to set headers later, an error message will appear telling you on which
415 line your output started. An alternative way of setting headers is using Perl's
416 BEGIN blocks. BEGIN blocks are executed as soon as possible, before anything
419 Because the interpreter that mod_perl uses never ends, C<END { }> blocks won't
420 work properly. You should use C<PLP_END { };> instead. Note that this is a not
421 a built-in construct, so it needs proper termination with a semi-colon (as do
424 Under mod_perl, modules are loaded only once. A good modular design can improve
425 performance because of this, but you will have to B<reload> the modules
426 yourself when there are newer versions.
428 The special hashes are tied hashes and do not always behave the way you expect,
429 especially when mixed with modules that expect normal CGI environments, like
430 CGI.pm. Read L<PLP::Fields> for information more about this.
434 A lot of questions are asked often, so before asking yours, please read the
435 FAQ at L<PLP::FAQ>. Some examples can be found at L<PLP::HowTo>.
439 Currently maintained by Mischa POSLAWSKY <perl@shiar.org>
441 Originally by Juerd Waalboer <juerd@cpan.org>
445 Copyright (c) 2000-2002 Juerd Waalboer, 2005-2008 Mischa POSLAWSKY.
448 This software is free software;
449 you can redistribute and/or modify it under the terms of the MIT/X11 license.
453 L<PLP::Functions>, L<PLP::Fields>, L<PLP::FAQ>, L<PLP::HowTo>
459 # About the #S lines:
460 # I wanted to implement Safe.pm so that scripts were run inside a
461 # configurable compartment. This needed for XS modules to be pre-loaded,
462 # hence the PLPsafe_* Apache directives. However, $safe->reval() lets
463 # Apache segfault. End of fun. The lines are still here so that I can
464 # s/^#S //g to re-implement them whenever this has been fixed.
466 #S # For PLPsafe scripts
468 #S my ($r, $code) = @_;
469 #S $r->send_http_header('text/plain');
471 #S unless ($PLP::safe) {
472 #S $PLP::safe = Safe->new('PLP::Script');
473 #S for ( map split, $r->dir_config->get('PLPsafe_module') ) {
474 #S $PLP::safe->share('*' . $_ . '::');
476 #S require $_ . '.pm';
478 #S $PLP::safe->permit(Opcode::full_opset());
479 #S $PLP::safe->deny(Opcode::opset(':dangerous'));
481 #S $PLP::safe->reval($code);
486 #S if ($PLP::use_safe) {
487 #S PLP::safe_eval($r, $PLP::code);
489 # eval qq{ package PLP::Script; $PLP::code; };
491 # PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
492 #S if ($PLP::use_safe) {
493 #S PLP::safe_eval($r, '$_->() for reverse @PLP::END');
495 # eval { package PLP::Script; $_->() for reverse @PLP::END };
497 # PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;