On Wed, Oct 03, 2001 at 08:40:40PM -0700, Doug MacEachern wrote:
> On Thu, 4 Oct 2001, Philippe M . Chiasson wrote:
>
> > Can you tell me exactly why ? I started doing it the way 1.x used to do it
> > but it was pretty complicated and I thought about this method instead, that
> > sounded as good yet a lot simpler. Care to explain why we need to check %INC
> > for real ?
>
> just because it is possible for a %package:: to exist with the .pm loaded.
> but i guess we could just check the package for now and change later if
> needed. pretty sure 1.x goes through the trouble for a reason, but we can
> wait and seen if there actually is a problem which just checking the
> stash.
>
> > One question remains though, if I am stuck in some bit of code that doesn't
> > get passed anything interesting as arguments, how can I cleanly get my hands
> > on the current apr_pool ?
>
> there is apr_pool_t *modperl_global_pconf_get() to get the server pool,
> and modperl_global_request_rec_get() for the current request_rec (only
> with PerlOptions +GlobalRequest). we should try to avoid using these
> globals at all costs though.
With all that considered and the previous code suggestion, here is a new
patch that hopefully should be better ;-)
/home/gozer/sources/mod_perl2/deps/perl/bin/perl build/cvsdiff
Index: lib/Apache/compat.pm
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/lib/Apache/compat.pm,v
retrieving revision 1.15
diff -u -U5 -b -B -I'$Id' -I'$Revision' -r1.15 compat.pm
--- lib/Apache/compat.pm 2001/10/01 09:04:10 1.15
+++ lib/Apache/compat.pm 2001/10/02 05:44:01
@@ -40,10 +40,15 @@
}
sub untaint {
}
+sub module {
+ eval { require Apache::Module; };
+ return Apache::Module::loaded($_[1]);
+}
+
package Apache::Constants;
use Apache::Const ();
sub import {
Index: src/modules/perl/modperl_util.c
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/src/modules/perl/modperl_util.c,v
retrieving revision 1.19
diff -u -U5 -b -B -I'$Id' -I'$Revision' -r1.19 modperl_util.c
--- src/modules/perl/modperl_util.c 2001/09/28 20:11:01 1.19
+++ src/modules/perl/modperl_util.c 2001/10/04 08:52:53
@@ -441,5 +441,10 @@
apr_table_set(table, key, SvPV_nolen(sv_val));
}
return RETVAL;
}
+
+MP_INLINE int modperl_is_module_loaded(pTHX_ const char *name)
+{
+ return (NULL != gv_stashpv(name, FALSE));
+}
Index: src/modules/perl/modperl_util.h
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/src/modules/perl/modperl_util.h,v
retrieving revision 1.19
diff -u -U5 -b -B -I'$Id' -I'$Revision' -r1.19 modperl_util.h
--- src/modules/perl/modperl_util.h 2001/09/28 20:11:01 1.19
+++ src/modules/perl/modperl_util.h 2001/10/04 08:53:04
@@ -70,6 +70,8 @@
char *key, SV *sv_val);
SV *modperl_table_get_set(pTHX_ apr_table_t *table, char *key,
SV *sv_val, bool do_taint);
+MP_INLINE int modperl_is_module_loaded(pTHX_ const char *name);
+
#endif /* MODPERL_UTIL_H */
Index: t/response/TestAPI/module.pm
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/t/response/TestAPI/module.pm,v
retrieving revision 1.1
diff -u -U5 -b -B -I'$Id' -I'$Revision' -r1.1 module.pm
--- t/response/TestAPI/module.pm 2001/04/04 05:45:48 1.1
+++ t/response/TestAPI/module.pm 2001/10/04 06:58:02
@@ -2,36 +2,76 @@
use strict;
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});
+
+ 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;
+ if ($modp && $modp->name) {
+ $modules->{$modp->name} = 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;
Index: todo/api.txt
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/todo/api.txt,v
retrieving revision 1.7
diff -u -U5 -b -B -I'$Id' -I'$Revision' -r1.7 api.txt
--- todo/api.txt 2001/10/02 13:36:10 1.7
+++ todo/api.txt 2001/10/03 02:22:58
@@ -26,13 +26,10 @@
instead.
$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)
Apache::Util::*
Index: xs/Apache/Module/Apache__Module.h
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/xs/Apache/Module/Apache__Module.h,v
retrieving revision 1.2
diff -u -U5 -b -B -I'$Id' -I'$Revision' -r1.2 Apache__Module.h
--- xs/Apache/Module/Apache__Module.h 2001/03/26 15:51:50 1.2
+++ xs/Apache/Module/Apache__Module.h 2001/10/04 09:12:08
@@ -1,2 +1,36 @@
#define mpxs_Apache__Module_top_module(CLASS) \
(CLASS ? ap_top_module : ap_top_module)
+
+static MP_INLINE int mpxs_Apache__Module_loaded(char *name)
+{
+ dTHX; /*XXX*/
+ char nameptr[255];
+ 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);
+
+ /* is that module NOT loaded at all? */
+ modp = ap_find_linked_module(nameptr);
+ if (NULL == modp)
+ return 0;
+
+ if ('c' == *(base + 1))
+ return 1;
+
+ /* if it ends in '.so', check if it was dynamically loaded */
+ if ('s' == *(base + 1) && 'o' == *(base + 2)
+ && modp->dynamic_load_handle)
+ return 1;
+
+ return 0;
+ }
+ else {
+ return modperl_is_module_loaded(aTHX_ name);
+ }
+}
Index: xs/maps/apache_functions.map
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/xs/maps/apache_functions.map,v
retrieving revision 1.30
diff -u -U5 -b -B -I'$Id' -I'$Revision' -r1.30 apache_functions.map
--- xs/maps/apache_functions.map 2001/09/17 01:06:08 1.30
+++ xs/maps/apache_functions.map 2001/10/01 10:58:47
@@ -178,10 +178,11 @@
>ap_single_module_configure
>ap_setup_prelinked_modules
>ap_show_directives
>ap_show_modules
>ap_register_hooks
+ mpxs_Apache__Module_loaded
MODULE=Apache::Directive
ap_directive_t *:DEFINE_conftree | | SV *:CLASS
!ap_add_node
!ap_build_config
--
+----------------------------------------------------+
| Philippe M. Chiasson <[EMAIL PROTECTED]> |
+----------------------------------------------------+
| F9BF E0C2 480E 7680 1AE5 3631 CB32 A107 88C3 A5A5 |
+----------------------------------------------------+
gethostent not implemented : Your C library apparently
doesn't implement gethostent(), probably because if it did,
it'd feel morally obligated to return every hostname on the
Internet.
-- perldiag(1)
perl -e '$$=\${gozer};{$_=unpack(P26,pack(L,$$));/^Just Another Perl
Hacker!\n$/&&print||$$++&&redo}'
PGP signature
