PLP/Apache.pm

   1 package PLP::Apache;
   2
   3 use strict;
   4
   5 our $VERSION = '1.00';
   6
   7 use PLP;
   8
   9 use constant MP2 => (
  10         defined $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2
  11 );
  12
  13 BEGIN {
  14         if (MP2) {
  15                 require Apache2::Const;
  16                 require Apache2::RequestRec;
  17                 require Apache2::RequestUtil;
  18                 require Apache2::RequestIO;
  19         } else {
  20                 require Apache::Constants;
  21         }
  22 }
  23
  24 # mod_perl initializer: returns 0 on success, Apache error code on failure
  25 sub init {
  26         our $r = shift;
  27
  28         $PLP::print = 'PLP::Apache::print';
  29         $PLP::read = \&read;
  30
  31         $ENV{PLP_FILENAME} = my $filename = $r->filename;
  32
  33         unless (-f $filename) {
  34                 return MP2 ? Apache2::Const::HTTP_NOT_FOUND() : Apache::Constants::NOT_FOUND();
  35         }
  36         unless (-r _) {
  37                 return MP2 ? Apache2::Const::HTTP_FORBIDDEN() : Apache::Constants::FORBIDDEN();
  38         }
  39
  40         $ENV{PLP_NAME} = $r->uri;
  41
  42         our $use_cache = $r->dir_config('PLPcache') !~ /^off$/i;
  43 #S      our $use_safe  = $r->dir_config('PLPsafe')  =~ /^on$/i;
  44         my $path = $r->filename();
  45         my ($file, $dir) = File::Basename::fileparse($path);
  46         chdir $dir;
  47
  48         $PLP::code = PLP::source($file, 0, undef, $path);
  49
  50         return 0; # OK
  51 }
  52
  53 sub read ($) {
  54         my ($bytes) = @_;
  55         $r->read(my $data, $bytes);
  56         return $data;
  57 }
  58
  59 # FAST printing under mod_perl
  60 sub print {
  61         return unless grep length, @_;
  62         PLP::sendheaders() unless $PLP::sentheaders;
  63         $PLP::Apache::r->print(@_);
  64 }
  65
  66 # This is the mod_perl handler.
  67 sub handler {
  68         PLP::clean();
  69         if (my $ret = init($_[0])) {
  70                 return $ret;
  71         }
  72         #S PLP::start($_[0]);
  73         PLP::start();
  74         no strict 'subs';
  75         return MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
  76 }
  77
  78 1;
  79