cvs commit: modperl-2.0/t/filter/TestFilter in_bbs_consume.pm

[st...@apache.org]

stas        2003/05/15 23:06:54

  Added:       t/filter in_bbs_consume.t
               t/filter/TestFilter in_bbs_consume.pm
  Log:
  this test consumes a bit of a data and discards the rest. all during a
  single invocation.
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/filter/in_bbs_consume.t
  
  Index: in_bbs_consume.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestRequest;
  
  plan tests => 1;
  
  my $location = '/TestFilter__in_bbs_consume';
  
  # send a message bigger than 8k, so to make sure that the input filter
  # will get more than one bucket brigade with data.
  my $length = 40 * 1024 + 7; # ~40k+ (~6 incoming bucket brigades)
  my $expected = join '', 'a'..'z';
  my $data = $expected . "x" x $length;
  my $received = POST_BODY $location, content => $data;
  
  ok t_cmp($expected, $received, "input bbs filter full consume")
  
  
  
  1.1                  modperl-2.0/t/filter/TestFilter/in_bbs_consume.pm
  
  Index: in_bbs_consume.pm
  ===================================================================
  package TestFilter::in_bbs_consume;
  
  # this test consumes a chunk of input, then consumes and throws away
  # the rest of the data, finally returns to the caller that initial
  # chunk. This all happens during a single filter invocation. Even
  # though there about 6-7 incoming data brigades.
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Filter ();
  use Apache::TestTrace;
  
  use Apache::Const -compile => qw(OK M_POST);
  
  use constant READ_SIZE => 26;
  
  sub handler {
      my($filter, $bb, $mode, $block, $readbytes) = @_;
      my $ba = $filter->r->connection->bucket_alloc;
      my $seen_eos = 0;
      my $satisfied = 0;
      my $buffer = '';
      debug_sub "filter called";
  
      until ($satisfied) {
          my $tbb = APR::Brigade->new($filter->r->pool, $ba);
          my $rv = $filter->next->get_brigade($tbb, $mode, $block, READ_SIZE);
          debug "asking for a bb of " . READ_SIZE . " bytes\n";
          my $data;
          ($data, $seen_eos) = bb_data_n_eos($tbb);
          $tbb->destroy;
          $buffer .= $data;
          length($buffer) < READ_SIZE ? redo : $satisfied++;
      }
  
      # consume all the remaining input
      do {
          my $tbb = APR::Brigade->new($filter->r->pool, $ba);
          my $rv = $filter->next->get_brigade($tbb, $mode, $block, $readbytes);
          debug "discarding the next bb";
          $seen_eos = bb_data_n_eos($tbb, 1); # only scan
          $tbb->destroy;
      } while (!$seen_eos);
  
      if ($seen_eos) {
          # flush the remainder
          $bb->insert_tail(APR::Bucket->new($buffer));
          $bb->insert_tail(APR::Bucket::eos_create($ba));
          debug "seen eos, sending: " . length($buffer) . " bytes";
      }
      else {
          die "Something is wrong, this filter should have been called only once";
      }
  
      return Apache::OK;
  }
  
  # if $scan_only is true, don't read the data, just look for eos
  sub bb_data_n_eos {
      my ($bb, $scan_only) = @_;
  
      if ($scan_only) {
          for (my $b = $bb->first; $b; $b = $bb->next($b)) {
              return 1 if $b->is_eos;
          }
          return 0;
      }
  
      my $seen_eos = 0;
  
      my @data;
      for (my $b = $bb->first; $b; $b = $bb->next($b)) {
          $seen_eos++, last if $b->is_eos;
          $b->read(my $bdata);
          $bdata = '' unless defined $bdata;
          push @data, $bdata;
      }
      return (join('', @data), $seen_eos);
  }
  
  sub response {
      my $r = shift;
  
      $r->content_type('text/plain');
  
      if ($r->method_number == Apache::M_POST) {
          my $data = ModPerl::Test::read_post($r);
          #warn "HANDLER READ: $data\n";
          $r->print($data);
      }
  
      return Apache::OK;
  }
  1;
  __DATA__
  SetHandler modperl
  PerlModule          TestFilter::in_bbs_consume
  PerlResponseHandler TestFilter::in_bbs_consume::response