stas 2003/03/31 21:20:51
Modified: xs/Apache/Filter Apache__Filter.h
xs/maps modperl_functions.map
xs/tables/current/ModPerl FunctionTable.pm
todo filters.txt
. Changes
Added: t/filter/TestFilter out_str_remove.pm
t/filter out_str_remove.t
Log:
implement $filter->remove (filter self-removal) + tests
Revision Changes Path
1.26 +24 -0 modperl-2.0/xs/Apache/Filter/Apache__Filter.h
Index: Apache__Filter.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/Apache/Filter/Apache__Filter.h,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- Apache__Filter.h 25 Jan 2003 03:08:05 -0000 1.25
+++ Apache__Filter.h 1 Apr 2003 05:20:50 -0000 1.26
@@ -183,3 +183,27 @@
callback,
"OutputFilter");
}
+
+static MP_INLINE
+void mpxs_Apache__Filter_remove(pTHX_ I32 items, SV **MARK, SV **SP)
+{
+ modperl_filter_t *modperl_filter;
+ ap_filter_t *f;
+
+ mpxs_usage_va_1(modperl_filter, "$filter->remove()");
+ f = modperl_filter->f;
+
+#ifdef MP_TRACE
+ {
+ modperl_filter_ctx_t *ctx = (modperl_filter_ctx_t *)(f->ctx);
+ MP_TRACE_f(MP_FUNC, "removing filter %s\n", ctx->handler->name);
+ }
+#endif
+
+ if (modperl_filter->mode == MP_INPUT_FILTER_MODE) {
+ ap_remove_input_filter(f);
+ }
+ else {
+ ap_remove_output_filter(f);
+ }
+}
1.56 +4 -3 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.55
retrieving revision 1.56
diff -u -r1.55 -r1.56
--- modperl_functions.map 2 Mar 2003 13:28:13 -0000 1.55
+++ modperl_functions.map 1 Apr 2003 05:20:50 -0000 1.56
@@ -78,10 +78,11 @@
MODULE=Apache::Filter
modperl_filter_attributes | MPXS_ | ... | MODIFY_CODE_ATTRIBUTES
- mpxs_Apache__Filter_print | | ...
- mpxs_Apache__Filter_read | | ...
+ mpxs_Apache__Filter_print | | ...
+ mpxs_Apache__Filter_read | | ...
mpxs_Apache__Filter_seen_eos | | ...
- mpxs_Apache__Filter_ctx | | filter, data=Nullsv
+ mpxs_Apache__Filter_ctx | | filter, data=Nullsv
+ mpxs_Apache__Filter_remove | | ...
SV *:DEFINE_TIEHANDLE | | SV *:stashsv, SV *:sv=Nullsv
int:DEFINE_PRINT | | ...
1.110 +26 -0 modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
Index: FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.109
retrieving revision 1.110
diff -u -r1.109 -r1.110
--- FunctionTable.pm 22 Mar 2003 03:19:11 -0000 1.109
+++ FunctionTable.pm 1 Apr 2003 05:20:50 -0000 1.110
@@ -5175,6 +5175,32 @@
},
{
'return_type' => 'void',
+ 'name' => 'mpxs_Apache__Filter_remove',
+ 'attr' => [
+ 'static',
+ '__inline__'
+ ],
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'I32',
+ 'name' => 'items'
+ },
+ {
+ 'type' => 'SV **',
+ 'name' => 'mark'
+ },
+ {
+ 'type' => 'SV **',
+ 'name' => 'sp'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'void',
'name' => 'mpxs_Apache__Log_BOOT',
'attr' => [
'static'
1.1 modperl-2.0/t/filter/TestFilter/out_str_remove.pm
Index: out_str_remove.pm
===================================================================
package TestFilter::out_str_remove;
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestUtil;
use Apache::RequestRec ();
use Apache::RequestIO ();
use Apache::Filter ();
use Apache::Const -compile => qw(OK);
use constant READ_SIZE => 1024;
# this filter reads the first bb, upcases the data in it and removes itself
sub upcase_n_remove {
my $filter = shift;
#warn "filter upcase_n_remove called\n";
while ($filter->read(my $buffer, 1024)) {
$filter->print(uc $buffer);
}
$filter->remove;
return Apache::OK;
}
# this filter inserts underscores after each character it receives
sub insert_underscores {
my $filter = shift;
#warn "filter insert_underscores called\n";
while ($filter->read(my $buffer, 1024)) {
$buffer =~ s/(.)/$1_/g;
$filter->print($buffer);
}
return Apache::OK;
}
sub response {
my $r = shift;
# just to make sure that print() won't flush, or we would get the
# count wrong
local $| = 0;
$r->content_type('text/plain');
$r->print("Foo");
$r->rflush; # this sends the data in the buffer + flush bucket
$r->print("bar");
Apache::OK;
}
1;
__DATA__
SetHandler modperl
PerlModule TestFilter::out_str_remove
PerlResponseHandler TestFilter::out_str_remove::response
PerlOutputFilterHandler TestFilter::out_str_remove::insert_underscores
PerlOutputFilterHandler TestFilter::out_str_remove::upcase_n_remove
1.1 modperl-2.0/t/filter/out_str_remove.t
Index: out_str_remove.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestRequest;
use Apache::TestUtil;
plan tests => 1;
my $expected = "F_O_O_b_a_r_";
my $location = '/TestFilter::out_str_remove';
my $response = GET_BODY $location;
ok t_cmp($expected, $response, "a filter that removes itself");
1.3 +0 -2 modperl-2.0/todo/filters.txt
Index: filters.txt
===================================================================
RCS file: /home/cvs/modperl-2.0/todo/filters.txt,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- filters.txt 11 Mar 2003 07:47:54 -0000 1.2
+++ filters.txt 1 Apr 2003 05:20:50 -0000 1.3
@@ -104,8 +104,6 @@
- Currently there is no way to MIX & MATCH mod-perl FILTERS declared
via "PerlOutputFilterHandler" with APACHE standard ones.
-- currently we have no way to remove the filter
-
- we also may need filter_init hook
tie handle interface
1.161 +2 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.160
retrieving revision 1.161
diff -u -r1.160 -r1.161
--- Changes 31 Mar 2003 01:50:51 -0000 1.160
+++ Changes 1 Apr 2003 05:20:51 -0000 1.161
@@ -10,6 +10,8 @@
=item 1.99_09-dev
+implement $filter->remove (filter self-removal) + tests [Stas]
+
remove the second-guessing code that was trying to guess the package
name to load from the handler configuration (by stripping ::string and
trying to load the package). fall back to using explicit PerlModule to
