cvs commit: modperl-2.0/t/protocol/TestProtocol echo_bbs.pm

[stas]

stas        2004/06/03 01:20:50

  Added:       t/protocol echo_bbs.t
               t/protocol/TestProtocol echo_bbs.pm
  Log:
  new test: test buckets manipulation inside the protocol handler
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/protocol/echo_bbs.t
  
  Index: echo_bbs.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Test;
  use Apache::TestUtil;
  use Apache::TestRequest ();
  
  my @test_strings = qw(hello world);
  
  plan tests => 1 + @test_strings;
  
  my $socket = Apache::TestRequest::vhost_socket('TestProtocol::echo_bbs');
  
  ok $socket;
  
  for (@test_strings) {
      print $socket "$_\n";
      chomp(my $reply = <$socket>||'');
      ok t_cmp(uc($_), $reply);
  }
  
  
  
  1.1                  modperl-2.0/t/protocol/TestProtocol/echo_bbs.pm
  
  Index: echo_bbs.pm
  ===================================================================
  package TestProtocol::echo_bbs;
  
  # this test is similar to TestProtocol::echo_filter, but performs the
  # manipulations on the buckets inside the connection handler, rather
  # then using filter
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Connection ();
  use APR::Socket ();
  use APR::Bucket ();
  use APR::Brigade ();
  use APR::Error ();
  
  use Apache::Const -compile => qw(OK MODE_GETLINE);
  use APR::Const    -compile => qw(SUCCESS EOF SO_NONBLOCK);
  
  sub handler {
      my $c = shift;
  
      # starting from Apache 2.0.49 several platforms require you to set
      # the socket to a blocking IO mode
      $c->client_socket->opt_set(APR::SO_NONBLOCK => 0);
  
      my $bb_in  = APR::Brigade->new($c->pool, $c->bucket_alloc);
      my $bb_out = APR::Brigade->new($c->pool, $c->bucket_alloc);
  
      while (1) {
          my $rc = $c->input_filters->get_brigade($bb_in,
                                                  Apache::MODE_GETLINE);
          if ($rc != APR::SUCCESS && $rc != APR::EOF) {
              my $error = APR::Error::strerror($rc);
              warn __PACKAGE__ . ": get_brigade: $error\n";
              last;
          }
  
          last if $bb_in->is_empty;
  
          while (!$bb_in->is_empty) {
              my $bucket = $bb_in->first;
  
              $bucket->remove;
  
              if ($bucket->is_eos) {
                  $bb_out->insert_tail($bucket);
                  last;
              }
  
              my $data = $bucket->read;
              if (length $data) {
                  last if $data =~ /^[\r\n]+$/;
                  $bucket = APR::Bucket->new(uc $data);
              }
  
              $bb_out->insert_tail($bucket);
          }
  
          $c->output_filters->fflush($bb_out);
      }
  
      $bb_in->destroy;
      $bb_out->destroy;
  
      Apache::OK;
  }
  
  1;