11 use File::Basename ();
17 our $VERSION = '3.16';
19 # subs in this package:
20 # sendheaders Send headers
21 # source($path, $level, $linespec) Read and parse .plp files
22 # error($error, $type) Handle errors
23 # _default_error($plain, $html) Default error handler
24 # clean Reset variables
25 # cgi_init Initialization for CGI
26 # mod_perl_init($r) Initialization for mod_perl
27 # start Start the initialized PLP script
28 # everything Do everything: CGI
29 # handler($r) Do everything: mod_perl
32 # I wanted to implement Safe.pm so that scripts were run inside a
33 # configurable compartment. This needed for XS modules to be pre-loaded,
34 # hence the PLPsafe_* Apache directives. However, $safe->reval() lets
35 # Apache segfault. End of fun. The lines are still here so that I can
36 # s/^#S //m to re-implement them whenever this has been fixed.
38 # Sends the headers waiting in %PLP::Script::header
41 print STDOUT "Content-Type: text/plain\n\n" if $PLP::DEBUG & 2;
42 print STDOUT map("$_: $PLP::Script::header{$_}\n", keys %PLP::Script::header), "\n";
46 my %cached; # Conceal cached sources: ( path => [ [ deps ], source, -M ] )
48 # Given a filename and optional level (level should be 0 if the caller isn't
49 # source() itself), and optional linespec (used by PLP::Functions::Include),
50 # this function parses a PLP file and returns Perl code, ready to be eval'ed
52 my ($file, $level, $linespec, $path) = @_;
53 # $file is displayed, $path is used. $path is constructed from $file if
55 $level = 0 if not defined $level;
56 $linespec = '1' if not defined $linespec;
61 ? qq{\cQ; die qq[Include recursion detected]; print q\cQ}
62 : qq{\n#line $linespec\ndie qq[Include recursion detected];};
65 our ($inA, $inB, $use_cache);
66 $path ||= File::Spec->rel2abs($file);
68 my $source_start = $level
69 ? qq/\cQ;\n#line 1 "$file"\nprint q\cQ/
70 : qq/\n#line 1 "$file"\nprint q\cQ/;
72 if ($use_cache and exists $cached{$path}) {
74 my @checkstack = ($path);
77 while (defined(my $item = shift @checkstack)) {
78 next if $checked{$item};
79 last BREAKOUT if $cached{$item}[2] > -M $item;
81 push @checkstack, @{ $cached{$item}[0] }
82 if @{ $cached{$item}[0] };
85 ? $source_start . $cached{$path}[1]
86 : $source_start . $cached{$path}[1] . "\cQ";
90 $cached{$path} = [ [ ], undef, undef ] if $use_cache;
96 open SOURCE, '<', $path or return $level
97 ? qq{\cQ; die qq[Can't open "\Q$path\E" (\Q$!\E)]; print q\cQ}
98 : qq{\n#line $linespec\ndie qq[Can't open "\Q$path\E" (\Q$!\E)];};
101 while (defined (my $line = <SOURCE>)) {
105 \G # Begin where left off
107 | <:=? | :> # PLP tags <:= ... :> <: ... :>
108 | <\(.*?\)> # Include tags <(...)>
109 | <[^:(][^<:]* # Normal text
110 | :[^>][^<:]* # Normal text
111 | [^<:]* # Normal text
114 next LINE unless length $1;
116 if ($part eq '<:=' and not $inA || $inB) {
119 } elsif ($part eq '<:' and not $inA || $inB) {
122 } elsif ($part eq ':>' and $inA) {
125 } elsif ($part eq ':>' and $inB) {
127 $source .= "; print q\cQ";
128 } elsif ($part =~ /^<\((.*?)\)>\z/ and not $inA || $inB) {
129 my $ipath = File::Spec->rel2abs($1, File::Basename::dirname($path));
130 $source .= source($1, $level + 1, undef, $ipath) .
131 qq/\cQ, \n#line $linenr "$file"\nq\cQ/;
132 push @{ $cached{$path}[0] }, $ipath;
134 $part =~ s/\\/\\\\/ if not $inA || $inB;
141 $cached{$path}[1] = $source;
142 $cached{$path}[2] = -M $path;
146 ? $source_start . $source
147 : $source_start . $source . "\cQ";
151 # Handles errors, uses subref $PLP::ERROR (default: \&_default_error)
153 my ($error, $type) = @_;
154 if (not defined $type or $type < 100) {
155 return undef unless $PLP::DEBUG & 1;
157 (my $html = $plain) =~ s/([<&>])/'&#' . ord($1) . ';'/ge;
158 PLP::sendheaders unless $PLP::sentheaders;
159 $PLP::ERROR->($plain, $html);
162 my ($short, $long) = @{
166 "The requested URL $ENV{REQUEST_URI} was not found on this server."
170 "You don't have permission to access $ENV{REQUEST_URI} on this server."
174 print "Status: $type\nContent-Type: text/html\n\n",
175 qq{<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">\n},
176 "<html><head>\n<title>--$type $short</title>\n</head></body>\n",
177 "<h1>$short</h1>\n$long<p>\n<hr>\n$ENV{SERVER_SIGNATURE}</body></html>";
181 # This gets referenced as the initial $PLP::ERROR
183 my ($plain, $html) = @_;
184 print qq{<table border=1 class="PLPerror"><tr><td>},
185 qq{<span><b>Debug information:</b><BR>$html</td></tr></table>};
188 # This cleans up from previous requests, and sets the default $PLP::DEBUG
192 $PLP::sentheaders = 0;
196 delete @ENV{ grep /^PLP_/, keys %ENV };
199 # The *_init subs do the following:
200 # o Set $PLP::code to the initial code
201 # o Set $ENV{PLP_*} and makes PATH_INFO if needed
204 # CGI initializer: parses PATH_TRANSLATED
206 my $path = $ENV{PATH_TRANSLATED};
207 $ENV{PLP_NAME} = $ENV{PATH_INFO};
209 while (not -f $path) {
210 if (not $path =~ s/(\/+[^\/]*)$//) {
211 print STDERR "PLP: Not found: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
212 PLP::error(undef, 404);
216 $ENV{PLP_NAME} =~ s/\Q$pi\E$//;
217 $path_info = $pi . $path_info;
221 print STDERR "PLP: Can't read: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
222 PLP::error(undef, 403);
227 qw(PATH_TRANSLATED SCRIPT_NAME SCRIPT_FILENAME PATH_INFO),
228 grep { /^REDIRECT_/ } keys %ENV
231 $ENV{PATH_INFO} = $path_info if defined $path_info;
232 $ENV{PLP_FILENAME} = $path;
233 my ($file, $dir) = File::Basename::fileparse($path);
236 $PLP::code = PLP::source($file, 0, undef, $path);
239 # mod_perl initializer: returns 0 on success, Apache error code on failure
243 $ENV{PLP_FILENAME} = my $filename = $r->filename;
245 unless (-f $filename) {
246 return Apache::Constants::NOT_FOUND();
249 return Apache::Constants::FORBIDDEN();
252 $ENV{PLP_NAME} = $r->uri;
254 our $use_cache = $r->dir_config('PLPcache') !~ /^off$/i;
255 #S our $use_safe = $r->dir_config('PLPsafe') =~ /^on$/i;
256 my $path = $r->filename();
257 my ($file, $dir) = File::Basename::fileparse($path);
260 $PLP::code = PLP::source($file, 0, undef, $path);
265 #S # For PLPsafe scripts
267 #S my ($r, $code) = @_;
268 #S $r->send_http_header('text/plain');
270 #S unless ($PLP::safe) {
271 #S $PLP::safe = Safe->new('PLP::Script');
272 #S for ( map split, $r->dir_config->get('PLPsafe_module') ) {
273 #S $PLP::safe->share('*' . $_ . '::');
275 #S require $_ . '.pm';
277 #S $PLP::safe->permit(Opcode::full_opset());
278 #S $PLP::safe->deny(Opcode::opset(':dangerous'));
280 #S $PLP::safe->reval($code);
283 # Let the games begin! No lexicals may exist at this point.
287 tie *PLPOUT, 'PLP::Tie::Print';
289 $PLP::ERROR = \&_default_error;
294 use vars qw(%headers %header %cookies %cookie %get %post %fields);
297 PLP::Functions->import();
298 # No lexicals may exist at this point.
300 #S if ($PLP::use_safe) {
301 #S PLP::safe_eval($r, $PLP::code);
303 eval qq{ package PLP::Script; $PLP::code; };
305 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
307 #S if ($PLP::use_safe) {
308 #S PLP::safe_eval($r, '$_->() for reverse @PLP::END');
310 eval { package PLP::Script; $_->() for reverse @PLP::END };
312 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
314 PLP::sendheaders() unless $PLP::sentheaders;
316 undef *{"PLP::Script::$_"} for keys %PLP::Script::;
317 # Symbol::delete_package('PLP::Script');
318 # The above does not work. TODO - find out why not.
321 # This is run by the CGI script. (#!perl \n use PLP; PLP::everything;)
328 # This is the mod_perl handler.
330 require Apache::Constants;
332 if (my $ret = mod_perl_init($_[0])) {
338 return Apache::Constants::OK();
345 PLP - Perl in HTML pages
349 =head2 mod_perl installation
353 =item * httpd.conf (for mod_perl setup)
356 SetHandler perl-script
359 PerlSetVar PLPcache On
362 # Who said CGI was easier to set up? :)
366 =head2 CGI installation
370 =item * /foo/bar/plp.cgi (local filesystem address)
376 =item * httpd.conf (for CGI setup)
378 ScriptAlias /foo/bar/ /PLP_COMMON/
379 <Directory /foo/bar/>
385 AddHandler plp-document plp
386 Action plp-document /PLP_COMMON/plp.cgi
390 =head2 Test script (test.plp)
394 print "Hurrah, it works!<br>" for 1..10;
400 PLP is yet another Perl embedder, primarily for HTML documents. Unlike with
401 other Perl embedders, there is no need to learn a meta-syntax or object
402 model: one can just use the normal Perl constructs. PLP runs under mod_perl
403 for speeds comparable to those of PHP, but can also be run as a CGI script.
409 =item C<< <: perl_code(); :> >>
411 With C<< <: >> and C<< :> >>, you can add Perl code to your document. This is
412 what PLP is all about. All code outside of these tags is printed. It is
413 possible to mix perl language constructs with normal HTML parts of the document:
415 <: unless ($ENV{REMOTE_USER}) { :>
416 You are not logged in.
419 C<< :> >> always stops a code block, even when it is found in a string literal.
421 =item C<< <:= $expression :> >>
423 Includes a dynamic expression in your document. The expression is evaluated in
424 list context. Please note that the expression should not end a statement: avoid
425 semi-colons. No whitespace may be between C<< <: >> and the equal sign.
427 C<< foo <:= $bar :> $baz >> is like C<< <: print 'foo ', $bar, ' baz'; :> >>.
429 =item C<< <(filename)> >>
431 Includes another file before the PLP code is executed. The file is included
432 literally, so it shares lexical variables. Because this is a compile-time tag,
433 it's fast, but you can't use a variable as the filename. You can create
434 recursive includes, so beware! (PLP will catch simple recursion: the maximum
435 depth is 128.) Whitespace in the filename is not ignored so C<< <( foo.txt)> >>
436 includes the file named C< foo.txt>, including the space in its name. A
437 compile-time alternative is include(), which is described in L<PLP::Functions>.
443 These are described in L<PLP::Functions>.
451 The URI of the PLP document, without the query string. (Example: C</foo.plp>)
453 =item $ENV{PLP_FILENAME}
455 The filename of the PLP document. (Example: C</var/www/index.plp>)
463 Controls debugging output, and should be treated as a bitmask. The least
464 significant bit (1) controls if run-time error messages are reported to the
465 browser, the second bit (2) controls if headers are sent twice, so they get
466 displayed in the browser. A value of 3 means both features are enabled. The
471 Contains a reference to the code that is used to report run-time errors. You
472 can override this to have it in your own design, and you could even make it
473 report errors by e-mail. The sub reference gets two arguments: the error message
474 as plain text and the error message with special characters encoded with HTML
477 =item %header, %cookie, %get, %post, %fields
479 These are described in L<PLP::Fields>.
483 =head2 (mod_perl only) PerlSetVar configuration directives
489 Sets caching B<On>/B<Off>. When caching, PLP saves your script in memory and
490 doesn't re-read and re-parse it if it hasn't changed. PLP will use more memory,
491 but will also run 50% faster.
493 B<On> is default, anything that isn't =~ /^off$/i is considered On.
497 =head2 Things that you should know about
499 Not only syntax is important, you should also be aware of some other important
500 features. Your script runs inside the package C<PLP::Script> and shouldn't
501 leave it. This is because when your script ends, all global variables in the
502 C<PLP::Script> package are destroyed, which is very important if you run under
503 mod_perl (they would retain their values if they weren't explicitly destroyed).
505 Until your first output, you are printing to a tied filehandle C<PLPOUT>. On
506 first output, headers are sent to the browser and C<STDOUT> is selected for
507 efficiency. To set headers, you must assign to C<$header{ $header_name}> before
508 any output. This means the opening C<< <: >> have to be the first characters in
509 your document, without any whitespace in front of them. If you start output and
510 try to set headers later, an error message will appear telling you on which
511 line your output started. An alternative way of setting headers is using Perl's
512 BEGIN blocks. BEGIN blocks are executed as soon as possible, before anything
515 Because the interpreter that mod_perl uses never ends, C<END { }> blocks won't
516 work properly. You should use C<PLP_END { };> instead. Note that this is a not
517 a built-in construct, so it needs proper termination with a semi-colon (as do
520 Under mod_perl, modules are loaded only once. A good modular design can improve
521 performance because of this, but you will have to B<reload> the modules
522 yourself when there are newer versions.
524 The special hashes are tied hashes and do not always behave the way you expect,
525 especially when mixed with modules that expect normal CGI environments, like
526 CGI.pm. Read L<PLP::Fields> for information more about this.
530 A lot of questions are asked often, so before asking yours, please read the
531 FAQ at L<PLP::FAQ>. Some examples can be found at L<PLP::HowTo>.
535 No warranty, no guarantees. Use PLP at your own risk, as I disclaim all
540 Juerd Waalboer <juerd@cpan.org>
544 L<PLP::Functions>, L<PLP::Fields>, L<PLP::FAQ>, L<PLP::HowTo>