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

[dougm]

dougm       01/04/19 10:46:37

  Added:       t/filter input_body.t
               t/filter/TestFilter input_body.pm
  Log:
  add test for PerlInputFilterHandler
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/filter/input_body.t
  
  Index: input_body.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestRequest;
  
  plan tests => 2, \&have_lwp;
  
  my $location = '/TestFilter::input_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/TestFilter/input_body.pm
  
  Index: input_body.pm
  ===================================================================
  package TestFilter::input_body;
  
  use strict;
  use warnings FATAL => 'all';
  
  use base qw(Apache::Filter); #so we inherit MODIFY_CODE_ATTRIBUTES
  
  use Test;
  use Apache::Test ();
  use Apache::Const -compile => qw(M_POST);
  use APR::Const -compile => ':common';
  use APR::Brigade ();
  use APR::Bucket ();
  
  #XXX
  @Apache::InputFilter::ISA = qw(Apache::OutputFilter);
  
  sub handler : InputFilterBody {
      my($filter, $bb, $mode) = @_;
  
      if ($bb->empty) {
          my $rv = $filter->f->next->get_brigade($bb, $mode);
  
          if ($rv != APR::SUCCESS) {
              return $rv;
          }
      }
  
      for (my $bucket = $bb->first; $bucket; $bucket = $bb->next($bucket)) {
          my $data;
          my $status = $bucket->read($data);
  
          $bucket->remove;
          if ($data) {
              $bb->insert_tail(APR::Bucket->new(scalar reverse $data));
          }
          else {
              #maintain EOS bucket
              $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::input_body::response