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:[EMAIL PROTECTED]
> > Sent: Monday, April 02, 2001 12:51 AM
> > To: Ken Williams
> > Cc: [EMAIL PROTECTED]
> > 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: [EMAIL PROTECTED]
> > For additional commands, e-mail: [EMAIL PROTECTED]
> >
>
> ---------------------------------------------------------------------
> To unsubscribe, e-mail: [EMAIL PROTECTED]
> For additional commands, e-mail: [EMAIL PROTECTED]
--
-- -----------------------------------------------------------------------------
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}'
signature.asc
Description: This is a digitally signed message part
