stas 2003/01/14 22:47:16 Modified: t/filter/TestFilter in_str_msg.pm Added: t/filter in_bbs_body.t in_bbs_msg.t out_bbs_basic.t out_bbs_ctx.t out_str_api.t out_str_ctx.t out_str_lc.t out_str_reverse.t t/filter/TestFilter in_bbs_body.pm in_bbs_msg.pm out_bbs_basic.pm out_bbs_ctx.pm out_str_api.pm out_str_ctx.pm out_str_lc.pm out_str_reverse.pm Removed: t/filter context.t context_stream.t input_body.t input_msg.t lc.t reverse.t t/filter/TestFilter api.pm buckets.pm context.pm context_stream.pm input_body.pm input_msg.pm lc.pm reverse.pm Log: rename filter tests so it's easy to test what kind of filter is run from its name (also to tell the streaming interface from BBs.) Revision Changes Path 1.1 modperl-2.0/t/filter/in_bbs_body.t Index: in_bbs_body.t =================================================================== use strict; use warnings FATAL => 'all'; use Apache::Test; use Apache::TestRequest; plan tests => 2; my $location = '/TestFilter::in_bbs_body'; for my $x (1,2) { my $data = scalar reverse "ok $x\n"; print POST_BODY $location, content => $data; } 1.1 modperl-2.0/t/filter/in_bbs_msg.t Index: in_bbs_msg.t =================================================================== use Apache::TestRequest; use Apache::Test (); use Apache::TestUtil; my $module = 'TestFilter::in_bbs_msg'; Apache::TestRequest::scheme('http'); #force http for t/TEST -ssl Apache::TestRequest::module($module); my $config = Apache::Test::config(); my $hostport = Apache::TestRequest::hostport($config); t_debug("connecting to $hostport"); print GET_BODY("/input_filter.html"); 1.1 modperl-2.0/t/filter/out_bbs_basic.t Index: out_bbs_basic.t =================================================================== # WARNING: this file is generated, do not edit # 01: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestConfig.pm:696 # 02: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestConfig.pm:713 # 03: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestConfigPerl.pm:83 # 04: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestConfigPerl.pm:407 # 05: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestConfig.pm:407 # 06: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestConfig.pm:422 # 07: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestConfig.pm:1215 # 08: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestRun.pm:398 # 09: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestRunPerl.pm:32 # 10: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestRun.pm:569 # 11: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestRun.pm:569 # 12: t/TEST:19 use Apache::TestRequest 'GET_BODY'; print GET_BODY "/TestFilter::out_bbs_basic"; 1.1 modperl-2.0/t/filter/out_bbs_ctx.t Index: out_bbs_ctx.t =================================================================== use strict; use warnings FATAL => 'all'; use Apache::Test; use Apache::TestRequest; use Apache::TestUtil; plan tests => 1; my $blocks = 33; my $invoked = 100; my $sig = join "\n", "received $blocks complete blocks", "filter invoked $invoked times\n"; my $data = "#" x $blocks . "x" x $blocks; my $expected = join "\n", $data, $sig; { # test the filtering of the mod_perl response handler my $location = '/TestFilter::out_bbs_ctx'; my $response = GET_BODY $location; ok t_cmp($expected, $response, "context filter"); } 1.1 modperl-2.0/t/filter/out_str_api.t Index: out_str_api.t =================================================================== # WARNING: this file is generated, do not edit # 01: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestConfig.pm:696 # 02: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestConfig.pm:713 # 03: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestConfigPerl.pm:83 # 04: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestConfigPerl.pm:407 # 05: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestConfig.pm:407 # 06: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestConfig.pm:422 # 07: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestConfig.pm:1215 # 08: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestRun.pm:398 # 09: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestRunPerl.pm:32 # 10: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestRun.pm:569 # 11: /home/stas/apache.org/modperl-2.0/t/../Apache-Test/lib/Apache/TestRun.pm:569 # 12: t/TEST:19 use Apache::TestRequest 'GET_BODY'; print GET_BODY "/TestFilter::out_str_api"; 1.1 modperl-2.0/t/filter/out_str_ctx.t Index: out_str_ctx.t =================================================================== use strict; use warnings FATAL => 'all'; use Apache::Test; use Apache::TestRequest; use Apache::TestUtil; plan tests => 1; my $blocks = 33; my $invoked = 100; my $sig = join "\n", "received $blocks complete blocks", "filter invoked $invoked times\n"; my $data = "#" x $blocks . "x" x $blocks; my $expected = join "\n", $data, $sig; { # test the filtering of the mod_perl response handler my $location = '/TestFilter::out_str_ctx'; my $response = GET_BODY $location; ok t_cmp($expected, $response, "context stream filter"); } 1.1 modperl-2.0/t/filter/out_str_lc.t Index: out_str_lc.t =================================================================== use strict; use warnings FATAL => 'all'; use Apache::Test; use Apache::TestRequest; plan tests => 1; my $location = "/top_dir/Makefile"; my $str = GET_BODY $location; ok $str !~ /[A-Z]/; 1.1 modperl-2.0/t/filter/out_str_reverse.t Index: out_str_reverse.t =================================================================== use strict; use warnings FATAL => 'all'; use Apache::Test; use Apache::TestRequest; use Apache::TestUtil; plan tests => 2; my @data = (join('', 'a'..'z'), join('', 0..9)); my $reversed_data = join '', map { scalar(reverse $_) . "\n" } @data; #t_debug($reversed_data); my $sig = "Reversed by mod_perl 2.0\n"; my $expected = join "\n", @data, $sig; { # test the filtering of the mod_perl response handler my $location = '/TestFilter::out_str_reverse'; my $response = POST_BODY $location, content => $reversed_data; ok t_cmp($expected, $response, "reverse filter"); } { # test the filtering of the non-mod_perl response handler (file) my $location = '/filter/reverse.txt'; my $response = GET_BODY $location; $response =~ s/\r//g; ok t_cmp($expected, $response, "reverse filter"); } 1.2 +2 -2 modperl-2.0/t/filter/TestFilter/in_str_msg.pm Index: in_str_msg.pm =================================================================== RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_str_msg.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -u -r1.1 -r1.2 --- in_str_msg.pm 15 Jan 2003 06:19:25 -0000 1.1 +++ in_str_msg.pm 15 Jan 2003 06:47:15 -0000 1.2 @@ -18,11 +18,11 @@ sub handler : FilterConnectionHandler { my($filter, $bb, $mode, $block, $readbytes) = @_; - warn "FILTER CALLED\n"; + #warn "FILTER CALLED\n"; my $ctx = $filter->ctx; while ($filter->read($mode, $block, $readbytes, my $buffer, 1024)) { - warn "FILTER READ: $buffer\n"; + #warn "FILTER READ: $buffer\n"; unless ($ctx) { $buffer =~ s|GET $from_url|GET $to_url|; $ctx = 1; # done 1.1 modperl-2.0/t/filter/TestFilter/in_bbs_body.pm Index: in_bbs_body.pm =================================================================== package TestFilter::in_bbs_body; use strict; use warnings FATAL => 'all'; use base qw(Apache::Filter); #so we inherit MODIFY_CODE_ATTRIBUTES use Apache::RequestRec (); use Apache::RequestIO (); use APR::Brigade (); use APR::Bucket (); use Apache::Const -compile => qw(OK M_POST); use APR::Const -compile => ':common'; sub handler : FilterRequestHandler { my($filter, $bb, $mode, $block, $readbytes) = @_; #warn "Called!"; my $ba = $filter->r->connection->bucket_alloc; my $ctx_bb = APR::Brigade->new($filter->r->pool, $ba); my $rv = $filter->next->get_brigade($ctx_bb, $mode, $block, $readbytes); if ($rv != APR::SUCCESS) { return $rv; } while (!$ctx_bb->empty) { my $data; my $bucket = $ctx_bb->first; $bucket->remove; if ($bucket->is_eos) { #warn "EOS!!!!"; $bb->insert_tail($bucket); last; } my $status = $bucket->read($data); #warn "DATA bucket!!!!"; if ($status != APR::SUCCESS) { return $status; } if ($data) { #warn"[$data]\n"; $bucket = APR::Bucket->new(scalar reverse $data); } $bb->insert_tail($bucket); } Apache::OK; } sub response { my $r = shift; $r->content_type('text/plain'); if ($r->method_number == Apache::M_POST) { my $data = ModPerl::Test::read_post($r); $r->puts($data); } else { $r->puts("1..1\nok 1\n"); } Apache::OK; } 1; __DATA__ SetHandler modperl PerlResponseHandler TestFilter::in_bbs_body::response 1.1 modperl-2.0/t/filter/TestFilter/in_bbs_msg.pm Index: in_bbs_msg.pm =================================================================== package TestFilter::in_bbs_msg; use strict; use warnings FATAL => 'all'; use base qw(Apache::Filter); use Apache::RequestRec (); use Apache::RequestIO (); use APR::Brigade (); use APR::Bucket (); use Apache::Const -compile => 'OK'; use APR::Const -compile => ':common'; my $from_url = '/input_filter.html'; my $to_url = '/TestFilter::in_bbs_msg::response'; sub handler : FilterConnectionHandler { my($filter, $bb, $mode, $block, $readbytes) = @_; #warn "FILTER CALLED\n"; my $c = $filter->c; my $ctx_bb = APR::Brigade->new($c->pool, $c->bucket_alloc); my $rv = $filter->next->get_brigade($ctx_bb, $mode, $block, $readbytes); if ($rv != APR::SUCCESS) { return $rv; } while (!$ctx_bb->empty) { my $data; my $bucket = $ctx_bb->first; $bucket->remove; if ($bucket->is_eos) { #warn "EOS!!!!"; $bb->insert_tail($bucket); last; } my $status = $bucket->read($data); #warn "FILTER READ: $data\n"; if ($status != APR::SUCCESS) { return $status; } if ($data and $data =~ s,GET $from_url,GET $to_url,) { $bucket = APR::Bucket->new($data); } $bb->insert_tail($bucket); } Apache::OK; } sub response { my $r = shift; $r->content_type('text/plain'); $r->puts("1..1\nok 1\n"); Apache::OK; } 1; __END__ <VirtualHost TestFilter::in_bbs_msg> # must be preloaded so the FilterConnectionHandler attributes will # be set by the time the filter is inserted into the filter chain PerlModule TestFilter::in_bbs_msg PerlInputFilterHandler TestFilter::in_bbs_msg <Location /TestFilter::in_bbs_msg::response> SetHandler modperl PerlResponseHandler TestFilter::in_bbs_msg::response </Location> </VirtualHost> 1.1 modperl-2.0/t/filter/TestFilter/out_bbs_basic.pm Index: out_bbs_basic.pm =================================================================== package TestFilter::out_bbs_basic; use strict; use warnings FATAL => 'all'; use Apache::Test; use Apache::RequestRec (); use Apache::RequestIO (); use Apache::Filter (); use APR::Brigade (); use APR::Bucket (); use Apache::Const -compile => 'OK'; #XXX: Not implemented yet, required by Test.pm sub Apache::TestToString::PRINTF {} sub handler { my($filter, $bb) = @_; unless ($filter->ctx) { Apache::TestToString->start; plan tests => 4; my $ba = $filter->r->connection->bucket_alloc; #should only have 1 bucket from the response() below for (my $bucket = $bb->first; $bucket; $bucket = $bb->next($bucket)) { ok $bucket->type->name; ok $bucket->length == 2; $bucket->read(my $data); ok (defined $data and $data eq 'ok'); } my $tests = Apache::TestToString->finish; my $brigade = APR::Brigade->new($filter->r->pool, $ba); my $bucket = APR::Bucket->new($tests); $brigade->insert_tail($bucket); my $ok = $brigade->first->type->name =~ /mod_perl/ ? 4 : 0; $brigade->insert_tail(APR::Bucket->new("ok $ok\n")); $filter->next->pass_brigade($brigade); $filter->ctx(1); # flag that we have run this already } Apache::OK; } sub response { my $r = shift; $r->content_type('text/plain'); $r->puts("ok"); 0; } 1; __DATA__ SetHandler modperl PerlResponseHandler TestFilter::out_bbs_basic::response 1.1 modperl-2.0/t/filter/TestFilter/out_bbs_ctx.pm Index: out_bbs_ctx.pm =================================================================== package TestFilter::out_bbs_ctx; # this is the same test as TestFilter::context_stream, but uses the # bucket brigade API use strict; use warnings;# FATAL => 'all'; use Apache::RequestRec (); use Apache::RequestIO (); use APR::Brigade (); use APR::Bucket (); use base qw(Apache::Filter); use Apache::Const -compile => qw(OK M_POST); use APR::Const -compile => ':common'; use constant BLOCK_SIZE => 5003; sub handler { my($filter, $bb) = @_; my $c = $filter->c; my $bb_ctx = APR::Brigade->new($c->pool, $c->bucket_alloc); my $ctx = $filter->ctx; $ctx->{invoked}++; my $data = exists $ctx->{data} ? $ctx->{data} : ''; while (my $bucket = $bb->first) { $bucket->remove; if ($bucket->is_eos) { # flush the remainings and send a stats signature $bb_ctx->insert_tail(APR::Bucket->new("$data\n")) if $data; my $sig = join "\n", "received $ctx->{blocks} complete blocks", "filter invoked $ctx->{invoked} times\n"; $bb_ctx->insert_tail(APR::Bucket->new($sig)); $bb_ctx->insert_tail($bucket); last; } my $status = $bucket->read(my $bdata); return $status unless $status == APR::SUCCESS; if (defined $bdata) { $data .= $bdata; my $len = length $data; my $blocks = 0; if ($len >= BLOCK_SIZE) { $blocks = int($len / BLOCK_SIZE); $len = $len % BLOCK_SIZE; $data = substr $data, $blocks*BLOCK_SIZE, $len; $ctx->{blocks} += $blocks; } if ($blocks) { $bucket = APR::Bucket->new("#" x $blocks); $bb_ctx->insert_tail($bucket); } } } $ctx->{data} = $data; $filter->ctx($ctx); my $rv = $filter->next->pass_brigade($bb_ctx); return $rv unless $rv == APR::SUCCESS; return Apache::OK; } sub response { my $r = shift; $r->content_type('text/plain'); # make sure that # - we send big enough data so it won't fit into one buffer # - use chunk size which doesn't nicely fit into a buffer size, so # we have something to store in the context between filter calls my $blocks = 33; my $block_size = BLOCK_SIZE + 1; my $block = "x" x $block_size; for (1..$blocks) { $r->print($block); $r->rflush; # so the filter reads a chunk at a time } return Apache::OK; } 1; __DATA__ SetHandler modperl PerlResponseHandler TestFilter::out_bbs_ctx::response 1.1 modperl-2.0/t/filter/TestFilter/out_str_api.pm Index: out_str_api.pm =================================================================== package TestFilter::out_str_api; use strict; use warnings FATAL => 'all'; use Apache::RequestRec (); use Apache::RequestIO (); use Apache::Filter (); use Apache::FilterRec (); use Apache::Test; use Apache::Const -compile => 'OK'; my $response_data = "blah blah blah"; #XXX: else pp_untie complains: #untie attempted while %d inner references still exist sub Apache::Filter::UNTIE {} sub Apache::Filter::PRINTF {} sub handler { my $filter = shift; unless ($filter->ctx) { $filter->read(my $buffer); #slurp everything; tie *STDOUT, $filter; plan tests => 6; ok $buffer eq $response_data; ok $filter->isa('Apache::Filter'); my $frec = $filter->frec; ok $frec->isa('Apache::FilterRec'); ok $frec->name; my $r = $filter->r; ok $r->isa('Apache::RequestRec'); ok $r->uri eq '/' . __PACKAGE__; untie *STDOUT; $filter->ctx(1); # flag that we have sent this output already } Apache::OK; } sub response { my $r = shift; $r->content_type('text/plain'); $r->puts($response_data); Apache::OK; } 1; __DATA__ SetHandler modperl PerlResponseHandler TestFilter::out_str_api::response 1.1 modperl-2.0/t/filter/TestFilter/out_str_ctx.pm Index: out_str_ctx.pm =================================================================== package TestFilter::out_str_ctx; # this is the same test as TestFilter::context, but uses the streaming # API use strict; use warnings;# FATAL => 'all'; use Apache::RequestRec (); use Apache::RequestIO (); use APR::Brigade (); use APR::Bucket (); use base qw(Apache::Filter); use Apache::Const -compile => qw(OK M_POST); use APR::Const -compile => ':common'; use constant BLOCK_SIZE => 5003; use constant READ_SIZE => 1024; sub handler { my $filter = shift; my $ctx = $filter->ctx; my $data = exists $ctx->{data} ? $ctx->{data} : ''; $ctx->{invoked}++; while ($filter->read(my $bdata, READ_SIZE)) { $data .= $bdata; my $len = length $data; my $blocks = 0; if ($len >= BLOCK_SIZE) { $blocks = int($len / BLOCK_SIZE); $len = $len % BLOCK_SIZE; $data = substr $data, $blocks*BLOCK_SIZE, $len; $ctx->{blocks} += $blocks; } if ($blocks) { $filter->print("#" x $blocks); } } if ($filter->seen_eos) { # flush the remaining data and add a statistics signature $filter->print("$data\n") if $data; my $sig = join "\n", "received $ctx->{blocks} complete blocks", "filter invoked $ctx->{invoked} times\n"; $filter->print($sig); } else { # store context for all but the last invocation $ctx->{data} = $data; $filter->ctx($ctx); } return Apache::OK; } sub response { my $r = shift; $r->content_type('text/plain'); # make sure that # - we send big enough data so it won't fit into one buffer # - use chunk size which doesn't nicely fit into a buffer size, so # we have something to store in the context between filter calls my $blocks = 33; my $block_size = BLOCK_SIZE + 1; my $block = "x" x $block_size; for (1..$blocks) { $r->print($block); $r->rflush; # so the filter reads a chunk at a time } return Apache::OK; } 1; __DATA__ SetHandler modperl PerlResponseHandler TestFilter::out_str_ctx::response 1.1 modperl-2.0/t/filter/TestFilter/out_str_lc.pm Index: out_str_lc.pm =================================================================== package TestFilter::out_str_lc; use strict; use warnings FATAL => 'all'; use Apache::Filter (); use Apache::Const -compile => 'OK'; sub handler { my $filter = shift; while ($filter->read(my $buffer, 1024)) { $filter->print(lc $buffer); } Apache::OK; } 1; __DATA__ <Location /top_dir> PerlOutputFilterHandler TestFilter::out_str_lc </Location> Alias /top_dir @top_dir@ 1.1 modperl-2.0/t/filter/TestFilter/out_str_reverse.pm Index: out_str_reverse.pm =================================================================== package TestFilter::out_str_reverse; use strict; use warnings FATAL => 'all'; use Apache::RequestRec (); use Apache::RequestIO (); use Apache::Filter (); use Apache::Const -compile => qw(OK M_POST); sub handler { my $filter = shift; while ($filter->read(my $buffer, 1024)) { for (split "\n", $buffer) { $filter->print(scalar reverse $_); $filter->print("\n"); } } if ($filter->seen_eos) { $filter->print("Reversed by mod_perl 2.0\n"); } return Apache::OK; } sub response { my $r = shift; $r->content_type('text/plain'); if ($r->method_number == Apache::M_POST) { my $data = ModPerl::Test::read_post($r); $r->puts($data); } return Apache::OK; } 1; __DATA__ <Base> <LocationMatch "/filter/reverse.txt"> PerlOutputFilterHandler TestFilter::out_str_reverse </LocationMatch> </Base> SetHandler modperl PerlResponseHandler TestFilter::out_str_reverse::response