- Verification qu'une socket est bien connectée avant de la fermer,

  sinon Segmentation fault
- Amélioration mineures des commentaires

1 files changed, 54 insertions, 50 deletions

diff --git a/Ivy.pm b/Ivy.pm
index 29f135e..823f775 100644
--- a/Ivy.pm
+++ b/Ivy.pm
@@ -387,7 +387,7 @@ sub init
   }
 
  $SIG{'PIPE'} = 'IGNORE' ;
-}
+} # end init
 
 ############# METHODE DE CLASSE NEW
 sub new ($%) 
@@ -551,7 +551,7 @@ sub new ($%)
 
   
   return ($self);
-}
+} # end new
 
 ############### METHODE	IVY DESTROY
 sub DESTROY ($)
@@ -565,23 +565,28 @@ sub DESTROY ($)
     #      send ($fd, sprintf (MSG_FMT, BYE, 0, ""), 0) 
     #	or $self->_removeFileDescriptor ($fd);
     # the 2 previous lines seems to works with other ivy-perl applis
-    # but DONOT work with ivy-c api.
+    # but DO NOT work with ivy-c api.
     # the 2 next lines works. This has to been validated! CM 21/12/2000
-    send ($fd, sprintf (MSG_FMT, BYE, 0, ""), 0);
-    $self->_removeFileDescriptor ($fd);
-    print "";  # this line strangely avoids some bugs with perl-tk 800.024
+      if (defined $fd) {
+	  send ($fd, sprintf (MSG_FMT, BYE, 0, ""), 0);
+	  $self->_removeFileDescriptor ($fd);
+      }
   }
 
   #  on clot la socket de signalisation (UDP)
-  # print "DBG> fermeture de supSock\n";
-  $self->[supSock]->close() if $self->[supSock];
+  # print "DBG> fermeture de supSock ", $self->[supSock] ,"\n";
+  # the following test has been expanded to avoid some nasty bug
+  # which appeared when upgrading from perl-tk 800.023 to 800.024
+  $self->[supSock]->close() if ($self->[supSock] and $self->[supSock]->connected());
   delete $allBuses{$self};
 
   # on clot la socket de connection 
-  # print "DBG> fermeture de connSock\n";
-  $self->[connSock]->close() if  $self->[connSock];
+  # print "DBG> fermeture de connSock ", $self->[connSock], "\n";
+  # the following test has been expanded to avoid some nasty bug
+  # which appeared when upgrading from perl-tk 800.023 to 800.024
+  $self->[connSock]->close() if ($self->[connSock] and $self->[connSock]->connected());
   undef (@$self);
-}
+} # end DESTROY
 
 ############### METHODE DE CLASSE STOP
 sub stop ()
@@ -589,7 +594,7 @@ sub stop ()
   foreach my $bus (values %allBuses) {
     $bus->DESTROY();
   }  # pour toutes les connections
-}
+} # end stop
 
 
 ############## METHODE DE CLASSE EXIT
@@ -604,7 +609,7 @@ sub exit ()
   else {
     Tk::exit ();
   }
-}
+} # end exit
 
 ############### PROCEDURE	BUS START
 sub start
@@ -659,7 +664,7 @@ sub start
     &$fileEventFunc ($self->[connSock], [\&_getConnections, $self]) ;
 
    return $self;
-}
+} # end start
 
 	   
 ############### PROCEDURE	BIND REGEXP	   
@@ -721,7 +726,7 @@ sub bindRegexp
       }
     }
   }
-}
+} # end bindRegexp
 
 ############### METHODE	BIND REGEXP	   
 sub bindDirect 	   
@@ -737,7 +742,7 @@ sub bindDirect
     # on vire le callback
     undef $self->[directCbList][$id];
   }
-}
+} # end bindDirect
 	   
 ############### PROCEDURE	SEND MSGS	    
 sub sendMsgs
@@ -755,15 +760,15 @@ sub sendMsgs
       # pour routes les connections
       foreach my $fd (keys %{$self->[sockList]}) {
 
-      # pour toutes les fonctions de filtrage de regexp
-      foreach my $regexpFunc (@{$self->[sendRegList]{$fd}}) {
-	$total += &{$regexpFunc} (\$msg) if defined $regexpFunc;
+	  # pour toutes les fonctions de filtrage de regexp
+	  foreach my $regexpFunc (@{$self->[sendRegList]{$fd}}) {
+	      $total += &{$regexpFunc} (\$msg) if defined $regexpFunc;
+	  }
       }
-    }
   }
   #    print "DBG> sended $total times\n";
   return $total;
-}
+} # end sendMsgs
 
 ############### PROCEDURE	SEND MSGS	    
 sub sendAppNameMsgs
@@ -779,7 +784,7 @@ sub sendAppNameMsgs
     my $msg = "$self->[appName] $_";
     study ($msg);
 
-    # pour routes les connections
+    # pour toutes les connections
     foreach my $fd (keys %{$self->[sockList]}) {
 
       # pour toutes les fonctions de filtrage de regexp
@@ -790,7 +795,7 @@ sub sendAppNameMsgs
   }
   #    print "DBG> sended $total times\n";
   return $total;
-}
+} # end sendAppNameMsgs
 
 
 
@@ -818,7 +823,7 @@ sub sendDirectMsgs
     carp "Warning in Ivy::sendDirectMsgs, application $to_appli unknown";
     return 0;
   }
-}
+} # end sendDirectMsgs
 
 
 ############### METHOD	SEND DIE TO	    
@@ -844,7 +849,7 @@ sub sendDieTo
     carp "Warning in Ivy::sendDieTo, application '$to_appli' is unknown" if $^W;
     return 0;
   }
-}
+} # end sendDieTo
 
 
 ############### METHOD	PING    
@@ -868,7 +873,7 @@ sub ping
     carp "Warning in Ivy::ping, application '$to_appli' is unknown" if $^W;
     return 0;
   }
-}
+} # end ping
 
 ###############   METHODE     MAINLOOP
 sub mainLoop ()
@@ -892,9 +897,8 @@ sub mainLoop ()
       }
     }
   }
-}
+} # end mainLoop
 
-#sub MainLoop () { mainLoop ();} # Alias pour avoir la meme syntaxe que Tk
 
 ############### METHODE	AFTER	
 sub after ($$;$)
@@ -914,7 +918,7 @@ sub after ($$;$)
 			    timeofday()+$timeAfter, $cbListRef];
 
   return ($afterId);
-}
+} # end after
 
 ############### METHODE	REPEAT
 sub repeat ($$;$)
@@ -932,7 +936,7 @@ sub repeat ($$;$)
   $afterList{++$afterId}= [REPEAT, $timeAfter, timeofday()+$timeAfter, 
 			   $cbListRef];
   return ($afterId);
-}
+} # end repeat
 
 ############### METHODE	AFTER CANCEL	
 sub afterCancel ($;$)
@@ -958,7 +962,7 @@ sub afterCancel ($;$)
       delete $afterList{$id} ;
     }
   }
-}
+} # end afterCancel
 
 ############### METHODE AFTER RESET TIMER
 # permet de gérer des timout plus facilement en permettant de
@@ -975,7 +979,7 @@ sub afterResetTimer ($;$)
   if (defined ($id) && defined $afterList{$id}) {
     $afterList{$id}->[2] = $afterList{$id}->[1] + timeofday();
   }
-}
+} # end afterResetTimer
 
 
 ############### METHODE	FILE EVENT 	
@@ -1003,7 +1007,7 @@ sub fileEvent ($$;$)
 #    print ("DBG: Ivy::fileEvent : removing fd from the select\n");
     $localLoopSel->remove ($fd);
   }
-}
+} # end fileEvent
 
 #############################################################################
 ####                     METHODES       PRIVEES                       #####
@@ -1097,7 +1101,7 @@ sub _getBonjour ($)
     carp "Warning in Ivy::_getBonjour, connection to " .
       "$peerName:$peerPort is impossible" ;
   }
-}
+} # end _getBonjour
 
 
 ############### PROCEDURE	GET CONNECTIONS
@@ -1127,7 +1131,7 @@ sub _getConnections ($)
   $self->[sockList]{$appSock} = $appSock;
   # on balance les regexps qui nous interessent a l'appli distante
   $self->_sendWantedRegexp ($appSock);
-}
+} # end _getConnections
 
 
 ############### METHODE	GET MESSAGES
@@ -1344,7 +1348,7 @@ _EOL_
       }
     } 
     return 0;
-  }
+} # end _getMessages
 
 ############### METHODE	SEND WANTED REGEXP	
 sub _sendWantedRegexp ($$)
@@ -1368,7 +1372,7 @@ sub _sendWantedRegexp ($$)
   # on envoie le message de fin d'envoi de regexps
   send ($appSock, sprintf (MSG_FMT, ENDREGEXP, 0, ""), 0)  
     or $self->_removeFileDescriptor ($appSock) ;
-}
+} # end _sendWantedRegexp
 
 ############### METHODE	SEND LAST REGEXP TO ALLREADY CONNECTED
 sub _sendLastRegexpToAllreadyConnected ($$)
@@ -1379,7 +1383,7 @@ sub _sendLastRegexpToAllreadyConnected ($$)
     send ($fd, sprintf (MSG_FMT, REGEXP, $id, $self->[recCbList][$id]->[0]), 
 	  0) or $self->_removeFileDescriptor ($fd) ;
   }
-}
+} # end _sendLastRegexpToAllreadyConnected
 
 ############### METHODE	INET ADR BY NAME
 sub _inetAdrByName ($$) {
@@ -1396,7 +1400,7 @@ sub _inetAdrByName ($$) {
   print "$addr,$port\n";
   my $host = (gethostbyaddr ($addr, AF_INET))[0] ;
   return "$host:$port";
-}
+} # end _inetAdrByName
 
 
 ############### PROCEDURE	REMOVE FILE DESCRIPTOR
@@ -1460,7 +1464,7 @@ sub _removeFileDescriptor ($$)
   my $addr = substr ($addrInet,0,4);
   my $host = (gethostbyaddr ($addr, AF_INET))[0] ;
   $self->_scanConnStatus ($diedAppName, "died", $host) ;
-}
+} # end _removeFileDescriptor
 
 
 ############### METHODE	SEND ERROR TO
@@ -1470,7 +1474,7 @@ sub _sendErrorTo ($$$)
   
   send ($fd, join (' ', ERROR, "0\002$error\n"), 0) 
     or $self->_removeFileDescriptor ($fd);
-}
+} # end _sendErrorTo
 
 
 ############### METHODE	PONG
@@ -1480,7 +1484,7 @@ sub _pong ($$)
 
   send ($fd, join (' ', PONG, "0\002 \n"), 0) 
     or $self->_removeFileDescriptor ($fd);
-}
+} # end _pong
 
 
 ############### METHODE	SEND ERROR TO
@@ -1490,7 +1494,7 @@ sub _sendDieTo ($$)
   
   send ($fd, join (' ', DIE, "0\002\n"), 0) 
     or $self->_removeFileDescriptor ($fd);
-}
+} # end _sendDieTo
 
 
 ############### METHODE	SEND MSG TO
@@ -1502,7 +1506,7 @@ sub _sendMsgTo ($$$)
   foreach my $regexpFunc (@{$self->[sendRegList]{$fd}}) {
     &{$regexpFunc} (\$msg) if defined $regexpFunc;
   }
-}
+} # end _sendMsgTo
 
 
 ############### PROCEDURE TK FILE EVENT	
@@ -1511,7 +1515,7 @@ sub _tkFileEvent ($$)
   my ($fd, $cb) = @_;
     
   Tk::fileevent ('', $fd, 'readable', $cb) ;
-}
+} # end _tkFileEvent
 
 
 ############### PROCEDURE SCAN AFTER
@@ -1546,7 +1550,7 @@ sub _scanAfter ()
       $selectTimout = $timeTotrigg if $timeTotrigg < $selectTimout;
     }
   }
-}
+} # end _scanAfter
 
 
 ############### METHODE	SCAN CONN STATUS	
@@ -1573,7 +1577,7 @@ sub _scanConnStatus ($$$$)
   # de facon a detecter plus facilement quand il y a trop d'applis
   # de meme nom sur le meme bus.
   &{$self->[statusFunc]} ([keys %readyApp], \@nonReadyApp, \%readyApp, $appname, $status, $addr);
-}
+} # end _scanConnStatus
 
 
 ############### METHODE	TO BE PRUNED
@@ -1618,7 +1622,7 @@ sub _toBePruned ($$$)
     #print "DBG> on garde de $from : $regexp\n";
     return (0);
   }
-}
+} # end _toBePruned
 
 
 ############### PROCEDURE PARSE IVY BUS PARAM
@@ -1689,7 +1693,7 @@ sub _parseIvyBusParam ($)
   }
 
   return ($ivyPort, \@ivyAddrInet);
-}
+} # end _parseIvyBusParam
   
 ############# Procedure _SUBSTITUTE ESCAPED CHAR
 sub _substituteEscapedChar ($$)
@@ -1704,7 +1708,7 @@ sub _substituteEscapedChar ($$)
 
   $reg =~ s/\\([wWsSdDne])/$escapeRegexp{$1}/ge;
   return $reg;
-}
+} # end _substituteEscapedChar
 
 1;