I'm not interested in modifying CGI.pm to use MP2 until I start using MP2 myself. This isn't likely in the near future, since I'm very happy indeed with MP1/Apache1.
I've done the porting of CGI.pm, CGI::Carp and CGI::Pretty (no more Apache/compat.pm). I did some basic testing, however it'd be nice if people were to test this patch and confirm that I didn't break anything that did work before. So that Lincoln doesn't have to figure out how to test it.
I've attached the diff against 2.91 distro.
One more thing, Lincoln, why CGI.pm does:
$| = 1;
without localizing the change, when running under mod_perl? This has a potentially bad effect on the rest of the modules running under the same server, since now every print() will flush the data. Can this setting be localized (this will probably require to move the unbuffering where it's relevant, rather than globally)?
Thanks.
__________________________________________________________________ Stas Bekman JAm_pH ------> Just Another mod_perl Hacker http://stason.org/ mod_perl Guide ---> http://perl.apache.org mailto:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com http://modperlbook.org http://apache.org http://ticketmaster.com
--- CGI.pm.orig 2003-03-09 18:29:48.000000000 +1100
+++ CGI.pm 2003-03-11 12:30:23.000000000 +1100
@@ -36,6 +36,8 @@
my @SAVED_SYMBOLS;
+$MOD_PERL = 0; # no mod_perl by default
+
# >>>>> Here are some globals that you might want to adjust <<<<<<
sub initialize_globals {
# Set this to 1 to enable copious autoloader debugging messages
@@ -159,16 +161,17 @@
$IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
# Turn on special checking for Doug MacEachern's modperl
-if (exists $ENV{'GATEWAY_INTERFACE'}
- &&
- ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl\//))
- {
+if (exists $ENV{MOD_PERL}) {
$| = 1;
require mod_perl;
if ($mod_perl::VERSION >= 1.99) {
- require Apache::compat;
+ $MOD_PERL = 2;
+ require Apache::RequestRec;
+ require Apache::RequestUtil;
+ require APR::Pool;
} else {
- require Apache;
+ $MOD_PERL = 1;
+ require Apache;
}
}
@@ -278,9 +281,15 @@
my($class,$initializer) = @_;
my $self = {};
bless $self,ref $class || $class || $DefaultClass;
- if ($MOD_PERL && defined Apache->request) {
- Apache->request->register_cleanup(\&CGI::_reset_globals);
- undef $NPH;
+ if ($MOD_PERL) {
+ my $r = Apache->request;
+ if ($MOD_PERL == 1) {
+ $r->register_cleanup(\&CGI::_reset_globals);
+ }
+ else {
+ $r->pool->cleanup_register(\&CGI::_reset_globals);
+ }
+ undef $NPH;
}
$self->_reset_globals if $PERLEX;
$self->init($initializer);
@@ -1279,13 +1288,21 @@
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) {
my $r = Apache->request;
- $r->send_cgi_header($header);
+ for (@header) {
+ my($k, $v) = split /:\s+/, $_, 2;
+ if ($k eq 'Content-Type') {
+ $r->content_type($v);
+ }
+ else {
+ $r->headers_out->{$k} = $v;
+ }
+ }
+ $r->send_http_header() if $MOD_PERL == 1;
return '';
}
- return $header;
+ return join($CRLF,@header)."${CRLF}${CRLF}";
}
END_OF_FUNC
--- CGI/Carp.pm.orig 2003-03-11 11:51:28.000000000 +1100
+++ CGI/Carp.pm 2003-03-11 12:30:02.000000000 +1100
@@ -358,9 +358,9 @@
# eval. These evals don't count when looking at the stack backtrace.
sub _longmess {
my $message = Carp::longmess();
- my $mod_perl = exists $ENV{MOD_PERL};
- $message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s if $mod_perl;
- return $message;
+ $message =~ s,eval[^\n]+(ModPerl|Apache)/Registry\w*\.pm.*,,s
+ if exists $ENV{MOD_PERL};
+ return $message;
}
sub ineval {
@@ -452,14 +452,25 @@
END
;
- if ($mod_perl && (my $r = Apache->request)) {
+ if ($mod_perl) {
+ require mod_perl;
+ if ($mod_perl::VERSION >= 1.99) {
+ $mod_perl = 2;
+ require Apache::RequestRec;
+ require Apache::RequestIO;
+ require Apache::RequestUtil;
+ require APR::Pool;
+ require ModPerl::Util;
+ require Apache::Response;
+ }
+ my $r = Apache->request;
# If bytes have already been sent, then
# we print the message out directly.
# Otherwise we make a custom error
# handler to produce the doc for us.
if ($r->bytes_sent) {
$r->print($mess);
- $r->exit;
+ $mod_perl == 2 ? ModPerl::Util::exit(0) : $r->exit;
} else {
$r->status(500);
$r->custom_response(500,$mess);
--- CGI/Pretty.pm.orig 2003-03-11 11:51:47.000000000 +1100
+++ CGI/Pretty.pm 2003-03-11 12:20:30.000000000 +1100
@@ -147,7 +147,15 @@
my $class = shift;
my $this = $class->SUPER::new( @_ );
- Apache->request->register_cleanup(\&CGI::Pretty::_reset_globals) if
($CGI::MOD_PERL);
+ if ($CGI::MOD_PERL) {
+ my $r = Apache->request;
+ if ($CGI::MOD_PERL == 1) {
+ $r->register_cleanup(\&CGI::Pretty::_reset_globals);
+ }
+ else {
+ $r->pool->cleanup_register(\&CGI::Pretty::_reset_globals);
+ }
+ }
$class->_reset_globals if $CGI::PERLEX;
return bless $this, $class;
