perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/t/protocol/TestProtocol eliza.pm
Date Thu, 06 Sep 2001 02:45:13 GMT
stas        01/09/05 19:45:13

  Added:       t/protocol eliza.t
               t/protocol/TestProtocol eliza.pm
  Log:
  now we have our own Rogerian psychotherapist overlooking our test suite :)
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/protocol/eliza.t
  
  Index: eliza.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestRequest ();
  
  my @test_strings = ('Hello Eliza', 
                      'How are you', 
                      'Why do I have core dumped?', 
                      'I feel like writing some tests today, you?',
                      'good bye');
  
  plan tests => 1 + @test_strings, test_module 'Chatbot::Eliza';
  
  my $socket = Apache::TestRequest::vhost_socket('TestProtocol::eliza');
  
  ok $socket;
  
  for (@test_strings) {
      print "SEND ='$_'\n";
      print $socket "$_\n";
      chomp(my $reply = <$socket>);
      print "REPLY='$reply'\n";
      ok $reply;
  }
  
  
  
  1.1                  modperl-2.0/t/protocol/TestProtocol/eliza.pm
  
  Index: eliza.pm
  ===================================================================
  package TestProtocol::eliza;
  
  use strict;
  use Apache::Connection ();
  use APR::Socket ();
  require Chatbot::Eliza;
  
  use constant BUFF_LEN => 1024;
  my $mybot = new Chatbot::Eliza;
  
  sub handler {
      my Apache::Connection $c = shift;
      my APR::Socket $socket = $c->client_socket;
  
      my $buff;
      my $last = 0;
      for (;;) {
          my($rlen, $wlen);
          my $rlen = BUFF_LEN;
          $socket->recv($buff, $rlen);
          last if $rlen <= 0;
          $last++ if $buff eq 'good bye';
          $buff = $mybot->transform( $buff ) . "\n";
          $socket->send($buff, length $buff);
          last if $last;
      }
  
      return 0;
  }
  
  1;
  
  
  

Mime
View raw message