diff options
| -rw-r--r-- | Ivy.pm | 104 |
1 files changed, 54 insertions, 50 deletions
@@ -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; |