X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FMsg.pm;h=33a0af80786bab83e44bf12b1bbc26324a1d1f97;hb=cace76c5873d6d58c4db43d5eb9b3d2e4107428f;hp=20e000334ca5d72d103d51e63f17694ea643bc88;hpb=0017002e2dc438d49fcc090dc99b6d22f7037aa7;p=spider.git diff --git a/perl/Msg.pm b/perl/Msg.pm index 20e00033..33a0af80 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -67,7 +67,8 @@ sub disconnect { my $sock = delete $conn->{sock}; return unless defined($sock); set_event_handler ($sock, "read" => undef, "write" => undef); - close($sock); + shutdown($sock, 3); + close($sock); } sub send_now { @@ -109,9 +110,11 @@ sub _send { while (@$rq) { my $msg = $rq->[0]; - my $bytes_to_write = length($msg) - $offset; + my $mlth = length($msg); + my $bytes_to_write = $mlth - $offset; my $bytes_written = 0; - while ($bytes_to_write) { + confess("Negative Length! msg: '$msg' lth: $mlth offset: $offset") if $bytes_to_write < 0; + while ($bytes_to_write > 0) { $bytes_written = syswrite ($sock, $msg, $bytes_to_write, $offset); if (!defined($bytes_written)) { @@ -123,6 +126,7 @@ sub _send { # be called back eventually, and will resume sending return 1; } else { # Uh, oh + delete $conn->{send_offset}; $conn->handle_send_err($!); return 0; # fail. Message remains in queue .. } @@ -165,6 +169,7 @@ sub set_blocking { fcntl ($_[0], F_SETFL(), $flags); } } + sub handle_send_err { # For more meaningful handling of send errors, subclass Msg and # rebless $conn. @@ -277,6 +282,13 @@ sub _new_client { } } +sub close_server +{ + set_event_handler ($main_socket, "read" => undef); + $main_socket->close; + $main_socket = 0; +} + #---------------------------------------------------- # Event loop routines used by both client and server