11 use File::Basename ();
16 our $VERSION = '3.19';
18 # Subs in this package:
19 # _default_error($plain, $html) Default error handler
20 # cgi_init Initialization for CGI
21 # clean Reset variables
22 # error($error, $type) Handle errors
23 # everything Do everything: CGI
24 # handler($r) Do everything: mod_perl
25 # mod_perl_init($r) Initialization for mod_perl
26 # mod_perl_print Faster printing for mod_perl
27 # sendheaders Send headers
28 # source($path, $level, $linespec) Read and parse .plp files
29 # start Start the initialized PLP script
31 # The _init subs do the following:
32 # Set $PLP::code to the initial code
33 # Set $ENV{PLP_*} and make PATH_INFO if needed
36 # This gets referenced as the initial $PLP::ERROR
38 my ($plain, $html) = @_;
39 print qq{<table border=1 class="PLPerror"><tr><td>},
40 qq{<b>Debug information:</b><br>$html</td></tr></table>};
43 # CGI initializer: parses PATH_TRANSLATED
46 $PLP::print = 'print';
48 my $path = $ENV{PATH_TRANSLATED};
49 $ENV{PLP_NAME} = $ENV{PATH_INFO};
51 while (not -f $path) {
52 if (not $path =~ s/(\/+[^\/]*)$//) {
53 print STDERR "PLP: Not found: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
54 PLP::error(undef, 404);
58 $ENV{PLP_NAME} =~ s/\Q$pi\E$//;
59 $path_info = $pi . $path_info;
63 print STDERR "PLP: Can't read: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
64 PLP::error(undef, 403);
69 qw(PATH_TRANSLATED SCRIPT_NAME SCRIPT_FILENAME PATH_INFO),
70 grep /^REDIRECT_/, keys %ENV
73 $ENV{PATH_INFO} = $path_info if defined $path_info;
74 $ENV{PLP_FILENAME} = $path;
75 my ($file, $dir) = File::Basename::fileparse($path);
78 $PLP::code = PLP::source($file, 0, undef, $path);
81 # This cleans up from previous requests, and sets the default $PLP::DEBUG
85 $PLP::sentheaders = 0;
89 delete @ENV{ grep /^PLP_/, keys %ENV };
92 # Handles errors, uses subref $PLP::ERROR (default: \&_default_error)
94 my ($error, $type) = @_;
95 if (not defined $type or $type < 100) {
96 return undef unless $PLP::DEBUG & 1;
98 (my $html = $plain) =~ s/([<&>])/'&#' . ord($1) . ';'/ge;
99 PLP::sendheaders() unless $PLP::sentheaders;
100 $PLP::ERROR->($plain, $html);
103 my ($short, $long) = @{
107 "The requested URL $ENV{REQUEST_URI} was not found " .
112 "You don't have permission to access $ENV{REQUEST_URI} " .
117 print "Status: $type\nContent-Type: text/html\n\n",
118 qq{<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">\n<html>},
119 "<head>\n<title>$type $short</title>\n</head></body>\n<h1>$short",
120 "</h1>\n$long<p>\n<hr>\n$ENV{SERVER_SIGNATURE}</body></html>";
124 # This is run by the CGI script. (#!perl \n use PLP; PLP::everything;)
131 # This is the mod_perl handler.
133 require Apache::Constants;
135 if (my $ret = mod_perl_init($_[0])) {
141 return Apache::Constants::OK();
144 # mod_perl initializer: returns 0 on success, Apache error code on failure
148 $PLP::print = 'PLP::mod_perl_print';
150 $ENV{PLP_FILENAME} = my $filename = $r->filename;
152 unless (-f $filename) {
153 return Apache::Constants::NOT_FOUND();
156 return Apache::Constants::FORBIDDEN();
159 $ENV{PLP_NAME} = $r->uri;
161 our $use_cache = $r->dir_config('PLPcache') !~ /^off$/i;
162 #S our $use_safe = $r->dir_config('PLPsafe') =~ /^on$/i;
163 my $path = $r->filename();
164 my ($file, $dir) = File::Basename::fileparse($path);
167 $PLP::code = PLP::source($file, 0, undef, $path);
172 # FAST printing under mod_perl
174 return unless grep length, @_;
175 PLP::sendheaders() unless $PLP::sentheaders;
179 # Sends the headers waiting in %PLP::Script::header
181 $PLP::sentheaders ||= [ caller 1 ? (caller 1)[1, 2] : (caller)[1, 2] ];
182 print STDOUT "Content-Type: text/plain\n\n" if $PLP::DEBUG & 2;
183 print STDOUT map("$_: $PLP::Script::header{$_}\n", keys %PLP::Script::header), "\n";
187 my %cached; # Conceal cached sources: ( path => [ [ deps ], source, -M ] )
189 # Given a filename and optional level (level should be 0 if the caller isn't
190 # source() itself), and optional linespec (used by PLP::Functions::Include),
191 # this function parses a PLP file and returns Perl code, ready to be eval'ed
193 my ($file, $level, $linespec, $path) = @_;
196 # $file is displayed, $path is used. $path is constructed from $file if
199 $level = 0 unless defined $level;
200 $linespec = '1' unless defined $linespec;
205 ? qq{\cQ; die qq[Include recursion detected]; print q\cQ}
206 : qq{\n#line $linespec\ndie qq[Include recursion detected];};
209 my $in_block = 0; # 1 => "<:", 2 => "<:="
211 $path ||= File::Spec->rel2abs($file);
213 my $source_start = $level
214 ? qq/\cQ;\n#line 1 "$file"\n$PLP::print q\cQ/
215 : qq/\n#line 1 "$file"\n$PLP::print q\cQ/;
217 if ($use_cache and exists $cached{$path}) {
219 my @checkstack = ($path);
222 while (defined(my $item = shift @checkstack)) {
223 next if $checked{$item};
224 last BREAKOUT if $cached{$item}[2] > -M $item;
226 push @checkstack, @{ $cached{$item}[0] }
227 if @{ $cached{$item}[0] };
230 ? $source_start . $cached{$path}[1]
231 : $source_start . $cached{$path}[1] . "\cQ";
235 $cached{$path} = [ [ ], undef, undef ] if $use_cache;
241 open SOURCE, '<', $path or return $level
242 ? qq{\cQ; die qq[Can't open "\Q$path\E" (\Q$!\E)]; print q\cQ}
243 : qq{\n#line $linespec\ndie qq[Can't open "\Q$path\E" (\Q$!\E)];};
246 while (defined (my $line = <SOURCE>)) {
250 \G # Begin where left off
252 | <:=? | :> # PLP tags <:= ... :> <: ... :>
253 | <\([^)]*\)> # Include tags <(...)>
254 | <[^:(][^<:]* # Normal text
255 | :[^>][^<:]* # Normal text
256 | [^<:]* # Normal text
259 next LINE unless length $1;
261 if ($part eq '<:=' and not $in_block) {
264 } elsif ($part eq '<:' and not $in_block) {
267 } elsif ($part eq ':>' and $in_block) {
271 : "; $PLP::print q\cQ" # 1
274 } elsif ($part =~ /^<\((.*?)\)>\z/ and not $in_block) {
275 my $ipath = File::Spec->rel2abs(
276 $1, File::Basename::dirname($path)
278 $source .= source($1, $level + 1, undef, $ipath) .
279 qq/\cQ, \n#line $linenr "$file"\nq\cQ/;
280 push @{ $cached{$path}[0] }, $ipath;
282 $part =~ s/\\/\\\\/ unless $in_block;
292 : "; $PLP::print q\cQ" # 1
297 $cached{$path}[1] = $source;
298 $cached{$path}[2] = -M $path;
302 ? $source_start . $source
303 : $source_start . $source . "\cQ";
308 # Let the games begin! No lexicals may exist at this point.
311 tie *PLPOUT, 'PLP::Tie::Print';
313 $PLP::ERROR = \&_default_error;
318 use vars qw(%headers %header %cookies %cookie %get %post %fields);
321 PLP::Functions->import();
323 # No lexicals may exist at this point.
325 eval qq{ package PLP::Script; $PLP::code; };
326 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
328 eval { package PLP::Script; $_->() for reverse @PLP::END };
329 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
331 PLP::sendheaders() unless $PLP::sentheaders;
333 undef *{"PLP::Script::$_"} for keys %PLP::Script::;
334 # Symbol::delete_package('PLP::Script');
335 # The above does not work. TODO - find out why not.
342 PLP - Perl in HTML pages
346 =head2 mod_perl installation
350 =item * httpd.conf (for mod_perl setup)
353 SetHandler perl-script
356 PerlSetVar PLPcache On
359 # Who said CGI was easier to set up? :)
363 =head2 CGI installation
367 =item * /foo/bar/plp.cgi (local filesystem address)
373 =item * httpd.conf (for CGI setup)
375 ScriptAlias /foo/bar/ /PLP_COMMON/
376 <Directory /foo/bar/>
382 AddHandler plp-document plp
383 Action plp-document /PLP_COMMON/plp.cgi
387 =head2 Test script (test.plp)
391 print "Hurrah, it works!<br>" for 1..10;
397 PLP is yet another Perl embedder, primarily for HTML documents. Unlike with
398 other Perl embedders, there is no need to learn a meta-syntax or object
399 model: one can just use the normal Perl constructs. PLP runs under mod_perl
400 for speeds comparable to those of PHP, but can also be run as a CGI script.
406 =item C<< <: perl_code(); :> >>
408 With C<< <: >> and C<< :> >>, you can add Perl code to your document. This is
409 what PLP is all about. All code outside of these tags is printed. It is
410 possible to mix perl language constructs with normal HTML parts of the document:
412 <: unless ($ENV{REMOTE_USER}) { :>
413 You are not logged in.
416 C<< :> >> always stops a code block, even when it is found in a string literal.
418 =item C<< <:= $expression :> >>
420 Includes a dynamic expression in your document. The expression is evaluated in
421 list context. Please note that the expression should not end a statement: avoid
422 semi-colons. No whitespace may be between C<< <: >> and the equal sign.
424 C<< foo <:= $bar :> $baz >> is like C<< <: print 'foo ', $bar, ' $baz'; :> >>.
426 =item C<< <(filename)> >>
428 Includes another file before the PLP code is executed. The file is included
429 literally, so it shares lexical variables. Because this is a compile-time tag,
430 it's fast, but you can't use a variable as the filename. You can create
431 recursive includes, so beware! (PLP will catch simple recursion: the maximum
432 depth is 128.) Whitespace in the filename is not ignored so C<< <( foo.txt)> >>
433 includes the file named C< foo.txt>, including the space in its name. A
434 compile-time alternative is include(), which is described in L<PLP::Functions>.
440 These are described in L<PLP::Functions>.
448 The URI of the PLP document, without the query string. (Example: C</foo.plp>)
450 =item $ENV{PLP_FILENAME}
452 The filename of the PLP document. (Example: C</var/www/index.plp>)
460 Controls debugging output, and should be treated as a bitmask. The least
461 significant bit (1) controls if run-time error messages are reported to the
462 browser, the second bit (2) controls if headers are sent twice, so they get
463 displayed in the browser. A value of 3 means both features are enabled. The
468 Contains a reference to the code that is used to report run-time errors. You
469 can override this to have it in your own design, and you could even make it
470 report errors by e-mail. The sub reference gets two arguments: the error message
471 as plain text and the error message with special characters encoded with HTML
474 =item %header, %cookie, %get, %post, %fields
476 These are described in L<PLP::Fields>.
480 =head2 (mod_perl only) PerlSetVar configuration directives
486 Sets caching B<On>/B<Off>. When caching, PLP saves your script in memory and
487 doesn't re-read and re-parse it if it hasn't changed. PLP will use more memory,
488 but will also run 50% faster.
490 B<On> is default, anything that isn't =~ /^off$/i is considered On.
494 =head2 Things that you should know about
496 Not only syntax is important, you should also be aware of some other important
497 features. Your script runs inside the package C<PLP::Script> and shouldn't
498 leave it. This is because when your script ends, all global variables in the
499 C<PLP::Script> package are destroyed, which is very important if you run under
500 mod_perl (they would retain their values if they weren't explicitly destroyed).
502 Until your first output, you are printing to a tied filehandle C<PLPOUT>. On
503 first output, headers are sent to the browser and C<STDOUT> is selected for
504 efficiency. To set headers, you must assign to C<$header{ $header_name}> before
505 any output. This means the opening C<< <: >> have to be the first characters in
506 your document, without any whitespace in front of them. If you start output and
507 try to set headers later, an error message will appear telling you on which
508 line your output started. An alternative way of setting headers is using Perl's
509 BEGIN blocks. BEGIN blocks are executed as soon as possible, before anything
512 Because the interpreter that mod_perl uses never ends, C<END { }> blocks won't
513 work properly. You should use C<PLP_END { };> instead. Note that this is a not
514 a built-in construct, so it needs proper termination with a semi-colon (as do
517 Under mod_perl, modules are loaded only once. A good modular design can improve
518 performance because of this, but you will have to B<reload> the modules
519 yourself when there are newer versions.
521 The special hashes are tied hashes and do not always behave the way you expect,
522 especially when mixed with modules that expect normal CGI environments, like
523 CGI.pm. Read L<PLP::Fields> for information more about this.
527 A lot of questions are asked often, so before asking yours, please read the
528 FAQ at L<PLP::FAQ>. Some examples can be found at L<PLP::HowTo>.
532 No warranty, no guarantees. Use PLP at your own risk, as I disclaim all
537 Currently maintained by Mischa POSLAWSKY <perl@shiar.org>
539 Originally by Juerd Waalboer <juerd@cpan.org>
543 L<PLP::Functions>, L<PLP::Fields>, L<PLP::FAQ>, L<PLP::HowTo>
549 # About the #S lines:
550 # I wanted to implement Safe.pm so that scripts were run inside a
551 # configurable compartment. This needed for XS modules to be pre-loaded,
552 # hence the PLPsafe_* Apache directives. However, $safe->reval() lets
553 # Apache segfault. End of fun. The lines are still here so that I can
554 # s/^#S //g to re-implement them whenever this has been fixed.
556 #S # For PLPsafe scripts
558 #S my ($r, $code) = @_;
559 #S $r->send_http_header('text/plain');
561 #S unless ($PLP::safe) {
562 #S $PLP::safe = Safe->new('PLP::Script');
563 #S for ( map split, $r->dir_config->get('PLPsafe_module') ) {
564 #S $PLP::safe->share('*' . $_ . '::');
566 #S require $_ . '.pm';
568 #S $PLP::safe->permit(Opcode::full_opset());
569 #S $PLP::safe->deny(Opcode::opset(':dangerous'));
571 #S $PLP::safe->reval($code);
576 #S if ($PLP::use_safe) {
577 #S PLP::safe_eval($r, $PLP::code);
579 # eval qq{ package PLP::Script; $PLP::code; };
581 # PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
582 #S if ($PLP::use_safe) {
583 #S PLP::safe_eval($r, '$_->() for reverse @PLP::END');
585 # eval { package PLP::Script; $_->() for reverse @PLP::END };
587 # PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;