dougm 00/09/28 12:59:47
Modified: . Changes ToDo
lib/Apache PerlRun.pm RegistryBB.pm RegistryNG.pm
Log:
change Apache::PerlRun's Apache class relationship from is-a to has-a
Revision Changes Path
1.537 +3 -0 modperl/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl/Changes,v
retrieving revision 1.536
retrieving revision 1.537
diff -u -r1.536 -r1.537
--- Changes 2000/09/28 19:28:27 1.536
+++ Changes 2000/09/28 19:59:23 1.537
@@ -10,6 +10,9 @@
=item 1.24_01-dev
+change Apache::PerlRun's Apache class relationship from is-a to has-a
+[Ken Williams <[EMAIL PROTECTED]>]
+
Apache::SubRequest->run(1) allows ap_send_http_headers() to output for
subrequests
1.261 +3 -3 modperl/ToDo
Index: ToDo
===================================================================
RCS file: /home/cvs/modperl/ToDo,v
retrieving revision 1.260
retrieving revision 1.261
diff -u -r1.260 -r1.261
--- ToDo 2000/09/28 19:28:28 1.260
+++ ToDo 2000/09/28 19:59:25 1.261
@@ -40,9 +40,6 @@
- replace Apache::StatINC with Apache::ModuleReload?
-- ken w's Apache::PerlRun patch to change Apache class relationship
- from is-a to has-a
-
- ken w's Apache::test patch
- CHECK blocks? [Michael J Schout <[EMAIL PROTECTED]>]
@@ -118,6 +115,9 @@
---------------------------------------------------------------------------
MISC BUGS
---------------------------------------------------------------------------
+
+- Apache->request($r) digs the request_rec out of $r regardless of the
+ type/class, e.g. Apache->request(bless {r => $r}, 'My::Apache')
- $r->finfo problem with HTML::Mason::ApacheHandler
[Shane Adams <[EMAIL PROTECTED]>]
1.31 +30 -37 modperl/lib/Apache/PerlRun.pm
Index: PerlRun.pm
===================================================================
RCS file: /home/cvs/modperl/lib/Apache/PerlRun.pm,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- PerlRun.pm 2000/09/28 16:35:52 1.30
+++ PerlRun.pm 2000/09/28 19:59:36 1.31
@@ -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;
}
@@ -65,8 +55,7 @@
}
sub mark_line {
- my($pr) = @_;
- my $filename = $pr->filename;
+ my $filename = shift->{r}->filename;
return $Apache::Registry::MarkLine ?
"\n#line 1 $filename\n" : "";
}
@@ -115,26 +104,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;
@@ -142,11 +133,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;
}
@@ -154,24 +145,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;
}
@@ -201,7 +193,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;
@@ -210,13 +202,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;
@@ -258,12 +250,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 ($$) {
@@ -419,3 +411,4 @@
Doug MacEachern
+=cut
1.5 +1 -1 modperl/lib/Apache/RegistryBB.pm
Index: RegistryBB.pm
===================================================================
RCS file: /home/cvs/modperl/lib/Apache/RegistryBB.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- RegistryBB.pm 2000/05/29 08:11:14 1.4
+++ RegistryBB.pm 2000/09/28 19:59:37 1.5
@@ -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;
1.7 +1 -1 modperl/lib/Apache/RegistryNG.pm
Index: RegistryNG.pm
===================================================================
RCS file: /home/cvs/modperl/lib/Apache/RegistryNG.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- RegistryNG.pm 2000/06/01 21:07:57 1.6
+++ RegistryNG.pm 2000/09/28 19:59:39 1.7
@@ -17,7 +17,7 @@
# see also: Apache::RegistryBB
sub namespace_from {
- shift->filename;
+ shift->{r}->filename;
}
sub handler ($$) {
