X-Git-Url: http://git.shiar.nl/gitweb.cgi/perl/plp/.git/blobdiff_plain/6b971262dcda8586066379c1b3fcea9c457ce575..720e78a4f8351eedac26b196aa9f3922fd5bd0ee:/plp.cgi diff --git a/plp.cgi b/plp.cgi index c281fc0..4c6e41e 100755 --- a/plp.cgi +++ b/plp.cgi @@ -1,6 +1,12 @@ #!/usr/bin/perl +use strict; +use vars qw($VERSION %INTERNAL %get %post %fields %header %cookie %BLOCK $DEBUG $output); -$VERSION = '2.01'; +$VERSION = '2.22'; +$DEBUG = 1; + +# We put most everything in %INTERNAL, just so the user won't screw it. +# We could also have used packages, but let's keep it simple. $INTERNAL{file} = $ENV{PATH_TRANSLATED}; unless (-e $INTERNAL{file}){ @@ -23,8 +29,8 @@ use plp; $INTERNAL{qq} = ""; #^P $INTERNAL{q} = ""; #^Q -$header{'content-type'} = 'text/html'; -$header{'status'} = '200 OK'; +$header{'Content-Type'} = 'text/html'; +$header{Status} = '200 OK'; $INTERNAL{code} = ReadFile($INTERNAL{file}); @@ -46,6 +52,8 @@ $INTERNAL{code} =~ s(\\\\\r?\n)()g; $INTERNAL{code} =~ s(<\[([^>]*?):(.*?)\]>)($BLOCK{"${1}-1"}$2$BLOCK{"${1}-2"})g; $INTERNAL{code} =~ s(<\[(?!/)(.*?)\]>)($BLOCK{"${1}-1"})g; $INTERNAL{code} =~ s(<\[/(.*?)\]>)($BLOCK{"${1}-2"})g; + + $INTERNAL{code} =~ s(<{[ \08\09]*)($INTERNAL{q};print qq$INTERNAL{qq})g; $INTERNAL{code} =~ s([ \08\09]*}>)($INTERNAL{qq};print q$INTERNAL{q})g; $INTERNAL{code} = "print q$INTERNAL{q}$INTERNAL{code}$INTERNAL{q};"; @@ -56,19 +64,35 @@ $INTERNAL{code} =~ s{print q$INTERNAL{q}$INTERNAL{q};}[]g; while ($INTERNAL{code} =~ s/<_(.*?)_>//s){ $INTERNAL{pre} = $1; - eval $INTERNAL{pre}; -} - -for (keys %header){ - print "$_: $header{$_}\n"; + { + no strict; + eval $INTERNAL{pre}; + if ($@ && $DEBUG){ + print "\nDebug:\n $@"; + } + } } -print "\n"; -eval $INTERNAL{code}; -if ($@){ - print "
Debug
", Entity($@); +print "\n\n" if $DEBUG == 2; + +{ + my %HEADER; + for (sort keys %header){ # Sort, so lowercase and underscores come first) + my $copy = $_; + tr/_/-/; + s/\b(\w)(\w*)/\U$1\E\L$2\E/g; + $HEADER{$_} = $header{$copy}; + } + for (keys %HEADER){ + print "$_: $HEADER{$_}\n"; + } + print "\n"; } -if ($Debug){ - print "
Debug:
$INTERNAL{code}
$output"; +{ + no strict; + eval $INTERNAL{code}; + if ($@ && $DEBUG){ + print "
Debug
", Entity($@); + } }