15 our $VERSION = '3.13';
17 # subs in this package:
18 # sendheaders Send headers
19 # source($path, $level, $linespec) Read and parse .plp files
20 # error($error, $type) Handle errors
21 # _default_error($plain, $html) Default error handler
22 # clean Reset variables
23 # cgi_init Initialization for CGI
24 # mod_perl_init($r) Initialization for mod_perl
25 # start Start the initialized PLP script
26 # everything Do everything: CGI
27 # handler($r) Do everything: mod_perl
30 # Sends the headers waiting in %PLP::Script::header
33 print STDOUT "Content-Type: text/plain\n\n" if $PLP::DEBUG & 2;
34 print STDOUT map("$_: $PLP::Script::header{$_}\n", keys %PLP::Script::header), "\n";
37 # Given a filename and optional level (level should be 0 if the caller isn't
38 # source() itself), and optional linespec (used by PLP::Functions::Include),
39 # this function parses a PLP file and returns Perl code, ready to be eval'ed
41 my ($path, $level, $linespec) = @_;
42 $level = 0 if not defined $level;
43 $linespec = '1' if not defined $linespec;
47 (my $file = $path) =~ s[.*/][];
50 ? qq/\cQ;\n#line 1 "$file"\nprint q\cQ/
51 : qq/\n#line 1 "$file"\nprint q\cQ/;
55 open SOURCE, '<', $path or return $level
56 ? qq{\cQ; die qq[Can't open "\Q$path\E" (\Q$!\E)]; print q\cQ}
57 : qq{\n#line $linespec\ndie qq[Can't open "\Q$path\E" (\Q$!\E)];};
60 while (defined (my $line = <SOURCE>)) {
64 \G # Begin where left off
66 | <:=? | :> # PLP tags <:= ... :> <: ... :>
67 | <\(.*?\)> # Include tags <(...)>
68 | <[^:(][^<:]* # Normal text
69 | :[^>][^<:]* # Normal text
70 | [^<:]* # Normal text
73 next LINE unless length $1;
75 if ($part eq '<:=' and not $inA || $inB) {
78 } elsif ($part eq '<:' and not $inA || $inB) {
81 } elsif ($part eq ':>' and $inA) {
84 } elsif ($part eq ':>' and $inB) {
86 $source .= "; print q\cQ";
87 } elsif ($part =~ /^<\((.*?)\)>\z/ and not $inA || $inB) {
88 $source .= source($1, $level + 1) .
89 qq/\cQ, \n#line $linenr "$file"\nq\cQ/;
91 $part =~ s/\\/\\\\/ if not $inA || $inB;
96 $source .= "\cQ" unless $level;
101 # Handles errors, uses the sub reference $PLP::ERROR that gets two arguments:
102 # the error message in plain text, and the error message with html entities
104 my ($error, $type) = @_;
105 if (not defined $type or $type < 100) {
106 return undef unless $PLP::DEBUG & 1;
108 (my $html = $plain) =~ s/([<&>])/'&#' . ord($1) . ';'/ge;
109 PLP::sendheaders unless $PLP::sentheaders;
110 $PLP::ERROR->($plain, $html);
113 my ($short, $long) = @{
117 "The requested URL $ENV{REQUEST_URI} was not found on this server."
121 "You don't have permission to access $ENV{REQUEST_URI} on this server."
125 print "Status: $type\nContent-Type: text/html\n\n",
126 qq{<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">\n},
127 "<html><head>\n<title>--$type $short</title>\n</head></body>\n",
128 "<h1>$short</h1>\n$long<p>\n<hr>\n$ENV{SERVER_SIGNATURE}</body></html>";
132 # This gets referenced as the initial $PLP::ERROR
134 my ($plain, $html) = @_;
135 print qq{<table border=1 class="PLPerror"><tr><td>},
136 qq{<span><b>Debug information:</b><BR>$html</td></tr></table>};
139 # This cleans up from previous requests, and sets the default $PLP::DEBUG
143 $PLP::sentheaders = 0;
147 delete @ENV{ grep /^PLP_/, keys %ENV };
150 # The *_init subs do the following:
151 # o Set $PLP::code to the initial code
152 # o Set $ENV{PLP_*} and makes PATH_INFO if needed
155 # This sub is meant for CGI requests only, and takes apart PATH_TRANSLATED
158 my $file = defined $_[0] ? $_[0] : $ENV{PATH_TRANSLATED};
159 $ENV{PLP_NAME} = $ENV{PATH_INFO};
161 while (not -f $file) {
162 if (not $file =~ s/(\/+[^\/]*)$//) {
163 print STDERR "PLP: Not found: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
164 PLP::error(undef, 404);
168 $ENV{PLP_NAME} =~ s/\Q$pi\E$//;
169 $path_info = $pi . $path_info;
173 print STDERR "PLP: Can't read: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
174 PLP::error(undef, 403);
179 qw(PATH_TRANSLATED SCRIPT_NAME SCRIPT_FILENAME PATH_INFO),
180 grep { /^REDIRECT_/ } keys %ENV
183 $ENV{PATH_INFO} = $path_info if defined $path_info;
184 $ENV{PLP_FILENAME} = $file;
185 (my $dir = $file) =~ s{/[^/]+$}[];
188 $PLP::code = PLP::source($file, 0);
191 # This is the mod_perl initializer.
192 # Returns 0 on success.
196 $ENV{PLP_FILENAME} = my $filename = $r->filename;
198 unless (-f $filename) {
199 return Apache::Constants::NOT_FOUND();
202 return Apache::Constants::FORBIDDEN();
205 (my $dir) = $filename =~ m!(.*)/!s;
207 $ENV{PLP_NAME} = $r->uri;
208 $PLP::code = PLP::source($r->filename);
213 # Let the games begin!
214 # No lexicals may exist at this point.
217 tie *PLPOUT, 'PLP::Tie::Print';
219 $PLP::ERROR = \&_default_error;
224 use vars qw(%headers %header %cookies %cookie %get %post %fields);
227 PLP::Functions->import();
228 # No lexicals may exist at this point.
229 eval qq{ package PLP::Script; $PLP::code; };
230 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
231 eval { package PLP::Script; $_->() for reverse @PLP::END };
232 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
234 PLP::sendheaders() unless $PLP::sentheaders;
236 undef *{"PLP::Script::$_"} for keys %PLP::Script::;
237 # Symbol::delete_package('PLP::Script');
238 # The above does not work. TODO - find out why not.
241 # This is run by the CGI script.
242 # The CGI script is just:
252 # This is the mod_perl handler.
254 require Apache::Constants;
256 if (my $ret = mod_perl_init(shift)) {
261 return Apache::Constants::OK();
268 PLP - Perl in HTML pages
272 =head2 mod_perl installation
276 =item * httpd.conf (for mod_perl setup)
279 SetHandler perl-script
284 # Who said CGI was easier to set up? :)
288 =head2 CGI installation
292 =item * /foo/bar/plp.cgi (local filesystem address)
298 =item * httpd.conf (for CGI setup)
300 ScriptAlias /foo/bar/ /PLP_COMMON/
301 <Directory /foo/bar/>
307 AddHandler plp-document plp
308 Action plp-document /PLP_COMMON/plp.cgi
312 =head2 Test script (test.plp)
316 print "Hurrah, it works!<br>" for 1..10;
322 PLP is yet another Perl embedder, primarily for HTML documents. Unlike with
323 other Perl embedders, there is no need to learn a meta-syntax or object
324 model: one can just use the normal Perl constructs. PLP runs under mod_perl
325 for speeds comparable to those of PHP, but can also be run as a CGI script.
331 =item C<< <: perl_code(); :> >>
333 With C<< <: >> and C<< :> >>, you can add Perl code to your document. This is
334 what PLP is all about. All code outside of these tags is printed. It is
335 possible to mix perl language constructs with normal HTML parts of the document:
337 <: unless ($ENV{REMOTE_USER}) { :>
338 You are not logged in.
341 C<< :> >> always stops a code block, even when it is found in a string literal.
343 =item C<< <:= $expression :> >>
345 Includes a dynamic expression in your document. The expression is evaluated in
346 list context. Please note that the expression should not end a statement: avoid
347 semi-colons. No whitespace may be between C<< <: >> and the equal sign.
349 C<< foo <:= $bar :> $baz >> is like C<< <: print 'foo ', $bar, ' baz'; :> >>.
351 =item C<< <(filename)> >>
353 Includes another file before the PLP code is executed. The file is included
354 literally, so it shares lexical variables. Because this is a compile-time tag,
355 it's fast, but you can't use a variable as the filename. You can create
356 recursive includes, so beware of that! Whitespace in the filename is not
357 ignored so C<< <( foo.txt)> >> includes the file named C< foo.txt>, including
358 the space in its name. A compile-time alternative is include(), which is
359 described in L<PLP::Functions>.
365 These are described in L<PLP::Functions>.
373 The URI of the PLP document, without the query string. (Example: C</foo.plp>)
375 =item $ENV{PLP_FILENAME}
377 The filename of the PLP document. (Example: C</var/www/index.plp>)
385 Controls debugging output, and should be treated as a bitmask. The least
386 significant bit (1) controls if run-time error messages are reported to the
387 browser, the second bit (2) controls if headers are sent twice, so they get
388 displayed in the browser. A value of 3 means both features are enabled. The
393 Contains a reference to the code that is used to report run-time errors. You
394 can override this to have it in your own design, and you could even make it
395 report errors by e-mail. The sub reference gets two arguments: the error message
396 as plain text and the error message with special characters encoded with HTML
399 =item %header, %cookie, %get, %post, %fields
401 These are described in L<PLP::Fields>.
405 =head2 Things that you should know about
407 Not only syntax is important, you should also be aware of some other important
408 features. Your script runs inside the package C<PLP::Script> and shouldn't
409 leave it. This is because when your script ends, all global variables in the
410 C<PLP::Script> package are destroyed, which is very important if you run under
411 mod_perl (they would retain their values if they weren't explicitly destroyed).
413 Until your first output, you are printing to a tied filehandle C<PLPOUT>. On
414 first output, headers are sent to the browser and C<STDOUT> is selected for
415 efficiency. To set headers, you must assign to C<$header{ $header_name}> before
416 any output. This means the opening C<< <: >> have to be the first characters in
417 your document, without any whitespace in front of them. If you start output and
418 try to set headers later, an error message will appear telling you on which
419 line your output started.
421 Because the interpreter that mod_perl uses never ends, C<END { }> blocks won't
422 work properly. You should use C<PLP_END { };> instead. Note that this is a not
423 a built-in construct, so it needs proper termination with a semi-colon (as do
426 Under mod_perl, modules are loaded only once. A good modular design can improve
427 performance because of this, but you will have to B<reload> the modules
428 yourself when there are newer versions.
430 The special hashes are tied hashes and do not always behave the way you expect,
431 especially when mixed with modules that expect normal CGI environments, like
432 CGI.pm. Read L<PLP::Fields> for information more about this.
436 For now, all documentation is on the website. Everything will be POD one day,
437 but until that day, you will need to visit http://plp.juerd.nl/
441 A lot of questions are asked often, so before asking yours, please read the
446 No warranty, no guarantees. Use PLP at your own risk, as I disclaim all
451 Juerd Waalboer <juerd@juerd.nl>