You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by st...@apache.org on 2004/07/24 08:54:26 UTC

cvs commit: modperl-2.0/t/response/TestAPI in_out_filters.pm request_rec.pm

stas        2004/07/23 23:54:26

  Modified:    t/response/TestAPI request_rec.pm
  Added:       t/api    in_out_filters.t
               t/response/TestAPI in_out_filters.pm
  Log:
  testing: $r->input_filters and $r->output_filters
  it's possible to read a POST data and send a response body w/o using
  $r->read/$r->print
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/api/in_out_filters.t
  
  Index: in_out_filters.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestRequest;
  use Apache::TestUtil;
  
  plan tests => 1;
  
  my $location = '/TestAPI__in_out_filters';
  
  my $content = join '', 'AA'..'ZZ', 1..99999;
  
  my $expected = lc $content;
  my $received = POST_BODY $location, content => $content;
  
  ok $expected eq $received;
  
  
  
  
  1.25      +5 -5      modperl-2.0/t/response/TestAPI/request_rec.pm
  
  Index: request_rec.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/response/TestAPI/request_rec.pm,v
  retrieving revision 1.24
  retrieving revision 1.25
  diff -u -u -r1.24 -r1.25
  --- request_rec.pm	24 Jul 2004 00:54:02 -0000	1.24
  +++ request_rec.pm	24 Jul 2004 06:54:26 -0000	1.25
  @@ -1,7 +1,7 @@
   package TestAPI::request_rec;
   
   use strict;
  -use warnings FATAL => 'all';
  +use warnings;# FATAL => 'all';
   
   use Apache::Test;
   use Apache::TestUtil;
  @@ -54,13 +54,13 @@
   
       ok $r->proxyreq || 1;
   
  -    ok $r->header_only || 1;
  +    ok !$r->header_only;
   
       ok $r->protocol =~ /http/i;
   
       ok $r->proto_num;
   
  -    ok $r->hostname || 1;
  +    ok t_cmp $r->hostname, $r->get_server_name, "hostname";
   
       ok $r->request_time;
   
  @@ -154,8 +154,8 @@
       #per_dir_config
       #request_config
   
  -    #output_filters
  -    #input_filers
  +    # input_filters and output_filters are tested in
  +    # TestAPI::in_out_filters;
   
       #eos_sent
   
  
  
  
  1.1                  modperl-2.0/t/response/TestAPI/in_out_filters.pm
  
  Index: in_out_filters.pm
  ===================================================================
  package TestAPI::in_out_filters;
  
  # testing: $r->input_filters and $r->output_filters
  # it's possible to read a POST data and send a response body w/o using
  # $r->read/$r->print
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::RequestRec ();
  use Apache::RequestUtil ();
  
  use APR::Brigade ();
  use APR::Bucket ();
  use Apache::Filter ();
  
  use Apache::Const -compile => qw(OK DECLINED MODE_READBYTES);
  use APR::Const    -compile => qw(SUCCESS BLOCK_READ);
  
  use constant IOBUFSIZE => 8192;
  
  sub handler {
      my $r = shift;
  
      return Apache::DECLINED unless $r->method_number == Apache::M_POST;
  
      $r->content_type("text/plain");
  
      my $data = read_request_body($r);
      send_response_body($r, lc($data));
  
      Apache::OK;
  }
  
  
  sub send_response_body {
      my($r, $data) = @_;
  
      my $bb = APR::Brigade->new($r->pool,
                                 $r->connection->bucket_alloc);
  
      my $b = APR::Bucket->new($data);
      $bb->insert_tail($b);
      $r->output_filters->fflush($bb);
      $bb->destroy;
  }
  
  sub read_request_body {
      my $r = shift;
      my $debug = shift || 0;
  
      my $bb = APR::Brigade->new($r->pool,
                                 $r->connection->bucket_alloc);
  
      my $data = '';
      my $seen_eos = 0;
      my $count = 0;
      do {
          $r->input_filters->get_brigade($bb, Apache::MODE_READBYTES,
                                         APR::BLOCK_READ, IOBUFSIZE);
  
          $count++;
  
          warn "read_post: bb $count\n" if $debug;
  
          for (my $b = $bb->first; $b; $b = $bb->next($b)) {
              if ($b->is_eos) {
                  warn "read_post: EOS bucket:\n" if $debug;
                  $seen_eos++;
                  last;
              }
  
              if ($b->read(my $buf)) {
                  warn "read_post: DATA bucket: [$buf]\n" if $debug;
                  $data .= $buf;
              }
  
              $b->remove; # optimization to reuse memory
          }
  
      } while (!$seen_eos);
  
      $bb->destroy;
  
      return $data;
  }
  
  1;
  __END__