perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Geoffrey Young <ge...@modperlcookbook.org>
Subject opening up $cfg to XS
Date Fri, 30 May 2003 14:09:48 GMT
hi again

the below patch moves the guts of mpxs_Apache__Module_get_config to a new public function,

modperl_get_config, and leaves mpxs_Apache__Module_get_config as a wrapper.

a project I'm tinkering with now requires the config object from within XS, but currently

I need to copy most of the code from mpxs_Apache__Module_get_config into my XS due to the

hidden nature of the function.  modperl_module_config_get_obj doesn't fit the bill either,

since it requires lots of stuff not available outside of the config environment.

the new function would be used like this

   SV *obj = modperl_get_config(aTHX_ newSVpvn("My::Foo", 7),
                                r->server, r->per_dir_config);

anyway, I figured that making the object-fetching routine publically available would 
benefit XS developers (ok, who am I kidding - nobody cares about this stuff but me :).

anyway... objections, thoughts, comments?

--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   30 May 2003 13:58:27 -0000
@@ -853,3 +853,44 @@

      return NULL;
  }
+
+SV *modperl_get_config(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 SvREFCNT_inc(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   30 May 2003 13:58:27 -0000
@@ -8,4 +8,6 @@
  const char *modperl_module_add(apr_pool_t *p, server_rec *s,
                                 const char *name);

+SV *modperl_get_config(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   30 May 2003 13:58:27 -0000
@@ -44,41 +44,5 @@
                                                      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);
+    return modperl_get_config(aTHX_ pmodule, s, v);
  }
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  30 May 2003 13:58:29 -0000
@@ -3139,6 +3139,28 @@
      ]
    },
    {
+    'return_type' => 'SV *',
+    'name' => 'modperl_get_config',
+    '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' => [


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


Mime
View raw message