13 our $VERSION = '3.11';
15 # subs in this package:
16 # sendheaders Send headers
17 # source($path, $level, $linespec) Read and parse .plp files
18 # error($error, $type) Handle errors
19 # _default_error($plain, $html) Default error handler
20 # clean Reset variables
21 # cgi_init Initialization for CGI
22 # mod_perl_init($r) Initialization for mod_perl
23 # start Start the initialized PLP script
24 # everything Do everything: CGI
25 # handler($r) Do everything: mod_perl
28 # Sends the headers waiting in %PLP::Script::header
31 print STDOUT "Content-Type: text/plain\n\n" if $PLP::DEBUG & 2;
32 print STDOUT map("$_: $PLP::Script::header{$_}\n", keys %PLP::Script::header), "\n";
35 # Given a filename and optional level (level should be 0 if the caller isn't
36 # source() itself), and optional linespec (used by PLP::Functions::Include),
37 # this function parses a PLP file and returns Perl code, ready to be eval'ed
39 my ($path, $level, $linespec) = @_;
40 $level = 0 if not defined $level;
41 $linespec = '1' if not defined $linespec;
45 (my $file = $path) =~ s[.*/][];
48 ? qq/\cQ;\n#line 1 "$file"\nprint q\cQ/
49 : qq/\n#line 1 "$file"\nprint q\cQ/;
53 open SOURCE, '<', $path or return $level
54 ? qq{\cQ; die qq[Can't open "\Q$path\E" (\Q$!\E)]; print q\cQ}
55 : qq{\n#line $linespec\ndie qq[Can't open "\Q$path\E" (\Q$!\E)];};
58 while (defined (my $line = <SOURCE>)) {
62 \G # Begin where left off
64 | <:=? | :> # PLP tags <:= ... :> <: ... :>
65 | <\(.*?\)> # Include tags <(...)>
66 | <[^:(][^<:]* # Normal text
67 | :[^>][^<:]* # Normal text
68 | [^<:]* # Normal text
71 next LINE unless length $1;
73 if ($part eq '<:=' and not $inA || $inB) {
76 } elsif ($part eq '<:' and not $inA || $inB) {
79 } elsif ($part eq ':>' and $inA) {
82 } elsif ($part eq ':>' and $inB) {
84 $source .= "; print q\cQ";
85 } elsif ($part =~ /^<\((.*?)\)>\z/ and not $inA || $inB) {
86 $source .= source($1, $level + 1) .
87 qq/\cQ, \n#line $linenr "$file"\nq\cQ/;
89 $part =~ s/\\/\\\\/ if not $inA || $inB;
94 $source .= "\cQ" unless $level;
99 # Handles errors, uses the sub reference $PLP::ERROR that gets two arguments:
100 # the error message in plain text, and the error message with html entities
102 my ($error, $type) = @_;
103 if (not defined $type or $type < 100) {
104 return undef unless $PLP::DEBUG & 1;
106 (my $html = $plain) =~ s/([<&>])/'&#' . ord($1) . ';'/ge;
107 PLP::sendheaders unless $PLP::sentheaders;
108 $PLP::ERROR->($plain, $html);
111 my ($short, $long) = @{
115 "The requested URL $ENV{REQUEST_URI} was not found on this server."
119 "You don't have permission to access $ENV{REQUEST_URI} on this server."
123 print "Status: $type\nContent-Type: text/html\n\n",
124 qq{<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">\n},
125 "<html><head>\n<title>--$type $short</title>\n</head></body>\n",
126 "<h1>$short</h1>\n$long<p>\n<hr>\n$ENV{SERVER_SIGNATURE}</body></html>";
130 # This gets referenced as the initial $PLP::ERROR
132 my ($plain, $html) = @_;
133 print qq{<table border=1 class="PLPerror"><tr><td>},
134 qq{<span><b>Debug information:</b><BR>$html</td></tr></table>};
137 # This cleans up from previous requests, and sets the default $PLP::DEBUG
141 $PLP::sentheaders = 0;
145 delete @ENV{ grep /^PLP_/, keys %ENV };
148 # The *_init subs do the following:
149 # o Set $PLP::code to the initial code
150 # o Set $ENV{PLP_*} and makes PATH_INFO if needed
153 # This sub is meant for CGI requests only, and takes apart PATH_TRANSLATED
156 my $file = defined $_[0] ? $_[0] : $ENV{PATH_TRANSLATED};
157 $ENV{PLP_NAME} = $ENV{PATH_INFO};
159 while (not -f $file) {
160 if (not $file =~ s/(\/+[^\/]*)$//) {
161 print STDERR "PLP: Not found: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
162 PLP::error(undef, 404);
166 $ENV{PLP_NAME} =~ s/\Q$pi\E$//;
167 $path_info = $pi . $path_info;
171 print STDERR "PLP: Can't read: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
172 PLP::error(undef, 403);
177 qw(PATH_TRANSLATED SCRIPT_NAME SCRIPT_FILENAME PATH_INFO),
178 grep { /^REDIRECT_/ } keys %ENV
181 $ENV{PATH_INFO} = $path_info if defined $path_info;
182 $ENV{PLP_FILENAME} = $file;
183 (my $dir = $file) =~ s{/[^/]+$}[];
186 $PLP::code = PLP::source($file, 0);
189 # This is the mod_perl initializer.
190 # Returns 0 on success.
194 $ENV{PLP_FILENAME} = my $filename = $r->filename;
196 unless (-f $filename) {
197 return Apache::Constants::NOT_FOUND;
200 return Apache::Constants::FORBIDDEN;
203 (my $dir) = $filename =~ m!(.*)/!s;
205 $ENV{PLP_NAME} = $r->uri;
206 $PLP::code = PLP::source($r->filename);
211 # Let the games begin!
212 # No lexicals may exist at this point.
215 tie *PLPOUT, 'PLP::Tie::Print';
217 $PLP::ERROR = \&_default_error;
224 PLP::Functions->import();
225 # No lexicals may exist at this point.
226 eval qq{ package PLP::Script; $PLP::code; };
227 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
228 eval { package PLP::Script; $_->() for reverse @PLP::END };
229 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
231 PLP::sendheaders() unless $PLP::sentheaders;
233 undef *{"PLP::Script::$_"} for keys %PLP::Script::;
234 # Symbol::delete_package('PLP::Script');
235 # The above does not work. TODO - find out why not.
238 # This is run by the CGI script.
239 # The CGI script is just:
249 # This is the mod_perl handler.
251 require Apache::Constants;
253 if (my $ret = mod_perl_init(shift)) {
257 return Apache::Constants::OK;
264 PLP - Perl in HTML pages
268 =head2 mod_perl installation
272 =item * httpd.conf (for mod_perl setup)
275 SetHandler perl-script
280 # Who said CGI was easier to set up? :)
284 =head2 CGI installation
288 =item * /foo/bar/plp.cgi (local filesystem address)
294 =item * httpd.conf (for CGI setup)
296 ScriptAlias /foo/bar/ /PLP_COMMON/
297 <Directory /foo/bar/>
303 AddHandler plp-document plp
304 Action plp-document /PLP_COMMON/plp.cgi
308 =head2 Test script (test.plp)
312 print "Hurrah, it works!<br>" for 1..10;
318 PLP is yet another Perl embedder, primarily for HTML documents. Unlike with
319 other Perl embedders, there is no need to learn a meta-syntax or object
320 model: one can just use the normal Perl constructs. PLP runs under mod_perl
321 for speeds comparable to those of PHP, but can also be run as a CGI script.
325 For now, all documentation is on the website. Everything will be POD one day,
326 but until that day, you will need to visit http://plp.juerd.nl/
330 No warranty, no guarantees. Use PLP at your own risk, as I disclaim all
335 Juerd Waalboer <juerd@juerd.nl>