11 use File::Basename ();
16 our $VERSION = '3.19';
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;
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$ENV{SERVER_SIGNATURE}</body></html>";
83 # This is run by the CGI script. (#!perl \n use PLP; PLP::everything;)
91 # This is the mod_perl handler.
94 require Apache::Constants;
96 if (my $ret = PLP::Apache::init($_[0])) {
102 return Apache::Constants::OK();
105 # Sends the headers waiting in %PLP::Script::header
107 $PLP::sentheaders ||= [ caller 1 ? (caller 1)[1, 2] : (caller)[1, 2] ];
108 print STDOUT "Content-Type: text/plain\n\n" if $PLP::DEBUG & 2;
109 print STDOUT map("$_: $PLP::Script::header{$_}\n", keys %PLP::Script::header), "\n";
113 my %cached; # Conceal cached sources: ( path => [ [ deps ], source, -M ] )
115 # Given a filename and optional level (level should be 0 if the caller isn't
116 # source() itself), and optional linespec (used by PLP::Functions::Include),
117 # this function parses a PLP file and returns Perl code, ready to be eval'ed
119 my ($file, $level, $linespec, $path) = @_;
122 # $file is displayed, $path is used. $path is constructed from $file if
125 $level = 0 unless defined $level;
126 $linespec = '1' unless defined $linespec;
131 ? qq{\cQ; die qq[Include recursion detected]; print q\cQ}
132 : qq{\n#line $linespec\ndie qq[Include recursion detected];};
135 my $in_block = 0; # 1 => "<:", 2 => "<:="
137 $path ||= File::Spec->rel2abs($file);
139 my $source_start = $level
140 ? qq/\cQ;\n#line 1 "$file"\n$PLP::print q\cQ/
141 : qq/\n#line 1 "$file"\n$PLP::print q\cQ/;
143 if ($use_cache and exists $cached{$path}) {
145 my @checkstack = ($path);
148 while (defined(my $item = shift @checkstack)) {
149 next if $checked{$item};
150 last BREAKOUT if $cached{$item}[2] > -M $item;
152 push @checkstack, @{ $cached{$item}[0] }
153 if @{ $cached{$item}[0] };
156 ? $source_start . $cached{$path}[1]
157 : $source_start . $cached{$path}[1] . "\cQ";
161 $cached{$path} = [ [ ], undef, undef ] if $use_cache;
167 open SOURCE, '<', $path or return $level
168 ? qq{\cQ; die qq[Can't open "\Q$path\E" (\Q$!\E)]; print q\cQ}
169 : qq{\n#line $linespec\ndie qq[Can't open "\Q$path\E" (\Q$!\E)];};
172 while (defined (my $line = <SOURCE>)) {
176 \G # Begin where left off
178 | <:=? | :> # PLP tags <:= ... :> <: ... :>
179 | <\([^)]*\)> # Include tags <(...)>
180 | <[^:(][^<:]* # Normal text
181 | :[^>][^<:]* # Normal text
182 | [^<:]* # Normal text
185 next LINE unless length $1;
187 if ($part eq '<:=' and not $in_block) {
190 } elsif ($part eq '<:' and not $in_block) {
193 } elsif ($part eq ':>' and $in_block) {
197 : "; $PLP::print q\cQ" # 1
200 } elsif ($part =~ /^<\((.*?)\)>\z/ and not $in_block) {
201 my $ipath = File::Spec->rel2abs(
202 $1, File::Basename::dirname($path)
204 $source .= source($1, $level + 1, undef, $ipath) .
205 qq/\cQ, \n#line $linenr "$file"\nq\cQ/;
206 push @{ $cached{$path}[0] }, $ipath;
208 $part =~ s/\\/\\\\/ unless $in_block;
218 : "; $PLP::print q\cQ" # 1
223 $cached{$path}[1] = $source;
224 $cached{$path}[2] = -M $path;
228 ? $source_start . $source
229 : $source_start . $source . "\cQ";
234 # Let the games begin! No lexicals may exist at this point.
237 tie *PLPOUT, 'PLP::Tie::Print';
239 $PLP::ERROR = \&_default_error;
244 use vars qw(%headers %header %cookies %cookie %get %post %fields);
247 PLP::Functions->import();
249 # No lexicals may exist at this point.
251 eval qq{ package PLP::Script; $PLP::code; };
252 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
254 eval { package PLP::Script; $_->() for reverse @PLP::END };
255 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
257 PLP::sendheaders() unless $PLP::sentheaders;
259 undef *{"PLP::Script::$_"} for keys %PLP::Script::;
260 # Symbol::delete_package('PLP::Script');
261 # The above does not work. TODO - find out why not.
268 PLP - Perl in HTML pages
272 =head2 mod_perl installation
276 =item * httpd.conf (for mod_perl setup)
279 SetHandler perl-script
282 PerlSetVar PLPcache On
285 # Who said CGI was easier to set up? :)
289 =head2 CGI installation
293 =item * /foo/bar/plp.cgi (local filesystem address)
299 =item * httpd.conf (for CGI setup)
301 ScriptAlias /foo/bar/ /PLP_COMMON/
302 <Directory /foo/bar/>
308 AddHandler plp-document plp
309 Action plp-document /PLP_COMMON/plp.cgi
313 =head2 Test script (test.plp)
317 print "Hurrah, it works!<br>" for 1..10;
323 PLP is yet another Perl embedder, primarily for HTML documents. Unlike with
324 other Perl embedders, there is no need to learn a meta-syntax or object
325 model: one can just use the normal Perl constructs. PLP runs under mod_perl
326 for speeds comparable to those of PHP, but can also be run as a CGI script.
332 =item C<< <: perl_code(); :> >>
334 With C<< <: >> and C<< :> >>, you can add Perl code to your document. This is
335 what PLP is all about. All code outside of these tags is printed. It is
336 possible to mix perl language constructs with normal HTML parts of the document:
338 <: unless ($ENV{REMOTE_USER}) { :>
339 You are not logged in.
342 C<< :> >> always stops a code block, even when it is found in a string literal.
344 =item C<< <:= $expression :> >>
346 Includes a dynamic expression in your document. The expression is evaluated in
347 list context. Please note that the expression should not end a statement: avoid
348 semi-colons. No whitespace may be between C<< <: >> and the equal sign.
350 C<< foo <:= $bar :> $baz >> is like C<< <: print 'foo ', $bar, ' $baz'; :> >>.
352 =item C<< <(filename)> >>
354 Includes another file before the PLP code is executed. The file is included
355 literally, so it shares lexical variables. Because this is a compile-time tag,
356 it's fast, but you can't use a variable as the filename. You can create
357 recursive includes, so beware! (PLP will catch simple recursion: the maximum
358 depth is 128.) Whitespace in the filename is not ignored so C<< <( foo.txt)> >>
359 includes the file named C< foo.txt>, including the space in its name. A
360 compile-time alternative is include(), which is described in L<PLP::Functions>.
366 These are described in L<PLP::Functions>.
374 The URI of the PLP document, without the query string. (Example: C</foo.plp>)
376 =item $ENV{PLP_FILENAME}
378 The filename of the PLP document. (Example: C</var/www/index.plp>)
386 Controls debugging output, and should be treated as a bitmask. The least
387 significant bit (1) controls if run-time error messages are reported to the
388 browser, the second bit (2) controls if headers are sent twice, so they get
389 displayed in the browser. A value of 3 means both features are enabled. The
394 Contains a reference to the code that is used to report run-time errors. You
395 can override this to have it in your own design, and you could even make it
396 report errors by e-mail. The sub reference gets two arguments: the error message
397 as plain text and the error message with special characters encoded with HTML
400 =item %header, %cookie, %get, %post, %fields
402 These are described in L<PLP::Fields>.
406 =head2 (mod_perl only) PerlSetVar configuration directives
412 Sets caching B<On>/B<Off>. When caching, PLP saves your script in memory and
413 doesn't re-read and re-parse it if it hasn't changed. PLP will use more memory,
414 but will also run 50% faster.
416 B<On> is default, anything that isn't =~ /^off$/i is considered On.
420 =head2 Things that you should know about
422 Not only syntax is important, you should also be aware of some other important
423 features. Your script runs inside the package C<PLP::Script> and shouldn't
424 leave it. This is because when your script ends, all global variables in the
425 C<PLP::Script> package are destroyed, which is very important if you run under
426 mod_perl (they would retain their values if they weren't explicitly destroyed).
428 Until your first output, you are printing to a tied filehandle C<PLPOUT>. On
429 first output, headers are sent to the browser and C<STDOUT> is selected for
430 efficiency. To set headers, you must assign to C<$header{ $header_name}> before
431 any output. This means the opening C<< <: >> have to be the first characters in
432 your document, without any whitespace in front of them. If you start output and
433 try to set headers later, an error message will appear telling you on which
434 line your output started. An alternative way of setting headers is using Perl's
435 BEGIN blocks. BEGIN blocks are executed as soon as possible, before anything
438 Because the interpreter that mod_perl uses never ends, C<END { }> blocks won't
439 work properly. You should use C<PLP_END { };> instead. Note that this is a not
440 a built-in construct, so it needs proper termination with a semi-colon (as do
443 Under mod_perl, modules are loaded only once. A good modular design can improve
444 performance because of this, but you will have to B<reload> the modules
445 yourself when there are newer versions.
447 The special hashes are tied hashes and do not always behave the way you expect,
448 especially when mixed with modules that expect normal CGI environments, like
449 CGI.pm. Read L<PLP::Fields> for information more about this.
453 A lot of questions are asked often, so before asking yours, please read the
454 FAQ at L<PLP::FAQ>. Some examples can be found at L<PLP::HowTo>.
458 No warranty, no guarantees. Use PLP at your own risk, as I disclaim all
463 Currently maintained by Mischa POSLAWSKY <perl@shiar.org>
465 Originally by Juerd Waalboer <juerd@cpan.org>
469 L<PLP::Functions>, L<PLP::Fields>, L<PLP::FAQ>, L<PLP::HowTo>
475 # About the #S lines:
476 # I wanted to implement Safe.pm so that scripts were run inside a
477 # configurable compartment. This needed for XS modules to be pre-loaded,
478 # hence the PLPsafe_* Apache directives. However, $safe->reval() lets
479 # Apache segfault. End of fun. The lines are still here so that I can
480 # s/^#S //g to re-implement them whenever this has been fixed.
482 #S # For PLPsafe scripts
484 #S my ($r, $code) = @_;
485 #S $r->send_http_header('text/plain');
487 #S unless ($PLP::safe) {
488 #S $PLP::safe = Safe->new('PLP::Script');
489 #S for ( map split, $r->dir_config->get('PLPsafe_module') ) {
490 #S $PLP::safe->share('*' . $_ . '::');
492 #S require $_ . '.pm';
494 #S $PLP::safe->permit(Opcode::full_opset());
495 #S $PLP::safe->deny(Opcode::opset(':dangerous'));
497 #S $PLP::safe->reval($code);
502 #S if ($PLP::use_safe) {
503 #S PLP::safe_eval($r, $PLP::code);
505 # eval qq{ package PLP::Script; $PLP::code; };
507 # PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
508 #S if ($PLP::use_safe) {
509 #S PLP::safe_eval($r, '$_->() for reverse @PLP::END');
511 # eval { package PLP::Script; $_->() for reverse @PLP::END };
513 # PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;