Stas, can you please resend your patch, it got mangled or something. Doesn't apply at all for me ;-(
On Fri, 2003-02-07 at 15:35, Stas Bekman wrote:
> 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]
>
>
--
--------------------------------------------------------------------------------
Philippe M. Chiasson /gozer\@(cpan|ectoplasm)\.org/ 88C3A5A5
(122FF51B/C634E37B)
http://gozer.ectoplasm.org/ F9BF E0C2 480E 7680 1AE5 3631 CB32 A107
88C3 A5A5
Q: It is impossible to make anything foolproof because fools are so
ingenious.
perl
-e'$$=\${gozer};{$_=unpack(P7,pack(L,$$));/^JAm_pH\n$/&&print||$$++&&redo}'
signature.asc
Description: This is a digitally signed message part
