X-Git-Url: http://git.shiar.nl/gitweb.cgi/perl/plp/.git/blobdiff_plain/720e78a4f8351eedac26b196aa9f3922fd5bd0ee..d7eecb5ca73d043897b6e49c14845bda97ba2202:/plp.cgi?ds=inline diff --git a/plp.cgi b/plp.cgi old mode 100755 new mode 100644 index 4c6e41e..aa3b32f --- a/plp.cgi +++ b/plp.cgi @@ -1,98 +1,9 @@ #!/usr/bin/perl -use strict; -use vars qw($VERSION %INTERNAL %get %post %fields %header %cookie %BLOCK $DEBUG $output); -$VERSION = '2.22'; -$DEBUG = 1; +# This script is not installed automatically, and is not needed for mod_perl +# installations. -# 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. +use PLP; +PLP::everything(); -$INTERNAL{file} = $ENV{PATH_TRANSLATED}; -unless (-e $INTERNAL{file}){ - $ENV{REDIRECT_STATUS} = '404'; - print STDERR "htmpl: Not found: $INTERNAL{file}\n"; - #Change this if you have an error handling script. - print `/vhost/COMMON/err.cgi` || "Status: 404 Not found\n\nFile not found"; - - exit; -} - -($INTERNAL{dir} = $INTERNAL{file}) =~ s{^(.*)/.*?$}[$1]; -chdir $INTERNAL{dir}; - -($ENV{PLP_NAME} = $ENV{REQUEST_URI}) =~ s/\?.*$//; - -use plp; - -$INTERNAL{qq} = ""; #^P -$INTERNAL{q} = ""; #^Q - -$header{'Content-Type'} = 'text/html'; -$header{Status} = '200 OK'; - -$INTERNAL{code} = ReadFile($INTERNAL{file}); - -while ($INTERNAL{code} =~ /<\((.*?)\)>/ ){ - ($INTERNAL{file} = $1) =~ s/[<>\|]//g; - $INTERNAL{code} =~ s//ReadFile($INTERNAL{file})/e; -} - -$INTERNAL{code} =~ s(<:)($INTERNAL{q};)g; -$INTERNAL{code} =~ s(:>)(;\nprint q$INTERNAL{q})g; - -while ($INTERNAL{code} =~ /(<\[1(.*?)\]>(.*?)<\[2\]>(.*?)<\[3\]>)/s){ - $INTERNAL{naam} = $2; - $BLOCK{"$INTERNAL{naam}-1"} = $3; - $BLOCK{"$INTERNAL{naam}-2"} = $4; - $INTERNAL{code} =~ s///; #Redo last match -} -$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};"; - -$INTERNAL{code} =~ s{print qq$INTERNAL{qq}$INTERNAL{qq};}[]g; -$INTERNAL{code} =~ s{print q$INTERNAL{q}$INTERNAL{q};}[]g; - - -while ($INTERNAL{code} =~ s/<_(.*?)_>//s){ - $INTERNAL{pre} = $1; - { - no strict; - eval $INTERNAL{pre}; - if ($@ && $DEBUG){ - print "\nDebug:\n $@"; - } - } -} - -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"; -} - -{ - no strict; - eval $INTERNAL{code}; - if ($@ && $DEBUG){ - print "