Geoffrey Young wrote:
>
> Stas Bekman wrote:
> >
> > A "method handler" is now specified using the `method' sub attribute, e.g.
> >
> > sub handler : method {};
>
> well, I submitted a patch to get this to work in 1.3. last I
> remember, doug was looking it over to make sure it didn't have any
> leaks.
>
> you could always commit it, which would give people a migration path
> :)
BTW, here is the patch against current CVS, along with a test handler
Index: mod_perl.c
===================================================================
RCS file: /home/cvspublic/modperl/src/modules/perl/mod_perl.c,v
retrieving revision 1.141
diff -u -r1.141 mod_perl.c
--- mod_perl.c 10 Jul 2001 03:30:27 -0000 1.141
+++ mod_perl.c 21 Jan 2002 15:19:51 -0000
@@ -1199,20 +1199,33 @@
if (gvp) cv = GvCV(gvp);
}
+ if (cv != NULL) {
+ is_method = perl_cv_ismethod(cv);
+ }
+
+ MP_TRACE_h(fprintf(stderr, "checking if `%s' is a method...%s\n",
+ sub, (is_method ? "yes" : "no")));
+ SvREFCNT_dec(sv);
+ return is_method;
+}
+
+int perl_cv_ismethod(CV *cv)
+{
+ int is_method=0;
+
#ifdef CVf_METHOD
if (cv && (CvFLAGS(cv) & CVf_METHOD)) {
is_method = 1;
}
#endif
+
if (!is_method && (cv && SvPOK(cv))) {
is_method = strnEQ(SvPVX(cv), "$$", 2);
}
- MP_TRACE_h(fprintf(stderr, "checking if `%s' is a method...%s\n",
- sub, (is_method ? "yes" : "no")));
- SvREFCNT_dec(sv);
return is_method;
}
+
#endif
void mod_perl_noop(void *data) {}
@@ -1453,6 +1466,7 @@
HV *stash = Nullhv;
SV *pclass = newSVsv(sv), *dispsv = Nullsv;
CV *cv = Nullcv;
+ GV *gv = Nullgv;
char *method = "handler";
int defined_sub = 0, anon = 0;
char *dispatcher = NULL;
@@ -1587,8 +1601,27 @@
#endif
}
else {
- MP_TRACE_h(fprintf(stderr, "perl_call: handler is a %s\n",
- dispatcher ? "dispatcher" : "cached CV"));
+ if (!dispatcher) {
+ MP_TRACE_h(fprintf(stderr, "perl_call: handler is a cached CV\n"));
+#ifdef PERL_METHOD_HANDLERS
+ cv = sv_2cv(sv, &stash, &gv, FALSE);
+
+ if (cv != NULL) {
+ is_method = perl_cv_ismethod(cv);
+ }
+
+ if (is_method) {
+ sv_setpv(pclass, HvNAME(stash));
+ method = GvNAME(CvGV(cv));
+ }
+
+ MP_TRACE_h(fprintf(stderr, "checking if CV is a method...%s\n",
+ (is_method ? "yes" : "no")));
+#endif
+ }
+ else {
+ MP_TRACE_h(fprintf(stderr, "perl_call: handler is a dispatcher\n"));
+ }
}
callback:
package My::MethodTest;
use Apache::Constants qw(OK);
use strict;
sub handler {
my $r = shift;
$r->push_handlers($r->current_callback => 'My::MethodTest->foo');
$r->push_handlers($r->current_callback => 'My::MethodTest->bar');
return OK;
}
sub foo : method {
my $self = shift;
my $r = shift;
print STDERR "My::Method::foo\n";
print STDERR "self: $self, r: $r\n";
return OK;
}
sub bar ($$) {
my $self = shift;
my $r = shift;
print STDERR "My::Method::bar\n";
print STDERR "self: $self, r: $r\n";
return OK;
}
1;
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
