stas 2004/08/18 21:50:18
Modified: t/filter/TestFilter in_bbs_body.pm in_bbs_msg.pm
out_bbs_ctx.pm out_bbs_filebucket.pm
t/protocol/TestProtocol echo_bbs.pm
Log:
revert the bb traversal code change from while() to foreach(), as it seems
to break on win32
Revision Changes Path
1.9 +16 -6 modperl-2.0/t/filter/TestFilter/in_bbs_body.pm
Index: in_bbs_body.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_body.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -u -r1.8 -r1.9
--- in_bbs_body.pm 15 Aug 2004 07:55:52 -0000 1.8
+++ in_bbs_body.pm 19 Aug 2004 04:50:18 -0000 1.9
@@ -19,17 +19,27 @@
#warn "Called!";
my $ba = $filter->r->connection->bucket_alloc;
- $filter->next->get_brigade($bb, $mode, $block, $readbytes);
- for (my $b = $bb->first; $b; $b = $bb->next($b)) {
+ my $ctx_bb = APR::Brigade->new($filter->r->pool, $ba);
- last if $b->is_eos;
+ $filter->next->get_brigade($ctx_bb, $mode, $block, $readbytes);
+
+ while (!$ctx_bb->is_empty) {
+ my $b = $ctx_bb->first;
+
+ $b->remove;
+
+ if ($b->is_eos) {
+ #warn "EOS!!!!";
+ $bb->insert_tail($b);
+ last;
+ }
if ($b->read(my $data)) {
#warn"[$data]\n";
- my $nb = APR::Bucket->new(scalar reverse $data);
- $b->insert_before($nb);
- $b->remove;
+ $b = APR::Bucket->new(scalar reverse $data);
}
+
+ $bb->insert_tail($b);
}
Apache::OK;
1.13 +20 -9 modperl-2.0/t/filter/TestFilter/in_bbs_msg.pm
Index: in_bbs_msg.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_msg.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -u -r1.12 -r1.13
--- in_bbs_msg.pm 15 Aug 2004 07:55:52 -0000 1.12
+++ in_bbs_msg.pm 19 Aug 2004 04:50:18 -0000 1.13
@@ -23,24 +23,35 @@
debug "FILTER CALLED";
my $c = $filter->c;
+ my $ctx_bb = APR::Brigade->new($c->pool, $c->bucket_alloc);
- $filter->next->get_brigade($bb, $mode, $block, $readbytes);
- for (my $b = $bb->first; $b; $b = $bb->next($b)) {
+ $filter->next->get_brigade($ctx_bb, $mode, $block, $readbytes);
- last if $b->is_eos;
+ while (!$ctx_bb->is_empty) {
+ my $b = $ctx_bb->first;
- if ($b->read(my $data)) {
- next unless $data =~ s|GET $from_url|GET $to_url|;
- debug "new GET line:\n$data";
- my $nb = APR::Bucket->new($data);
- $b->insert_before($nb);
- $b->remove;
+ $b->remove;
+
+ if ($b->is_eos) {
+ debug "EOS!!!";
+ $bb->insert_tail($b);
+ last;
+ }
+
+ $b->read(my $data);
+ debug "FILTER READ:\n$data";
+
+ if ($data and $data =~ s,GET $from_url,GET $to_url,) {
+ debug "GET line rewritten to be:\n$data";
+ $b = APR::Bucket->new($data);
# XXX: currently a bug in httpd doesn't allow to remove
# the first connection filter. once it's fixed adjust the test
# to test that it was invoked only once.
# debug "removing the filter";
# $filter->remove; # this filter is no longer needed
}
+
+ $bb->insert_tail($b);
}
Apache::OK;
1.9 +1 -7 modperl-2.0/t/filter/TestFilter/out_bbs_ctx.pm
Index: out_bbs_ctx.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/out_bbs_ctx.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -u -r1.8 -r1.9
--- out_bbs_ctx.pm 15 Aug 2004 07:55:52 -0000 1.8
+++ out_bbs_ctx.pm 19 Aug 2004 04:50:18 -0000 1.9
@@ -31,6 +31,7 @@
my $data = exists $ctx->{data} ? $ctx->{data} : '';
while (my $b = $bb->first) {
+ $b->remove;
if ($b->is_eos) {
# flush the remainings and send a stats signature
@@ -43,7 +44,6 @@
}
if ($b->read(my $bdata)) {
- $b->remove;
$data .= $bdata;
my $len = length $data;
@@ -59,12 +59,6 @@
$bb_ctx->insert_tail($b);
}
}
- else {
- # insert META buckets as is
- $b->remove;
- $bb_ctx->insert_tail($b);
- }
-
}
$ctx->{data} = $data;
1.4 +10 -4 modperl-2.0/t/filter/TestFilter/out_bbs_filebucket.pm
Index: out_bbs_filebucket.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/out_bbs_filebucket.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -u -r1.3 -r1.4
--- out_bbs_filebucket.pm 15 Aug 2004 07:55:52 -0000 1.3
+++ out_bbs_filebucket.pm 19 Aug 2004 04:50:18 -0000 1.4
@@ -23,6 +23,9 @@
sub handler {
my($filter, $bb) = @_;
+ my $c = $filter->c;
+ my $bb_ctx = APR::Brigade->new($c->pool, $c->bucket_alloc);
+
debug "FILTER INVOKED";
my $cnt = 0;
@@ -31,16 +34,19 @@
$cnt++;
debug "reading bucket #$cnt";
- last if $b->is_eos;
+ if ($b->is_eos) {
+ $b->remove;
+ $bb_ctx->insert_tail($b);
+ last;
+ }
if (my $len = $b->read(my $data)) {
my $nb = APR::Bucket->new(uc $data);
- $b->insert_before($nb);
- $b->remove;
+ $bb_ctx->insert_tail($nb);
}
}
- my $rv = $filter->next->pass_brigade($bb);
+ my $rv = $filter->next->pass_brigade($bb_ctx);
return $rv unless $rv == APR::SUCCESS;
return Apache::OK;
1.7 +18 -14 modperl-2.0/t/protocol/TestProtocol/echo_bbs.pm
Index: echo_bbs.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo_bbs.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -u -r1.6 -r1.7
--- echo_bbs.pm 15 Aug 2004 07:55:52 -0000 1.6
+++ echo_bbs.pm 19 Aug 2004 04:50:18 -0000 1.7
@@ -4,9 +4,6 @@
# manipulations on the buckets inside the connection handler, rather
# then using filter
-# it also demonstrates how to use a single bucket bridade to do all
-# the manipulation
-
use strict;
use warnings FATAL => 'all';
@@ -26,31 +23,38 @@
# the socket to a blocking IO mode
$c->client_socket->opt_set(APR::SO_NONBLOCK, 0);
- my $bb = APR::Brigade->new($c->pool, $c->bucket_alloc);
+ my $bb_in = APR::Brigade->new($c->pool, $c->bucket_alloc);
+ my $bb_out = APR::Brigade->new($c->pool, $c->bucket_alloc);
while (1) {
- my $rc = $c->input_filters->get_brigade($bb,
+ my $rc = $c->input_filters->get_brigade($bb_in,
Apache::MODE_GETLINE);
last if $rc == APR::EOF;
die APR::Error::strerror($rc) unless $rc == APR::SUCCESS;
- for (my $b = $bb->first; $b; $b = $bb->next($b)) {
+ while (!$bb_in->is_empty) {
+ my $bucket = $bb_in->first;
+
+ $bucket->remove;
- last if $b->is_eos;
+ if ($bucket->is_eos) {
+ $bb_out->insert_tail($bucket);
+ last;
+ }
- if ($b->read(my $data)) {
+ if ($bucket->read(my $data)) {
last if $data =~ /^[\r\n]+$/;
- my $nb = APR::Bucket->new(uc $data);
- # head->...->$nb->$b ->...->tail
- $b->insert_before($nb);
- $b->remove;
+ $bucket = APR::Bucket->new(uc $data);
}
+
+ $bb_out->insert_tail($bucket);
}
- $c->output_filters->fflush($bb);
+ $c->output_filters->fflush($bb_out);
}
- $bb->destroy;
+ $bb_in->destroy;
+ $bb_out->destroy;
Apache::OK;
}