X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FMsg.pm;h=815937963962169d8fb2e4d8e0808cb8675bc2a4;hb=3f64c5686df118fa3f3a1d66a87f25b89eb1732a;hp=aa5edc48bd4a8ba454005f3ff8c3e5df5f8fc7cf;hpb=503b6b1f503860def06f4e2121b0367e856081cd;p=spider.git diff --git a/perl/Msg.pm b/perl/Msg.pm index aa5edc48..81593796 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -32,8 +32,9 @@ BEGIN { eval { require POSIX; POSIX->import(qw(O_NONBLOCK F_SETFL F_GETFL)) }; - if ($@) { + if ($@ || $main::is_win) { print STDERR "POSIX Blocking *** NOT *** supported $@\n"; + $blocking_supported = 0; } else { $blocking_supported = 1; print STDERR "POSIX Blocking enabled\n"; @@ -72,9 +73,9 @@ sub new csort => 'telnet', timeval => 60, blocking => 0, + cnum => ++$noconns, }; - $noconns++; dbg('connll', "Connection created ($noconns)"); return bless $conn, $class; } @@ -120,7 +121,7 @@ sub conns confess "changing $pkg->{call} to $call" if exists $pkg->{call} && $call ne $pkg->{call}; $pkg->{call} = $call; $ref = $conns{$call} = $pkg; - dbg('connll', "Connection $call stored"); + dbg('connll', "Connection $pkg->{cnum} $call stored"); } else { $ref = $conns{$call}; } @@ -193,9 +194,9 @@ sub disconnect { delete $conns{$call} if $ref && $ref == $conn; } $call ||= 'unallocated'; - dbg('connll', "Connection $call disconnected"); + dbg('connll', "Connection $conn->{cnum} $call disconnected"); - unless ($^O =~ /^MS/i) { + unless ($main::is_win) { kill 'TERM', $conn->{pid} if exists $conn->{pid}; } @@ -271,7 +272,10 @@ sub _send { $conn->disconnect; return 0; # fail. Message remains in queue .. } - } + } elsif (isdbg('raw')) { + my $call = $conn->{call} || 'none'; + dbgdump('raw', "$call send $bytes_written: ", $msg); + } $offset += $bytes_written; $bytes_to_write -= $bytes_written; } @@ -373,6 +377,10 @@ sub _rcv { # Complement to _send if (defined ($bytes_read)) { if ($bytes_read > 0) { $conn->{msg} .= $msg; + if (isdbg('raw')) { + my $call = $conn->{call} || 'none'; + dbgdump('raw', "$call read $bytes_read: ", $msg); + } } } else { if (_err_will_block($!)) { @@ -481,7 +489,7 @@ sub event_loop { # Quit the loop if no handles left to process last unless ($rd_handles->count() || $wt_handles->count()); - ($rset, $wset) = IO::Select->select($rd_handles, $wt_handles, $er_handles, $timeout); + ($rset, $wset, $eset) = IO::Select->select($rd_handles, $wt_handles, $er_handles, $timeout); foreach $e (@$eset) { &{$er_callbacks{$e}}($e) if exists $er_callbacks{$e}; @@ -514,7 +522,9 @@ sub DESTROY { my $conn = shift; my $call = $conn->{call} || 'unallocated'; - dbg('connll', "Connection $call being destroyed ($noconns)"); + my $host = $conn->{peerhost} || ''; + my $port = $conn->{peerport} || ''; + dbg('connll', "Connection $conn->{cnum} $call [$host $port] being destroyed"); $noconns--; }