... *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 ($@ and substr($@,0,4) ne " at ") {
- $pr->log_error("PerlRun: `$@'");
+ Apache->request->log_error("PerlRun: `$@'");
$@{$pr->uri} = $@;
$@ = ''; #XXX fix me, if we don't do this Apache::exit() breaks
return SERVER_ERROR;
@@ -257,12 +248,12 @@
sub chdir_file {
my($pr, $dir) = @_;
- $pr->{'_r'}->chdir_file($dir ? $dir : $pr->filename);
+ my $r = Apache->request;
+ $r->chdir_file($dir ? $dir : $r->filename);
}
sub set_script_name {
- my($pr) = @_;
- *0 = \$pr->filename;
+ *0 = \(Apache->request->filename);
}
sub handler ($$) {
Index: RegistryBB.pm
===================================================================
RCS file: /home/cvspublic/modperl/lib/Apache/RegistryBB.pm,v
retrieving revision 1.4
diff -u -r1.4 RegistryBB.pm
--- RegistryBB.pm 2000/05/29 08:11:14 1.4
+++ RegistryBB.pm 2000/08/24 06:32:53
@@ -16,7 +16,7 @@
#skip -x, OPT_EXEC, etc. checks
sub can_compile {
- my $r = shift;
+ my $r = Apache->request;
unless (-r $r->finfo) {
$r->log_reason("file does not exist");
return NOT_FOUND;
Index: RegistryNG.pm
===================================================================
RCS file: /home/cvspublic/modperl/lib/Apache/RegistryNG.pm,v
retrieving revision 1.6
diff -u -r1.6 RegistryNG.pm
--- RegistryNG.pm 2000/06/01 21:07:57 1.6
+++ RegistryNG.pm 2000/08/24 06:32:53
@@ -17,7 +17,7 @@
# see also: Apache::RegistryBB
sub namespace_from {
- shift->filename;
+ Apache->request->filename;
}
sub handler ($$) {
===================================================================
