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/04/23 03:37:54 UTC
cvs commit: modperl-2.0/t/protocol/TestProtocol echo_block.pm echo_timeout.pm echo.pm
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;