perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Geoffrey Young <ge...@modperlcookbook.org>
Subject Re: back compatibility layer for method handlers?
Date Mon, 21 Jan 2002 15:20:26 GMT
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: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org


Mime
View raw message