use IO::Socket;
use DXDebug;
use Timer;
-use Errno qw(EWOULDBLOCK EAGAIN EINPROGRESS);
-use POSIX qw(F_GETFL F_SETFL O_NONBLOCK);
use vars qw(%rd_callbacks %wt_callbacks %er_callbacks $rd_handles $wt_handles $er_handles $now %conns $noconns);
BEGIN {
# Checks if blocking is supported
eval {
- require POSIX; POSIX->import(qw (F_SETFL O_NONBLOCK));
+ require POSIX; POSIX->import(qw (F_SETFL F_GETFL O_NONBLOCK));
};
$blocking_supported = 1 unless $@;
+
+ # import as many of these errno values as are available
+ eval {
+ require Errno; Errno->import(qw(EAGAIN EINPROGRESS EWOULDBLOCK));
+ };
}
my $w = $^W;
lineend => "\r\n",
csort => 'telnet',
timeval => 60,
+ blocking => 0,
};
$noconns++;
my $proto = getprotobyname('tcp');
$sock->socket(AF_INET, SOCK_STREAM, $proto) or return undef;
- blocking($sock, 0);
+ if ($conn->{blocking}) {
+ blocking($sock, 0);
+ $conn->{blocking} = 0;
+ }
+
my $ip = gethostbyname($to_host);
# my $r = $sock->connect($to_port, $ip);
my $r = connect($sock, pack_sockaddr_in($to_port, $ip));
- return undef unless $r || _err_will_block($r);
+ return undef unless $r || _err_will_block($!);
$conn->{sock} = $sock;
# return to the event loop only after every message, or if it
# is likely to block in the middle of a message.
- blocking($sock, $flush);
+ if ($conn->{blocking} != $flush) {
+ blocking($sock, $flush);
+ $conn->{blocking} = $flush;
+ }
my $offset = (exists $conn->{send_offset}) ? $conn->{send_offset} : 0;
while (@$rq) {
1; # Success
}
+sub dup_sock
+{
+ my $conn = shift;
+ my $oldsock = $conn->{sock};
+ my $rc = $rd_callbacks{$oldsock};
+ my $wc = $wt_callbacks{$oldsock};
+ my $ec = $er_callbacks{$oldsock};
+ my $sock = $oldsock->new_from_fd($oldsock, "w+");
+ if ($sock) {
+ set_event_handler($oldsock, read=>undef, write=>undef, error=>undef);
+ $conn->{sock} = $sock;
+ set_event_handler($sock, read=>$rc, write=>$wc, error=>$ec);
+ $oldsock->close;
+ }
+}
+
sub _err_will_block {
return 0 unless $blocking_supported;
return ($_[0] == $eagain || $_[0] == $ewouldblock || $_[0] == $einprogress);
return unless defined($sock);
my @lines;
- blocking($sock, 0);
+ if ($conn->{blocking}) {
+ blocking($sock, 0);
+ $conn->{blocking} = 0;
+ }
$bytes_read = sysread ($sock, $msg, 1024, 0);
if (defined ($bytes_read)) {
if ($bytes_read > 0) {
}
}
+#
#----------------------------------------------------
# Event loop routines used by both client and server
}
}
+sub sleep
+{
+ my ($pkg, $interval) = @_;
+ my $now = time;
+ while (time - $now < $interval) {
+ $pkg->event_loop(10, 0.01);
+ }
+}
+
sub DESTROY
{
my $conn = shift;