perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/t/filter/TestFilter in_bbs_underrun.pm
Date Thu, 15 May 2003 07:21:25 GMT
stas        2003/05/15 00:21:24

  Added:       t/filter in_bbs_underrun.t
               t/filter/TestFilter in_bbs_underrun.pm
  Log:
  add another interesting filter implemenation, that solves the data
  underrun situations
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/filter/in_bbs_underrun.t
  
  Index: in_bbs_underrun.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestRequest;
  
  plan tests => 1;
  
  my $location = '/TestFilter__in_bbs_underrun';
  
  # 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 (~5 incoming bucket brigades)
  my $data = "x" x $length;
  my $received = POST_BODY $location, content => $data;
  my $expected = "read $length chars";
  
  ok t_cmp($expected, $received, "input stream filter underrun test")
  
  
  
  1.1                  modperl-2.0/t/filter/TestFilter/in_bbs_underrun.pm
  
  Index: in_bbs_underrun.pm
  ===================================================================
  package TestFilter::in_bbs_underrun;
  
  # this test exercises the underrun filter concept. Sometimes filters
  # need to read at least N bytes before they can apply they
  # transformation. It's quite possible that reading one bucket brigade
  # is not enough. But two or more are needed.
  #
  # When the filter realizes that it doesn't have enough data, it can
  # stash the read data in the context, and wait for the next
  # invocation, meanwhile it must return an empty bb to the filter that
  # has called it. This is not efficient. Instead of returning an empty
  # bb to a caller, the input filter can initiate the retrieval of extra
  # bucket brigades, after one was received. Notice that this is
  # absolutely transparent to any filters before or after the current
  # filter.
  #
  # to see the filter at work, run it as:
  # t/TEST -trace=debug -v filter/in_bbs_underrun
  #
  # and look in the error_log. You will see something like:
  #
  # ==> TestFilter::in_bbs_underrun::handler : filter called
  # ==> asking for a bb
  # ==> asking for a bb
  # ==> asking for a bb
  # ==> storing the remainder: 7611 bytes
  # ==> TestFilter::in_bbs_underrun::handler : filter called
  # ==> asking for a bb
  # ==> asking for a bb
  # ==> storing the remainder: 7222 bytes
  # ==> TestFilter::in_bbs_underrun::handler : filter called
  # ==> asking for a bb
  # ==> seen eos, flushing the remaining: 8182 bytes
  #
  # it's clear from the log that the filter was invoked 3 times, however
  # it has consumed 6 bucket brigade
  #
  # finally, we have to note that this is impossible to do with
  # streaming filters, since they can only read data from one bucket
  # brigade. So you must process bucket brigades.
  #
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::TestTrace;
  
  use Apache::Filter ();
  
  use Apache::Const -compile => qw(OK M_POST);
  
  use constant SIZE => 1024*16 + 5; # ~16k
  
  sub handler {
      my($filter, $bb, $mode, $block, $readbytes) = @_;
      my $ba = $filter->r->connection->bucket_alloc;
      my $ctx = $filter->ctx;
      my $buffer = defined $ctx ? $ctx : '';
      $ctx = '';  # reset
      my $seen_eos = 0;
      my $data;
      debug_sub "filter called";
  
      # consume data untill we get at least SIZE bytes
      do {
          my $tbb = APR::Brigade->new($filter->r->pool, $ba);
          my $rv = $filter->next->get_brigade($tbb, $mode, $block, $readbytes);
          debug "asking for a bb";
          ($data, $seen_eos) = flatten_bb($tbb);
          $tbb->destroy;
          $buffer .= $data;
      } while (!$seen_eos && length($buffer) < SIZE);
  
      # now create a bucket per chunk of SIZE size and put the remainder
      # in ctx
      for (unpack "(A".SIZE.")*", $buffer) {
          if (length($_) == SIZE) {
              $bb->insert_tail(APR::Bucket->new($_));
          }
          else {
              $ctx .= $_;
          }
      }
  
      if ($seen_eos) {
          # flush the remainder
          $bb->insert_tail(APR::Bucket->new($ctx));
          $bb->insert_tail(APR::Bucket::eos_create($ba));
          debug "seen eos, flushing the remaining: " . length($ctx) . " bytes";
      }
      else {
          # will re-use the remainder on the next invocation
          $filter->ctx($ctx);
          debug "storing the remainder: " . length($ctx) . " bytes";
      }
  
      return Apache::OK;
  }
  
  sub flatten_bb {
      my ($bb) = shift;
  
      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";
          my $length = length $data;
          $r->print("read $length chars");
      }
  
      return Apache::OK;
  }
  1;
  __DATA__
  SetHandler modperl
  PerlModule          TestFilter::in_bbs_underrun
  PerlResponseHandler TestFilter::in_bbs_underrun::response
  PerlInputFilterHandler TestFilter::in_bbs_underrun::handler
  PerlInputFilterHandler ModPerl::TestFilterDebug::snoop_request
  
  
  

Mime
View raw message