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                 # Physical mapping provided; SCRIPT_* points to handler script
  15                 # (Apache action)
  16                 my $path = delete $ENV{PATH_TRANSLATED};
  17                 my $path_info;
  18                 while (not -f $path) {
  19                         if (not $path =~ s/(\/+[^\/]*)$//) {
  20                                 printf STDERR "PLP: Not found: $path$path_info ($ENV{REQUEST_URI})\n";
  21                                 PLP::error(undef, 404);
  22                                 exit;
  23                         }
  24                         # move last path element from PLP_*NAME to PATH_INFO
  25                         $path_info = $1 . $path_info;
  26                 }
  27                 $ENV{PLP_FILENAME} = $path;
  28                 $ENV{PLP_NAME} = delete $ENV{PATH_INFO};
  29                 if (defined $path_info) {
  30                         $ENV{PLP_NAME} =~ s/\Q$path_info\E$//;
  31                         $ENV{PATH_INFO} = $path_info;
  32                 }
  33         } else {
  34                 # SCRIPT_*/PATH_INFO already modified to target script
  35                 # (Lighttpd cgi.assign)
  36                 $ENV{PLP_FILENAME} = $ENV{SCRIPT_FILENAME};
  37                 $ENV{PLP_NAME} = $ENV{SCRIPT_NAME};
  38         }
  39
  40         if (not -r $ENV{PLP_FILENAME}) {
  41                 print STDERR "PLP: Can't read: $ENV{PLP_FILENAME} ($ENV{REQUEST_URI})\n";
  42                 PLP::error(undef, 403);
  43                 exit;
  44         }
  45
  46         delete @ENV{
  47                 qw(SCRIPT_NAME SCRIPT_FILENAME),
  48                 grep /^REDIRECT_/, keys %ENV
  49         };
  50
  51         my ($file, $dir) = File::Basename::fileparse($ENV{PLP_FILENAME});
  52         chdir $dir;
  53
  54         $PLP::code = PLP::source($file, 0, undef, $ENV{PLP_FILENAME});
  55 }
  56
  57 # This is run by the CGI script. (#!perl \n use PLP::CGI; PLP::CGI::everything;)
  58 sub everything {
  59         PLP::clean();
  60         init();
  61         PLP::start();
  62 }
  63
  64 1;
  65