perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Geoffrey Young <ge...@modperlcookbook.org>
Subject implementing Apache::CmdParms::info()
Date Wed, 28 May 2003 02:46:00 GMT
hi all...

here is an implementation for the final missing piece in directive handlers - $parms->info.

even though info is part of the cmd_parms_struct, it needs special treatment due to the 
underlying and imposed mod_perl struct on the slot.  so, info() is implemented in 
Apache__CmdParms.h which, I gather, is the way to add stuff to the autogenerated classes.

in XS, the patch changes the current (autogenerated) implementation from

   void *
   info(obj, val=NULL)
       Apache::CmdParms obj
       void * val
   ...
       RETVAL = (void *) obj->info;
   ...

to its new form

   char *
   info(obj, val=NULL)
       Apache::CmdParms obj
       void * val
   ...
       RETVAL = ((modperl_module_cmd_data_t *)obj->info)->cmd_data;
   ...

which is essentially how mp1 handled it.

the patch was (for the most part) generated by making the above change in WrapXS, 
compiling, then putting the results from the generated .c into Apache__CmdParms.h - in 
other words, the patch was autogenerated too, so don't blame me :)

anyway, I had to shuffle the modperl_module_cmd_data_t struct around so that everybody 
could see everything, but it all worked out in the end.

oh, and I couldn't figure out how to cvs diff the xs/Apache/CmdParms/Apache__CmdParms.h 
file and directory I needed to add (-RuN didn't seem to work), so that file is included as

a diff against /dev/null.

--Geoff

Index: src/modules/perl/modperl_module.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_module.c,v
retrieving revision 1.13
diff -u -r1.13 modperl_module.c
--- src/modules/perl/modperl_module.c   12 May 2003 13:00:15 -0000      1.13
+++ src/modules/perl/modperl_module.c   28 May 2003 02:25:21 -0000
@@ -13,12 +13,6 @@
      modperl_module_info_t *minfo;
  } modperl_module_cfg_t;

-typedef struct {
-    module *modp;
-    const char *cmd_data;
-    const char *func_name;
-} modperl_module_cmd_data_t;
-
  #define MP_MODULE_INFO(modp) \
      (modperl_module_info_t *)modp->dynamic_load_handle

@@ -711,7 +705,7 @@
          cmd->cmd_data = info;

          /* no default if undefined */
-        if (!(errmsg = modperl_module_cmd_fetch(aTHX_ obj, "data", &val))) {
+        if (!(errmsg = modperl_module_cmd_fetch(aTHX_ obj, "cmd_data", &val))) {
              info->cmd_data = apr_pstrdup(p, SvPV(val, len));
          }

Index: src/modules/perl/modperl_module.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_module.h,v
retrieving revision 1.1
diff -u -r1.1 modperl_module.h
--- src/modules/perl/modperl_module.h   27 Aug 2002 04:21:20 -0000      1.1
+++ src/modules/perl/modperl_module.h   28 May 2003 02:25:21 -0000
@@ -8,4 +8,10 @@
  const char *modperl_module_add(apr_pool_t *p, server_rec *s,
                                 const char *name);

+typedef struct {
+    module *modp;
+    const char *cmd_data;
+    const char *func_name;
+} modperl_module_cmd_data_t;
+
  #endif /* MODPERL_MODULE_H */
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  28 May 2003 02:25:21 -0000
@@ -23,6 +23,7 @@
      },
      {
       name => 'MyOtherTest',
+     cmd_data => 'some info',
      },
      {
       name => 'ServerTest',
@@ -72,11 +73,13 @@
  sub MyTest {
      my($self, $parms, @args) = @_;
      $self->{MyTest} = \@args;
+    $self->{MyTestInfo} = $parms->info;
  }

  sub MyOtherTest {
      my($self, $parms, $arg) = @_;
      $self->{MyOtherTest} = $arg;
+    $self->{MyOtherTestInfo} = $parms->info;
  }

  sub ServerTest {
@@ -97,7 +100,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 => 9;

      t_debug("per-dir config:", $dir_cfg);
      t_debug("per-srv config:", $srv_cfg);
@@ -116,8 +119,13 @@
      ok t_cmp('value', $dir_cfg->{MyOtherTest},
               'MyOtherTest value');

+    ok t_cmp('some info', $dir_cfg->{MyOtherTestInfo},
+             'MyOtherTest cmd_data');
+
      ok t_cmp(['one', 'two'], $dir_cfg->{MyTest},
               'MyTest one two');
+
+    ok (! $dir_cfg->{MyTestInfo});

      ok t_cmp('per-server', $srv_cfg->{ServerTest});

Index: xs/maps/modperl_functions.map
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.56
diff -u -r1.56 modperl_functions.map
--- xs/maps/modperl_functions.map       1 Apr 2003 05:20:50 -0000       1.56
+++ xs/maps/modperl_functions.map       28 May 2003 02:25:21 -0000
@@ -130,3 +130,5 @@
   mpxs_Apache__Directive_as_hash
   Apache__Directive_lookup | MPXS_ | ...

+MODULE=Apache::CmdParms
+ Apache__CmdParms_info | MPXS_ | ...
Index: xs/tables/current/Apache/StructureTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/Apache/StructureTable.pm,v
retrieving revision 1.35
diff -u -r1.35 StructureTable.pm
--- xs/tables/current/Apache/StructureTable.pm  24 Aug 2002 17:14:40 -0000      1.35
+++ xs/tables/current/Apache/StructureTable.pm  28 May 2003 02:25:21 -0000
@@ -2499,10 +2499,6 @@
      'type' => 'cmd_parms',
      'elts' => [
        {
-        'type' => 'void *',
-        'name' => 'info'
-      },
-      {
          'type' => 'int',
          'name' => 'override'
        },
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.114
diff -u -r1.114 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm  12 May 2003 13:00:15 -0000      1.114
+++ xs/tables/current/ModPerl/FunctionTable.pm  28 May 2003 02:25:23 -0000
@@ -6641,6 +6641,19 @@
        }
      ]
    },
+  {
+    'return_type' => 'char *',
+    'name' => 'Apache__CmdParms_info',
+    'attr' => [
+      'static'
+    ],
+    'args' => [
+      {
+        'type' => 'PerlInterpreter *',
+        'name' => 'my_perl'
+      },
+    ]
+  },
  ];


--- /dev/null   Tue May  5 16:32:27 1998
+++ xs/Apache/CmdParms/Apache__CmdParms.h       Tue May 27 21:41:51 2003
@@ -0,0 +1,39 @@
+#include "modperl_module.h"
+
+static XS(MPXS_Apache__CmdParms_info)
+{
+    dXSARGS;
+
+    if (items < 1 || items > 2)
+        Perl_croak(aTHX_ "Usage: Apache::CmdParms::info(obj, val=NULL)");
+    {
+        Apache__CmdParms        obj;
+        char *  val;
+        char *  RETVAL;
+        dXSTARG;
+
+        if (SvROK(ST(0)) && sv_derived_from(ST(0), "Apache::CmdParms")) {
+            IV tmp = SvIV((SV*)SvRV(ST(0)));
+            obj = INT2PTR(Apache__CmdParms,tmp);
+        }
+        else {
+            Perl_croak(aTHX_ SvROK(ST(0)) ?
+                       "obj is not of type Apache::CmdParms" :
+                       "obj is not a blessed reference");
+        };
+
+        if (items < 2)
+            val = NULL;
+        else {
+            val = (char *)SvPV_nolen(ST(1));
+        }
+    RETVAL = ((modperl_module_cmd_data_t *)obj->info)->cmd_data;
+
+    if (items > 1) {
+         ((modperl_module_cmd_data_t *)obj->info)->cmd_data = (char *) val;
+    }
+
+        sv_setpv(TARG, RETVAL); XSprePUSH; PUSHTARG;
+    }
+    XSRETURN(1);
+}




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


Mime
View raw message