changeset 279:c754b1c79efe

Tests: better timeout handling in proxy_upgrade.t. Now it uses nonblocking IO instead of eval + alarm model, and properly handles write timeouts as well as read ones.
author Maxim Dounin <mdounin@mdounin.ru>
date Mon, 15 Apr 2013 22:43:51 +0000
parents b6f0537afa01
children 3dd8c7acf3ad
files proxy_upgrade.t
diffstat 1 files changed, 35 insertions(+), 14 deletions(-) [+]
line wrap: on
line diff
--- a/proxy_upgrade.t
+++ b/proxy_upgrade.t
@@ -147,7 +147,7 @@ sub upgrade_connect {
 	local $SIG{PIPE} = 'IGNORE';
 
 	log_out($buf);
-	$s->print($buf);
+	$s->syswrite($buf);
 
 	# read response
 
@@ -174,27 +174,48 @@ sub upgrade_connect {
 
 sub upgrade_getline {
 	my ($s) = @_;
-	my $buf;
+	my ($h, $buf, $line);
 
-	eval {
-		local $SIG{ALRM} = sub { die "timeout\n"; };
-		alarm(2);
-		$buf = $s->getline();
-		alarm(0);
-	};
-	alarm(0);
+	${*$s}->{_upgrade_private} ||= { b => ''};
+	$h = ${*$s}->{_upgrade_private};
 
-	if ($@) {
-		log_in("died: $@");
-		return undef;
+	if ($h->{b} =~ /^(.*?\x0a)(.*)/ms) {
+		$h->{b} = $2;
+		return $1;
 	}
 
-	return $buf;
+	$s->blocking(0);
+	while (IO::Select->new($s)->can_read(1.5)) {
+		my $n = $s->sysread($buf, 1024);
+		last unless $n;
+
+		$h->{b} .= $buf;
+
+		if ($h->{b} =~ /^(.*?\x0a)(.*)/ms) {
+			$h->{b} = $2;
+			return $1;
+		}
+	};
 }
 
 sub upgrade_write {
 	my ($s, $message) = @_;
-	$s->print($message . CRLF);
+
+	$message = $message . CRLF;
+
+	local $SIG{PIPE} = 'IGNORE';
+
+	$s->blocking(0);
+	while (IO::Select->new($s)->can_write(1.5)) {
+		my $n = $s->syswrite($message);
+		last unless $n;
+		$message = substr($message, $n);
+		last unless length $message;
+	}
+
+	if (length $message) {
+		$s->close();
+	}
 }
 
 sub upgrade_read {