perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Geoffrey Young <ge...@modperlcookbook.org>
Subject Re: DECLINE_CMD (take 3)
Date Fri, 09 May 2003 14:28:59 GMT
ok, here's take 3.

re:

if ($name eq 'DECLINE_CMD' || $name eq 'DIR_MAGIC_TYPE') {
     print $c_fh <<EOF;
               return newSVpv($alias{$name}, 0);
EOF

I think it's proper to use newSVpv instead of newSVpvn - because the length in question is

the length of the constant (not the name), presupposing we know the length of DECLINE_CMD

beforehand seems wrong (if we knew the value of the constants then why have a lookup 
function :).  it also allows us to simplify logic in Code.pm and add to the list of 
exceptional string cases if they arise in the future.

anyway, here's the latest version.  I hope I got the threading stuff right :)

--Geoff

Index: Changes
===================================================================
RCS file: /home/cvspublic/modperl-2.0/Changes,v
retrieving revision 1.184
diff -u -r1.184 Changes
--- Changes	9 May 2003 03:33:02 -0000	1.184
+++ Changes	9 May 2003 14:26:25 -0000
@@ -12,6 +12,9 @@

  =item 1.99_10-dev

+implement DECLINE_CMD and DIR_MAGIC_TYPE constants
+[Geoffrey Young]
+
  allow init filter handlers to call other methods than just $f->ctx [Stas]

  Fix Apache::Reload to gracefully handle the case with empty Touchfiles
Index: lib/Apache/ParseSource.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/lib/Apache/ParseSource.pm,v
retrieving revision 1.42
diff -u -r1.42 ParseSource.pm
--- lib/Apache/ParseSource.pm	15 Apr 2003 02:22:41 -0000	1.42
+++ lib/Apache/ParseSource.pm	9 May 2003 14:26:25 -0000
@@ -156,8 +156,8 @@
          satisfy    => [qw{SATISFY_}],
          remotehost => [qw{REMOTE_}],
          http       => [qw{HTTP_}],
-#       config     => [qw{DECLINE_CMD}],
-#       types      => [qw{DIR_MAGIC_TYPE}],
+        config     => [qw{DECLINE_CMD}],
+        types      => [qw{DIR_MAGIC_TYPE}],
          override   => [qw{OR_ ACCESS_CONF RSRC_CONF}],
          log        => [qw(APLOG_)],
      },
Index: lib/ModPerl/Code.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/lib/ModPerl/Code.pm,v
retrieving revision 1.96
diff -u -r1.96 Code.pm
--- lib/ModPerl/Code.pm	24 Apr 2003 01:51:37 -0000	1.96
+++ lib/ModPerl/Code.pm	9 May 2003 14:26:25 -0000
@@ -769,7 +769,7 @@
      my $package_len = length $package;

      my $func = canon_func(qw(constants lookup), $postfix);
-    my $proto = "int $func(const char *name)";
+    my $proto = "SV \*$func(pTHX_ const char *name)";

      print $h_fh "$proto;\n";

@@ -804,7 +804,20 @@
              print $c_fh <<EOF;
  $ifdef[0]
            if (strEQ(name, "$name")) {
-              return $alias{$name};
+EOF
+
+            if ($name eq 'DECLINE_CMD' || $name eq 'DIR_MAGIC_TYPE') {
+                print $c_fh <<EOF;
+              return newSVpv($alias{$name}, 0);
+EOF
+            }
+            else {
+                print $c_fh <<EOF;
+              return newSViv($alias{$name});
+EOF
+            }
+
+            print $c_fh <<EOF;
            }
  $ifdef[1]
  EOF
@@ -815,7 +828,7 @@
      print $c_fh <<EOF
      };
      Perl_croak_nocontext("unknown constant %s", name);
-    return MP_ENOCONST;
+    return newSViv(MP_ENOCONST);
  }
  EOF
  }
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	9 May 2003 14:26:25 -0000
@@ -1,27 +1,27 @@
  #include "mod_perl.h"
  #include "modperl_const.h"

-typedef int (*constants_lookup)(const char *);
+typedef SV *(*constants_lookup)(pTHX_ const char *);
  typedef const char ** (*constants_group_lookup)(const char *);

-static int new_constsub(pTHX_ constants_lookup lookup,
+static SV *new_constsub(pTHX_ constants_lookup lookup,
                          HV *caller_stash, HV *stash,
                          const char *name)
  {
      int name_len = strlen(name);
      GV **gvp = (GV **)hv_fetch(stash, name, name_len, TRUE);
-    int val;
+    SV *val;

      /* dont redefine */
      if (!isGV(*gvp) || !GvCV(*gvp)) {
-        val = (*lookup)(name);
+        val = (*lookup)(aTHX_ name);

  #if 0
          fprintf(stderr, "newCONSTSUB(%s, %s, %d)\n",
                  HvNAME(stash), name, val);
  #endif

-        newCONSTSUB(stash, (char *)name, newSViv(val));
+        newCONSTSUB(stash, (char *)name, val);
  #ifdef GvSHARED
          GvSHARED_on(*gvp);
  #endif
Index: src/modules/perl/modperl_module.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_module.c,v
retrieving revision 1.12
diff -u -r1.12 modperl_module.c
--- src/modules/perl/modperl_module.c	14 Apr 2003 06:38:50 -0000	1.12
+++ src/modules/perl/modperl_module.c	9 May 2003 14:26:25 -0000
@@ -669,7 +669,7 @@
              }
              else {
                  cmd->args_how =
-                    modperl_constants_lookup_apache(SvPV(val, len));
+                    SvIV(modperl_constants_lookup_apache(aTHX_ SvPV(val, len)));
              }
          }

@@ -695,7 +695,7 @@
              }
              else {
                  cmd->req_override =
-                    modperl_constants_lookup_apache(SvPV(val, len));
+                    SvIV(modperl_constants_lookup_apache(aTHX_ SvPV(val, len)));
              }
          }

Index: t/apache/constants.t
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/apache/constants.t,v
retrieving revision 1.5
diff -u -r1.5 constants.t
--- t/apache/constants.t	18 May 2002 02:29:44 -0000	1.5
+++ t/apache/constants.t	9 May 2003 14:26:25 -0000
@@ -5,10 +5,11 @@
  use Test;

  use Apache2 ();
-use Apache::Const -compile => qw(DECLINED :http :common TAKE23 &OPT_EXECCGI);
+use Apache::Const -compile => qw(DECLINED :http :common TAKE23 &OPT_EXECCGI
+                                 DECLINE_CMD DIR_MAGIC_TYPE);
  use Apache::Const; #defaults to :common

-plan tests => 13;
+plan tests => 15;

  ok REDIRECT == 302;
  ok AUTH_REQUIRED == 401;
@@ -17,6 +18,8 @@
  ok Apache::DECLINED == -1;
  ok Apache::HTTP_GONE == 410;
  ok Apache::OPT_EXECCGI;
+ok Apache::DECLINE_CMD eq "\x07\x08";
+ok Apache::DIR_MAGIC_TYPE eq "httpd/unix-directory";

  ok ! defined &M_GET;
  Apache::Const->import('M_GET');
Index: xs/tables/current/Apache/ConstantsTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/Apache/ConstantsTable.pm,v
retrieving revision 1.27
diff -u -r1.27 ConstantsTable.pm
--- xs/tables/current/Apache/ConstantsTable.pm	24 Aug 2002 17:14:39 -0000	1.27
+++ xs/tables/current/Apache/ConstantsTable.pm	9 May 2003 14:26:26 -0000
@@ -143,6 +143,12 @@
        'HTTP_INSUFFICIENT_STORAGE',
        'HTTP_NOT_EXTENDED'
      ],
+    'config' => [
+      'DECLINE_CMD'
+    ],
+    'types' => [
+      'DIR_MAGIC_TYPE'
+    ],
      'filter_type' => [
        'AP_FTYPE_RESOURCE',
        'AP_FTYPE_CONTENT_SET',
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.113
diff -u -r1.113 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm	9 May 2003 03:33:02 -0000	1.113
+++ xs/tables/current/ModPerl/FunctionTable.pm	9 May 2003 14:26:27 -0000
@@ -1473,7 +1473,7 @@
      ]
    },
    {
-    'return_type' => 'int',
+    'return_type' => 'SV *',
      'name' => 'modperl_constants_lookup_apache',
      'args' => [
        {
@@ -1483,7 +1483,7 @@
      ]
    },
    {
-    'return_type' => 'int',
+    'return_type' => 'SV *',
      'name' => 'modperl_constants_lookup_apr',
      'args' => [
        {


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


Mime
View raw message