[patch] ($r|$s)->is_hook_enabled($hook_name)

[Stas Bekman]

I'm trying to take care of this todo item:

-Apache::perl_hook:
-should have this or something check if PerlOptions allows the given
-handler/feature to be used.

It works, though since the hooks implemenation is very different in 2.0, we can't just call Apache::perl_hook($r) at least because there are overlapping
hooks (e.g. Unset)

So first of all I've called the method: is_hook_enabled
and it checks srv config flags when called as $s->is_hook_enabled($hook_name) or dir config flags if called as $r->is_hook_enabled($hook_name).

Is that a healthy API? Or should we use:

my $dir_cfg = $self->get_config($s, $r->per_dir_config);
my $srv_cfg = $self->get_config($s);

add call:

$dir_cfg->is_hook_enabled($hook_name);
$srv_cfg->is_hook_enabled($hook_name);

anyways, here is the patch of the current implementation and tests:

Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.123
diff -u -r1.123 Changes
--- Changes 7 Feb 2003 02:58:30 -0000 1.123
+++ Changes 7 Feb 2003 07:26:57 -0000
@@ -10,6 +10,9 @@

=item 1.99_09-dev

+added ($r|$s)->is_hook_enabled($hook_name), to test for PerlOptions
++ tests [Stas]
+
Several issues resolved with parsing headers, including making work
the handlers calling $r->content_type() and not sending raw headers,
when the headers scanning is turned on. Lots of tests added to

Index: src/modules/perl/modperl_config.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.62
diff -u -r1.62 modperl_config.c
--- src/modules/perl/modperl_config.c 3 Feb 2003 06:40:33 -0000 1.62
+++ src/modules/perl/modperl_config.c 7 Feb 2003 07:26:57 -0000
@@ -476,3 +476,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 -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 7 Feb 2003 07:26:57 -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: todo/api.txt
===================================================================
RCS file: /home/cvs/modperl-2.0/todo/api.txt,v
retrieving revision 1.31
diff -u -r1.31 api.txt
--- todo/api.txt 22 Jan 2003 06:12:43 -0000 1.31
+++ todo/api.txt 7 Feb 2003 07:26:57 -0000
@@ -81,10 +81,6 @@
Apache->unescape_url{_info}:
not yet implemented. should be moved to Apache::Util

-Apache::perl_hook:
-should have this or something check if PerlOptions allows the given
-handler/feature to be used.
-
mod_perl::import():
not yet implemented

Index: xs/Apache/RequestUtil/Apache__RequestUtil.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/Apache/RequestUtil/Apache__RequestUtil.h,v
retrieving revision 1.17
diff -u -r1.17 Apache__RequestUtil.h
--- xs/Apache/RequestUtil/Apache__RequestUtil.h 31 Jan 2003 04:20:20 -0000 1.17
+++ xs/Apache/RequestUtil/Apache__RequestUtil.h 7 Feb 2003 07:26:57 -0000
@@ -245,3 +245,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 -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 7 Feb 2003 07:26:57 -0000
@@ -51,8 +51,16 @@
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",
newSVpv(ap_server_root, 0));
}
+
Index: xs/maps/modperl_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.52
diff -u -r1.52 modperl_functions.map
--- xs/maps/modperl_functions.map 29 Jan 2003 03:56:00 -0000 1.52
+++ xs/maps/modperl_functions.map 7 Feb 2003 07:26:57 -0000
@@ -17,6 +17,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
@@ -61,6 +62,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.104
diff -u -r1.104 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm 31 Jan 2003 04:20:20 -0000 1.104
+++ xs/tables/current/ModPerl/FunctionTable.pm 7 Feb 2003 07:26:57 -0000
@@ -1337,6 +1337,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' => [
@@ -5346,6 +5368,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' => [
@@ -5722,6 +5762,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 1970-01-01 10:00:00.000000000 +1000
+++ t/hooks/is_enabled.t 2003-02-07 18:23:35.000000000 +1100
@@ -0,0 +1,20 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest 'GET';
+
+my $module = "TestHooks::is_enabled";
+Apache::TestRequest::module($module);
+my $hostport = Apache::TestRequest::hostport(Apache::Test::config());
+my $location = "http://$hostport/$module";;
+
+my $res = GET "http://$hostport/$module";;
+if ($res->is_success) {
+ print $res->content;
+}
+else {
+ die "server side has failed (response code: ", $res->code, "),\n",
+ "see t/logs/error_log for more details\n";
+}

--- /dev/null 1970-01-01 10:00:00.000000000 +1000
+++ t/hooks/TestHooks/is_enabled.pm 2003-02-07 18:23:07.000000000 +1100
@@ -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:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com


---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]