This is part of The Pile, a partial archive of some open source mailing lists and newsgroups.
Subject: Why is Apache::PerlRun a subclass of Apache?
From: Ken Williams <ken@forum.swarthmore.edu>
Date: Tue, 22 Aug 2000 21:41:26 -0500
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.
===
Subject: Re: Why is Apache::PerlRun a subclass of Apache?
From: Ken Williams <ken@forum.swarthmore.edu>
Date: Thu, 24 Aug 2000 01:42:29 -0500
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.
((deleted))
===
Subject: Re: Why is Apache::PerlRun a subclass of Apache?
From: Ken Williams <ken@forum.swarthmore.edu>
Date: Fri, 25 Aug 2000 16:22:26 -0500
This message bounced last time I sent it, so I'm trying again.]
ken@mathforum.com (Ken Williams) wrote:
> ... *crickets* ...
>
>Here's a patch for the implementation I'm looking for.
And here's a better one. I discovered that Apache->request($r) doesn't
work as expected (see my previous message with subject
"Apache->request($r) broken?"), so this patch makes $r a data member and
uses that instead of the value returned by Apache->request.
There were also a couple of buglets in my last patch - now I've got this
working and cooperating with Apache::Filter and Apache::RegistryFilter.
RegistryFilter is getting slicker as a result of these changes - it's
starting to handle $r->send_http_header() in a nice transparent way.
____________________________________________________________________
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/25 19:05:11
@@ -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 {r=>$r}, $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 = $pr->{r};
+ 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 = shift->{r}->filename;
return $Apache::Registry::MarkLine ?
"\n#line 1 $filename\n" : "";
}
@@ -114,26 +103,28 @@
sub compile {
my($pr, $eval) = @_;
$eval ||= $pr->{'sub'};
- $pr->clear_rgy_endav;
- $pr->log_error("Apache::PerlRun->compile") if $Debug && $Debug & 4;
+ my $r = $pr->{r};
+ $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;
}
sub run {
my $pr = shift;
my $package = $pr->{'namespace'};
+ my $r = $pr->{r};
my $rc = OK;
my $cv = \&{"$package\::handler"};
my $oldwarn = $^W;
- eval { $rc = &{$cv}($pr, @_) } if $pr->seqno;
+ eval { $rc = &{$cv}($r, @_) } if $r->seqno;
$pr->{status} = $rc;
$^W = $oldwarn;
@@ -141,11 +132,11 @@
if($@) {
$errsv = $@;
$@ = ''; #XXX fix me, if we don't do this Apache::exit() breaks
- $@{$pr->uri} = $errsv;
+ $@{$r->uri} = $errsv;
}
if($errsv) {
- $pr->log_error($errsv);
+ $r->log_error($errsv);
return SERVER_ERROR;
}
@@ -153,24 +144,25 @@
}
sub status {
- shift->{'_r'}->status;
+ shift->{r}->status;
}
sub namespace_from {
my($pr) = @_;
+ my $r = $pr->{r};
- 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 +192,7 @@
$root ||= "Apache::ROOT";
- $pr->log_error("Apache::PerlRun->namespace: package $root$script_name")
+ $pr->{r}->log_error("Apache::PerlRun->namespace: package $root$script_name")
if $Debug && $Debug & 4;
$pr->{'namespace'} = $root.$script_name;
@@ -209,13 +201,13 @@
sub readscript {
my $pr = shift;
- $pr->{'code'} = $pr->slurp_filename;
+ $pr->{'code'} = $pr->{r}->slurp_filename;
}
sub error_check {
my $pr = shift;
if ($@ and substr($@,0,4) ne " at ") {
- $pr->log_error("PerlRun: `$@'");
+ $pr->{r}->log_error("PerlRun: `$@'");
$@{$pr->uri} = $@;
$@ = ''; #XXX fix me, if we don't do this Apache::exit() breaks
return SERVER_ERROR;
@@ -257,12 +249,12 @@
sub chdir_file {
my($pr, $dir) = @_;
- $pr->{'_r'}->chdir_file($dir ? $dir : $pr->filename);
+ my $r = $pr->{r};
+ $r->chdir_file($dir ? $dir : $r->filename);
}
sub set_script_name {
- my($pr) = @_;
- *0 = \$pr->filename;
+ *0 = \(shift->{r}->filename);
}
sub handler ($$) {
@@ -418,3 +410,4 @@
Doug MacEachern
+=cut
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/25 19:05:11
@@ -16,7 +16,7 @@
#skip -x, OPT_EXEC, etc. checks
sub can_compile {
- my $r = shift;
+ my $r = shift->{r};
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/25 19:05:11
@@ -17,7 +17,7 @@
# see also: Apache::RegistryBB
sub namespace_from {
- shift->filename;
+ shift->{r}->filename;
}
sub handler ($$) {
===