Right on all counts Stas...
Only unresolved issue left is the malloc stuff....
I just't can't figure out how to get my hands on an apr_pool at this time.
I agree, using malloc if _bad_ , just tell me where can I get a pool from?
Gozer out.
Index: todo/api.txt
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/todo/api.txt,v
retrieving revision 1.6
diff -u -I'$Id' -I'$Revision' -r1.6 api.txt
--- todo/api.txt 2001/09/28 13:51:57 1.6
+++ todo/api.txt 2001/10/02 10:47:30
@@ -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)
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 -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/02 10:47:30
@@ -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
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 -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/02 10:47:30
@@ -1,2 +1,31 @@
#define mpxs_Apache__Module_top_module(CLASS) \
(CLASS ? ap_top_module : ap_top_module)
+
+static MP_INLINE
+int mpxs_Apache__Module_loaded(const char *name)
+{
+ dTHX; /*XXX*/
+ module *mod;
+
+ if (0 == ap_strcmp_match(name,"*.c")) {
+ mod = modperl_get_ap_module(name);
+ return ( NULL != mod );
+ }
+ else if (0 == ap_strcmp_match(name,"*.so")) {
+ size_t len = strlen(name);
+ char *so = malloc(len+1);
+
+ apr_cpystrn(so, name, len+1);
+ so[len-2] = 'c';
+ so[len-1] = '\0';
+ mod = modperl_get_ap_module(so);
+ free(so);
+
+ return (mod && (NULL != mod->dynamic_load_handle));
+ }
+ else {
+ return modperl_is_module_loaded(aTHX_ name);
+ }
+
+
+}
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 -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/02 10:47:30
@@ -4,32 +4,59 @@
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 => 11;
my $top_module = Apache::Module->top_module;
ok $top_module;
- ok $top_module->version;
-
- ok $top_module->module_index;
-
- ok $top_module->name;
-
- ok $top_module->cmds;
-
- for (my $modp = $top_module; $modp; $modp = $modp->next) {
- if ($modp->name eq 'mod_perl.c') {
- ok 1;
- last;
+ 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});
+
+ my $cmd = $top_module->cmds;
+
+ ok defined $cmd;
+
+ ok UNIVERSAL::isa($cmd, 'Apache::Command');
+
+ {
+ local $cfg->{modules}{'mod_perl.c'} = 1;
+ my $modules = {};
+
+ for (my $modp = $top_module; $modp; $modp = $modp->next) {
+ if ($modp && $modp->name) {
+ $modules->{$modp->name} = 1;
+ }
}
+
+ ok t_cmp($cfg->{modules}, $modules,"Modules list");
}
+
+ ok t_cmp(1, Apache::Module::loaded('mod_perl.c'),
+ "Apache::Module::loaded('mod_perl.c')");
+ 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'),
+ "Apache::Module::loaded('Apache__Module_foo')");
+ ok t_cmp(1, Apache::Module::loaded('Apache::Module'),
+ "Apache::Module::loaded('Apache::Module')");
0;
}
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 -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/02 10:47:30
@@ -443,3 +443,19 @@
return RETVAL;
}
+
+MP_INLINE module *modperl_get_ap_module(const char *name)
+{
+ module *modp;
+ for (modp = ap_top_module; modp; modp = modp->next) {
+ if (modp && modp->name && ( 0 == apr_strnatcmp(modp->name, name))) {
+ return modp;
+ }
+ }
+ return NULL;
+}
+
+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 -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/02 10:47:30
@@ -72,4 +72,8 @@
SV *modperl_table_get_set(pTHX_ apr_table_t *table, char *key,
SV *sv_val, bool do_taint);
+MP_INLINE module *modperl_get_ap_module(const char *name);
+
+MP_INLINE int modperl_is_module_loaded(pTHX_ const char *name);
+
#endif /* MODPERL_UTIL_H */
Index: lib/Apache/compat.pm
===================================================================
RCS file: /home/anoncvs/mod_perl-2-cvs/lib/Apache/compat.pm,v
retrieving revision 1.15
diff -u -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 10:47:30
@@ -42,6 +42,11 @@
sub untaint {
}
+sub module {
+ eval { require Apache::Module; };
+ return Apache::Module::loaded($_[1]);
+}
+
package Apache::Constants;
use Apache::Const ();
On Tue, Oct 02, 2001 at 06:14:11PM +0800, Stas Bekman wrote:
> Philippe M . Chiasson wrote:
>
> > Hi, this patch implements the Apache->module() functionnality with a few
>differences.
> >
> > Apache->module() is in Apache::compat and the real name for this is
>Apache::Module::loaded()
> > and I am open for better suggestions. "if (Apache->module('Apache::Auth'))"
>doesn't quite
> > make as much sense to me than "if (Apache::Module::loaded('Apache::Auth'))"
> >
> > Added a fet test cases for it and took the time to rewrite the module.t tests
> > with Stas's cool t_cmp()
> >
> > The behavious is now 3-fold instead of 2 like mod_perl 1.x
> >
> > 1- if the name ends in '.c' then it will return true/false if that apache
> > module is present or not.
> >
> > 2- if the name ends in '.so' then it will return true/false if that apache
> > module is present and was loaded as a DSO
> >
> > 3- else it returns true/false if a perl module of that name is already loaded.
> >
> > Comments most welcome.
> >
> > Index: todo/api.txt
> > ===================================================================
> > RCS file: /home/anoncvs/mod_perl-2-cvs/todo/api.txt,v
> > retrieving revision 1.6
> > diff -u -I'$Id' -I'$Revision' -r1.6 api.txt
> > --- todo/api.txt 2001/09/28 13:51:57 1.6
> > +++ todo/api.txt 2001/10/02 07:17:48
> > @@ -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)
> > 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 -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/02 07:17:48
> > @@ -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
> > 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 -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/02 07:17:48
> > @@ -1,2 +1,31 @@
> > #define mpxs_Apache__Module_top_module(CLASS) \
> > (CLASS ? ap_top_module : ap_top_module)
> > +
> > +static MP_INLINE
> > +int mpxs_Apache__Module_loaded(const char *name)
> > +{
> > + dTHX; /*XXX*/
> > + module *mod;
> > +
> > + if (0 == ap_strcmp_match(name,"*.c")) {
> > + mod = modperl_get_ap_module(name);
> > + return ( NULL != mod );
> > + }
> > + else if (0 == ap_strcmp_match(name,"*.so")) {
> > + size_t len = strlen(name);
> > + char *so = malloc(len+1);
>
>
> should we actually use malloc? I thought that we have to use APR for
> this kind of staff? In any case if you use malloc, you should check for
> success, right?
>
>
> > 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 -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/02 07:17:48
> > @@ -4,32 +4,51 @@
> > 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::TestConfig->thaw;
>
>
> that's too heavy. please use Apache::Test::config() instead. I'll
> correct other tests not to use thaw.
>
>
> > - ok $top_module->version;
> > + ok t_cmp($cfg->{httpd_info}{MODULE_MAGIC_NUMBER}, $top_module->version . ':0'
>, q{$top_module->version});
>
>
> < 74-80 char wrap here please, and the rest of the file
>
>
> > - ok $top_module->module_index;
> > + ok t_cmp(scalar(keys(%{$cfg->{modules}})), $top_module->module_index,
>q{$top_module->module_index});
>
>
> better readable as %{ $cfg->{modules} }
>
>
> > - ok $top_module->name;
> > + ok t_cmp('mod_perl.c', $top_module->name(), q{$top_module->name});
>
>
> > + ok t_cmp(0, Apache::Module::loaded('foo'), "Apache::Module::loaded('foo')");
>
>
> 'foo' is too useful to be make sure that it won't fail in the future, if
> someone adds module_foo (like module_example). When in doubt, use the
> test package name, e.g. TestAPI__module, it's unique in t.
>
> ...the rest looks good :) thanks Philippe
>
> _____________________________________________________________________
> Stas Bekman JAm_pH -- Just Another mod_perl Hacker
> http://stason.org/ mod_perl Guide http://perl.apache.org/guide
> mailto:[EMAIL PROTECTED] http://ticketmaster.com http://apacheweek.com
> http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
>
--
Philippe M. Chiasson <[EMAIL PROTECTED]>
Extropia's Resident System Guru
http://www.eXtropia.com/
/* After several hours of tedious analysis, the following
hash * function won. Do not mess with it... -DaveM */
-- Linux 2.2.16 /usr/src/linux/fs/buffer.c
perl -e '$$=\${gozer};{$_=unpack(P26,pack(L,$$));/^Just Another Perl
Hacker!\n$/&&print||$$++&&redo}'
PGP signature
