dougm 01/10/05 18:03:28
Modified: lib/Apache compat.pm
src/modules/perl modperl_util.c modperl_util.h
t/response/TestAPI module.pm
todo api.txt
xs/Apache/Module Apache__Module.h
xs/maps apache_functions.map
xs/tables/current/ModPerl FunctionTable.pm
Log:
add Apache::Module::loaded function
and Apache::module wrapper in Apache::compat
Submitted by: Philippe M . Chiasson <[EMAIL PROTECTED]>
Reviewed by: dougm
Revision Changes Path
1.16 +5 -0 modperl-2.0/lib/Apache/compat.pm
Index: compat.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/compat.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- compat.pm 2001/10/01 09:04:10 1.15
+++ compat.pm 2001/10/06 01:03:26 1.16
@@ -42,6 +42,11 @@
sub untaint {
}
+sub module {
+ require Apache::Module;
+ return Apache::Module::loaded($_[1]);
+}
+
package Apache::Constants;
use Apache::Const ();
1.20 +5 -0 modperl-2.0/src/modules/perl/modperl_util.c
Index: modperl_util.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- modperl_util.c 2001/09/28 20:11:01 1.19
+++ modperl_util.c 2001/10/06 01:03:27 1.20
@@ -443,3 +443,8 @@
return RETVAL;
}
+
+MP_INLINE int modperl_perl_module_loaded(pTHX_ const char *name)
+{
+ return gv_stashpv(name, FALSE) ? 1 : 0;
+}
1.20 +2 -0 modperl-2.0/src/modules/perl/modperl_util.h
Index: modperl_util.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- modperl_util.h 2001/09/28 20:11:01 1.19
+++ modperl_util.h 2001/10/06 01:03:27 1.20
@@ -72,4 +72,6 @@
SV *modperl_table_get_set(pTHX_ apr_table_t *table, char *key,
SV *sv_val, bool do_taint);
+MP_INLINE int modperl_perl_module_loaded(pTHX_ const char *name);
+
#endif /* MODPERL_UTIL_H */
1.2 +65 -9 modperl-2.0/t/response/TestAPI/module.pm
Index: module.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPI/module.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- module.pm 2001/04/04 05:45:48 1.1
+++ module.pm 2001/10/06 01:03:27 1.2
@@ -4,32 +4,88 @@
use warnings FATAL => 'all';
use Apache::Test;
+use Apache::TestConfig;
+use Apache::TestUtil;
use Apache::Module ();
use DynaLoader ();
sub handler {
my $r = shift;
- plan $r, tests => 6;
+ my $cfg = Apache::Test::config();
+ plan $r, tests => 14;
+
my $top_module = Apache::Module->top_module;
ok $top_module;
+
+ ok t_cmp($cfg->{httpd_info}->{MODULE_MAGIC_NUMBER},
+ $top_module->version . ':0',
+ q{$top_module->version});
+
+ ok t_cmp(scalar keys %{ $cfg->{modules} },
+ $top_module->module_index,
+ q{$top_module->module_index});
+
+ #XXX: some of these tests will fail if modperl is linked static
+ #rather than dso. also no promise that mod_perl will be the top_module
+
+ ok t_cmp('mod_perl.c', $top_module->name(), q{$top_module->name});
- ok $top_module->version;
+ my $cmd = $top_module->cmds;
- ok $top_module->module_index;
+ ok defined $cmd;
- ok $top_module->name;
+ ok UNIVERSAL::isa($cmd, 'Apache::Command');
- ok $top_module->cmds;
+ {
+ local $cfg->{modules}->{'mod_perl.c'} = 1;
+ my $modules = {};
- for (my $modp = $top_module; $modp; $modp = $modp->next) {
- if ($modp->name eq 'mod_perl.c') {
- ok 1;
- last;
+ for (my $modp = $top_module; $modp; $modp = $modp->next) {
+ if ($modp && $modp->name) {
+ $modules->{$modp->name} = 1;
+ }
}
+
+ my %alias = (
+ 'sapi_apache2.c' => 'mod_php4.c',
+ );
+
+ while (my($key, $val) = each %alias) {
+ next unless $modules->{$key};
+ delete $modules->{$key};
+ $modules->{$val} = 1;
+ }
+
+ ok t_cmp($cfg->{modules}, $modules, "Modules list");
}
+
+ #.c
+ ok t_cmp(1, Apache::Module::loaded('mod_perl.c'),
+ "Apache::Module::loaded('mod_perl.c')");
+
+ ok t_cmp(0, Apache::Module::loaded('Apache__Module_foo.c'),
+ "Apache::Module::loaded('Apache__Module_foo.c')");
+
+ #.so
+ ok t_cmp(1, Apache::Module::loaded('mod_perl.so'),
+ "Apache::Module::loaded('mod_perl.so')");
+
+ ok t_cmp(0, Apache::Module::loaded('Apache__Module__foo.so'),
+ "Apache::Module::loaded('Apache__Module_foo.so')");
+
+ #perl
+ ok t_cmp(1, Apache::Module::loaded('Apache::Module'),
+ "Apache::Module::loaded('Apache::Module')");
+
+ ok t_cmp(0, Apache::Module::loaded('Apache__Module_foo'),
+ "Apache::Module::loaded('Apache__Module_foo')");
+
+ #bogus
+ ok t_cmp(0, Apache::Module::loaded('Apache__Module_foo.foo'),
+ "Apache::Module::loaded('Apache__Module_foo.foo')");
0;
}
1.8 +0 -3 modperl-2.0/todo/api.txt
Index: api.txt
===================================================================
RCS file: /home/cvs/modperl-2.0/todo/api.txt,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- api.txt 2001/10/02 13:36:10 1.7
+++ api.txt 2001/10/06 01:03:27 1.8
@@ -28,9 +28,6 @@
$r->log_reason:
should be simple, see modperl_log.h
-Apache->module:
-not yet implemented
-
Apache->server_root_relative:
needs to default to current pool (pconf at startup, r->pool at request
time)
1.3 +38 -0 modperl-2.0/xs/Apache/Module/Apache__Module.h
Index: Apache__Module.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/Apache/Module/Apache__Module.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Apache__Module.h 2001/03/26 15:51:50 1.2
+++ Apache__Module.h 2001/10/06 01:03:27 1.3
@@ -1,2 +1,40 @@
#define mpxs_Apache__Module_top_module(CLASS) \
(CLASS ? ap_top_module : ap_top_module)
+
+static MP_INLINE int mpxs_Apache__Module_loaded(char *name)
+{
+ char nameptr[256];
+ char *base;
+ module *modp;
+
+ /* Does the module name have a '.' in it ? */
+ if ((base = ap_strchr(name, '.'))) {
+ int len = base - name;
+
+ memcpy(nameptr, name, len);
+ memcpy(nameptr + len, ".c\0", 3);
+
+ /* check if module is loaded */
+ if (!(modp = ap_find_linked_module(nameptr))) {
+ return 0;
+ }
+
+ if (*(base + 1) == 'c') {
+ return 1;
+ }
+
+ /* if it ends in '.so', check if it was dynamically loaded */
+ if ((strlen(base+1) == 2) &&
+ (*(base + 1) == 's') && (*(base + 2) == 'o') &&
+ modp->dynamic_load_handle)
+ {
+ return 1;
+ }
+
+ return 0;
+ }
+ else {
+ dTHX; /*XXX*/
+ return modperl_perl_module_loaded(aTHX_ name);
+ }
+}
1.31 +1 -0 modperl-2.0/xs/maps/apache_functions.map
Index: apache_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/apache_functions.map,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- apache_functions.map 2001/09/17 01:06:08 1.30
+++ apache_functions.map 2001/10/06 01:03:27 1.31
@@ -180,6 +180,7 @@
>ap_show_directives
>ap_show_modules
>ap_register_hooks
+ mpxs_Apache__Module_loaded
MODULE=Apache::Directive
ap_directive_t *:DEFINE_conftree | | SV *:CLASS
1.30 +25 -1 modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
Index: FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- FunctionTable.pm 2001/10/05 23:38:56 1.29
+++ FunctionTable.pm 2001/10/06 01:03:27 1.30
@@ -2,7 +2,7 @@
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
# ! WARNING: generated by ModPerl::ParseSource/0.01
-# ! Fri Oct 5 16:36:16 2001
+# ! Fri Oct 5 17:52:47 2001
# ! do NOT edit, any changes will be lost !
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2767,6 +2767,20 @@
]
},
{
+ 'return_type' => 'int',
+ 'name' => 'modperl_perl_module_loaded',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'const char *',
+ 'name' => 'name'
+ }
+ ]
+ },
+ {
'return_type' => 'void',
'name' => 'modperl_post_config_handler',
'args' => [
@@ -3734,6 +3748,16 @@
{
'type' => 'int',
'name' => 'logtype'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'int',
+ 'name' => 'mpxs_Apache__Module_loaded',
+ 'args' => [
+ {
+ 'type' => 'char *',
+ 'name' => 'name'
}
]
},
