From a5521fb1820cc67ab3d7c0fe728ef36b0b379a3f Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sat, 31 Mar 2007 04:31:20 +0200 Subject: [PATCH] reindent remaining 4-space+tab@8 code Use only tabs for indenting, spaces for alignment. --- PLP.pm | 494 ++++++++++++++++++++++----------------------- PLP/Fields.pm | 106 +++++----- PLP/Tie/Delay.pm | 64 +++--- PLP/Tie/Headers.pm | 82 ++++---- PLP/Tie/Print.pm | 20 +- 5 files changed, 383 insertions(+), 383 deletions(-) diff --git a/PLP.pm b/PLP.pm index 10747fd..6fa79be 100644 --- 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{
}, - qq{Debug information:
$html
}; + my ($plain, $html) = @_; + print qq{
}, + qq{Debug information:
$html
}; } # 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{\n}, - "\n$type $short\n\n

$short", - "

\n$long

\n

\n$ENV{SERVER_SIGNATURE}"; - } + 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{\n}, + "\n$type $short\n\n

$short", + "

\n$long

\n

\n$ENV{SERVER_SIGNATURE}"; + } } # 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 = )) { + $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 = )) { - $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 3dda7d3..2a4190c 100644 --- 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 423bfc8..bf7a7a7 100644 --- 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 566b198..df41fbe 100644 --- 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 83b5c76..ef537a0 100644 --- 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 } -- 2.30.0