cvs commit: modperl-2.0/t/protocol/TestProtocol echo_block.pm echo_timeout.pm echo.pm

[stas]

stas        2004/04/22 18:37:54

  Added:       t/protocol echo_block.t echo_timeout.t
               t/protocol/TestProtocol echo_block.pm echo_timeout.pm
  Removed:     t/protocol echo.t
               t/protocol/TestProtocol echo.pm
  Log:
  split the TestProtocol::echo test in two, one to test blocking IO, the
  other non-blocking w timeout
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/protocol/echo_block.t
  
  Index: echo_block.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_block');
  
  ok $socket;
  
  for (@test_strings) {
      print $socket "$_\n";
      chomp(my $reply = <$socket>||'');
      ok t_cmp($_, $reply);
  }
  
  
  
  1.1                  modperl-2.0/t/protocol/echo_timeout.t
  
  Index: echo_timeout.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Test;
  use Apache::TestUtil;
  use Apache::TestRequest ();
  
  my @test_strings = qw(good bye cruel world);
  
  plan tests => 1 + @test_strings;
  
  my $socket = Apache::TestRequest::vhost_socket('TestProtocol::echo_timeout');
  
  ok $socket;
  
  for (@test_strings) {
      print $socket "$_\n";
      chomp(my $reply = <$socket>||'');
      ok t_cmp($_, $reply);
  }
  
  
  
  1.1                  modperl-2.0/t/protocol/TestProtocol/echo_block.pm
  
  Index: echo_block.pm
  ===================================================================
  package TestProtocol::echo_block;
  
  # this test reads from/writes to the socket doing blocking IO
  #
  # see TestProtocol::echo_timeout for how to do the same with
  # nonblocking IO but using the timeout
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Connection ();
  use APR::Socket ();
  
  use Apache::Const -compile => 'OK';
  use APR::Const    -compile => qw(SO_NONBLOCK);
  
  use constant BUFF_LEN => 1024;
  
  sub handler {
      my Apache::Connection $c = shift;
      my APR::Socket $socket = $c->client_socket;
  
      # make sure the socket is in the blocking mode for recv().
      # on some platforms (e.g. OSX/Solaris) httpd hands us a
      # non-blocking socket
      my $nonblocking = $socket->opt_get(APR::SO_NONBLOCK);
      if ($nonblocking) {
          $socket->opt_set(APR::SO_NONBLOCK => 0);
  
          # test that we really are in the non-blocking mode
          $socket->opt_get(APR::SO_NONBLOCK)
              or die "failed to set non-blocking mode";
      }
  
      my ($buff, $rlen, $wlen);
      for (;;) {
          $rlen = BUFF_LEN;
          $socket->recv($buff, $rlen);
          last if $rlen <= 0;
  
          $wlen = $rlen;
          $socket->send($buff, $wlen);
  
          last if $wlen != $rlen;
      }
  
      Apache::OK;
  }
  
  1;
  
  
  
  1.1                  modperl-2.0/t/protocol/TestProtocol/echo_timeout.pm
  
  Index: echo_timeout.pm
  ===================================================================
  package TestProtocol::echo_timeout;
  
  # this test reads from/writes to the socket doing nonblocking IO but
  # using the timeout
  #
  # see TestProtocol::echo_block for how to do the same with blocking IO
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Connection ();
  use APR::Socket ();
  
  use Apache::Const -compile => 'OK';
  use APR::Const    -compile => qw(TIMEUP);
  
  use constant BUFF_LEN => 1024;
  
  sub handler {
      my Apache::Connection $c = shift;
      my APR::Socket $socket = $c->client_socket;
  
      # set timeout (20 sec) so later we can do error checking on
      # read/write timeouts
      $socket->timeout_set(20_000_000);
  
      my ($buff, $rlen, $wlen, $rc);
      for (;;) {
          $rlen = BUFF_LEN;
          $rc = $socket->recv($buff, $rlen);
          die "timeout on socket read" if $rc == APR::TIMEUP;
          last if $rlen <= 0;
  
          $wlen = $rlen;
          $rc = $socket->send($buff, $wlen);
          die "timeout on socket write" if $rc == APR::TIMEUP;
  
          last if $wlen != $rlen;
      }
  
      Apache::OK;
  }
  
  1;