You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by st...@apache.org on 2003/01/15 07:47:16 UTC
cvs commit: modperl-2.0/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 in_str_msg.pm api.pm buckets.pm context.pm context_stream.pm input_body.pm input_msg.pm lc.pm reverse.pm
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