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} = [EMAIL PROTECTED];
+ $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: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
