perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Geoffrey Young <ge...@modperlcookbook.org>
Subject DECLINE_CMD
Date Wed, 07 May 2003 19:57:48 GMT
hi all

   I've been playing around with directive handlers and have found a problem 
with DECLINE_CMD, namely that it doesn't exist within Apache::Const.

   unfortunately, implementing DECLINE_CMD is not as easy as just adding it 
to the constants map - DECLINE_CMD is the only constant in Apache/APR that 
isn't an integer, and all the autogeneration/newCONSTSUB stuff is geared 
toward creating integer constants.

   the below patch works and seems a decent way to do it (now we have a 
routine for character-based constants in case there end up being others), 
but somebody else might have a better idea.

   the good news is that once you have DECLINE_CMD, declining directive 
handlers works the same way it did in mp1 :)

--Geoff

Index: src/modules/perl/modperl_const.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_const.c,v
retrieving revision 1.8
diff -u -r1.8 modperl_const.c
--- src/modules/perl/modperl_const.c	22 Oct 2001 05:42:23 -0000	1.8
+++ src/modules/perl/modperl_const.c	7 May 2003 19:38:49 -0000
@@ -42,6 +42,42 @@
      return val;
  }

+static char * new_char_constsub(pTHX_ char *lookup,
+                        HV *caller_stash, HV *stash,
+                        const char *name)
+{
+    int name_len = strlen(name);
+    GV **gvp = (GV **)hv_fetch(stash, name, name_len, TRUE);
+
+    /* dont redefine */
+    if (!isGV(*gvp) || !GvCV(*gvp)) {
+
+#if 0
+        fprintf(stderr, "newCONSTSUB(%s, %s, %s)\n",
+                HvNAME(stash), name, lookup);
+#endif
+
+        newCONSTSUB(stash, (char *)name, newSVpv(lookup, 0));
+#ifdef GvSHARED
+        GvSHARED_on(*gvp);
+#endif
+    }
+
+    /* export into callers namespace */
+    if (caller_stash) {
+        GV *alias = *(GV **)hv_fetch(caller_stash,
+                                     (char *)name, name_len, TRUE);
+
+        if (!isGV(alias)) {
+            gv_init(alias, caller_stash, name, name_len, TRUE);
+        }
+
+        GvCV(alias) = GvCV(*gvp);
+    }
+
+    return lookup;
+}
+
  int modperl_const_compile(pTHX_ const char *classname,
                            const char *arg,
                            const char *name)
@@ -54,6 +90,11 @@
      if (strnEQ(classname, "APR", 3)) {
          lookup       = modperl_constants_lookup_apr;
          group_lookup = modperl_constants_group_lookup_apr;
+    }
+    else if (strnEQ(name, "DECLINE_CMD", 11)) {
+      /* DECLINE_CMD is the only constant that's not an integer */
+      new_char_constsub(aTHX_ DECLINE_CMD, caller_stash, stash, name);
+      return 1;
      }
      else {
          lookup       = modperl_constants_lookup_apache;
Index: t/response/TestDirective/perlloadmodule.pm
===================================================================
RCS file: 
/home/cvspublic/modperl-2.0/t/response/TestDirective/perlloadmodule.pm,v
retrieving revision 1.2
diff -u -r1.2 perlloadmodule.pm
--- t/response/TestDirective/perlloadmodule.pm	13 Dec 2002 10:06:55 -0000	1.2
+++ t/response/TestDirective/perlloadmodule.pm	7 May 2003 19:38:49 -0000
@@ -6,7 +6,7 @@
  use Apache::Test;
  use Apache::TestUtil;

-use Apache::Const -compile => qw(OK OR_ALL RSRC_CONF TAKE1 TAKE23);
+use Apache::Const -compile => qw(OK OR_ALL RSRC_CONF TAKE1 TAKE23 
DECLINE_CMD);

  use Apache::CmdParms ();
  use Apache::Module ();
@@ -97,7 +97,7 @@
      my $dir_cfg = $self->get_config($s, $r->per_dir_config);
      my $srv_cfg = $self->get_config($s);

-    plan $r, tests => 7;
+    plan $r, tests => 8;

      t_debug("per-dir config:", $dir_cfg);
      t_debug("per-srv config:", $srv_cfg);
@@ -120,6 +120,8 @@
               'MyTest one two');

      ok t_cmp('per-server', $srv_cfg->{ServerTest});
+
+    ok t_cmp("\x07\x08", Apache::DECLINE_CMD);

      Apache::OK;
  }


---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org


Mime
View raw message