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 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) {
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) {
sub new_client {
my $server_conn = shift;
my $sock = $server_conn->{sock}->accept();
- my $conn = $server_conn->new($server_conn->{rproc});
- $conn->{sock} = $sock;
- my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost} = $sock->peerhost(), $conn->{peerport} = $sock->peerport());
- $conn->{sort} = 'Incoming';
- if ($eproc) {
- $conn->{eproc} = $eproc;
- set_event_handler ($sock, error => $eproc);
+ if ($sock) {
+ my $conn = $server_conn->new($server_conn->{rproc});
+ $conn->{sock} = $sock;
+ my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost} = $sock->peerhost(), $conn->{peerport} = $sock->peerport());
+ $conn->{sort} = 'Incoming';
+ if ($eproc) {
+ $conn->{eproc} = $eproc;
+ set_event_handler ($sock, error => $eproc);
+ }
+ if ($rproc) {
+ $conn->{rproc} = $rproc;
+ my $callback = sub {$conn->_rcv};
+ set_event_handler ($sock, read => $callback);
+ } else { # Login failed
+ &{$conn->{eproc}}($conn, undef) if exists $conn->{eproc};
+ $conn->disconnect();
+ }
+ } else {
+ dbg('err', "Msg: error on accept ($!)");
}
- if ($rproc) {
- $conn->{rproc} = $rproc;
- my $callback = sub {$conn->_rcv};
- set_event_handler ($sock, read => $callback);
- } else { # Login failed
- &{$conn->{eproc}}($conn, undef) if exists $conn->{eproc};
- $conn->disconnect();
- }
}
sub close_server
}
}
+#
#----------------------------------------------------
# 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;