... *crickets* ...
Here's a patch for the implementation I'm looking for. It passes the
'make test' stuff in CVS. I'd love to see this change done, or a
discussion of why it's not a good idea.
Patch pasted below.
[EMAIL PROTECTED] (Ken Williams) wrote:
Hi,
I've got to ask this because I'm going through immense pain and
suffering* dealing with this problem. Why is Apache::PerlRun a subclass
of Apache? Shouldn't it just be a regular content handler that 'has-a'
$r instead of 'is-a' Apache request?
The problem I'm having is that I'm trying to write Apache::Filter as a
subclass of Apache (because it 'is-a' Apache request class, in that it
extends the Apache class), but PerlRun and its derived class RegistryNG
step in and clobber $r.
So I'm trying to open the discussion about whether the current implementation
of Apache::PerlRun might be changeable. I'm about to take a stab at
implementing it the way I think (for the moment) it should be.
-Ken
*Well, perhaps not actual pain and suffering, but I just watched "Buffy
the Vampire Slayer" so it's on my mind. =)
Index: PerlRun.pm
===
RCS file: /home/cvspublic/modperl/lib/Apache/PerlRun.pm,v
retrieving revision 1.29
diff -u -r1.29 PerlRun.pm
--- PerlRun.pm 2000/06/01 21:07:56 1.29
+++ PerlRun.pm 2000/08/24 06:32:53
@@ -19,32 +19,22 @@
$Debug ||= 0;
my $Is_Win32 = $^O eq "MSWin32";
-@Apache::PerlRun::ISA = qw(Apache);
-
sub new {
my($class, $r) = @_;
-return $r unless ref($r) eq "Apache";
-if(ref $r) {
- $r-request($r);
-}
-else {
- $r = Apache-request;
-}
my $filename = $r-filename;
$r-warn("Apache::PerlRun-new for $filename in process $$")
if $Debug $Debug 4;
-bless {
- '_r' = $r,
-}, $class;
+return bless {}, $class;
}
sub can_compile {
my($pr) = @_;
-my $filename = $pr-filename;
-if (-r $filename -s _) {
- if (!($pr-allow_options OPT_EXECCGI)) {
- $pr-log_reason("Options ExecCGI is off in this directory",
+my $r = Apache-request;
+my $filename = $r-filename;
+if (-r $r-finfo -s _) {
+ if (!($r-allow_options OPT_EXECCGI)) {
+ $r-log_reason("Options ExecCGI is off in this directory",
$filename);
return FORBIDDEN;
}
@@ -52,7 +42,7 @@
return DECLINED;
}
unless (-x _ or $Is_Win32) {
- $pr-log_reason("file permissions deny server execution",
+ $r-log_reason("file permissions deny server execution",
$filename);
return FORBIDDEN;
}
@@ -64,8 +54,7 @@
}
sub mark_line {
-my($pr) = @_;
-my $filename = $pr-filename;
+my $filename = Apache-request-filename;
return $Apache::Registry::MarkLine ?
"\n#line 1 $filename\n" : "";
}
@@ -114,14 +103,15 @@
sub compile {
my($pr, $eval) = @_;
$eval ||= $pr-{'sub'};
-$pr-clear_rgy_endav;
-$pr-log_error("Apache::PerlRun-compile") if $Debug $Debug 4;
+my $r = Apache-request;
+$r-clear_rgy_endav;
+$r-log_error("Apache::PerlRun-compile") if $Debug $Debug 4;
Apache-untaint($$eval);
{
no strict; #so eval'd code doesn't inherit our bits
eval $$eval;
}
-$pr-stash_rgy_endav;
+$r-stash_rgy_endav;
return $pr-error_check;
}
@@ -145,7 +135,7 @@
}
if($errsv) {
- $pr-log_error($errsv);
+ Apache-request-log_error($errsv);
return SERVER_ERROR;
}
@@ -153,24 +143,25 @@
}
sub status {
-shift-{'_r'}-status;
+Apache-request-status;
}
sub namespace_from {
my($pr) = @_;
+my $r = Apache-request;
-my $uri = $pr-uri;
+my $uri = $r-uri;
-$pr-log_error(sprintf "Apache::PerlRun-namespace escaping %s",
+$r-log_error(sprintf "Apache::PerlRun-namespace escaping %s",
$uri) if $Debug $Debug 4;
-my $path_info = $pr-path_info;
+my $path_info = $r-path_info;
my $script_name = $path_info $uri =~ /$path_info$/ ?
substr($uri, 0, length($uri)-length($path_info)) :
$uri;
-if ($Apache::Registry::NameWithVirtualHost $pr-server-is_virtual) {
- my $name = $pr-get_server_name;
+if ($Apache::Registry::NameWithVirtualHost $r-server-is_virtual) {
+ my $name = $r-get_server_name;
$script_name = join "", $name, $script_name if $name;
}
@@ -200,7 +191,7 @@
$root ||= "Apache::ROOT";
-$pr-log_error("Apache::PerlRun-namespace: package $root$script_name")
+Apache-request-log_error("Apache::PerlRun-namespace: package
+$root$script_name")
if $Debug $Debug 4;
$pr-{'namespace'} = $root.$script_name;
@@ -209,13 +200,13 @@
sub readscript {
my $pr = shift;
-$pr-{'code'} = $pr-slurp_filename;
+$pr-{'code'} = Apache-request-slurp_filename;
}
sub error_check {
my $pr = shift;
if ($@
