From: Juerd Waalboer <juerd@cpan.org>
Date: Sat, 18 May 2002 00:35:58 +0000 (+0000)
Subject: checkin v3.10
X-Git-Tag: 3.10
X-Git-Url: http://git.shiar.net/perl/plp/.git/commitdiff_plain/55b5d8b2c5b2d13e40ed37f37ef54f0e1f37af4b

checkin v3.10
---

diff --git a/Changes b/Changes
new file mode 100644
index 0000000..f19c9f2
--- /dev/null
+++ b/Changes
@@ -0,0 +1,41 @@
+3.10 - May 18, 2002
+- First standardized module distribution, to allow easy distribution via CPAN
+- Caution: installation procedure has changed because of that!
+- Moved all code from plp.cgi to PLP.pm, and made PLP.pm use strict (it was
+  strict compliant, but didn't actually use the pragma).
+- Added mod_perl handler() for extremely easy installation :)
+- Added some documentation (perldoc PLP) with installation instructions
+- Moved a few lines from init() to start()
+- Added comments in PLP.pm
+- Uses Symbol.pm to delete the package (Symbol is in the Perl distr.)
+
+3.06 - April 23, 2002
+- Added PLP_END functionality to simulate END { ... } for mod_perl
+- Fixed header sending in case PLP::Tie::Print->PRINT never happened
+- Added an override for exit(), to avoid needless debugging output in mod_perl
+
+3.05 - April 12, 2002
+- Fixed a potential bug in PLP::source and PLP::Functions::Counter
+
+3.04 - April 11, 2002
+- $PLP::DEBUG works again (set to 1 for $@ output, 2 for plain text+headers,
+  3 for both)
+- $PLP::ERROR is now a subref that can be overridden (April 12: see FAQ for
+  info)
+
+3.03 - April 11, 2002
+- Removed a bug that made sending alternative headers impossible. Sorry!
+- By the way, remember that if you want to send headers, the "<:" have to be
+  the very first characters in the file, with no white space in front of it!
+
+3.02 - April 11, 2002
+- Efficiency improvement by caching initialisation in PLP.pm
+
+3.01 - April 10, 2002
+- Bugfixes: include() used strict, fixed some typos, logging
+- Improved: error reporting
+
+3.00 - April 9, 2002
+- New release, a lot has been done from scratch again, this time following 
+  strict rules and mod_perl compatible. It's also a lot faster than 2.x.
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..e2bb0f2
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,12 @@
+Changes
+Makefile.PL
+MANIFEST
+PLP.pm
+README
+plp.cgi
+test.pl
+PLP/Fields.pm
+PLP/Functions.pm
+PLP/Tie/Delay.pm
+PLP/Tie/Headers.pm
+PLP/Tie/Print.pm
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..bfbd826
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,11 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    'NAME'		=> 'PLP',
+    'VERSION_FROM'	=> 'PLP.pm', # finds $VERSION
+    'PREREQ_PM'		=> { }, # e.g., Module::Name => 1.1
+    ($] >= 5.005 ?    ## Add these new keywords supported since 5.005
+      (ABSTRACT_FROM => 'PLP.pm', # retrieve abstract from module
+       AUTHOR     => 'Juerd <juerd@juerd.nl>') : ()),
+);
diff --git a/PLP.pm b/PLP.pm
index 03b5b92..12abc1f 100644
--- a/PLP.pm
+++ b/PLP.pm
@@ -1,8 +1,6 @@
 package PLP;
 
-# Not to be used without the CGI script;
-
-our $VERSION = '3.06';
+use v5.6;
 
 use PLP::Functions ();
 use PLP::Fields;
@@ -10,61 +8,61 @@ use PLP::Tie::Headers;
 use PLP::Tie::Delay;
 use PLP::Tie::Print;
 
-=head1 PLP
-
-None of the functions in this module should be called by PLP scripts.
-
-Functions:
-
-=over 10
-
-=item sendheaders
-
-Sends the headers waiting in %PLP::Script::header
-
-=item source
-
-Given a filename and optional level (level should be C<0> if it isn't called
-by C<source> itself), and optional linespec (used by C<PLP::Functions::Include>),
-parses a PLP file and returns Perl code, ready to be eval'ed.
-
-=item error
+use Symbol ();
+#use strict;
 
-Given a description OR number, returns a piece of HTML, OR prints error headers.
+our $VERSION = '3.10';
 
-=item start
+# subs in this package:
+#  sendheaders                      Send headers
+#  source($path, $level, $linespec) Read and parse .plp files
+#  error($error, $type)             Handle errors
+#  _default_error($plain, $html)    Default error handler
+#  clean                            Reset variables
+#  cgi_init                         Initialization for CGI
+#  mod_perl_init($r)                Initialization for mod_perl
+#  start                            Start the initialized PLP script
+#  everything                       Do everything: CGI
+#  handler($r)                      Do everything: mod_perl
 
-Inits everything, reads the first file, sets environment.
-
-=cut
 
+# Sends the headers waiting in %PLP::Script::header
 sub sendheaders () {
     our $sentheaders = 1;
-    print STDOUT "Content-Type: text/plain\n\n" if $DEBUG & 2;
+    print STDOUT "Content-Type: text/plain\n\n" if $PLP::DEBUG & 2;
     print STDOUT map("$_: $PLP::Script::header{$_}\n", keys %PLP::Script::header), "\n";
 };
 
+# Given a filename and optional level (level should be 0 if the caller isn't
+# source() itself), and optional linespec (used by PLP::Functions::Include),
+# this function parses a PLP file and returns Perl code, ready to be eval'ed
 sub source {
     my ($path, $level, $linespec) = @_;
-    $level = 0 if not defined $level;
+    $level = 0      if not defined $level;
     $linespec = '1' if not defined $linespec;
+    
     our ($inA, $inB);
+    
     (my $file = $path) =~ s[.*/][];
+    
     my $source = $level
 	? qq/\cQ;\n#line 1 "$file"\nprint q\cQ/
 	: qq/\n#line 1 "$file"\nprint q\cQ/;
     my $linenr = 0;
+    
     local *SOURCE;
     open SOURCE, '<', $path or return $level
 	? qq{\cQ; die qq[Can't open "\Q$path\E" (\Q$!\E)]; print q\cQ}
 	: qq{\n#line $linespec\ndie qq[Can't open "\Q$path\E" (\Q$!\E)];};
-    LINE: while (defined (my $line = <SOURCE>)) {
+    
+    LINE:
+    while (defined (my $line = <SOURCE>)) {
 	$linenr++;
 	for (;;) {
 	    $line =~ /
 		\G                  # Begin where left off
 		( \z                # End
-		| <:=? | :>         # PLP tags     <:=? ... :>
+		| <:=? | :>         # PLP tags     <:= ... :> <: ... :>
 		| <\(.*?\)>         # Include tags <(...)>
 		| <[^:(][^<:]*      # Normal text
 		| :[^>][^<:]*       # Normal text
@@ -95,9 +93,12 @@ sub source {
 	}
     }
     $source .= "\cQ" unless $level;
+
     return $source;
 }
 
+# Handles errors, uses the sub reference $PLP::ERROR that gets two arguments:
+# the error message in plain text, and the error message with html entities
 sub error {
     my ($error, $type) = @_;
     if (not defined $type or $type < 100) {
@@ -108,10 +109,18 @@ sub error {
 	$PLP::ERROR->($plain, $html);
     } else {
 	select STDOUT;
-	my ($short, $long) = @{ +{
-	    404 => [ 'Not Found', "The requested URL $ENV{REQUEST_URI} was not found on this server." ],
-	    403 => [ 'Forbidden', "You don't have permission to access $ENV{REQUEST_URI} on this server." ],
-	}->{$type} };
+	my ($short, $long) = @{
+	    +{
+		404 => [
+		    'Not Found',
+		    "The requested URL $ENV{REQUEST_URI} was not found on this server."
+		],
+		403 => [
+		    'Forbidden',
+		    "You don't have permission to access $ENV{REQUEST_URI} on this server."
+		],
+	    }->{$type}
+	};
 	print "Status: $type\nContent-Type: text/html\n\n",
 	      qq{<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">\n},
 	      "<html><head>\n<title>--$type $short</title>\n</head></body>\n",
@@ -119,47 +128,50 @@ sub error {
     }
 }
 
+# This gets referenced as the initial $PLP::ERROR
 sub _default_error {
     my ($plain, $html) = @_; 
     print qq{<table border=1 class="PLPerror"><tr><td>},
 	  qq{<span><b>Debug information:</b><BR>$html</td></tr></table>};
 }
 
-sub start {
-    my $file = $ENV{PATH_TRANSLATED};
+# This cleans up from previous requests, and sets the default $PLP::DEBUG
+sub clean {
+    @PLP::END = ();
+    $PLP::code = '';
+    $PLP::sentheaders = 0;
+    $PLP::inA = 0;
+    $PLP::inB = 0;
+    $PLP::DEBUG = 1;
+    delete @ENV{ grep /^PLP_/, keys %ENV };
+}
+
+# The *_init subs do the following:
+#  o  Set $PLP::code to the initial code
+#  o  Set $ENV{PLP_*} and makes PATH_INFO if needed
+#  o  Change the CWD
+
+# This sub is meant for CGI requests only, and takes apart PATH_TRANSLATED
+# to find the file.
+sub cgi_init {
+    my $file = defined $_[0] ? $_[0] : $ENV{PATH_TRANSLATED};
     $ENV{PLP_NAME} = $ENV{PATH_INFO};
     my $path_info;
     while (not -f $file) {
         if (not $file =~ s/(\/+[^\/]*)$//) {
 	    print STDERR "PLP: Not found: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
-
-	    if (exists $ENV{MOD_PERL}) {
-		Apache->request->uri($ENV{REQUEST_URI});
-		print STDOUT "Status: 404 Not Found";
-		Apache::exit();
-	    } else {
-		PLP::error(undef, 404);
-		exit;
-	    }
+	    PLP::error(undef, 404);
+	    exit;
 	}
 	my $pi = $1;
 	$ENV{PLP_NAME} =~ s/\Q$pi\E$//;
 	$path_info = $pi . $path_info;
     }
     
-    if (exists $ENV{MOD_PERL}) {
-	Apache->request->uri($ENV{REQUEST_URI});
-    }
-
     if (not -r $file) {
 	print STDERR "PLP: Can't read: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
-	if (exists $ENV{MOD_PERL}) {
-	    print STDOUT "Status: 403 Forbidden";
-	    Apache::exit();
-	} else {
-	    PLP::error(undef, 403);
-	    exit;
-	}
+	PLP::error(undef, 403);
+	exit;
     }
 
     delete @ENV{
@@ -173,11 +185,154 @@ sub start {
     chdir $dir;
 
     $PLP::code = PLP::source($file, 0);
+}
+
+# This is the mod_perl initializer.
+# Returns 0 on success.
+sub mod_perl_init {
+    my $r = shift;
+    
+    $ENV{PLP_FILENAME} = my $filename = $r->filename;
+    
+    unless (-f $filename) {
+	return Apache::Constants::NOT_FOUND;
+    }
+    unless (-r _) {
+	return Apache::Constants::FORBIDDEN;
+    }
+    
+    (my $dir) = $filename =~ m!(.*)/!s;
+    chdir $dir;
+    $ENV{PLP_NAME} = $r->uri;
+    $PLP::code = PLP::source($r->filename);
+
+    return 0; # OK
+}
 
+# Let the games begin!
+# No lexicals may exist at this point.
+sub start {
+    no strict;
     tie *PLPOUT, 'PLP::Tie::Print';
     select PLPOUT;
     $PLP::ERROR = \&_default_error;
+
+    PLP::Fields::doit();
+    {
+	package PLP::Script;
+	*headers = \%header;
+	*cookies = \%cookie;
+	PLP::Functions->import();
+	# No lexicals may exist at this point.
+	eval qq{ package PLP::Script; $PLP::code; };
+	PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
+	eval   { package PLP::Script; $_->() for reverse @PLP::END };
+	PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
+    }
+    PLP::sendheaders() unless $PLP::sentheaders;
+    select STDOUT;
+    # undef *{"PLP::Script::$_"} for keys %PLP::Script::;
+    Symbol::delete_package('PLP::Script');
+}
+
+# This is run by the CGI script.
+# The CGI script is just:
+#   #!/usr/bin/perl
+#   use PLP;
+#   PLP::everything();
+sub everything {
+    clean();
+    cgi_init();
+    start();
+}
+
+# This is the mod_perl handler.
+sub handler {
+    require Apache::Constants;
+    clean();
+    if (my $ret = mod_perl_init(shift)) {
+	return $ret;
+    }
+    start();
+    return Apache::Constants::OK;
 }
 
 1;
 
+=head1 NAME
+
+PLP - Perl in HTML pages
+
+=head1 SYNOPSIS
+
+=head2 mod_perl installation
+
+=over 10
+
+=item * httpd.conf (for mod_perl setup)
+
+    <Files *.plp>
+        SetHandler perl-script
+        PerlHandler PLP
+        PerlSendHeader On
+    </Files>
+
+    # Who said CGI was easier to set up? :)
+
+=back
+
+=head2 CGI installation
+
+=over 10
+
+=item * /foo/bar/plp.cgi (local filesystem address)
+
+    #!/usr/bin/perl
+    use PLP;
+    PLP::everything();
+
+=item * httpd.conf (for CGI setup)
+
+    ScriptAlias /foo/bar/ /PLP_COMMON/
+    <Directory /foo/bar/>
+	AllowOverride None
+	Options +ExecCGI
+	Order allow,deny
+	Allow from all
+    </Directory>
+    AddHandler plp-document plp
+    Action plp-document /PLP_COMMON/plp.cgi
+
+=back
+
+=head2 Test script (test.plp)
+
+    <html><body>
+    <:
+        print "Hurrah, it works!<br>" for 1..10;
+    :>
+    </body></html>
+
+=head1 DESCRIPTION
+
+PLP is yet another Perl embedder, primarily for HTML documents. Unlike with
+other Perl embedders, there is no need to learn a meta-syntax or object
+model: one can just use the normal Perl constructs. PLP runs under mod_perl
+for speeds comparable to those of PHP, but can also be run as a CGI script.
+
+=head1 WEBSITE
+
+For now, all documentation is on the website. Everything will be POD one day,
+but until that day, you will need to visit http://plp.juerd.nl/
+
+=head1 NO WARRANTY
+
+No warranty, no guarantees. Use PLP at your own risk, as I disclaim all
+responsibility.
+
+=head1 AUTHOR
+
+Juerd Waalboer <juerd@juerd.nl>
+
+=cut
+
diff --git a/PLP/Fields.pm b/PLP/Fields.pm
index a14f038..7b563cb 100644
--- a/PLP/Fields.pm
+++ b/PLP/Fields.pm
@@ -10,13 +10,21 @@ PLP::Script. Also generates %cookie immediately.
 
     PLP::Fields::doit();
 
+This module is part of the PLP internals. Don't use it yourself.
+
 =cut
 
 sub doit {
     tie %PLP::Script::get, 'PLP::Tie::Delay', 'PLP::Script::get', sub {
 	my %get;
-	if ($ENV{QUERY_STRING} ne ''){
-	    for (split /[&;]/, $ENV{QUERY_STRING}) {
+	my $get;
+	if ($ENV{MOD_PERL}) {
+	    $get = Apache->request->args;
+	} else {
+	    $get = $ENV{QUERY_STRING}
+	}
+	if ($get ne ''){
+	    for (split /[&;]/, $get) {
 		my @keyval = split /=/, $_, 2;
 		PLP::Functions::DecodeURI(@keyval);
 		$get{$keyval[0]} = $keyval[1] unless $keyval[0] =~ /^\@/;
@@ -28,7 +36,12 @@ sub doit {
 
     tie %PLP::Script::post, 'PLP::Tie::Delay', 'PLP::Script::post', sub {
 	my %post;
-	our $post = <STDIN>;
+	my $post;
+	if ($ENV{MOD_PERL}) {
+	    $post = Apache->request->content;
+	} else {
+	    read(*STDIN, $post, $ENV{CONTENT_LENGTH});
+	}
 	if (defined($post) && $post ne '' &&
 	    ($ENV{CONTENT_TYPE} eq '' || $ENV{CONTENT_TYPE} eq 'application/x-www-form-urlencoded')){
 	    for (split /&/, $post) {
diff --git a/PLP/Tie/Delay.pm b/PLP/Tie/Delay.pm
index 022f424..267b620 100644
--- a/PLP/Tie/Delay.pm
+++ b/PLP/Tie/Delay.pm
@@ -11,6 +11,8 @@ Uses symbolic references, because circular ties make Perl go nuts :)
 
     tie %Some::hash, 'PLP::Tie::Delay', 'Some::hash', sub { \%generated_hash };
 
+This module is part of the PLP internals and probably not of any use to others.
+
 =cut
 
 sub _replace {
diff --git a/PLP/Tie/Headers.pm b/PLP/Tie/Headers.pm
index e5f79a8..e8f961c 100644
--- a/PLP/Tie/Headers.pm
+++ b/PLP/Tie/Headers.pm
@@ -11,6 +11,8 @@ the same as C<$foo{'Content-Type'}>.
 
     tie %somehash, 'PLP::Tie::Headers';
 
+This module is part of the PLP internals and probably not of much use to others.
+
 =cut
 
 sub _lc($) {
diff --git a/PLP/Tie/Print.pm b/PLP/Tie/Print.pm
index 0647f7c..4c6983f 100644
--- a/PLP/Tie/Print.pm
+++ b/PLP/Tie/Print.pm
@@ -9,6 +9,8 @@ Just prints to stdout, but sends headers if not sent before.
 
     tie *HANDLE, 'PLP::Tie::Print';
 
+This module is part of the PLP Internals and probably not of much use to others.
+
 =cut
 
 sub TIEHANDLE {
diff --git a/README b/README
new file mode 100644
index 0000000..d21d1f0
--- /dev/null
+++ b/README
@@ -0,0 +1,62 @@
+NAME
+    PLP - Perl in HTML pages
+
+MODULE INSTALLATION
+
+    perl Makefile.PL
+    make
+    make install
+
+SYNOPSIS
+  mod_perl installation
+    * httpd.conf (for mod_perl setup)
+                  <Files *.plp>
+                      SetHandler perl-script
+                      PerlHandler PLP
+                      PerlSendHeader On
+                  </Files>
+
+                  # Who said CGI was easier to set up? :)
+
+  CGI installation
+    * /foo/bar/plp.cgi (local filesystem address)
+                  #!/usr/bin/perl
+                  use PLP;
+                  PLP::everything();
+
+    * httpd.conf (for CGI setup)
+                  ScriptAlias /foo/bar/ /PLP_COMMON/
+                  <Directory /foo/bar/>
+                      AllowOverride None
+                      Options +ExecCGI
+                      Order allow,deny
+                      Allow from all
+                  </Directory>
+                  AddHandler plp-document plp
+                  Action plp-document /PLP_COMMON/plp.cgi
+
+  Test script (test.plp)
+        <html><body>
+        <:
+            print "Hurrah, it works!<br>" for 1..10;
+        :>
+        </body></html>
+
+DESCRIPTION
+    PLP is yet another Perl embedder, primarily for HTML documents. Unlike
+    with other Perl embedders, there is no need to learn a meta-syntax or
+    object model: one can just use the normal Perl constructs. PLP runs
+    under mod_perl for speeds comparable to those of PHP, but can also be
+    run as a CGI script.
+
+WEBSITE
+    For now, all documentation is on the website. Everything will be POD one
+    day, but until that day, you will need to visit http://plp.juerd.nl/
+
+NO WARRANTY
+    No warranty, no guarantees. Use PLP at your own risk, as I disclaim all
+    responsibility.
+
+AUTHOR
+    Juerd Waalboer <juerd@juerd.nl>
+
diff --git a/plp.cgi b/plp.cgi
old mode 100755
new mode 100644
index a16835c..aa3b32f
--- a/plp.cgi
+++ b/plp.cgi
@@ -1,38 +1,9 @@
-#!/usr/local/bin/perl
-use v5.6.0;
-use PLP;
-use strict;
-
-die 'Wrong module version' if $PLP::VERSION ne '3.06';
+#!/usr/bin/perl
 
-{
-    @PLP::END = ();
-    $PLP::code = '';
-    $PLP::sentheaders = 0;
-    $PLP::inA = 0;
-    $PLP::inB = 0;
-    $PLP::DEBUG = 1;
-    delete @ENV{ grep /^PLP_/, keys %ENV };
-}
+# This script is not installed automatically, and is not needed for mod_perl
+# installations.
 
-PLP::start();
+use PLP;
+PLP::everything();
 
-{
-    no strict;
-    PLP::Fields::doit();
-    {
-	package PLP::Script;
-	*headers = \%header;
-	*cookies = \%cookie;
-	PLP::Functions->import();
-	# No lexicals may exist at this point.
-	eval qq{ package PLP::Script; $PLP::code; };
-	PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
-	eval   { package PLP::Script; $_->() for reverse @PLP::END };
-	PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
-    }
-    PLP::sendheaders() unless $PLP::sentheaders;
-    select STDOUT;
-    undef *{"PLP::Script::$_"} for keys %PLP::Script::;
-}
 
diff --git a/test.pl b/test.pl
new file mode 100644
index 0000000..ee6478e
--- /dev/null
+++ b/test.pl
@@ -0,0 +1,20 @@
+
+# TODO - Write tests.
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test;
+BEGIN { plan tests => 1 };
+use PLP;
+ok(1); # If we made it this far, we're ok.
+
+#########################
+
+# Insert your test code below, the Test module is use()ed here so read
+# its man page ( perldoc Test ) for help writing this test script.
+