Skip Menu |
 

Preferred bug tracker

Please visit the preferred bug tracker to report your issue.

This queue is for tickets about the CGI CPAN distribution.

Report information
The Basics
Id: 25121
Status: rejected
Priority: 0/
Queue: CGI

People
Owner: MARKSTOS [...] cpan.org
Requestors: at [...] altlinux.ru
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



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>
Download (untitled) / with headers
text/plain 7.4k
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
Download (untitled) / with headers
text/plain 312b
On Sat Feb 24 08:05:28 2007, at@altlinux.ru wrote: Show quoted text
> Make mod_perl constant so that constant folding works.
Thanks for the patch. Since you submitted it some time again ago, the mod_perl detection has changed a lot. Do you have any suggestions for now we can further improve the way it works in 3.43? Mark
Download (untitled) / with headers
text/plain 818b
I put a patch like this in git [1], but I think I'v going to reject this idea. My benchmark showed a speed-up of 0 to 0.5%, and I think it will likely break some live code out there when people upgrade. Particularly, the new code requires that that the mod_perl environment variables be set before the CGI.pm module is "used". I think there are some cases out there where third party modules manipulate these variables after CGI.pm is loaded to get the results they want. If there were as a noticable, benchmarked performance improvement, I would consider merging this patch anyway, but no one is really complaining about performance in a way that this could improve, so the safe route for now is not to merge it. 1. https://github.com/markstos/CGI.pm/commit/7e643235ee3ea490a5bae4122726dd 8fee2545ef


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.