perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From "Philippe M. Chiasson" <go...@cpan.org>
Subject [mp1 Patch] Looking for magic in Apache->request
Date Wed, 28 May 2003 13:08:23 GMT
Going through the current state of STATUS, I've found this one intersting problem:

Right now, one can do this (from t/net/perl/api.pl)

@My::Req::ISA = qw(Apache);

my $hr = bless {
    _r => $r,
}, "My::Req";


And then call:
$hr->filename;

thru regular inheritance ;)


The problem pointed out by Ken is that it would be nice to be able to
call

Apache->request($hr);

So that later call to Apache->request (by other modules) would
return the subclassed object.

Well, the following patch does just that. Seems fine to me but I'd like
to get a few more eyeballs on this one.

(the changes in lib just get rid of strange, useless calls to $r->request(foo))

# $Id: request_rec_sv.patch,v 1.1 2003/05/28 13:07:07 gozer Exp $

Index: t/net/perl/api.pl
===================================================================
RCS file: /home/cvs/modperl/t/net/perl/api.pl,v
retrieving revision 1.51
diff -u -I$Id -r1.51 api.pl
--- t/net/perl/api.pl	25 May 2003 10:54:08 -0000	1.51
+++ t/net/perl/api.pl	28 May 2003 12:53:52 -0000
@@ -17,7 +17,7 @@
 
 my $is_xs = ($r->uri =~ /_xs/);
 
-my $tests = 81;
+my $tests = 82;
 my $is_win32 = WIN32;
 $tests += 4 unless $is_win32;
 my $test_get_set = Apache->can('set_handlers') && ($tests += 4);
@@ -297,6 +297,11 @@
 }, "My::Req";
 
 test ++$i, $hr->filename;
+
+Apache->request($hr);
+
+test ++$i, ref(Apache->request) eq "My::Req";
+
 delete $hr->{_r};
 my $uri;
 
Index: src/modules/perl/Apache.xs
===================================================================
RCS file: /home/cvs/modperl/src/modules/perl/Apache.xs,v
retrieving revision 1.127
diff -u -I$Id -r1.127 Apache.xs
--- src/modules/perl/Apache.xs	14 Mar 2003 06:05:06 -0000	1.127
+++ src/modules/perl/Apache.xs	28 May 2003 12:53:54 -0000
@@ -1343,15 +1343,17 @@
 #see httpd.h
 #struct request_rec {
 
-void
-request(self, r=NULL)
+SV *
+request(self, r=Nullsv)
     SV *self
-    Apache r
+    SV *r
 
-    PPCODE: 
-    self = self;
-    if(items > 1) perl_request_rec(r);
-    XPUSHs(perl_bless_request_rec(perl_request_rec(NULL)));
+    CODE:
+    if(r) perl_request_rec_sv(r);
+    RETVAL = perl_request_rec_sv(NULL);
+    
+    OUTPUT:
+    RETVAL
 
 #  pool *pool;
 #  conn_rec *connection;
Index: src/modules/perl/mod_perl.c
===================================================================
RCS file: /home/cvs/modperl/src/modules/perl/mod_perl.c,v
retrieving revision 1.146
diff -u -I$Id -r1.146 mod_perl.c
--- src/modules/perl/mod_perl.c	14 Mar 2003 04:45:52 -0000	1.146
+++ src/modules/perl/mod_perl.c	28 May 2003 12:53:54 -0000
@@ -64,6 +64,7 @@
 #endif
 
 static IV mp_request_rec;
+static SV *mp_request_rec_sv = Nullsv;
 static int seqno = 0;
 static int perl_is_running = 0;
 int mod_perl_socketexitoption = 3;
@@ -1141,6 +1142,12 @@
     perl_run_rgy_endav(r->uri);
     per_request_cleanup(r);
 
+    if(mp_request_rec_sv && SvREFCNT(mp_request_rec_sv)) {
+        fprintf(stderr, "Freeing mp_request_rec_sv (refcnt=%d)\n", SvREFCNT(mp_request_rec_sv));
+        SvREFCNT_dec(mp_request_rec_sv);
+    }
+    mp_request_rec_sv = Nullsv;
+
     /* clear %ENV */
     perl_clear_env();
 
@@ -1716,6 +1723,22 @@
     }
     else
 	return (request_rec *)mp_request_rec;
+}
+
+SV *perl_request_rec_sv(SV *r)
+{
+    if(r != NULL) {
+        if(mp_request_rec_sv && SvREFCNT(mp_request_rec_sv))
+            SvREFCNT_dec(mp_request_rec_sv);
+        mp_request_rec_sv = SvREFCNT_inc(r);
+        return NULL;
+    }
+    else if(mp_request_rec_sv) {
+        return SvREFCNT_inc(mp_request_rec_sv);
+    }
+    else {
+        return sv_setref_pv(newSV(0), "Apache", perl_request_rec(NULL));
+    }
 }
 
 SV *perl_bless_request_rec(request_rec *r)
Index: lib/Apache/Registry.pm
===================================================================
RCS file: /home/cvs/modperl/lib/Apache/Registry.pm,v
retrieving revision 1.34
diff -u -I$Id -r1.34 Registry.pm
--- lib/Apache/Registry.pm	23 May 2002 04:21:07 -0000	1.34
+++ lib/Apache/Registry.pm	28 May 2003 12:53:54 -0000
@@ -33,13 +33,6 @@
 
 sub handler {
     my $r = shift;
-    if(ref $r) {
-	$r->request($r);
-    }
-    else {
-	#warn "Registry args are: ($r, @_)\n";
-	$r = Apache->request;
-    }
     my $filename = $r->filename;
     #local $0 = $filename; #this core dumps!?
     *0 = \$filename;
Index: lib/Apache/Status.pm
===================================================================
RCS file: /home/cvs/modperl/lib/Apache/Status.pm,v
retrieving revision 1.28
diff -u -I$Id -r1.28 Status.pm
--- lib/Apache/Status.pm	28 Nov 2002 09:42:45 -0000	1.28
+++ lib/Apache/Status.pm	28 May 2003 12:53:54 -0000
@@ -55,7 +55,6 @@
 
 sub handler {
     my($r) = @_;
-    Apache->request($r); #for Apache::CGI
     my $qs = $r->args || "";
     my $sub = "status_$qs";
     no strict 'refs';




> > -----Original Message-----
> > From: Doug MacEachern [mailto:dougm@covalent.net]
> > Sent: Monday, April 02, 2001 12:51 AM
> > To: Ken Williams
> > Cc: dev@perl.apache.org
> > Subject: Re: Looking for magic in Apache->request
> > 
> > 
> > On Fri, 30 Mar 2001, Ken Williams wrote:
> >  
> > > The thing I can't figure out from the XS code is how/where
> > > Apache->request calls sv2request_rec(), which actually does the
> > > extraction work.  Somehow it's automatically converted, 
> > because I see no
> > > manual conversion in the Apache->request code below:
> > 
> > you don't need to change sv2request_rec(), the `Apache' 
> > typemap that calls
> > it needs to dig out the real request_rec for use with the apache api.
> > 
> > > void
> > > request(self, r=NULL)
> > >     SV *self
> > >     Apache r
> > 
> > what you can do is change 'Apache r' to 'SV *r', the global 
> > mp_request_rec
> > (in mod_perl.c) from an IV to SV.  then adjust things that 
> > fetch/modify
> > mp_request_rec acordingly.  this would require some SvREFCNT_{inc,dec}
> > managment, since the lifetime of mp_request_rec is longer 
> > than the object
> > you want it to point to.
> > i plan to catchup on 1.xx stuff after apachecon, i will look into it
> > then if you get stuck.
> > 
> > 
> > ---------------------------------------------------------------------
> > To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
> > For additional commands, e-mail: dev-help@perl.apache.org
> > 
> 
> ---------------------------------------------------------------------
> To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
> For additional commands, e-mail: dev-help@perl.apache.org
-- 
-- -----------------------------------------------------------------------------
Philippe M. Chiasson /gozer\@(cpan|ectoplasm)\.org/ 88C3A5A5 (122FF51B/C634E37B)
http://gozer.ectoplasm.org/    F9BF E0C2 480E 7680 1AE5 3631 CB32 A107 88C3 A5A5
Q: It is impossible to make anything foolproof because fools are so ingenious.
perl -e'$$=\${gozer};{$_=unpack(P7,pack(L,$$));/^JAm_pH\n$/&&print||$$++&&redo}'

Mime
View raw message