v3.02 release

diff --git a/PLP.pm b/PLP.pm
index 704870c8f697fc5557d3f09e3c8d63b8e6892168..78e0dacf85f2db4e9eb9a4174c2ca16c59b0b871 100644 (file)
--- a/PLP.pm
+++ b/PLP.pm
@@ -2,7 +2,7 @@ package PLP;
 
 # Not to be used without the CGI script;
 
-our $VERSION = '3.01';
+our $VERSION = '3.02';
 
 use PLP::Functions ();
 use PLP::Fields;
@@ -10,7 +10,35 @@ use PLP::Tie::Headers;
 use PLP::Tie::Delay;
 use PLP::Tie::Print;
 
-sub SendHeaders () {
+=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
+
+Given a description OR number, returns a piece of HTML, OR prints error headers.
+
+=item start
+
+Inits everything, reads the first file, sets environment.
+
+=cut
+
+sub sendheaders () {
     our $sentheaders = 1;
     print STDOUT "Content-Type: text/plain\n\n" if $DEBUG & 2;
     print STDOUT map("$_: $PLP::Script::header{$_}\n", keys %PLP::Script::header), "\n";
@@ -90,5 +118,57 @@ sub error {
     }
 }
 
+sub start {
+    my $file = $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;
+           }
+       }
+       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;
+       }
+    }
+
+    delete @ENV{
+       qw(PATH_TRANSLATED SCRIPT_NAME SCRIPT_FILENAME PATH_INFO),
+        grep { /^REDIRECT_/ } keys %ENV
+    };
+
+    $ENV{PATH_INFO} = $path_info if defined $path_info;
+    $ENV{PLP_FILENAME} = $file;
+    (my $dir = $file) =~ s{/[^/]+$}[];
+    chdir $dir;
+
+    $PLP::code = PLP::source($file, 0);
+    tie *PLPOUT, 'PLP::Tie::Print';
+    select PLPOUT;
+}
+
 1;
 

diff --git a/PLP/Fields.pm b/PLP/Fields.pm
index 99455110d1b53cef47f84db3dad37d12dd52d518..a14f03826d3fd44d67fe516692352aaef1496253 100644 (file)
--- a/PLP/Fields.pm
+++ b/PLP/Fields.pm
@@ -17,7 +17,7 @@ sub doit {
        my %get;
        if ($ENV{QUERY_STRING} ne ''){
            for (split /[&;]/, $ENV{QUERY_STRING}) {
-               my @keyval = split /=/;
+               my @keyval = split /=/, $_, 2;
                PLP::Functions::DecodeURI(@keyval);
                $get{$keyval[0]} = $keyval[1] unless $keyval[0] =~ /^\@/;
                push @{ $get{'@' . $keyval[0]} }, $keyval[1];
@@ -31,8 +31,8 @@ sub doit {
        our $post = <STDIN>;
        if (defined($post) && $post ne '' &&
            ($ENV{CONTENT_TYPE} eq '' || $ENV{CONTENT_TYPE} eq 'application/x-www-form-urlencoded')){
-           for (split /[&;]/, $post) {
-               my @keyval = split /=/;
+           for (split /&/, $post) {
+               my @keyval = split /=/, $_, 2;
                PLP::Functions::DecodeURI(@keyval);
                $post{$keyval[0]} = $keyval[1] unless $keyval[0] =~ /^\@/;
                push @{ $post{'@' . $keyval[0]} }, $keyval[1];
@@ -50,7 +50,7 @@ sub doit {
 
     if (defined($ENV{HTTP_COOKIE}) && $ENV{HTTP_COOKIE} ne ''){
        for (split /; ?/, $ENV{HTTP_COOKIE}) {
-           my @keyval = split /=/;
+           my @keyval = split /=/, $_, 2;
            $PLP::Script::cookie{$keyval[0]} ||= $keyval[1];
        }
     }

diff --git a/PLP/Tie/Print.pm b/PLP/Tie/Print.pm
index 7563ba5963760e78724d960d1f6064979e73fbe7..9d0c0a9e5e5f59e00ddc845644af5c5966dfffda 100644 (file)
--- a/PLP/Tie/Print.pm
+++ b/PLP/Tie/Print.pm
@@ -19,7 +19,7 @@ sub WRITE { undef; }
 
 sub PRINT {
     my ($self, @param) = @_;
-    PLP::SendHeaders() unless $PLP::sentheaders;
+    PLP::sendheaders() unless $PLP::sentheaders;
     print STDOUT @param;
     select STDOUT;
 }

diff --git a/plp.cgi b/plp.cgi
index 85d82100b55441ddd7ff00fd5437413f1fc79172..850e30579dc0afc447975dfcfbf358c8ced0518e 100755 (executable)
--- a/plp.cgi
+++ b/plp.cgi
@@ -2,7 +2,7 @@
 use v5.6.0;
 use PLP;
 
-die 'Wrong module version' if $PLP::VERSION ne '3.01';
+die 'Wrong module version' if $PLP::VERSION ne '3.02';
 
 use vars qw($DEBUG);
 
@@ -12,62 +12,12 @@ use strict;
     $PLP::sentheaders = 0;
     $PLP::inA = 0;
     $PLP::inB = 0;
+    delete @ENV{ grep /^PLP_/, keys %ENV };
 }
 
 $DEBUG = 1;
-our $mod_perl = exists $ENV{MOD_PERL};
 
-{
-    my $file = $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 ($mod_perl) {
-               Apache->request->uri($ENV{REQUEST_URI});
-               print STDOUT "Status: 404 Not Found";
-               Apache::exit();
-           } else {
-               PLP::error(undef, 404);
-               exit;
-           }
-       }
-       my $pi = $1;
-       $ENV{PLP_NAME} =~ s/\Q$pi\E$//;
-       $path_info = $pi . $path_info;
-    }
-    
-    if ($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;
-       }
-    }
-
-    delete @ENV{
-       qw(PATH_TRANSLATED SCRIPT_NAME SCRIPT_FILENAME PATH_INFO),
-        grep { /^REDIRECT_/ } keys %ENV
-    };
-
-    $ENV{PATH_INFO} = $path_info if defined $path_info;
-    $ENV{PLP_FILENAME} = $file;
-    (my $dir = $file) =~ s{/[^/]+$}[];
-    chdir $dir;
-
-    $PLP::code = PLP::source($file, 0);
-    tie *PLPOUT, 'PLP::Tie::Print';
-    select PLPOUT;
-}
+PLP::start();
 
 {
     no strict;
@@ -77,11 +27,12 @@ our $mod_perl = exists $ENV{MOD_PERL};
        *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 $@;
     select STDOUT;
     undef *{"PLP::Script::$_"} for keys %PLP::Script::;
-    PLP::SendHeaders() unless $PLP::sentheaders;
+    PLP::sendheaders() unless $PLP::sentheaders;
 }