PLP/CGI.pm

   1 package PLP::CGI;
   2
   3 use strict;
   4
   5 our $VERSION = '1.01';
   6
   7 use PLP;
   8
   9 # CGI initializer: opens SCRIPT_FILENAME
  10 sub init {
  11         $PLP::print = 'print';
  12
  13         if (defined $ENV{PATH_TRANSLATED}) {
  14                 # SCRIPT_* points to handler script (Apache CGI)
  15                 # Run backwards through PATH_TRANSLATED to find target filename,
  16                 # then get file (relative) by stripping PATH_INFO.
  17                 my ($path, $rel) = (delete $ENV{PATH_TRANSLATED}, delete $ENV{PATH_INFO});
  18                 my $path_info;
  19                 while (not -f $path) {
  20                         if (not $path =~ s/(\/+[^\/]*)$//) {
  21                                 printf STDERR "PLP: Not found: $path$path_info ($ENV{REQUEST_URI})\n";
  22                                 PLP::error(undef, 404);
  23                                 exit;
  24                         }
  25                         # move last path element onto PATH_INFO
  26                         $path_info = $1 . $path_info;
  27                 }
  28                 if (defined $path_info) {
  29                         $rel =~ s/\Q$path_info\E$//;
  30                         $ENV{PATH_INFO} = $path_info;
  31                 }
  32                 $ENV{SCRIPT_FILENAME} = $path;
  33                 $ENV{SCRIPT_NAME} = $rel;
  34         }
  35         elsif (not -f $ENV{SCRIPT_FILENAME}) {
  36                 print STDERR "PLP: Not found: $ENV{SCRIPT_FILENAME} ($ENV{REQUEST_URI})\n";
  37                 PLP::error(undef, 404);
  38                 return;
  39         }
  40
  41         $ENV{"PLP_$_"} = $ENV{"SCRIPT_$_"} for qw/NAME FILENAME/;
  42
  43         if (not -r $ENV{PLP_FILENAME}) {
  44                 print STDERR "PLP: Can't read: $ENV{PLP_FILENAME} ($ENV{REQUEST_URI})\n";
  45                 PLP::error(undef, 403);
  46                 exit;
  47         }
  48
  49         delete @ENV{
  50                 qw(SCRIPT_NAME SCRIPT_FILENAME),
  51                 grep /^REDIRECT_/, keys %ENV
  52         };
  53
  54         my ($file, $dir) = File::Basename::fileparse($ENV{PLP_FILENAME});
  55         chdir $dir;
  56
  57         $PLP::code = PLP::source($file, 0, undef, $ENV{PLP_FILENAME});
  58 }
  59
  60 # This is run by the CGI script. (#!perl \n use PLP::CGI; PLP::CGI::everything;)
  61 sub everything {
  62         PLP::clean();
  63         init();
  64         PLP::start();
  65 }
  66
  67 1;
  68