You are viewing a plain text version of this content. The canonical link for it is here.
Posted to dev@perl.apache.org by Stas Bekman <st...@stason.org> on 2004/01/09 02:05:08 UTC
[mp2 patch] ($r|$s)->is_hook_enabled($hook_name) implementation
Here is the implementation of ($r|$s)->is_hook_enabled($hook_name). See the
test at the very end of the patch. The immediate use example can be:
r->subprocess_env unless $r->is_hook_enabled('SetupEnv');
I'm not sure about the name of this method though. If it tests PerlOptions,
may be it should be called just that: is_perl_option_enabled()? the _hook_
part comes from:
http://perl.apache.org/docs/2.0/user/config/config.html#C_Perl_Handler_
but really works for any of:
http://perl.apache.org/docs/2.0/user/config/config.html#C_PerlOptions_
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.297
diff -u -u -r1.297 Changes
--- Changes 3 Jan 2004 01:17:33 -0000 1.297
+++ Changes 9 Jan 2004 00:38:54 -0000
@@ -442,6 +442,9 @@
similar to SetEnv, upcase the env keys for PassEnv on platforms with
caseless env (e.g. win32) [steve.sparling@ps.ge.com]
+added ($r|$s)->is_hook_enabled($hook_name), to test for PerlOptions
++ tests [Stas]
+
Add a backcompat wrapper for $r->notes (mp2 supports only the
APR::Table API) [Stas]
Index: src/modules/perl/modperl_config.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.72
diff -u -u -r1.72 modperl_config.c
--- src/modules/perl/modperl_config.c 23 Dec 2003 00:34:36 -0000 1.72
+++ src/modules/perl/modperl_config.c 9 Jan 2004 00:38:54 -0000
@@ -489,3 +489,38 @@
return NULL;
}
+
+
+/* if r!=NULL check for dir PerlOptions, otherwise check for server
+ * PerlOptions, (s must be always set)
+ */
+int modperl_config_is_hook_enabled(pTHX_ request_rec *r, server_rec *s,
+ const char *name)
+{
+ U32 flag;
+ MP_dSCFG(s);
+
+ /* XXX: should we test whether perl is disabled for this server? */
+ /* if (!MpSrvENABLE(scfg)) { */
+ /* return 0; */
+ /* } */
+
+ if (r) {
+ if ((flag = modperl_flags_lookup_dir(name))) {
+ MP_dDCFG;
+ return MpDirFLAGS(dcfg) & flag ? 1 : 0;
+ }
+ else {
+ Perl_croak(aTHX_ "PerlOptions %s is not a directory option", name);
+ }
+ }
+ else {
+ if ((flag = modperl_flags_lookup_srv(name))) {
+ return MpSrvFLAGS(scfg) & flag ? 1 : 0;
+ }
+ else {
+ Perl_croak(aTHX_ "PerlOptions %s is not a server option", name);
+ }
+ }
+
+}
Index: src/modules/perl/modperl_config.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.h,v
retrieving revision 1.31
diff -u -u -r1.31 modperl_config.h
--- src/modules/perl/modperl_config.h 5 Sep 2002 01:47:39 -0000 1.31
+++ src/modules/perl/modperl_config.h 9 Jan 2004 00:38:54 -0000
@@ -122,4 +122,9 @@
SV *lines,
char *path,
int override);
+
+int modperl_config_is_hook_enabled(pTHX_ request_rec *r, server_rec *s,
+ const char *name);
+
+
#endif /* MODPERL_CONFIG_H */
Index: xs/Apache/RequestUtil/Apache__RequestUtil.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/Apache/RequestUtil/Apache__RequestUtil.h,v
retrieving revision 1.18
diff -u -u -r1.18 Apache__RequestUtil.h
--- xs/Apache/RequestUtil/Apache__RequestUtil.h 30 Aug 2003 02:33:26 -0000 1.18
+++ xs/Apache/RequestUtil/Apache__RequestUtil.h 9 Jan 2004 00:38:55 -0000
@@ -248,3 +248,10 @@
return svh.sv;
}
+static MP_INLINE
+int mpxs_Apache__RequestRec_is_hook_enabled(pTHX_ request_rec *r,
+ const char *name)
+{
+ return modperl_config_is_hook_enabled(aTHX_ r, r->server, name);
+}
+
Index: xs/Apache/ServerUtil/Apache__ServerUtil.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/Apache/ServerUtil/Apache__ServerUtil.h,v
retrieving revision 1.8
diff -u -u -r1.8 Apache__ServerUtil.h
--- xs/Apache/ServerUtil/Apache__ServerUtil.h 19 Nov 2001 23:46:48 -0000 1.8
+++ xs/Apache/ServerUtil/Apache__ServerUtil.h 9 Jan 2004 00:38:55 -0000
@@ -51,6 +51,13 @@
return ap_server_root_relative(p, fname);
}
+static MP_INLINE
+int mpxs_Apache__Server_is_hook_enabled(pTHX_ server_rec *s,
+ const char *name)
+{
+ return modperl_config_is_hook_enabled(aTHX_ NULL, s, name);
+}
+
static void mpxs_Apache__ServerUtil_BOOT(pTHX)
{
newCONSTSUB(PL_defstash, "Apache::server_root",
Index: xs/maps/modperl_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.63
diff -u -u -r1.63 modperl_functions.map
--- xs/maps/modperl_functions.map 23 Dec 2003 03:02:34 -0000 1.63
+++ xs/maps/modperl_functions.map 9 Jan 2004 00:38:55 -0000
@@ -21,6 +21,7 @@
mpxs_Apache__RequestRec_push_handlers
mpxs_Apache__RequestRec_set_handlers
mpxs_Apache__RequestRec_get_handlers
+ mpxs_Apache__RequestRec_is_hook_enabled
mpxs_Apache__RequestRec_location
mpxs_Apache__RequestRec_as_string
mpxs_Apache__RequestRec_pnotes | | r, key=Nullsv, val=Nullsv
@@ -67,6 +68,7 @@
mpxs_Apache__Server_push_handlers
mpxs_Apache__Server_set_handlers
mpxs_Apache__Server_get_handlers
+ mpxs_Apache__Server_is_hook_enabled
modperl_config_insert_server | | | add_config
PACKAGE=Apache::Server
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.134
diff -u -u -r1.134 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm 23 Dec 2003 03:02:34 -0000 1.134
+++ xs/tables/current/ModPerl/FunctionTable.pm 9 Jan 2004 00:38:55 -0000
@@ -1369,6 +1369,28 @@
]
},
{
+ 'return_type' => 'int',
+ 'name' => 'modperl_config_is_hook_enabled',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'request_rec *',
+ 'name' => 's'
+ },
+ {
+ 'type' => 'server_rec *',
+ 'name' => 's'
+ },
+ {
+ 'type' => 'const char *',
+ 'name' => 'name'
+ }
+ ]
+ },
+ {
'return_type' => 'apr_status_t',
'name' => 'modperl_config_req_cleanup',
'args' => [
@@ -5562,6 +5584,24 @@
]
},
{
+ 'return_type' => 'int',
+ 'name' => 'mpxs_Apache__RequestRec_is_hook_enabled',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'request_rec *',
+ 'name' => 'r'
+ },
+ {
+ 'type' => 'const char *',
+ 'name' => 'name'
+ }
+ ]
+ },
+ {
'return_type' => 'char *',
'name' => 'mpxs_Apache__RequestRec_location',
'args' => [
@@ -5977,6 +6017,24 @@
{
'return_type' => 'SV *',
'name' => 'mpxs_Apache__Server_get_handlers',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'server_rec *',
+ 'name' => 's'
+ },
+ {
+ 'type' => 'const char *',
+ 'name' => 'name'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'int',
+ 'name' => 'mpxs_Apache__Server_is_hook_enabled',
'args' => [
{
'type' => 'PerlInterpreter *',
--- /dev/null 1969-12-31 16:00:00.000000000 -0800
+++ t/hooks/is_enabled.t 2004-01-08 16:57:08.000000000 -0800
@@ -0,0 +1,13 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+my $module = "TestHooks::is_enabled";
+Apache::TestRequest::module($module);
+my $hostport = Apache::TestRequest::hostport(Apache::Test::config());
+my $location = "http://$hostport/$module";
+
+print GET_BODY_ASSERT "http://$hostport/$module";
--- /dev/null 1969-12-31 16:00:00.000000000 -0800
+++ t/hooks/TestHooks/is_enabled.pm 2004-01-08 16:58:47.000000000 -0800
@@ -0,0 +1,53 @@
+package TestHooks::is_enabled;
+
+# test various ways to push handlers
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::RequestRec ();
+use Apache::RequestIO ();
+use Apache::RequestUtil ();
+use Apache::ServerUtil ();
+
+use Apache::Test;
+use Apache::TestUtil;
+
+use Apache::Const -compile => qw(OK DECLINED DONE);
+
+my @srv_plus = qw(ChildInit ChildExit);
+my @srv_minus = qw(PreConnection ProcessConnection Autoload Log
+ InputFilter OutputFilter);
+my @dir_plus = qw(ParseHeaders MergeHandlers);
+my @dir_minus = qw(SetupEnv GlobalRequest);
+
+sub handler {
+ my $r = shift;
+
+ plan $r, tests => @srv_plus + @srv_minus + @dir_plus + @dir_minus;
+ my $s = $r->server;
+ ok t_cmp(1, $s->is_hook_enabled($_), "PerlOptions +$_") for @srv_plus;
+ ok t_cmp(0, $s->is_hook_enabled($_), "PerlOptions -$_") for @srv_minus;
+ ok t_cmp(1, $r->is_hook_enabled($_), "PerlOptions +$_") for @dir_plus;
+ ok t_cmp(0, $r->is_hook_enabled($_), "PerlOptions -$_") for @dir_minus;
+
+ return Apache::OK;
+}
+
+1;
+__DATA__
+<NoAutoConfig>
+ <VirtualHost TestHooks::is_enabled>
+ PerlOptions -PreConnection -ProcessConnection
+ PerlOptions -Autoload -Log -InputFilter -OutputFilter
+ PerlOptions +ChildInit +ChildExit
+ PerlModule TestHooks::is_enabled
+ <Location /TestHooks::is_enabled>
+ SetHandler modperl
+ PerlOptions -GlobalRequest -SetupEnv
+ PerlOptions +ParseHeaders +MergeHandlers
+ PerlResponseHandler TestHooks::is_enabled
+ </Location>
+ </VirtualHost>
+</NoAutoConfig>
+
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 patch] ($r|$s)->is_hook_enabled($hook_name) implementation
Posted by Stas Bekman <st...@stason.org>.
>>it does DWIM, though you can't check server level flags with $r and
>>directory level flags with $s.
>
>
> that sounds funny, but I think you meant to say what the tests show, which
> is DWIMmy.
by DWIM, I meant that it does merge the configs and you don't have to check
separate. I guess I should have said it DoesWhatYouMeant ;)
>>Here is the new patch:
>
>
> looks great.
thanks, now committed.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 patch] ($r|$s)->is_hook_enabled($hook_name) implementation
Posted by Geoffrey Young <ge...@modperlcookbook.org>.
Stas Bekman wrote:
> Thanks for the comments, Geoff.
sure :)
> it does DWIM, though you can't check server level flags with $r and
> directory level flags with $s.
that sounds funny, but I think you meant to say what the tests show, which
is DWIMmy.
> Here is the new patch:
looks great.
--Geoff
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 patch] ($r|$s)->is_hook_enabled($hook_name) implementation
Posted by Stas Bekman <st...@stason.org>.
Thanks for the comments, Geoff.
>>I'm not sure about the name of this method though. If it tests
>>PerlOptions, may be it should be called just that:
>>is_perl_option_enabled()? the _hook_ part comes from:
>>http://perl.apache.org/docs/2.0/user/config/config.html#C_Perl_Handler_
>>but really works for any of:
>>http://perl.apache.org/docs/2.0/user/config/config.html#C_PerlOptions_
>
>
> since it's not only hooks, I'd prefer is_perl_option_enabled, or even just
> is_option_enabled (as everything is PerlSomething :)
Since we have Options too, it'll be confusing. So I've called it
is_perl_option_enabled
>>+use Apache::Const -compile => qw(OK DECLINED DONE);
>
>
> you only use OK :)
fixed
>>+my @srv_plus = qw(ChildInit ChildExit);
>
>
> what about some tests for things that are enabled by default but not in your
> config, like Fixup?
fixed
> also, does the method merge settings for you? that is, does
> $r->is_hook_enabled show per-server settings that would be inherited by the
> request? you're tests don't show it if it does, and it would be a pain to
> need to check both if it doesn't.
it does DWIM, though you can't check server level flags with $r and directory
level flags with $s. I've moved PerlOptions +ParseHeaders option to the server
level, so now it tests the merging alright.
> btw, this is much better than the old mod_perl::import(). nice.
;)
Here is the new patch:
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.297
diff -u -u -r1.297 Changes
--- Changes 3 Jan 2004 01:17:33 -0000 1.297
+++ Changes 10 Jan 2004 00:21:11 -0000
@@ -12,6 +12,9 @@
=item 1.99_13-dev
+added ($r|$s)->is_perl_option_enabled($option_name), to test for
+PerlOptions + tests [Stas]
+
On Solaris add a workaround for xs/APR/APR/Makefile.PL to build
APR.so, correctly linked against apr and apr-util libs, by addding the
missing -R paths corresponding to -L flags. EU::MM was adding them via
Index: src/modules/perl/modperl_config.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.72
diff -u -u -r1.72 modperl_config.c
--- src/modules/perl/modperl_config.c 23 Dec 2003 00:34:36 -0000 1.72
+++ src/modules/perl/modperl_config.c 10 Jan 2004 00:21:11 -0000
@@ -489,3 +489,38 @@
return NULL;
}
+
+
+/* if r!=NULL check for dir PerlOptions, otherwise check for server
+ * PerlOptions, (s must be always set)
+ */
+int modperl_config_is_perl_option_enabled(pTHX_ request_rec *r,
+ server_rec *s, const char *name)
+{
+ U32 flag;
+ MP_dSCFG(s);
+
+ /* XXX: should we test whether perl is disabled for this server? */
+ /* if (!MpSrvENABLE(scfg)) { */
+ /* return 0; */
+ /* } */
+
+ if (r) {
+ if ((flag = modperl_flags_lookup_dir(name))) {
+ MP_dDCFG;
+ return MpDirFLAGS(dcfg) & flag ? 1 : 0;
+ }
+ else {
+ Perl_croak(aTHX_ "PerlOptions %s is not a directory option", name);
+ }
+ }
+ else {
+ if ((flag = modperl_flags_lookup_srv(name))) {
+ return MpSrvFLAGS(scfg) & flag ? 1 : 0;
+ }
+ else {
+ Perl_croak(aTHX_ "PerlOptions %s is not a server option", name);
+ }
+ }
+
+}
Index: src/modules/perl/modperl_config.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.h,v
retrieving revision 1.31
diff -u -u -r1.31 modperl_config.h
--- src/modules/perl/modperl_config.h 5 Sep 2002 01:47:39 -0000 1.31
+++ src/modules/perl/modperl_config.h 10 Jan 2004 00:21:11 -0000
@@ -122,4 +122,9 @@
SV *lines,
char *path,
int override);
+
+int modperl_config_is_perl_option_enabled(pTHX_ request_rec *r,
+ server_rec *s, const char *name);
+
+
#endif /* MODPERL_CONFIG_H */
Index: xs/Apache/RequestUtil/Apache__RequestUtil.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/Apache/RequestUtil/Apache__RequestUtil.h,v
retrieving revision 1.18
diff -u -u -r1.18 Apache__RequestUtil.h
--- xs/Apache/RequestUtil/Apache__RequestUtil.h 30 Aug 2003 02:33:26 -0000 1.18
+++ xs/Apache/RequestUtil/Apache__RequestUtil.h 10 Jan 2004 00:21:11 -0000
@@ -248,3 +248,10 @@
return svh.sv;
}
+static MP_INLINE
+int mpxs_Apache__RequestRec_is_perl_option_enabled(pTHX_ request_rec *r,
+ const char *name)
+{
+ return modperl_config_is_perl_option_enabled(aTHX_ r, r->server, name);
+}
+
Index: xs/Apache/ServerUtil/Apache__ServerUtil.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/Apache/ServerUtil/Apache__ServerUtil.h,v
retrieving revision 1.8
diff -u -u -r1.8 Apache__ServerUtil.h
--- xs/Apache/ServerUtil/Apache__ServerUtil.h 19 Nov 2001 23:46:48 -0000 1.8
+++ xs/Apache/ServerUtil/Apache__ServerUtil.h 10 Jan 2004 00:21:11 -0000
@@ -51,6 +51,13 @@
return ap_server_root_relative(p, fname);
}
+static MP_INLINE
+int mpxs_Apache__Server_is_perl_option_enabled(pTHX_ server_rec *s,
+ const char *name)
+{
+ return modperl_config_is_perl_option_enabled(aTHX_ NULL, s, name);
+}
+
static void mpxs_Apache__ServerUtil_BOOT(pTHX)
{
newCONSTSUB(PL_defstash, "Apache::server_root",
Index: xs/maps/modperl_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.63
diff -u -u -r1.63 modperl_functions.map
--- xs/maps/modperl_functions.map 23 Dec 2003 03:02:34 -0000 1.63
+++ xs/maps/modperl_functions.map 10 Jan 2004 00:21:11 -0000
@@ -21,6 +21,7 @@
mpxs_Apache__RequestRec_push_handlers
mpxs_Apache__RequestRec_set_handlers
mpxs_Apache__RequestRec_get_handlers
+ mpxs_Apache__RequestRec_is_perl_option_enabled
mpxs_Apache__RequestRec_location
mpxs_Apache__RequestRec_as_string
mpxs_Apache__RequestRec_pnotes | | r, key=Nullsv, val=Nullsv
@@ -67,6 +68,7 @@
mpxs_Apache__Server_push_handlers
mpxs_Apache__Server_set_handlers
mpxs_Apache__Server_get_handlers
+ mpxs_Apache__Server_is_perl_option_enabled
modperl_config_insert_server | | | add_config
PACKAGE=Apache::Server
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.134
diff -u -u -r1.134 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm 23 Dec 2003 03:02:34 -0000 1.134
+++ xs/tables/current/ModPerl/FunctionTable.pm 10 Jan 2004 00:21:11 -0000
@@ -1369,6 +1369,28 @@
]
},
{
+ 'return_type' => 'int',
+ 'name' => 'modperl_config_is_perl_option_enabled',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'request_rec *',
+ 'name' => 's'
+ },
+ {
+ 'type' => 'server_rec *',
+ 'name' => 's'
+ },
+ {
+ 'type' => 'const char *',
+ 'name' => 'name'
+ }
+ ]
+ },
+ {
'return_type' => 'apr_status_t',
'name' => 'modperl_config_req_cleanup',
'args' => [
@@ -5562,6 +5584,24 @@
]
},
{
+ 'return_type' => 'int',
+ 'name' => 'mpxs_Apache__RequestRec_is_perl_option_enabled',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'request_rec *',
+ 'name' => 'r'
+ },
+ {
+ 'type' => 'const char *',
+ 'name' => 'name'
+ }
+ ]
+ },
+ {
'return_type' => 'char *',
'name' => 'mpxs_Apache__RequestRec_location',
'args' => [
@@ -5977,6 +6017,24 @@
{
'return_type' => 'SV *',
'name' => 'mpxs_Apache__Server_get_handlers',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'server_rec *',
+ 'name' => 's'
+ },
+ {
+ 'type' => 'const char *',
+ 'name' => 'name'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'int',
+ 'name' => 'mpxs_Apache__Server_is_perl_option_enabled',
'args' => [
{
'type' => 'PerlInterpreter *',
--- /dev/null 1969-12-31 16:00:00.000000000 -0800
+++ t/response/TestModperl/perl_options.pm 2004-01-09 16:33:08.000000000 -0800
@@ -0,0 +1,62 @@
+package TestModperl::perl_options;
+
+# test whether PerlOptions options are enabled
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::RequestRec ();
+use Apache::RequestIO ();
+use Apache::RequestUtil ();
+use Apache::ServerUtil ();
+
+use Apache::Test;
+use Apache::TestUtil;
+
+use Apache::Const -compile => qw(OK);
+
+my @srv_plus = qw(ChildInit ChildExit Fixup);
+my @srv_minus = qw(PreConnection ProcessConnection Autoload Log
+ InputFilter OutputFilter);
+my @dir_plus = qw(ParseHeaders MergeHandlers);
+my @dir_minus = qw(SetupEnv GlobalRequest);
+
+sub handler {
+ my $r = shift;
+
+ plan $r, tests => @srv_plus + @srv_minus + @dir_plus + @dir_minus;
+ my $s = $r->server;
+
+ ok t_cmp(1, $s->is_perl_option_enabled($_),
+ "PerlOptions +$_") for @srv_plus;
+
+ ok t_cmp(0, $s->is_perl_option_enabled($_),
+ "PerlOptions -$_") for @srv_minus;
+
+ ok t_cmp(1, $r->is_perl_option_enabled($_),
+ "PerlOptions +$_") for @dir_plus;
+
+ ok t_cmp(0, $r->is_perl_option_enabled($_),
+ "PerlOptions -$_") for @dir_minus;
+
+ return Apache::OK;
+}
+
+1;
+__DATA__
+
+ <VirtualHost TestModperl::perl_options>
+ PerlOptions -PreConnection -ProcessConnection
+ PerlOptions -Autoload -Log -InputFilter -OutputFilter
+ PerlOptions +ChildInit +ChildExit
+ PerlModule TestModperl::perl_options
+ PerlOptions +ParseHeaders
+ <Location /TestModperl::perl_options>
+ SetHandler modperl
+ PerlOptions -GlobalRequest -SetupEnv
+ PerlOptions +MergeHandlers
+ PerlResponseHandler TestModperl::perl_options
+ </Location>
+ </VirtualHost>
+
+
--- /dev/null 1969-12-31 16:00:00.000000000 -0800
+++ t/modperl/perl_options.t 2004-01-09 15:55:26.000000000 -0800
@@ -0,0 +1,13 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+my $module = "TestModperl::perl_options";
+Apache::TestRequest::module($module);
+my $hostport = Apache::TestRequest::hostport(Apache::Test::config());
+my $location = "http://$hostport/$module";
+
+print GET_BODY_ASSERT "http://$hostport/$module";
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 patch] ($r|$s)->is_hook_enabled($hook_name) implementation
Posted by Geoffrey Young <ge...@modperlcookbook.org>.
Stas Bekman wrote:
> Here is the implementation of ($r|$s)->is_hook_enabled($hook_name).
coolio.
>
> I'm not sure about the name of this method though. If it tests
> PerlOptions, may be it should be called just that:
> is_perl_option_enabled()? the _hook_ part comes from:
> http://perl.apache.org/docs/2.0/user/config/config.html#C_Perl_Handler_
> but really works for any of:
> http://perl.apache.org/docs/2.0/user/config/config.html#C_PerlOptions_
since it's not only hooks, I'd prefer is_perl_option_enabled, or even just
is_option_enabled (as everything is PerlSomething :)
> +use Apache::Const -compile => qw(OK DECLINED DONE);
you only use OK :)
> +my @srv_plus = qw(ChildInit ChildExit);
what about some tests for things that are enabled by default but not in your
config, like Fixup?
also, does the method merge settings for you? that is, does
$r->is_hook_enabled show per-server settings that would be inherited by the
request? you're tests don't show it if it does, and it would be a pain to
need to check both if it doesn't.
btw, this is much better than the old mod_perl::import(). nice.
--Geoff
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org