stas 2003/02/17 01:03:17
Modified: . Changes
lib/Apache compat.pm
src/modules/perl modperl_callback.c modperl_callback.h
modperl_handler.c
t/htdocs .cvsignore
t/modperl .cvsignore
t/response/TestCompat apache.pm
todo api.txt
xs/ModPerl/Util ModPerl__Util.h
xs/maps modperl_functions.map
Added: t/response/TestModperl current_callback.pm
Log:
- implement Apache::current_callback
- $r->current_callback goes into Apache::compat, since now we have a way
too many callbacks unrelated to $r
- add some tests
Revision Changes Path
1.125 +4 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.124
retrieving revision 1.125
diff -u -r1.124 -r1.125
--- Changes 12 Feb 2003 23:42:23 -0000 1.124
+++ Changes 17 Feb 2003 09:03:16 -0000 1.125
@@ -10,6 +10,10 @@
=item 1.99_09-dev
+implement Apache::current_callback + $r->current_callback goes into
+Apache::compat, since now we have a way too many callbacks unrelated
+to $r [Stas]
+
Add Apache::compat methods: $r->connection->auth_type and
$r->connection->user (requires 'PerlOptions +GlobalRequest') + tests
[Stas]
1.78 +4 -0 modperl-2.0/lib/Apache/compat.pm
Index: compat.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/compat.pm,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -r1.77 -r1.78
--- compat.pm 12 Feb 2003 23:42:23 -0000 1.77
+++ compat.pm 17 Feb 2003 09:03:16 -0000 1.78
@@ -125,6 +125,10 @@
die $err if $err;
}
+sub current_callback {
+ return Apache::current_callback();
+}
+
package Apache::Constants;
use Apache::Const ();
1.54 +2 -0 modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -r1.53 -r1.54
--- modperl_callback.c 29 Jan 2003 01:04:33 -0000 1.53
+++ modperl_callback.c 17 Feb 2003 09:03:16 -0000 1.54
@@ -172,6 +172,8 @@
break;
};
+ modperl_callback_current_callback_set(desc);
+
/* XXX: deal with {push,set}_handler of the phase we're currently in */
/* for now avoid the segfault by not letting av->nelts grow if
* somebody push_handlers to the phase we are currently in, but
1.22 +9 -0 modperl-2.0/src/modules/perl/modperl_callback.h
Index: modperl_callback.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.h,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- modperl_callback.h 21 Feb 2002 01:45:34 -0000 1.21
+++ modperl_callback.h 17 Feb 2003 09:03:16 -0000 1.22
@@ -10,6 +10,15 @@
#define ap_hook_fixup ap_hook_fixups
#define ap_hook_log ap_hook_log_transaction
+#define modperl_callback_current_callback_sv \
+ get_sv("Apache::__CurrentCallback", TRUE)
+
+#define modperl_callback_current_callback_set(desc) \
+ sv_setpv(modperl_callback_current_callback_sv, desc)
+
+#define modperl_callback_current_callback_get() \
+ SvPVX(modperl_callback_current_callback_sv)
+
int modperl_callback(pTHX_ modperl_handler_t *handler, apr_pool_t *p,
request_rec *r, server_rec *s, AV *args);
1.16 +1 -1 modperl-2.0/src/modules/perl/modperl_handler.c
Index: modperl_handler.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_handler.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- modperl_handler.c 1 Jan 2003 03:45:54 -0000 1.15
+++ modperl_handler.c 17 Feb 2003 09:03:16 -0000 1.16
@@ -175,7 +175,7 @@
}
#define set_desc(dtype) \
- MP_TRACE_a_do(if (desc) *desc = modperl_handler_desc_##dtype(idx))
+ if (desc) *desc = modperl_handler_desc_##dtype(idx)
#define check_modify(dtype) \
if ((action > MP_HANDLER_ACTION_GET) && rcfg) { \
1.2 +1 -0 modperl-2.0/t/htdocs/.cvsignore
Index: .cvsignore
===================================================================
RCS file: /home/cvs/modperl-2.0/t/htdocs/.cvsignore,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- .cvsignore 26 Feb 2002 19:09:10 -0000 1.1
+++ .cvsignore 17 Feb 2003 09:03:17 -0000 1.2
@@ -2,3 +2,4 @@
perlio
testdirective
util
+hooks
\ No newline at end of file
1.13 +3 -1 modperl-2.0/t/modperl/.cvsignore
Index: .cvsignore
===================================================================
RCS file: /home/cvs/modperl-2.0/t/modperl/.cvsignore,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- .cvsignore 4 Feb 2003 06:52:15 -0000 1.12
+++ .cvsignore 17 Feb 2003 09:03:17 -0000 1.13
@@ -1,3 +1,4 @@
+current_callback.t
env.t
endav.t
exit.t
@@ -11,4 +12,5 @@
method.t
setauth.t
request_rec_tie_api.t
-taint.t
\ No newline at end of file
+taint.t
+
1.4 +5 -1 modperl-2.0/t/response/TestCompat/apache.pm
Index: apache.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestCompat/apache.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- apache.pm 7 Oct 2002 02:44:30 -0000 1.3
+++ apache.pm 17 Feb 2003 09:03:17 -0000 1.4
@@ -16,7 +16,7 @@
sub handler {
my $r = shift;
- plan $r, tests => 7;
+ plan $r, tests => 8;
$r->send_http_header('text/plain');
@@ -33,6 +33,10 @@
ok t_cmp(Apache::exists_config_define('MODPERL2'),
Apache->define('MODPERL2'),
'Apache->define');
+
+ ok t_cmp('PerlResponseHandler',
+ Apache::current_callback(),
+ 'inside PerlResponseHandler');
Apache::log_error("Apache::log_error test ok");
ok 1;
1.1 modperl-2.0/t/response/TestModperl/current_callback.pm
Index: current_callback.pm
===================================================================
package TestModperl::current_callback;
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestUtil;
use ModPerl::Util;
use APR::Table ();
use Apache::RequestRec ();
use Apache::Const -compile => qw(OK DECLINED);
sub handler {
my $r = shift;
plan $r, tests => 1;
my $callback = Apache::current_callback();
ok t_cmp('PerlResponseHandler',
$callback,
'inside PerlResponseHandler');
warn "in callback: $callback\n";
# my $callback = Apache::current_callback();
# my $expected = 'PerlFixupHandler';
# die "expecting $expected callback, instead got $callback"
# unless $callback eq $expected;
Apache::OK;
}
sub log { check('Log') }
sub fixup { check('Fixup') }
sub headerparser { check('HeaderParser') }
sub check {
my $expected = 'Perl' . shift() . 'Handler';
my $callback = Apache::current_callback();
die "expecting $expected callback, instead got $callback"
unless $callback eq $expected;
warn "in callback: $callback\n";
}
1;
__DATA__
PerlHeaderParserHandler TestModperl::current_callback::headerparser
PerlFixupHandler TestModperl::current_callback::fixup
PerlResponseHandler TestModperl::current_callback
PerlLogHandler TestModperl::current_callback::log
SetHandler modperl
1.32 +0 -3 modperl-2.0/todo/api.txt
Index: api.txt
===================================================================
RCS file: /home/cvs/modperl-2.0/todo/api.txt,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- api.txt 22 Jan 2003 06:12:43 -0000 1.31
+++ api.txt 17 Feb 2003 09:03:17 -0000 1.32
@@ -60,9 +60,6 @@
Apache->import:
not yet implemented, required for exit/warn overridding
-$r->current_callback:
-not yet implemented
-
$r->{get,set,push}_handlers:
need to deal properly with modification of the current handler phase
we're running.
1.4 +5 -0 modperl-2.0/xs/ModPerl/Util/ModPerl__Util.h
Index: ModPerl__Util.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/ModPerl/Util/ModPerl__Util.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- ModPerl__Util.h 9 Oct 2001 05:14:49 -0000 1.3
+++ ModPerl__Util.h 17 Feb 2003 09:03:17 -0000 1.4
@@ -10,3 +10,8 @@
}
#define mpxs_ModPerl__Util_exit(status) modperl_perl_exit(aTHX_ status)
+
+#define mpxs_Apache_current_callback modperl_callback_current_callback_get
+
+
+
1.53 +3 -0 modperl-2.0/xs/maps/modperl_functions.map
Index: modperl_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -r1.52 -r1.53
--- modperl_functions.map 29 Jan 2003 03:56:00 -0000 1.52
+++ modperl_functions.map 17 Feb 2003 09:03:17 -0000 1.53
@@ -4,6 +4,9 @@
mpxs_ModPerl__Util_untaint | | ...
DEFINE_exit | | int:status=0
+PACKAGE=Apache
+ char *:DEFINE_current_callback
+
MODULE=ModPerl::Global
mpxs_ModPerl__Global_special_list_call
mpxs_ModPerl__Global_special_list_clear
