14 our $VERSION = '3.10';
16 # subs in this package:
17 # sendheaders Send headers
18 # source($path, $level, $linespec) Read and parse .plp files
19 # error($error, $type) Handle errors
20 # _default_error($plain, $html) Default error handler
21 # clean Reset variables
22 # cgi_init Initialization for CGI
23 # mod_perl_init($r) Initialization for mod_perl
24 # start Start the initialized PLP script
25 # everything Do everything: CGI
26 # handler($r) Do everything: mod_perl
29 # Sends the headers waiting in %PLP::Script::header
32 print STDOUT "Content-Type: text/plain\n\n" if $PLP::DEBUG & 2;
33 print STDOUT map("$_: $PLP::Script::header{$_}\n", keys %PLP::Script::header), "\n";
36 # Given a filename and optional level (level should be 0 if the caller isn't
37 # source() itself), and optional linespec (used by PLP::Functions::Include),
38 # this function parses a PLP file and returns Perl code, ready to be eval'ed
40 my ($path, $level, $linespec) = @_;
41 $level = 0 if not defined $level;
42 $linespec = '1' if not defined $linespec;
46 (my $file = $path) =~ s[.*/][];
49 ? qq/\cQ;\n#line 1 "$file"\nprint q\cQ/
50 : qq/\n#line 1 "$file"\nprint q\cQ/;
54 open SOURCE, '<', $path or return $level
55 ? qq{\cQ; die qq[Can't open "\Q$path\E" (\Q$!\E)]; print q\cQ}
56 : qq{\n#line $linespec\ndie qq[Can't open "\Q$path\E" (\Q$!\E)];};
59 while (defined (my $line = <SOURCE>)) {
63 \G # Begin where left off
65 | <:=? | :> # PLP tags <:= ... :> <: ... :>
66 | <\(.*?\)> # Include tags <(...)>
67 | <[^:(][^<:]* # Normal text
68 | :[^>][^<:]* # Normal text
69 | [^<:]* # Normal text
72 next LINE unless length $1;
74 if ($part eq '<:=' and not $inA || $inB) {
77 } elsif ($part eq '<:' and not $inA || $inB) {
80 } elsif ($part eq ':>' and $inA) {
83 } elsif ($part eq ':>' and $inB) {
85 $source .= "; print q\cQ";
86 } elsif ($part =~ /^<\((.*?)\)>\z/ and not $inA || $inB) {
87 $source .= source($1, $level + 1) .
88 qq/\cQ, \n#line $linenr "$file"\nq\cQ/;
90 $part =~ s/\\/\\\\/ if not $inA || $inB;
95 $source .= "\cQ" unless $level;
100 # Handles errors, uses the sub reference $PLP::ERROR that gets two arguments:
101 # the error message in plain text, and the error message with html entities
103 my ($error, $type) = @_;
104 if (not defined $type or $type < 100) {
105 return undef unless $PLP::DEBUG & 1;
107 (my $html = $plain) =~ s/([<&>])/'&#' . ord($1) . ';'/ge;
108 PLP::sendheaders unless $PLP::sentheaders;
109 $PLP::ERROR->($plain, $html);
112 my ($short, $long) = @{
116 "The requested URL $ENV{REQUEST_URI} was not found on this server."
120 "You don't have permission to access $ENV{REQUEST_URI} on this server."
124 print "Status: $type\nContent-Type: text/html\n\n",
125 qq{<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">\n},
126 "<html><head>\n<title>--$type $short</title>\n</head></body>\n",
127 "<h1>$short</h1>\n$long<p>\n<hr>\n$ENV{SERVER_SIGNATURE}</body></html>";
131 # This gets referenced as the initial $PLP::ERROR
133 my ($plain, $html) = @_;
134 print qq{<table border=1 class="PLPerror"><tr><td>},
135 qq{<span><b>Debug information:</b><BR>$html</td></tr></table>};
138 # This cleans up from previous requests, and sets the default $PLP::DEBUG
142 $PLP::sentheaders = 0;
146 delete @ENV{ grep /^PLP_/, keys %ENV };
149 # The *_init subs do the following:
150 # o Set $PLP::code to the initial code
151 # o Set $ENV{PLP_*} and makes PATH_INFO if needed
154 # This sub is meant for CGI requests only, and takes apart PATH_TRANSLATED
157 my $file = defined $_[0] ? $_[0] : $ENV{PATH_TRANSLATED};
158 $ENV{PLP_NAME} = $ENV{PATH_INFO};
160 while (not -f $file) {
161 if (not $file =~ s/(\/+[^\/]*)$//) {
162 print STDERR "PLP: Not found: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
163 PLP::error(undef, 404);
167 $ENV{PLP_NAME} =~ s/\Q$pi\E$//;
168 $path_info = $pi . $path_info;
172 print STDERR "PLP: Can't read: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
173 PLP::error(undef, 403);
178 qw(PATH_TRANSLATED SCRIPT_NAME SCRIPT_FILENAME PATH_INFO),
179 grep { /^REDIRECT_/ } keys %ENV
182 $ENV{PATH_INFO} = $path_info if defined $path_info;
183 $ENV{PLP_FILENAME} = $file;
184 (my $dir = $file) =~ s{/[^/]+$}[];
187 $PLP::code = PLP::source($file, 0);
190 # This is the mod_perl initializer.
191 # Returns 0 on success.
195 $ENV{PLP_FILENAME} = my $filename = $r->filename;
197 unless (-f $filename) {
198 return Apache::Constants::NOT_FOUND;
201 return Apache::Constants::FORBIDDEN;
204 (my $dir) = $filename =~ m!(.*)/!s;
206 $ENV{PLP_NAME} = $r->uri;
207 $PLP::code = PLP::source($r->filename);
212 # Let the games begin!
213 # No lexicals may exist at this point.
216 tie *PLPOUT, 'PLP::Tie::Print';
218 $PLP::ERROR = \&_default_error;
225 PLP::Functions->import();
226 # No lexicals may exist at this point.
227 eval qq{ package PLP::Script; $PLP::code; };
228 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
229 eval { package PLP::Script; $_->() for reverse @PLP::END };
230 PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
232 PLP::sendheaders() unless $PLP::sentheaders;
234 # undef *{"PLP::Script::$_"} for keys %PLP::Script::;
235 Symbol::delete_package('PLP::Script');
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>