perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Geoffrey Young <ge...@modperlcookbook.org>
Subject Re: opening up $cfg to XS
Date Tue, 03 Jun 2003 18:11:05 GMT


Stas Bekman wrote:
> Geoffrey Young wrote:
> 
>>
>>>
>>> - if your wrapper calls directly the function, without doing anything 
>>> else, but dropping "self" you should use DEFINE_, just in case 
>>> compiler doesn't inline that call. I don't remember if it's in the doc.
>>
>>
>>
>> re this an SvREFCNT_inc below, I figured it might be best to keep it 
>> as a separate function and not use define.  in the patch below, the C 
>> function digs out the object, while the *.h wrapper calls the C 
>> function and increments the refcount before returning to Perl-land.  
>> sound ok?
> 
> 
> but this can still be done in define:
> 
> #define ... SvREFCNT_inc(modperl_module_config_get(aTHX_ pmodule, s, v));
> 
> no?

yes, the below works (however, I was just following your advice wrt using #define to 
inline functions "without doing anything else" :)

I had to do the trickery with self to avoid unused variable warnings - lemme know if you 
have a better idea about that.

>> so, the below patch renames that function to 
>> modperl_module_config_create_obj instead, in the hopes of clarifying 
>> things a bit more.
> 
> 
> +1
> 
> shouldn't then the new function be called modperl_module_config_get_obj?

good idea.

--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.14
diff -u -r1.14 modperl_module.c
--- src/modules/perl/modperl_module.c   30 May 2003 12:55:14 -0000      1.14
+++ src/modules/perl/modperl_module.c   3 Jun 2003 17:30:50 -0000
@@ -246,7 +246,7 @@
      sv_2mortal(modperl_ptr2obj(aTHX_ "Apache::CmdParms", (void *)parms))

  static const char *
-modperl_module_config_get_obj(pTHX_
+modperl_module_config_create_obj(pTHX_
                                apr_pool_t *p,
                                PTR_TBL_t *table,
                                modperl_module_cfg_t *cfg,
@@ -385,7 +385,7 @@

      }

-    errmsg = modperl_module_config_get_obj(aTHX_ p, table, cfg, info,
+    errmsg = modperl_module_config_create_obj(aTHX_ p, table, cfg, info,
                                             minfo->dir_create,
                                             parms, &obj);

@@ -406,7 +406,7 @@

      if (srv_cfg) {
          SV *srv_obj;
-        errmsg = modperl_module_config_get_obj(aTHX_ p, table, srv_cfg, info,
+        errmsg = modperl_module_config_create_obj(aTHX_ p, table, srv_cfg, info,
                                                 minfo->srv_create,
                                                 parms, &srv_obj);
          if (errmsg) {
@@ -852,4 +852,46 @@
  #endif

      return NULL;
+}
+
+SV *modperl_module_config_get_obj(pTHX_ SV *pmodule, server_rec *s,
+                                  ap_conf_vector_t *v)
+{
+    MP_dSCFG(s);
+    module *modp;
+    const char *name;
+    void *ptr;
+    PTR_TBL_t *table;
+    SV *obj;
+
+    if (!v) {
+        v = s->module_config;
+    }
+
+    if (SvROK(pmodule)) {
+        name = SvCLASS(pmodule);
+    }
+    else {
+        STRLEN n_a;
+        name = SvPV(pmodule, n_a);
+    }
+
+    if (!(scfg->modules &&
+          (modp = apr_hash_get(scfg->modules, name, APR_HASH_KEY_STRING)))) {
+        return &PL_sv_undef;
+    }
+
+    if (!(ptr = ap_get_module_config(v, modp))) {
+        return &PL_sv_undef;
+    }
+
+    if (!(table = modperl_module_config_table_get(aTHX_ FALSE))) {
+        return &PL_sv_undef;
+    }
+
+    if (!(obj = modperl_svptr_table_fetch(aTHX_ table, ptr))) {
+        return &PL_sv_undef;
+    }
+
+    return obj;
  }
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   3 Jun 2003 17:30:50 -0000
@@ -8,4 +8,7 @@
  const char *modperl_module_add(apr_pool_t *p, server_rec *s,
                                 const char *name);

+SV *modperl_module_config_get_obj(pTHX_ SV *pmodule, server_rec *s,
+                                  ap_conf_vector_t *v);
+
  #endif /* MODPERL_MODULE_H */
Index: xs/Apache/Module/Apache__Module.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/Apache/Module/Apache__Module.h,v
retrieving revision 1.10
diff -u -r1.10 Apache__Module.h
--- xs/Apache/Module/Apache__Module.h   30 May 2003 13:39:44 -0000      1.10
+++ xs/Apache/Module/Apache__Module.h   3 Jun 2003 17:30:50 -0000
@@ -1,6 +1,9 @@
  #define mpxs_Apache__Module_top_module(CLASS) \
  (CLASS ? ap_top_module : ap_top_module)

+#define mpxs_Apache__Module_get_config(self, pmodule, s, v) \
+    (self ? SvREFCNT_inc(modperl_module_config_get_obj(aTHX_ pmodule, s, v)) : NULL);
+
  static MP_INLINE int mpxs_Apache__Module_loaded(pTHX_ char *name)
  {
      char nameptr[256];
@@ -36,49 +39,4 @@
      else {
          return modperl_perl_module_loaded(aTHX_ name);
      }
-}
-
-static MP_INLINE SV *mpxs_Apache__Module_get_config(pTHX_
-                                                    SV *self,
-                                                    SV *pmodule,
-                                                    server_rec *s,
-                                                    ap_conf_vector_t *v)
-{
-    MP_dSCFG(s);
-    module *modp;
-    const char *name;
-    void *ptr;
-    PTR_TBL_t *table;
-    SV *obj;
-
-    if (!v) {
-        v = s->module_config;
-    }
-
-    if (SvROK(pmodule)) {
-        name = SvCLASS(pmodule);
-    }
-    else {
-        STRLEN n_a;
-        name = SvPV(pmodule, n_a);
-    }
-
-    if (!(scfg->modules &&
-          (modp = apr_hash_get(scfg->modules, name, APR_HASH_KEY_STRING)))) {
-        return &PL_sv_undef;
-    }
-
-    if (!(ptr = ap_get_module_config(v, modp))) {
-        return &PL_sv_undef;
-    }
-
-    if (!(table = modperl_module_config_table_get(aTHX_ FALSE))) {
-        return &PL_sv_undef;
-    }
-
-    if (!(obj = modperl_svptr_table_fetch(aTHX_ table, ptr))) {
-        return &PL_sv_undef;
-    }
-
-    return SvREFCNT_inc(obj);
  }
Index: xs/maps/apache_functions.map
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/maps/apache_functions.map,v
retrieving revision 1.63
diff -u -r1.63 apache_functions.map
--- xs/maps/apache_functions.map        2 Mar 2003 13:28:13 -0000       1.63
+++ xs/maps/apache_functions.map        3 Jun 2003 17:30:51 -0000
@@ -200,7 +200,6 @@
  >ap_register_hooks
   mpxs_Apache__Module_loaded
   #ap_get_module_config
- mpxs_Apache__Module_get_config | | self, pmodule, s, v=NULL

  MODULE=Apache::Directive
   ap_directive_t *:DEFINE_conftree | | SV *:CLASS
Index: xs/maps/modperl_functions.map
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.57
diff -u -r1.57 modperl_functions.map
--- xs/maps/modperl_functions.map       30 May 2003 12:55:14 -0000      1.57
+++ xs/maps/modperl_functions.map       3 Jun 2003 17:30:51 -0000
@@ -132,3 +132,6 @@

  MODULE=Apache::CmdParms
   mpxs_Apache__CmdParms_info
+
+MODULE=Apache::Module
+SV *:DEFINE_get_config | | SV *:self, SV *:pmodule, server_rec *:s, ap_conf_vector_t *:v=NULL
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.115
diff -u -r1.115 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm  30 May 2003 12:55:15 -0000      1.115
+++ xs/tables/current/ModPerl/FunctionTable.pm  3 Jun 2003 17:30:52 -0000
@@ -3139,6 +3139,28 @@
      ]
    },
    {
+    'return_type' => 'SV *',
+    'name' => 'modperl_module_config_get_obj',
+    'args' => [
+      {
+        'type' => 'PerlInterpreter *',
+        'name' => 'my_perl'
+      },
+      {
+        'type' => 'SV *',
+        'name' => 'pmodule'
+      },
+      {
+        'type' => 'server_rec *',
+        'name' => 's'
+      },
+      {
+        'type' => 'ap_conf_vector_t *',
+        'name' => 'v'
+      }
+    ]
+  },
+  {
      'return_type' => 'PTR_TBL_t *',
      'name' => 'modperl_module_config_table_get',
      'args' => [
@@ -5226,36 +5248,6 @@
        {
          'type' => 'int',
          'name' => 'logtype'
-      }
-    ]
-  },
-  {
-    'return_type' => 'SV *',
-    'name' => 'mpxs_Apache__Module_get_config',
-    'attr' => [
-      'static',
-      '__inline__'
-    ],
-    'args' => [
-      {
-        'type' => 'PerlInterpreter *',
-        'name' => 'my_perl'
-      },
-      {
-        'type' => 'SV *',
-        'name' => 'self'
-      },
-      {
-        'type' => 'SV *',
-        'name' => 'pmodule'
-      },
-      {
-        'type' => 'server_rec *',
-        'name' => 's'
-      },
-      {
-        'type' => 'ap_conf_vector_t *',
-        'name' => 'v'
        }
      ]
    },


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


Mime
View raw message