reindent remaining 4-space+tab@8 code

Use only tabs for indenting, spaces for alignment.

diff --git a/PLP.pm b/PLP.pm
index 10747fdcb653171fb20f73c454a7cdda66d714bb..6fa79becaea05ac25af8ede3299a7019b965ecc6 100644 (file)
--- a/PLP.pm
+++ b/PLP.pm
@@ -36,304 +36,304 @@ our $VERSION = '3.19';
 
 # 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>};
+       my ($plain, $html) = @_; 
+       print qq{<table border=1 class="PLPerror"><tr><td>},
+             qq{<span><b>Debug information:</b><BR>$html</td></tr></table>};
 }
 
 # CGI initializer: parses PATH_TRANSLATED
 sub cgi_init {
 
-    $PLP::print = 'print';
-    
-    my $path = $ENV{PATH_TRANSLATED};
-    $ENV{PLP_NAME} = $ENV{PATH_INFO};
-    my $path_info;
-    while (not -f $path) {
-        if (not $path =~ s/(\/+[^\/]*)$//) {
-           print STDERR "PLP: Not found: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
-           PLP::error(undef, 404);
-           exit;
+       $PLP::print = 'print';
+       
+       my $path = $ENV{PATH_TRANSLATED};
+       $ENV{PLP_NAME} = $ENV{PATH_INFO};
+       my $path_info;
+       while (not -f $path) {
+               if (not $path =~ s/(\/+[^\/]*)$//) {
+                       print STDERR "PLP: Not found: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
+                       PLP::error(undef, 404);
+                       exit;
+               }
+               my $pi = $1;
+               $ENV{PLP_NAME} =~ s/\Q$pi\E$//;
+               $path_info = $pi . $path_info;
+       }
+       
+       if (not -r $path) {
+               print STDERR "PLP: Can't read: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
+               PLP::error(undef, 403);
+               exit;
        }
-       my $pi = $1;
-       $ENV{PLP_NAME} =~ s/\Q$pi\E$//;
-       $path_info = $pi . $path_info;
-    }
-    
-    if (not -r $path) {
-       print STDERR "PLP: Can't read: $ENV{PATH_TRANSLATED} ($ENV{REQUEST_URI})\n";
-       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} = $path;
-    my ($file, $dir) = File::Basename::fileparse($path);
-    chdir $dir;
-
-    $PLP::code = PLP::source($file, 0, undef, $path);
+
+       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} = $path;
+       my ($file, $dir) = File::Basename::fileparse($path);
+       chdir $dir;
+
+       $PLP::code = PLP::source($file, 0, undef, $path);
 }
 
 # This cleans up from previous requests, and sets the default $PLP::DEBUG
 sub clean {
-    @PLP::END = ();
-    $PLP::code = '';
-    $PLP::sentheaders = 0;
-    $PLP::DEBUG = 1;
-    $PLP::print = '';
-    $PLP::r = undef;
-    delete @ENV{ grep /^PLP_/, keys %ENV };
+       @PLP::END = ();
+       $PLP::code = '';
+       $PLP::sentheaders = 0;
+       $PLP::DEBUG = 1;
+       $PLP::print = '';
+       $PLP::r = undef;
+       delete @ENV{ grep /^PLP_/, keys %ENV };
 }
 
 # Handles errors, uses subref $PLP::ERROR (default: \&_default_error)
 sub error {
-    my ($error, $type) = @_;
-    if (not defined $type or $type < 100) {
-       return undef unless $PLP::DEBUG & 1;
-       my $plain = $error;
-       (my $html = $plain) =~ s/([<&>])/'&#' . ord($1) . ';'/ge;
-       PLP::sendheaders() unless $PLP::sentheaders;
-       $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}
-       };
-       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<h1>$short",
-             "</h1>\n$long<p>\n<hr>\n$ENV{SERVER_SIGNATURE}</body></html>";
-    }
+       my ($error, $type) = @_;
+       if (not defined $type or $type < 100) {
+               return undef unless $PLP::DEBUG & 1;
+               my $plain = $error;
+               (my $html = $plain) =~ s/([<&>])/'&#' . ord($1) . ';'/ge;
+               PLP::sendheaders() unless $PLP::sentheaders;
+               $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}
+               };
+               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<h1>$short",
+                       "</h1>\n$long<p>\n<hr>\n$ENV{SERVER_SIGNATURE}</body></html>";
+       }
 }
 
 # This is run by the CGI script. (#!perl \n use PLP; PLP::everything;)
 sub everything {
-    clean();
-    cgi_init();
-    start();
+       clean();
+       cgi_init();
+       start();
 }
 
 # This is the mod_perl handler.
 sub handler {
-    require Apache::Constants;
-    clean();
-    if (my $ret = mod_perl_init($_[0])) {
-       return $ret;
-    }
-    #S start($_[0]);
-    start();
-    no strict 'subs';
-    return Apache::Constants::OK();
+       require Apache::Constants;
+       clean();
+       if (my $ret = mod_perl_init($_[0])) {
+               return $ret;
+       }
+       #S start($_[0]);
+       start();
+       no strict 'subs';
+       return Apache::Constants::OK();
 }
 
 # mod_perl initializer: returns 0 on success, Apache error code on failure
 sub mod_perl_init {
-    our $r = shift;
-
-    $PLP::print = 'PLP::mod_perl_print';
-    
-    $ENV{PLP_FILENAME} = my $filename = $r->filename;
-    
-    unless (-f $filename) {
-       return Apache::Constants::NOT_FOUND();
-    }
-    unless (-r _) {
-       return Apache::Constants::FORBIDDEN();
-    }
-    
-    $ENV{PLP_NAME} = $r->uri;
-
-    our $use_cache = $r->dir_config('PLPcache') !~ /^off$/i;
-#S  our $use_safe  = $r->dir_config('PLPsafe')  =~ /^on$/i;
-    my $path = $r->filename();
-    my ($file, $dir) = File::Basename::fileparse($path);
-    chdir $dir;
-
-    $PLP::code = PLP::source($file, 0, undef, $path);
-
-    return 0; # OK
+       our $r = shift;
+
+       $PLP::print = 'PLP::mod_perl_print';
+       
+       $ENV{PLP_FILENAME} = my $filename = $r->filename;
+       
+       unless (-f $filename) {
+               return Apache::Constants::NOT_FOUND();
+       }
+       unless (-r _) {
+               return Apache::Constants::FORBIDDEN();
+       }
+       
+       $ENV{PLP_NAME} = $r->uri;
+
+       our $use_cache = $r->dir_config('PLPcache') !~ /^off$/i;
+#S     our $use_safe  = $r->dir_config('PLPsafe')  =~ /^on$/i;
+       my $path = $r->filename();
+       my ($file, $dir) = File::Basename::fileparse($path);
+       chdir $dir;
+
+       $PLP::code = PLP::source($file, 0, undef, $path);
+
+       return 0; # OK
 }
 
 # FAST printing under mod_perl
 sub mod_perl_print {
        return unless grep length, @_;
-    PLP::sendheaders() unless $PLP::sentheaders;
-    $PLP::r->print(@_);
+       PLP::sendheaders() unless $PLP::sentheaders;
+       $PLP::r->print(@_);
 }
 
 # Sends the headers waiting in %PLP::Script::header
 sub sendheaders () {
-    $PLP::sentheaders ||= [ caller 1 ? (caller 1)[1, 2] : (caller)[1, 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";
+       $PLP::sentheaders ||= [ caller 1 ? (caller 1)[1, 2] : (caller)[1, 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";
 }
 
 {
-    my %cached; # Conceal cached sources: ( path => [ [ deps ], source, -M ] )
-    
-    # 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 ($file, $level, $linespec, $path) = @_;
-       our $use_cache;
-
-       # $file is displayed, $path is used. $path is constructed from $file if
-       # not given.
-
-       $level = 0      unless defined $level;
-       $linespec = '1' unless defined $linespec;
+       my %cached; # Conceal cached sources: ( path => [ [ deps ], source, -M ] )
        
-       if ($level > 128) {
-           %cached = ();
-           return $level
-               ? qq{\cQ; die qq[Include recursion detected]; print q\cQ}
-               : qq{\n#line $linespec\ndie qq[Include recursion detected];};
-       }
+       # 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 ($file, $level, $linespec, $path) = @_;
+               our $use_cache;
+
+               # $file is displayed, $path is used. $path is constructed from $file if
+               # not given.
+
+               $level = 0      unless defined $level;
+               $linespec = '1' unless defined $linespec;
+               
+               if ($level > 128) {
+                       %cached = ();
+                       return $level
+                               ? qq{\cQ; die qq[Include recursion detected]; print q\cQ}
+                               : qq{\n#line $linespec\ndie qq[Include recursion detected];};
+               }
 
-       my $in_block = 0;   # 1 => "<:", 2 => "<:="
-       
-       $path ||= File::Spec->rel2abs($file);
-       
-       my $source_start = $level
-           ? qq/\cQ;\n#line 1 "$file"\n$PLP::print q\cQ/
-           : qq/\n#line 1 "$file"\n$PLP::print q\cQ/;
-       
-       if ($use_cache and exists $cached{$path}) {
-           BREAKOUT: {
-               my @checkstack = ($path);
-               my $item;
-               my %checked;
-               while (defined(my $item = shift @checkstack)) {
-                   next if $checked{$item};
-                   last BREAKOUT if $cached{$item}[2] > -M $item;
-                   $checked{$item} = 1;
-                   push @checkstack, @{ $cached{$item}[0] }
-                       if @{ $cached{$item}[0] };
+               my $in_block = 0;   # 1 => "<:", 2 => "<:="
+               
+               $path ||= File::Spec->rel2abs($file);
+               
+               my $source_start = $level
+                       ? qq/\cQ;\n#line 1 "$file"\n$PLP::print q\cQ/
+                       : qq/\n#line 1 "$file"\n$PLP::print q\cQ/;
+               
+               if ($use_cache and exists $cached{$path}) {
+                       BREAKOUT: {
+                               my @checkstack = ($path);
+                               my $item;
+                               my %checked;
+                               while (defined(my $item = shift @checkstack)) {
+                                       next if $checked{$item};
+                                       last BREAKOUT if $cached{$item}[2] > -M $item;
+                                       $checked{$item} = 1;
+                                       push @checkstack, @{ $cached{$item}[0] }
+                                               if @{ $cached{$item}[0] };
+                               }
+                               return $level
+                                       ? $source_start . $cached{$path}[1]
+                                       : $source_start . $cached{$path}[1] . "\cQ";
+                       }
                }
-               return $level
-                   ? $source_start . $cached{$path}[1]
-                   : $source_start . $cached{$path}[1] . "\cQ";
-           }
-       }
 
-       $cached{$path} = [ [ ], undef, undef ] if $use_cache;
-       
-       my $linenr = 0;
-       my $source = '';
+               $cached{$path} = [ [ ], undef, undef ] if $use_cache;
+               
+               my $linenr = 0;
+               my $source = '';
+
+               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>)) {
+                       $linenr++;
+                       for (;;) {
+                               $line =~ /
+                                       \G                  # Begin where left off
+                                       ( \z                # End
+                                       | <:=? | :>         # PLP tags     <:= ... :> <: ... :>
+                                       | <\([^)]*\)>       # Include tags <(...)>
+                                       | <[^:(][^<:]*      # Normal text
+                                       | :[^>][^<:]*       # Normal text
+                                       | [^<:]*            # Normal text
+                                       )
+                               /gxs;
+                               next LINE unless length $1;
+                               my $part = $1;
+                               if ($part eq '<:=' and not $in_block) {
+                                       $in_block = 2;
+                                       $source .= "\cQ, (";
+                               } elsif ($part eq '<:' and not $in_block) {
+                                       $in_block = 1;
+                                       $source .= "\cQ; ";
+                               } elsif ($part eq ':>' and $in_block) {
+                                       $source .= (
+                                               $in_block == 2
+                                                       ? "), q\cQ"              # 2
+                                                       : "; $PLP::print q\cQ"   # 1
+                                       );
+                                       $in_block = 0;
+                               } elsif ($part =~ /^<\((.*?)\)>\z/ and not $in_block) {
+                                       my $ipath = File::Spec->rel2abs(
+                                               $1, File::Basename::dirname($path)
+                                       );
+                                       $source .= source($1, $level + 1, undef, $ipath) .
+                                                  qq/\cQ, \n#line $linenr "$file"\nq\cQ/;
+                                       push @{ $cached{$path}[0] }, $ipath;
+                               } else {
+                                       $part =~ s/\\/\\\\/ unless $in_block;
+                                       $source .= $part;
+                               }
+                       }
+               }
+               
+               if ($in_block) {
+                       $source .= (
+                               $in_block == 2
+                                       ? "), q\cQ"              # 2
+                                       : "; $PLP::print q\cQ"   # 1
+                       );
+               }
 
-       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>)) {
-           $linenr++;
-           for (;;) {
-               $line =~ /
-                   \G                  # Begin where left off
-                   ( \z                # End
-                   | <:=? | :>         # PLP tags     <:= ... :> <: ... :>
-                   | <\([^)]*\)>         # Include tags <(...)>
-                   | <[^:(][^<:]*      # Normal text
-                   | :[^>][^<:]*       # Normal text
-                   | [^<:]*            # Normal text
-                   )
-               /gxs;
-               next LINE unless length $1;
-               my $part = $1;
-               if ($part eq '<:=' and not $in_block) {
-                   $in_block = 2;
-                   $source .= "\cQ, (";
-               } elsif ($part eq '<:' and not $in_block) {
-                   $in_block = 1;
-                   $source .= "\cQ; ";
-               } elsif ($part eq ':>' and $in_block) {
-                   $source .= (
-                         $in_block == 2
-                       ? "), q\cQ"              # 2
-                       : "; $PLP::print q\cQ"   # 1
-                   );
-                   $in_block = 0;
-               } elsif ($part =~ /^<\((.*?)\)>\z/ and not $in_block) {
-                   my $ipath = File::Spec->rel2abs(
-                       $1, File::Basename::dirname($path)
-                   );
-                   $source .= source($1, $level + 1, undef, $ipath) .
-                              qq/\cQ, \n#line $linenr "$file"\nq\cQ/;
-                   push @{ $cached{$path}[0] }, $ipath;
-               } else {
-                   $part =~ s/\\/\\\\/ unless $in_block;
-                   $source .= $part;
+               if ($use_cache) {
+                       $cached{$path}[1] = $source;
+                       $cached{$path}[2] = -M $path;
                }
-           }
-       }
-       
-       if ($in_block) {
-           $source .= (
-                 $in_block == 2
-               ? "), q\cQ"              # 2
-               : "; $PLP::print q\cQ"   # 1
-           );
-       }
 
-       if ($use_cache) {
-           $cached{$path}[1] = $source;
-           $cached{$path}[2] = -M $path;
+               return $level
+                       ? $source_start . $source
+                       : $source_start . $source . "\cQ";
        }
-
-       return $level
-           ? $source_start . $source
-           : $source_start . $source . "\cQ";
-    }
 }
 
 
 # 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;
-       use vars qw(%headers %header %cookies %cookie %get %post %fields);
-       *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');
-    # The above does not work. TODO - find out why not.
+       no strict;
+       tie *PLPOUT, 'PLP::Tie::Print';
+       select PLPOUT;
+       $PLP::ERROR = \&_default_error;
+
+       PLP::Fields::doit();
+       {
+               package PLP::Script;
+               use vars qw(%headers %header %cookies %cookie %get %post %fields);
+               *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');
+       # The above does not work. TODO - find out why not.
 }
 
 1;

diff --git a/PLP/Fields.pm b/PLP/Fields.pm
index 3dda7d3937b8bca0097820e2f80a800cc0625727..2a4190c062dd845c4e9c1f341a157799ffa3c0c9 100644 (file)
--- a/PLP/Fields.pm
+++ b/PLP/Fields.pm
@@ -6,63 +6,63 @@ use strict;
 # and %header in PLP::Script. Also generates %cookie immediately.
 sub doit {
 
-    # %get
-    
-    my $get = \%PLP::Script::get;
-    if (length $ENV{QUERY_STRING}){
-       for (split /[&;]/, $ENV{QUERY_STRING}) {
-           my @keyval = split /=/, $_, 2;
-           PLP::Functions::DecodeURI(@keyval);
-           $get->{$keyval[0]} = $keyval[1] unless $keyval[0] =~ /^\@/;
-           push @{ $get->{ '@' . $keyval[0] } }, $keyval[1];
-       }
-    }
-
-    # %post
-
-    tie %PLP::Script::post, 'PLP::Tie::Delay', 'PLP::Script::post', sub {
-       my %post;
-       my $post;
-       
-       return \%post if $ENV{CONTENT_TYPE} !~
-           m!^(?:application/x-www-form-urlencoded|$)!;
-       
-       if ($ENV{MOD_PERL}) {
-           $post = Apache->request->content;
-       } else {
-           read *STDIN, $post, $ENV{CONTENT_LENGTH};
-       }
-       
-       return \%post unless defined $post and length $post;
+       # %get
        
-       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];
+       my $get = \%PLP::Script::get;
+       if (length $ENV{QUERY_STRING}){
+               for (split /[&;]/, $ENV{QUERY_STRING}) {
+                       my @keyval = split /=/, $_, 2;
+                       PLP::Functions::DecodeURI(@keyval);
+                       $get->{$keyval[0]} = $keyval[1] unless $keyval[0] =~ /^\@/;
+                       push @{ $get->{ '@' . $keyval[0] } }, $keyval[1];
+               }
        }
-       
-       return \%post;
-    };
-
-    # %fields
-
-    tie %PLP::Script::fields, 'PLP::Tie::Delay', 'PLP::Script::fields', sub {
-       return { %PLP::Script::get, %PLP::Script::post };
-    };
-
-    # %header
-
-    tie %PLP::Script::header, 'PLP::Tie::Headers';
-
-    # %cookie
 
-    if (defined $ENV{HTTP_COOKIE} and length $ENV{HTTP_COOKIE}) {
-       for (split /; ?/, $ENV{HTTP_COOKIE}) {
-           my @keyval = split /=/, $_, 2;
-           $PLP::Script::cookie{$keyval[0]} ||= $keyval[1];
+       # %post
+
+       tie %PLP::Script::post, 'PLP::Tie::Delay', 'PLP::Script::post', sub {
+               my %post;
+               my $post;
+               
+               return \%post if $ENV{CONTENT_TYPE} !~
+                       m!^(?:application/x-www-form-urlencoded|$)!;
+               
+               if ($ENV{MOD_PERL}) {
+                       $post = Apache->request->content;
+               } else {
+                       read *STDIN, $post, $ENV{CONTENT_LENGTH};
+               }
+               
+               return \%post unless defined $post and length $post;
+               
+               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];
+               }
+               
+               return \%post;
+       };
+
+       # %fields
+
+       tie %PLP::Script::fields, 'PLP::Tie::Delay', 'PLP::Script::fields', sub {
+               return { %PLP::Script::get, %PLP::Script::post };
+       };
+
+       # %header
+
+       tie %PLP::Script::header, 'PLP::Tie::Headers';
+
+       # %cookie
+
+       if (defined $ENV{HTTP_COOKIE} and length $ENV{HTTP_COOKIE}) {
+               for (split /; ?/, $ENV{HTTP_COOKIE}) {
+                       my @keyval = split /=/, $_, 2;
+                       $PLP::Script::cookie{$keyval[0]} ||= $keyval[1];
+               }
        }
-    }
 }
 
 1;

diff --git a/PLP/Tie/Delay.pm b/PLP/Tie/Delay.pm
index 423bfc8e6504e6e3d1c89b1a813c7ca9cc1d53b7..bf7a7a71cc4a8e216a7807fe6013b99106fc955e 100644 (file)
--- a/PLP/Tie/Delay.pm
+++ b/PLP/Tie/Delay.pm
@@ -15,62 +15,62 @@ This module is part of the PLP internals and probably not of any use to others.
 =cut
 
 sub _replace {
-    my ($self) = @_;
-    untie %{ $self->[0] };
-
-    # I'd like to use *{ $self->[0] } = $self->[1]->(); here,
-    # but that causes all sorts of problems. The hash is accessible from
-    # within this sub, but not where its creation was triggered.
-    # Immediately after the triggering statement, the hash becomes available
-    # to all: even the scope where the previous access attempt failed.
-    
-    %{ $self->[0] } = %{ $self->[1]->() }
+       my ($self) = @_;
+       untie %{ $self->[0] };
+
+       # I'd like to use *{ $self->[0] } = $self->[1]->(); here,
+       # but that causes all sorts of problems. The hash is accessible from
+       # within this sub, but not where its creation was triggered.
+       # Immediately after the triggering statement, the hash becomes available
+       # to all: even the scope where the previous access attempt failed.
+       
+       %{ $self->[0] } = %{ $self->[1]->() }
 }
 
 sub TIEHASH {
-    # my ($class, $hash, $source) = @_;
-    return bless [ @_[1, 2] ], $_[0];
+       # my ($class, $hash, $source) = @_;
+       return bless [ @_[1, 2] ], $_[0];
 }
 
 sub FETCH {
-    my ($self, $key) = @_;
-    $self->_replace;
-    return $self->[0]->{$key};
+       my ($self, $key) = @_;
+       $self->_replace;
+       return $self->[0]->{$key};
 }
 
 sub STORE {
-    my ($self, $key, $value) = @_;
-    $self->_replace;
-    return $self->[0]->{$key} = $value;
+       my ($self, $key, $value) = @_;
+       $self->_replace;
+       return $self->[0]->{$key} = $value;
 }
 
 sub DELETE {
-    my ($self, $key) = @_;
-    $self->_replace;
-    return delete $self->[0]->{$key};
+       my ($self, $key) = @_;
+       $self->_replace;
+       return delete $self->[0]->{$key};
 }
 
 sub CLEAR {
-    my ($self) = @_;
-    $self->_replace;
-    return %{ $self->[0] };
+       my ($self) = @_;
+       $self->_replace;
+       return %{ $self->[0] };
 }
 
 sub EXISTS {
-    my ($self, $key) = @_;
-    $self->_replace;
-    return exists $self->[0]->{$key};
+       my ($self, $key) = @_;
+       $self->_replace;
+       return exists $self->[0]->{$key};
 }
 
 sub FIRSTKEY {
-    my ($self) = @_;
-    $self->_replace;
-    return 'PLPdummy';
+       my ($self) = @_;
+       $self->_replace;
+       return 'PLPdummy';
 }
 
 sub NEXTKEY {
-    # Let's hope this never happens. (It's shouldn't.)
-    return undef;
+       # Let's hope this never happens. (It's shouldn't.)
+       return undef;
 }
 
 sub UNTIE   { }

diff --git a/PLP/Tie/Headers.pm b/PLP/Tie/Headers.pm
index 566b19869a1609ae95e2649c7ed714148c1dd478..df41fbef2c105ec9c049764fd2735c20ec1c4b04 100644 (file)
--- a/PLP/Tie/Headers.pm
+++ b/PLP/Tie/Headers.pm
@@ -8,74 +8,74 @@ use Carp;
 Makes a hash case insensitive, and sets some headers. <_> equals <->, so C<$foo{CONTENT_TYPE}> is
 the same as C<$foo{'Content-Type'}>.
 
-    tie %somehash, 'PLP::Tie::Headers';
+       tie %somehash, 'PLP::Tie::Headers';
 
 This module is part of the PLP internals and probably not of much use to others.
 
 =cut
 
 sub TIEHASH {
-    return bless [ # Defaults
-        {
-           'Content-Type'  => 'text/html',
-           'X-PLP-Version' => $PLP::VERSION,
-       },
-       {
-           'content-type'  => 'Content-Type',
-           'x-plp-version' => 'X-PLP-Version',
-       }
-    ], $_[0];
+       return bless [ # Defaults
+               {
+                       'Content-Type'  => 'text/html',
+                       'X-PLP-Version' => $PLP::VERSION,
+               },
+               {
+                       'content-type'  => 'Content-Type',
+                       'x-plp-version' => 'X-PLP-Version',
+               }
+       ], $_[0];
 }
 
 sub FETCH {
-    my ($self, $key) = @_;
-    $key =~ tr/_/-/;
-    return $self->[0]->{ $self->[1]->{lc $key} };
+       my ($self, $key) = @_;
+       $key =~ tr/_/-/;
+       return $self->[0]->{ $self->[1]->{lc $key} };
 }
 
 sub STORE {
-    my ($self, $key, $value) = @_;
-    $key =~ tr/_/-/;
-    if ($PLP::sentheaders) {
-       my @caller = caller;
-       die "Can't set headers after sending them at " .
-           "$caller[1] line $caller[2].\n(Output started at " .
-           "$PLP::sentheaders->[0] line $PLP::sentheaders->[1].)\n"
-    }
-    if (defined $self->[1]->{lc $key}){
-        $key = $self->[1]->{lc $key};
-    } else {
-        $self->[1]->{lc $key} = $key;
-    }
-    return ($self->[0]->{$key} = $value);
+       my ($self, $key, $value) = @_;
+       $key =~ tr/_/-/;
+       if ($PLP::sentheaders) {
+               my @caller = caller;
+               die "Can't set headers after sending them at " .
+                   "$caller[1] line $caller[2].\n(Output started at " .
+                   "$PLP::sentheaders->[0] line $PLP::sentheaders->[1].)\n"
+       }
+       if (defined $self->[1]->{lc $key}){
+               $key = $self->[1]->{lc $key};
+       } else {
+               $self->[1]->{lc $key} = $key;
+       }
+       return ($self->[0]->{$key} = $value);
 }
 
 sub DELETE {
-    my ($self, $key) = @_;
-    $key =~ tr/_/-/;
-    delete $self->[0]->{$key};
-    return delete $self->[1]->{lc $key};
+       my ($self, $key) = @_;
+       $key =~ tr/_/-/;
+       delete $self->[0]->{$key};
+       return delete $self->[1]->{lc $key};
 }
 
 sub CLEAR {
-    my $self = $_[0];
-    return (@$self = ());
+       my $self = $_[0];
+       return (@$self = ());
 }
 
 sub EXISTS {
-    my ($self, $key) = @_;
-    $key =~ tr/_/-/;
-    return exists $self->[1]->{lc $key};
+       my ($self, $key) = @_;
+       $key =~ tr/_/-/;
+       return exists $self->[1]->{lc $key};
 }
 
 sub FIRSTKEY {
-    my $self = $_[0];
-    keys %{$self->[0]};
-    return each %{ $self->[0] }; # Key only, Tie::Hash doc is wrong.
+       my $self = $_[0];
+       keys %{$self->[0]};
+       return each %{ $self->[0] }; # Key only, Tie::Hash doc is wrong.
 }
 
 sub NEXTKEY {
-    return each %{ $_[0]->[0] };
+       return each %{ $_[0]->[0] };
 }
 
 1;

diff --git a/PLP/Tie/Print.pm b/PLP/Tie/Print.pm
index 83b5c76726f7b41f30dd4411634e973b5b5c2521..ef537a03a10a6a6bc7739fd87bfc4981d478340d 100644 (file)
--- a/PLP/Tie/Print.pm
+++ b/PLP/Tie/Print.pm
@@ -17,19 +17,19 @@ sub TIEHANDLE { bless \my $dummy, $_[0] }
 sub WRITE { undef }
 
 sub PRINT {
-    shift;
-    return unless grep length, @_;
-    PLP::sendheaders() unless $PLP::sentheaders;
-    print STDOUT @_;
-    select STDOUT;
+       shift;
+       return unless grep length, @_;
+       PLP::sendheaders() unless $PLP::sentheaders;
+       print STDOUT @_;
+       select STDOUT;
 }
 
 sub PRINTF {
-    shift;
-    return unless length $_[0];
-    PLP::sendheaders() unless $PLP::sentheaders;
-    printf STDOUT @_;
-    select STDOUT;
+       shift;
+       return unless length $_[0];
+       PLP::sendheaders() unless $PLP::sentheaders;
+       printf STDOUT @_;
+       select STDOUT;
 }
 
 sub READ { undef }