alter changing %conns callsign logic slightly

[spider.git] / perl / Msg.pm

diff --git a/perl/Msg.pm b/perl/Msg.pm
index aa5edc48bd4a8ba454005f3ff8c3e5df5f8fc7cf..0e6ee9661c07abd36053f5a1ef1032db739f1d43 100644 (file)
--- 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;
 }
@@ -117,10 +118,11 @@ sub conns
        if (ref $pkg) {
                $call = $pkg->{call} unless $call;
                return undef unless $call;
-               confess "changing $pkg->{call} to $call" if exists $pkg->{call} && $call ne $pkg->{call};
+               dbg('connll', "changing $pkg->{call} to $call") if exists $pkg->{call} && $call ne $pkg->{call};
+               delete $conns{$pkg->{call}} if $pkg->{call} ne $call; 
                $pkg->{call} = $call;
                $ref = $conns{$call} = $pkg;
-               dbg('connll', "Connection $call stored");
+               dbg('connll', "Connection $pkg->{cnum} $call stored");
        } else {
                $ref = $conns{$call};
        }
@@ -133,9 +135,9 @@ sub pid_gone
        my ($pkg, $pid) = @_;
        
        my @pid = grep {$_->{pid} == $pid} values %conns;
-       for (@pid) {
-               &{$_->{eproc}}($_, "$pid has gorn") if exists $_->{eproc};
-               $_->disconnect;
+       foreach my $p (@pid) {
+               &{$p->{eproc}}($p, "$pid has gorn") if exists $p->{eproc};
+               $p->disconnect;
        }
 }
 
@@ -193,9 +195,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 +273,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 +378,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($!)) {
@@ -428,8 +437,8 @@ sub close_server
 # close all clients (this is for forking really)
 sub close_all_clients
 {
-       for (values %conns) {
-               $_->disconnect;
+       foreach my $conn (values %conns) {
+               $conn->disconnect;
        }
 }
 
@@ -481,7 +490,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 +523,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--;
 }