# The most recent version and complete docs are available at:
# http://stein.cshl.org/WWW/software/CGI/
-$CGI::revision = '$Id: CGI.pm,v 1.178 2005/03/14 16:30:20 lstein Exp $';
-$CGI::VERSION=3.07;
+$CGI::revision = '$Id: CGI.pm,v 1.179 2005/04/07 22:40:37 lstein Exp $';
+$CGI::VERSION=3.08;
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
# Turn on special checking for Doug MacEachern's modperl
if (exists $ENV{MOD_PERL}) {
- eval "require mod_perl";
# mod_perl handlers may run system() on scripts using CGI.pm;
# Make sure so we don't get fooled by inherited $ENV{MOD_PERL}
- if (defined $mod_perl::VERSION) {
- if ($mod_perl::VERSION >= 1.99) {
- $MOD_PERL = 2;
- require Apache::Response;
- require Apache::RequestRec;
- require Apache::RequestUtil;
- require APR::Pool;
- } else {
- $MOD_PERL = 1;
- require Apache;
- }
+ if ($ENV{MOD_PERL_API_VERSION} == 2) {
+ $MOD_PERL = 2;
+ require Apache2::Response;
+ require Apache2::RequestRec;
+ require Apache2::RequestUtil;
+ require APR::Pool;
+ } else {
+ $MOD_PERL = 1;
+ require Apache;
}
}
if (ref($initializer[0])
&& (UNIVERSAL::isa($initializer[0],'Apache')
||
- UNIVERSAL::isa($initializer[0],'Apache::RequestRec')
+ UNIVERSAL::isa($initializer[0],'Apache2::RequestRec')
)) {
$self->r(shift @initializer);
}
$self->upload_hook(shift @initializer, shift @initializer);
}
if ($MOD_PERL) {
- $self->r(Apache->request) unless $self->r;
- my $r = $self->r;
if ($MOD_PERL == 1) {
+ $self->r(Apache->request) unless $self->r;
+ my $r = $self->r;
$r->register_cleanup(\&CGI::_reset_globals);
}
else {
# XXX: once we have the new API
# will do a real PerlOptions -SetupEnv check
+ $self->r(Apache2::RequestUtil->request) unless $self->r;
+ my $r = $self->r;
$r->subprocess_env unless exists $ENV{REQUEST_METHOD};
$r->pool->cleanup_register(\&CGI::_reset_globals);
}
;
if ($mod_perl) {
- require mod_perl;
- if ($mod_perl::VERSION >= 1.99) {
+ my $r;
+ if ($ENV{MOD_PERL_API_VERSION}) {
$mod_perl = 2;
- require Apache::RequestRec;
- require Apache::RequestIO;
- require Apache::RequestUtil;
+ require Apache2::RequestRec;
+ require Apache2::RequestIO;
+ require Apache2::RequestUtil;
require APR::Pool;
require ModPerl::Util;
- require Apache::Response;
+ require Apache2::Response;
+ $r = Apache2::RequestUtil->request;
+ }
+ else {
+ $r = Apache->request;
}
- my $r = Apache->request;
# If bytes have already been sent, then
# we print the message out directly.
# Otherwise we make a custom error
+ Version 3.08
+ 1. update support for mod_perl 2.0. versions prior to
+ mod_perl 1.999_22 (2.0.0-RC5) are no longer supported.
+
Version 3.07
1. Fixed typo in mod_perl detection.
# Turn on special checking for Doug MacEachern's modperl
my $MOD_PERL = 0;
if (exists $ENV{MOD_PERL}) {
- eval "require mod_perl";
- if (defined $mod_perl::VERSION) {
- my $float = $mod_perl::VERSION;
- $float += 0;
- if ($float >= 1.99) {
+ if ($ENV{MOD_PERL_API_VERSION} == 2) {
$MOD_PERL = 2;
- require Apache::RequestUtil;
- eval "require APR::Table"; # Changing APIs? I hope not.
- } else {
- $MOD_PERL = 1;
- require Apache;
- }
+ require Apache2::RequestUtil;
+ require APR::Table;
+ } else {
+ $MOD_PERL = 1;
+ require Apache;
}
}
sub get_raw_cookie {
my $r = shift;
- $r ||= eval { Apache->request() } if $MOD_PERL;
+ $r ||= eval { $MOD_PERL == 2 ?
+ Apache2::RequestUtil->request() :
+ Apache->request } if $MOD_PERL;
if ($r) {
$raw_cookie = $r->headers_in->{'Cookie'};
} else {
my $this = $class->SUPER::new( @_ );
if ($CGI::MOD_PERL) {
- my $r = Apache->request;
if ($CGI::MOD_PERL == 1) {
+ my $r = Apache->request;
$r->register_cleanup(\&CGI::Pretty::_reset_globals);
}
else {
+ my $r = Apache2::RequestUtil->request;
$r->pool->cleanup_register(\&CGI::Pretty::_reset_globals);
}
}