| Subject: | [PATCH] MOD_PERL consting |
| Date: | Sat, 24 Feb 2007 16:14:57 +0300 |
| To: | bug-CGI.pm [...] rt.cpan.org |
| From: | Alexey Tourbin <at [...] altlinux.ru> |
Make mod_perl constant so that constant folding works.
---
CGI.pm | 23 +++++++++++++----------
CGI/Carp.pm | 18 ++++++++++--------
CGI/Cookie.pm | 23 +++++++++--------------
CGI/Pretty.pm | 4 ++--
perl-CGI.spec | 1 -
5 files changed, 34 insertions(+), 35 deletions(-)
diff --git a/CGI.pm b/CGI.pm
index 4c429d5..6b001cf 100644
--- a/CGI.pm
+++ b/CGI.pm
@@ -180,20 +180,23 @@ $SL = {
$IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
# Turn on special checking for Doug MacEachern's modperl
-if (exists $ENV{MOD_PERL}) {
+use constant MOD_PERL =>
+ exists $ENV{MOD_PERL} ?
+ exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2 ?
+ 2 : 1 : 0;
+
+if (MOD_PERL == 2) {
# 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 (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
$MOD_PERL = 2;
require Apache2::Response;
require Apache2::RequestRec;
require Apache2::RequestUtil;
require Apache2::RequestIO;
require APR::Pool;
- } else {
+} elsif (MOD_PERL == 1) {
$MOD_PERL = 1;
require Apache;
- }
}
# Turn on special checking for ActiveState's PerlEx
@@ -346,8 +349,8 @@ sub new {
$self->upload_hook(shift @initializer, shift @initializer);
$self->{'use_tempfile'} = shift @initializer if (@initializer > 0);
}
- if ($MOD_PERL) {
- if ($MOD_PERL == 1) {
+ if (MOD_PERL) {
+ if (MOD_PERL == 1) {
$self->r(Apache->request) unless $self->r;
my $r = $self->r;
$r->register_cleanup(\&CGI::_reset_globals);
@@ -595,7 +598,7 @@ sub init {
# If method is GET or HEAD, fetch the query from
# the environment.
if ($meth=~/^(GET|HEAD)$/) {
- if ($MOD_PERL) {
+ if (MOD_PERL) {
$query_string = $self->r->args;
} else {
$query_string = $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'};
@@ -950,7 +953,7 @@ END_OF_FUNC
sub read_from_client {
my($self, $buff, $len, $offset) = @_;
local $^W=0; # prevent a warning
- return $MOD_PERL
+ return MOD_PERL
? $self->r->read($$buff, $len, $offset)
: read(\*STDIN, $$buff, $len, $offset);
}
@@ -985,7 +988,7 @@ sub import_names {
my($self,$namespace,$delete) = self_or_default(@_);
$namespace = 'Q' unless defined($namespace);
die "Can't import names into \"main\"\n" if \%{"${namespace}::"} == \%::;
- if ($delete || $MOD_PERL || exists $ENV{'FCGI_ROLE'}) {
+ if ($delete || MOD_PERL || exists $ENV{'FCGI_ROLE'}) {
# can anyone find an easier way to do this?
foreach (keys %{"${namespace}::"}) {
local *symbol = "${namespace}::${_}";
@@ -1481,7 +1484,7 @@ sub header {
push(@header,map {ucfirst $_} @other);
push(@header,"Content-Type: $type") if $type ne '';
my $header = join($CRLF,@header)."${CRLF}${CRLF}";
- if ($MOD_PERL and not $nph) {
+ if (MOD_PERL and not $nph) {
$self->r->send_cgi_header($header);
return '';
}
diff --git a/CGI/Carp.pm b/CGI/Carp.pm
index 40fc42e..180e3f0 100644
--- a/CGI/Carp.pm
+++ b/CGI/Carp.pm
@@ -371,18 +371,22 @@ sub _warn {
}
}
+use constant MOD_PERL =>
+ exists $ENV{MOD_PERL} ?
+ exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2 ?
+ 2 : 1 : 0;
# The mod_perl package Apache::Registry loads CGI programs by calling
# eval. These evals don't count when looking at the stack backtrace.
sub _longmess {
my $message = Carp::longmess();
$message =~ s,eval[^\n]+(ModPerl|Apache)/(?:Registry|Dispatch)\w*\.pm.*,,s
- if exists $ENV{MOD_PERL};
+ if MOD_PERL;
return $message;
}
sub ineval {
- (exists $ENV{MOD_PERL} ? 0 : $^S) || _longmess() =~ /eval [\{\']/m
+ (MOD_PERL ? 0 : $^S) || _longmess() =~ /eval [\{\']/m
}
sub die {
@@ -405,7 +409,7 @@ sub die {
my($file,$line,$id) = id(1);
$arg .= " at $file line $line." unless $arg=~/\n$/;
&fatalsToBrowser($arg) if $WRAP;
- if (($arg =~ /\n$/) || !exists($ENV{MOD_PERL})) {
+ if (($arg =~ /\n$/) || !MOD_PERL) {
my $stamp = stamp;
$arg=~s/^/$stamp/gm;
}
@@ -458,7 +462,6 @@ For help, please send mail to $wm, giving this error message
and the time and date of the error.
END
;
- my $mod_perl = exists $ENV{MOD_PERL};
if ($CUSTOM_MSG) {
if (ref($CUSTOM_MSG) eq 'CODE') {
@@ -480,10 +483,9 @@ $outer_message
END
;
- if ($mod_perl) {
+ if (MOD_PERL) {
my $r;
- if ($ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
- $mod_perl = 2;
+ if (MOD_PERL == 2) {
require Apache2::RequestRec;
require Apache2::RequestIO;
require Apache2::RequestUtil;
@@ -501,7 +503,7 @@ END
# handler to produce the doc for us.
if ($r->bytes_sent) {
$r->print($mess);
- $mod_perl == 2 ? ModPerl::Util::exit(0) : $r->exit;
+ MOD_PERL == 2 ? ModPerl::Util::exit(0) : $r->exit;
} else {
# MSIE won't display a custom 500 response unless it is >512 bytes!
if ($ENV{HTTP_USER_AGENT} =~ /MSIE/) {
diff --git a/CGI/Cookie.pm b/CGI/Cookie.pm
index 926109c..dd853cd 100644
--- a/CGI/Cookie.pm
+++ b/CGI/Cookie.pm
@@ -22,16 +22,11 @@ use overload '""' => \&as_string,
'fallback'=>1;
# Turn on special checking for Doug MacEachern's modperl
-my $MOD_PERL = 0;
-if (exists $ENV{MOD_PERL}) {
- if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
- $MOD_PERL = 2;
- require Apache2::RequestUtil;
- require APR::Table;
- } else {
- $MOD_PERL = 1;
+if (CGI::MOD_PERL == 2) {
+ require Apache2::RequestUtil;
+ require APR::Table;
+} elsif (CGI::MOD_PERL == 1) {
require Apache;
- }
}
# fetch a list of cookies from the environment and
@@ -70,13 +65,13 @@ sub fetch {
sub get_raw_cookie {
my $r = shift;
- $r ||= eval { $MOD_PERL == 2 ?
+ $r ||= eval { CGI::MOD_PERL == 2 ?
Apache2::RequestUtil->request() :
- Apache->request } if $MOD_PERL;
+ Apache->request } if CGI::MOD_PERL;
if ($r) {
$raw_cookie = $r->headers_in->{'Cookie'};
} else {
- if ($MOD_PERL && !exists $ENV{REQUEST_METHOD}) {
+ if (CGI::MOD_PERL && !exists $ENV{REQUEST_METHOD}) {
die "Run $r->subprocess_env; before calling fetch()";
}
$raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
@@ -179,10 +174,10 @@ sub bake {
my ($self, $r) = @_;
$r ||= eval {
- $MOD_PERL == 2
+ CGI::MOD_PERL == 2
? Apache2::RequestUtil->request()
: Apache->request
- } if $MOD_PERL;
+ } if CGI::MOD_PERL;
if ($r) {
$r->headers_out->add('Set-Cookie' => $self->as_string);
} else {
diff --git a/CGI/Pretty.pm b/CGI/Pretty.pm
index 2147143..9184dda 100644
--- a/CGI/Pretty.pm
+++ b/CGI/Pretty.pm
@@ -147,8 +147,8 @@ sub new {
my $class = shift;
my $this = $class->SUPER::new( @_ );
- if ($CGI::MOD_PERL) {
- if ($CGI::MOD_PERL == 1) {
+ if (CGI::MOD_PERL) {
+ if (CGI::MOD_PERL == 1) {
my $r = Apache->request;
$r->register_cleanup(\&CGI::Pretty::_reset_globals);
}
diff --git a/perl-CGI.spec b/perl-CGI.spec
index 28f29bf..48d2f4e 100644
--- a/perl-CGI.spec
+++ b/perl-CGI.spec
@@ -13,7 +13,6 @@ Source: %dist-%version.tar
BuildArch: noarch
# skip conditional dependencies
-%set_perl_req_method relaxed
%add_findreq_skiplist */CGI/Fast.pm
# Added by buildreq2 on Fri Aug 25 2006
--
1.5.0.1.GIT