[This message bounced last time I sent it, so I'm trying again.]

[EMAIL PROTECTED] (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 ($$) {

  -------------------                            -------------------
  Ken Williams                             Last Bastion of Euclidity
  [EMAIL PROTECTED]                            The Math Forum


Reply via email to