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
Date Thu, 08 May 2003 14:27:09 GMT

> I think there is a much cleaner solution. Fix ModPerl::Code to make
> modperl_constants_lookup_apr and modperl_constants_lookup_apache return 
> SV. 

good idea - I thought it would be harder than it was to change the return type of 
everything.  here is take 2.  the only thing that I'm not sure about is

-        newCONSTSUB(stash, (char *)name, newSViv(val));
+        newCONSTSUB(stash, (char *)name, newSVsv(val));

and whether we need to copy val with newSVsv or can just pass val along without the copy.

> 
> BTW, why do we have the same generated files in two places?
> 
> grep -Ilr modperl_constants_lookup_apr src xs 
> src/modules/perl/modperl_const.c | grep '\.c$'
> src/modules/perl/modperl_const.c
> src/modules/perl/modperl_constants.c
> xs/ModPerl/Const/modperl_const.c
> xs/ModPerl/Const/modperl_constants.c

I have no idea :)

--Geoff

Index: Changes
===================================================================
RCS file: /home/cvspublic/modperl-2.0/Changes,v
retrieving revision 1.183
diff -u -r1.183 Changes
--- Changes	8 May 2003 00:31:27 -0000	1.183
+++ Changes	8 May 2003 13:53:54 -0000
@@ -12,6 +12,9 @@

  =item 1.99_10-dev

+implement DECLINE_CMD and DIR_MAGIC_TYPE constants
+[Geoffrey Young]
+
  Fix Apache::Reload to gracefully handle the case with empty Touchfiles
  [Dmitri Tikhonov <dmitri@netilla.com>]

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	8 May 2003 13:53:54 -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	8 May 2003 13:53:55 -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(const char *name)";

      print $h_fh "$proto;\n";

@@ -777,6 +777,8 @@

  $proto
  {
+    dTHX;
+
      if (*name == 'A' && strnEQ(name, "$package", $package_len)) {
          name += $package_len;
      }
@@ -801,13 +803,25 @@

          for my $name (@$names) {
              my @ifdef = constants_ifdef($alias{$name});
-            print $c_fh <<EOF;
+            if ($name eq 'DECLINE_CMD' ||
+                $name eq 'DIR_MAGIC_TYPE') {
+                print $c_fh <<EOF;
+$ifdef[0]
+          if (strEQ(name, "$name")) {
+              return newSVpv($alias{$name},0);
+          }
+$ifdef[1]
+EOF
+            }
+            else {
+                print $c_fh <<EOF;
  $ifdef[0]
            if (strEQ(name, "$name")) {
-              return $alias{$name};
+              return newSViv($alias{$name});
            }
  $ifdef[1]
  EOF
+           }
          }
          print $c_fh "      break;\n";
      }
@@ -815,7 +829,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	8 May 2003 13:53:55 -0000
@@ -1,16 +1,16 @@
  #include "mod_perl.h"
  #include "modperl_const.h"

-typedef int (*constants_lookup)(const char *);
+typedef SV *(*constants_lookup)(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)) {
@@ -21,7 +21,7 @@
                  HvNAME(stash), name, val);
  #endif

-        newCONSTSUB(stash, (char *)name, newSViv(val));
+        newCONSTSUB(stash, (char *)name, newSVsv(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	8 May 2003 13:53:56 -0000
@@ -669,7 +669,7 @@
              }
              else {
                  cmd->args_how =
-                    modperl_constants_lookup_apache(SvPV(val, len));
+                    SvIV(modperl_constants_lookup_apache(SvPV(val, len)));
              }
          }

@@ -695,7 +695,7 @@
              }
              else {
                  cmd->req_override =
-                    modperl_constants_lookup_apache(SvPV(val, len));
+                    SvIV(modperl_constants_lookup_apache(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	8 May 2003 13:53:56 -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	8 May 2003 13:53:57 -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.112
diff -u -r1.112 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm	16 Apr 2003 03:03:35 -0000	1.112
+++ xs/tables/current/ModPerl/FunctionTable.pm	8 May 2003 13:54:00 -0000
@@ -1469,7 +1469,7 @@
      ]
    },
    {
-    'return_type' => 'int',
+    'return_type' => 'SV *',
      'name' => 'modperl_constants_lookup_apache',
      'args' => [
        {
@@ -1479,7 +1479,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