X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FMsg.pm;h=33a0af80786bab83e44bf12b1bbc26324a1d1f97;hb=cace76c5873d6d58c4db43d5eb9b3d2e4107428f;hp=7114eba8b9eea3ad3e9133d921f162694fbb824b;hpb=2e16209416d1d189707935868a708b525c93097b;p=spider.git diff --git a/perl/Msg.pm b/perl/Msg.pm index 7114eba8..33a0af80 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -5,6 +5,9 @@ # # I have modified it to suit my devious purposes (Dirk Koopman G1TLH) # +# $Id$ +# + package Msg; require Exporter; @@ -64,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 { @@ -106,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)) { @@ -120,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 .. } @@ -162,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. @@ -274,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