X-Git-Url: http://git.shiar.nl/perl/plp/.git/blobdiff_plain/b5eadb0c810558015cd4dc943e2c25b4acbfec58..c92c16d5c32aaf8fc61e7d008224eb8c44be438f:/plp.cgi diff --git a/plp.cgi b/plp.cgi index 3bf77f9..58cb1d0 100755 --- a/plp.cgi +++ b/plp.cgi @@ -1,82 +1,7 @@ -#!/usr/bin/perl -use strict; -use vars qw($VERSION %INTERNAL %get %post %fields %header %cookie %BLOCK $DEBUG $output); +#!/usr/bin/env perl -$VERSION = '2.21'; -$DEBUG = 1; +# Executable to serve PLP scripts using CGI. +# Not installed automatically, and only needed for CGI installations. -$INTERNAL{file} = $ENV{PATH_TRANSLATED}; -unless (-e $INTERNAL{file}){ - $ENV{REDIRECT_STATUS} = '404'; - print STDERR "htmpl: Not found: $INTERNAL{file}\n"; +use PLP::Backend::CGI; - #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 $@"; - } - } -} - -for (keys %header){ - print "$_: $header{$_}\n"; -} -print "\n"; - -{ - no strict; - eval $INTERNAL{code}; - if ($@ && $DEBUG){ - print "
Debug
", Entity($@); - } -}