cvs commit: modperl-2.0/t/filter out_bbs_filebucket.t

[stas]

stas        2004/08/12 18:51:15

  Added:       t/filter/TestFilter out_bbs_filebucket.pm
               t/filter out_bbs_filebucket.t
  Log:
  filebuckets handling in filter test
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/filter/TestFilter/out_bbs_filebucket.pm
  
  Index: out_bbs_filebucket.pm
  ===================================================================
  package TestFilter::out_bbs_filebucket;
  
  # testing how the filter handles file buckets
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  use Apache::Filter;
  
  use APR::Brigade ();
  use APR::Bucket ();
  
  use Apache::TestTrace;
  
  use Apache::Const -compile => qw(OK);
  use APR::Const    -compile => qw(SUCCESS);
  
  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);
  
      debug "FILTER INVOKED";
  
      my $cnt = 0;
      for (my $b = $bb->first; $b; $b = $bb->next($b)) {
  
          $cnt++;
          debug "reading bucket #$cnt";
  
          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);
              $bb_ctx->insert_tail($nb);
          }
      }
  
      my $rv = $filter->next->pass_brigade($bb_ctx);
      return $rv unless $rv == APR::SUCCESS;
  
      return Apache::OK;
  }
  
  sub response {
      my $r = shift;
  
      debug "\n-------- new request ----------";
  
      $r->content_type('text/plain');
      my $file = $r->args;
  
      $r->sendfile($file);
  
      return Apache::OK;
  }
  
  1;
  __DATA__
  SetHandler modperl
  PerlModule              TestFilter::out_bbs_filebucket
  PerlResponseHandler     TestFilter::out_bbs_filebucket::response
  PerlOutputFilterHandler TestFilter::out_bbs_filebucket::handler
  
  
  
  1.1                  modperl-2.0/t/filter/out_bbs_filebucket.t
  
  Index: out_bbs_filebucket.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestRequest;
  
  use File::Spec::Functions qw(catdir catfile);
  
  my $url = '/TestFilter__out_bbs_filebucket';
  
  my $dir = catdir Apache::Test::vars('documentroot'), qw(filter);
  
  my @sizes = qw(1 100 500 1000 5000);
  
  plan tests => 2 * scalar @sizes;
  
  for my $size (@sizes) {
      my($file, $data) = write_file($size);
      my $received = GET_BODY "$url?$file";
  
      my $received_size = length $received;
      my $expected_size = $size * 1024;
  
      ok t_cmp length($received), length($data), "length";
      ok $received && $received eq uc($data);
      unlink $file;
  }
  
  sub write_file {
      my $size = shift;
  
      my $data = "ABCD" x ($size * 256);
  
      my $file = catfile $dir, "data_${size}k.txt";
      open my $fh, ">$file" or die "can't open $file: $!";
      # need binmode on Win32 so as not to strip \r, which
      # are included when sending with sendfile().
      binmode $fh;
      print $fh $data;
      close $fh;
  
      return ($file, $data);
  }