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

[dougm]

dougm       01/04/02 02:07:23

  Added:       t/protocol echo.t
               t/protocol/TestProtocol echo.pm
  Log:
  start of protocol module tests
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/protocol/echo.t
  
  Index: echo.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Test;
  use Apache::TestRequest ();
  
  my @test_strings = qw(hello world);
  
  plan tests => 1 + @test_strings;
  
  my $socket = Apache::TestRequest::vhost_socket('TestProtocol::echo');
  
  ok $socket;
  
  for (@test_strings) {
      print $socket "$_\n";
      chomp(my $reply = <$socket>);
      print "REPLY=`$reply'\n";
      ok $reply eq $_;
  }
  
  
  
  1.1                  modperl-2.0/t/protocol/TestProtocol/echo.pm
  
  Index: echo.pm
  ===================================================================
  package TestProtocol::echo;
  
  use strict;
  use Apache::Connection ();
  use APR::Socket ();
  
  use constant BUFF_LEN => 1024;
  
  sub handler {
      my Apache::Connection $c = shift;
      my APR::Socket $socket = $c->client_socket;
  
      my $buff;
  
      for (;;) {
          my($rlen, $wlen);
          my $rlen = BUFF_LEN;
          $socket->recv($buff, $rlen);
          last if $rlen <= 0;
          $wlen = $rlen;
          $socket->send($buff, $wlen);
          last if $wlen != $rlen;
      }
  
      return 0;
  }
  
  1;