From 8681c365e13d601ae10ee2a24021f6e4552582cf Mon Sep 17 00:00:00 2001 From: mertz Date: Fri, 7 Jun 2002 16:37:43 +0000 Subject: - ivy-perl does no more allow subscription to illformed regular expressions as for example 'zaza (' or '*' - ivy-perl is now tolerant to illformed regular expressions subscribed by other agent on the bus - ivy-perl warn you when a message containing a \n is send. This is because the \n is currently the message separator - with the statusfunc, it is now possible to know every regexp subscribed / unsubscribed by other agents - the ivyprobe.pl application now displays all subscriptions / unsubscriptions. It also allows unsubscription - when a die message is issued with an unknown agentName, Ivy warn you correctly - man pages enhancements --- Ivy.pm | 170 +++++++++++++++++++++++++++++++++-------------------------------- 1 file changed, 87 insertions(+), 83 deletions(-) diff --git a/Ivy.pm b/Ivy.pm index e05ac3e..4411da9 100644 --- a/Ivy.pm +++ b/Ivy.pm @@ -38,7 +38,7 @@ use Sys::Hostname; use IO::Socket; use strict; use Time::Gettimeofday; - +use Carp; use vars qw($VERSION); @@ -273,25 +273,25 @@ my %allBuses = (); #### ##### #### ##### ############################################################################# -use constant servPort => $constantIndexer++; -use constant neededApp => $constantIndexer++; -use constant statusFunc => $constantIndexer++; -use constant supSock => $constantIndexer++; -use constant connSock => $constantIndexer++; -use constant sockList => $constantIndexer++; -use constant threadList => $constantIndexer++; -use constant appliList => $constantIndexer++; -use constant sendRegList => $constantIndexer++; -use constant sendRegListSrc => $constantIndexer++; -use constant topicRegexps => $constantIndexer++; -use constant recCbList => $constantIndexer++; -use constant directCbList => $constantIndexer++; -use constant cnnxion => $constantIndexer++; +use constant servPort => $constantIndexer++; +use constant neededApp => $constantIndexer++; +use constant statusFunc => $constantIndexer++; +use constant supSock => $constantIndexer++; +use constant connSock => $constantIndexer++; +use constant sockList => $constantIndexer++; +use constant threadList => $constantIndexer++; +use constant appliList => $constantIndexer++; +use constant sendRegList => $constantIndexer++; +use constant sendRegListSrc => $constantIndexer++; +use constant topicRegexps => $constantIndexer++; +use constant recCbList => $constantIndexer++; +use constant directCbList => $constantIndexer++; +use constant cnnxion => $constantIndexer++; use constant buffByConn => $constantIndexer++; -use constant broadcastPort => $constantIndexer++; -use constant broadcastBuses => $constantIndexer++; -use constant appName => $constantIndexer++; -use constant messWhenReady => $constantIndexer++; +use constant broadcastPort => $constantIndexer++; +use constant broadcastBuses => $constantIndexer++; +use constant appName => $constantIndexer++; +use constant messWhenReady => $constantIndexer++; ############################################################################# #### METHODES PUBLIQUES ##### @@ -332,7 +332,7 @@ sub init # fonction de cb appelee lorsque l'appli a recu l'ordre # de quitter, on peut dans ce callback fermer # proprement les ressources avant de sortir. - # ps : ne pas fasire d'exit dans le callback, + # ps : ne pas faire d'exit dans le callback, # c'est le bus qui s'en charge -pruneRegexp => [], @@ -341,7 +341,7 @@ sub init # et les regexps qui ne matchent pas # ces sujets sont eliminees. ) ; - + # on examine toutes les options possibles foreach my $opt (keys %optionsAndDefaults) { # si un parametre a ete fourni, ignorer les valeurs par defaut @@ -351,17 +351,17 @@ sub init $options{$opt} = $optionsAndDefaults{$opt} ; # sinon, on jette l'eponge } else { - die "Error in Ivy::init: option $opt is mandatory\n"; + croak "Error in Ivy::init: option $opt is mandatory\n"; } } - + # on examine toutes les options fournies, pour detecter les inutiles foreach my $opt (keys %options) { unless (exists ($optionsAndDefaults{$opt})) { - warn "Warning in Ivy::init: option $opt is unknown\n"; + carp "Warning in Ivy::init: option $opt is unknown"; } } - + my $loopMode = $options{-loopMode}; $ivyBus = $options{-ivyBus}; $appName = $options{-appName} ; @@ -383,7 +383,7 @@ sub init $fileEventFunc = \&_tkFileEvent ; } else { - die "Error in Ivy::init, argument loopMode must be either TK or LOCAL\n"; + croak "Error in Ivy::init, argument loopMode must be either TK or LOCAL\n"; } $SIG{'PIPE'} = 'IGNORE' ; @@ -399,7 +399,7 @@ sub new ($%) # on verifie que la methode de classe init ait ete appelee unless ((defined $appName) && ($appName ne '')) { - die "Error in Ivy::new, you should have called Ivy->init () first."; + croak "Error in Ivy::new, you should have called Ivy->init () first."; } # No de port tcp du serveur @@ -442,7 +442,7 @@ sub new ($%) $self->[sendRegList] = {}; # tableau ass de liste du type - # sockId => "regexp" + # sockId => ["regexp"...] # pour connaitre la valeur des regexp meme apres compilation $self->[sendRegListSrc] = {}; @@ -527,14 +527,14 @@ sub new ($%) $options{$opt} = $optionsAndDefaults{$opt} ; # sinon, on jette l'eponge } else { - die "Error in Ivy::new: option $opt is mandatory\n"; + croak "Error in Ivy::new: option $opt is mandatory\n"; } } # on examine toutes les options fournies, pour detecter les inutiles foreach my $opt (keys %options) { unless (exists ($optionsAndDefaults{$opt})) { - warn "Warning in Ivy::new, option $opt is unknown\n"; + carp "Warning in Ivy::new, option $opt is unknown"; } } @@ -558,7 +558,6 @@ sub DESTROY ($) { my $self = shift; return unless exists $allBuses{$self}; - # print ("DBG DESTROY appele sur l'objet $self\n"); # pour toutes les connections @@ -570,6 +569,7 @@ sub DESTROY ($) # 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 } # on clot la socket de signalisation (UDP) @@ -650,7 +650,7 @@ sub start foreach my $netBroadcastAddr (@{$self->[broadcastBuses]}) { send ($self->[supSock], $bonjourMsg, 0, $netBroadcastAddr) or - warn "Warning in Ivy::start, broadcast of Hello message failed: $!\n"; + carp "Warning in Ivy::start, broadcast of Hello message failed: $!"; } # callback pour traiter la reception des bonjours &$fileEventFunc ($self->[supSock], [\&_getBonjour, $self]) ; @@ -686,7 +686,7 @@ sub bindRegexp # print ("DBG regexp = $regexp\n"); eval {my $test = "a" =~ /$regexp/ } ; # testing the regexp for avoiding - if ($@) { warn "Warning in Ivy::bindRegexp, ill-formed regexp: '$original_regexp'" ; return }; + if ($@) { carp "Warning in Ivy::bindRegexp, ill-formed regexp: '$original_regexp'" ; return }; if ($cb) { my $id; @@ -748,8 +748,8 @@ sub sendMsgs # pour tous les messages foreach my $msg (@msgs) { - warn "Warning in Ivy::sendMsgs, a message contains a '\\n'. Skipping it:\n'$msg'\n" if ($msg =~ /\n/); - + carp "Warning in Ivy::sendMsgs, a message contains a '\\n'. You should correct it:\n'$msg'" if ($msg =~ /\n/) ; + study ($msg); # pour routes les connections @@ -774,7 +774,7 @@ sub sendAppNameMsgs # pour tous les messages foreach (@msgs) { - warn "Warning in Ivy::sendAppNameMsgs, a message contains a '\\n'. Skipping it:\n'$_'\n" if ($_ =~ /\n/); + carp "Warning in Ivy::sendAppNameMsgs, a message contains a '\\n'. Skipping it:\n'$_'" if ($_ =~ /\n/); my $msg = "$self->[appName] $_"; study ($msg); @@ -804,7 +804,7 @@ sub sendDirectMsgs my @fds = @{$self->[appliList]{$to}}; # pour tous les messages foreach my $msg (@msgs) { - warn "Warning in Ivy::sendDirectMsgs, a message contains a '\\n'. Skipping it:\n'$msg'\n" if ($msg =~ /\n/); + carp "Warning in Ivy::sendDirectMsgs, a message contains a '\\n'. Skipping it:\n'$msg'" if ($msg =~ /\n/); foreach my $fd (@fds) { send ($fd, sprintf (MSG_FMT, DIRECT_MSG, $id, "$msg"), 0) @@ -813,7 +813,7 @@ sub sendDirectMsgs } return 1; } else { - warn "Warning in Ivy::sendDirectMsgs, application $to unknown\n"; + carp "Warning in Ivy::sendDirectMsgs, application $to unknown"; return 0; } } @@ -824,11 +824,11 @@ sub sendDieTo { my $self = ref($_[0]) eq __PACKAGE__ ? shift : $globalIvy; my ($to) = @_; - - if (defined ($self->[appliList]{$to})) { + + if (defined $to and defined $self->[appliList]{$to}) { my @fds = @{$self->[appliList]{$to}}; - warn "Attention : Ivy::sendDieTo gros BUG \@fds est vide \n" + carp "Attention : in Ivy::sendDieTo big BUG \@fds is empty" if (scalar (@fds) == 0); # pour tous les messages @@ -838,7 +838,8 @@ sub sendDieTo return 1; } else { - warn "Warning in Ivy::sendDieTo, application $to is unknown\n" if $^W; + my $to_appli = (defined $to) ? $to : ''; + carp "Warning in Ivy::sendDieTo, application '$to_appli' is unknown" if $^W; return 0; } } @@ -865,7 +866,7 @@ sub ping ############### METHODE MAINLOOP sub mainLoop () { - die "Error in Ivy::mainLoop, Ivy should have been initialised with LOCAL loop mode \n" + croak "Error in Ivy::mainLoop, Ivy should have been initialised with LOCAL loop mode \n" unless defined $localLoopSel; my ($fd, @ready, @allDesc); @@ -885,7 +886,8 @@ sub mainLoop () } } } - + +#sub MainLoop () { mainLoop ();} # Alias pour avoir la meme syntaxe que Tk ############### METHODE AFTER sub after ($$;$) @@ -981,7 +983,7 @@ sub fileEvent ($$;$) unless (defined $localLoopSel) { - die ("Error in Ivy::fileEvent, Ivy should have been initialised in LOCAL loop mode\n"); + croak ("Error in Ivy::fileEvent, Ivy should have been initialised in LOCAL loop mode\n"); } if ($cb) { @@ -1012,7 +1014,7 @@ sub _getBonjour ($) my $inetAddr = $self->[supSock]->recv ($bonjourMsg, 1024, 0); unless (length $inetAddr) { - warn "Warning in Ivy::_getBonjour, recv error, Hello message discarded\n"; + carp "Warning in Ivy::_getBonjour, recv error, Hello message discarded"; return; } @@ -1024,14 +1026,14 @@ sub _getBonjour ($) my ($version, $peerPort) = $bonjourMsg =~ /^(\d+)\s+(\d+)/; unless (defined ($version) && defined ($peerPort)) { - warn "Warning in Ivy::_getBonjour, ill-formed Hello message \"$bonjourMsg\"\n" ; + carp "Warning in Ivy::_getBonjour, ill-formed Hello message \"$bonjourMsg\"" ; return; } if ($version != IVY_PROTOCOLE_VERSION) { - warn "Warning in Ivy::_getBonjour, connection request from ". + carp "Warning in Ivy::_getBonjour, connection request from ". "$peerName with protocol version $version,\ncurrent version is " . - IVY_PROTOCOLE_VERSION . "\n" ; + IVY_PROTOCOLE_VERSION ; return; } @@ -1062,7 +1064,7 @@ sub _getBonjour ($) } if ($addrInIvyBus == 0) { - warn "Warning: Hello message from $peerName ignored,\n". + carp "Warning: Hello message from $peerName ignored,\n". "this guy is outside our emission zone\n" if $^W; return; } @@ -1085,8 +1087,8 @@ sub _getBonjour ($) $self->_sendWantedRegexp ($appSock); } else { - warn "Warning in Ivy::_getBonjour, connection to " . - "$peerName:$peerPort is impossible\n" ; + carp "Warning in Ivy::_getBonjour, connection to " . + "$peerName:$peerPort is impossible" ; } } @@ -1099,7 +1101,7 @@ sub _getConnections ($) my $appSock = $self->[connSock]->accept(); unless (defined $appSock) { - warn "Warning in Ivy::_getConnections, \$appSock not defined\n"; + carp "Warning in Ivy::_getConnections, \$appSock not defined"; return; } else { @@ -1173,7 +1175,7 @@ sub _getMessages ($$) (.*)/x ; # si ca a chie on rale - (warn "Warning in Ivy::_getMessages, ill-formated message $mess\n" and return) unless defined $type ; + (carp "Warning in Ivy::_getMessages, ill-formated message $mess" and return) unless defined $type ; # sinon on fait en fonction du type de message if ($type == MSG) { # M S G @@ -1182,12 +1184,11 @@ sub _getMessages ($$) # traites par la regexp if (my @cb = @{$self->[recCbList][$id]->[1]}) { my $cb = shift @cb; - my $refcb = ref($cb); # cleaning $sendername with previous \004 used for connection status if ($senderName =~ /\004(.*)/) {$senderName = $0;} - if ($refcb ne 'CODE') { + if (ref($cb) ne 'CODE') { my $method = shift @cb; # on split sur ETX $cb->$method($senderName, @cb, split ("\003", $valeurs)) ; @@ -1198,7 +1199,7 @@ sub _getMessages ($$) } else { #_sendErrorTo ($appSock, "REEGXP ID $id inconnue"); - warn ("Warning in Ivy::_getMessages, received an unknown message ". + carp ("Warning in Ivy::_getMessages, received an unknown message ". "with id $id from $senderName :\n\"$mess\""); } } @@ -1241,8 +1242,8 @@ _EOL_ } } elsif ($type == ERROR) { # E R R O R - warn ("Warning in Ivy::_getMessages, error message received from ". - "$senderName : \"$valeurs\"\n"); + carp ("Warning in Ivy::_getMessages, error message received from ". + "$senderName : \"$valeurs\""); } elsif ($type == DELREGEXP) { # D E L R E G E X P # on vire la regexp des regexps verifiées @@ -1278,8 +1279,8 @@ _EOL_ elsif ($type == APP_NAME) { # etat Connecte if (($self->[appName] eq $valeurs) && $^W) { - warn "\033[1mWarning in Ivy::_getMessages, there is already an instance of ". - "$self->[appName] \033[m\n" ; + carp "\033[1mWarning in Ivy::_getMessages, there is already an instance of ". + "$self->[appName] \033[m" ; } $senderName = $valeurs; @@ -1290,8 +1291,7 @@ _EOL_ if (defined $self->[directCbList][$id]) { my @cb = @{$self->[directCbList][$id]}; my $cb = shift @cb; - my $refcb = ref($cb); - if ($refcb ne 'CODE') { + if (ref($cb) ne 'CODE') { my $method = shift @cb; $cb->$method(@cb, $valeurs); } @@ -1301,7 +1301,7 @@ _EOL_ } else { $self->_sendErrorTo ($appSock, "DIRECT ID $id inconnue"); - warn "Warning in Ivy::_getMessages, received a DIRECT message with ". + carp "Warning in Ivy::_getMessages, received a DIRECT message with ". "unknown id $id from $senderName :\n\"$mess\""; } } elsif ($type == DIE) { @@ -1309,8 +1309,7 @@ _EOL_ # on commence par appeler la callback de fin my @cb = @{$onDieFunc}; my $cb = shift @cb; - my $refcb = ref($cb); - if ($refcb ne 'CODE') { + if (ref($cb) ne 'CODE') { my $method = shift @cb; $cb->$method(@cb); } @@ -1318,9 +1317,8 @@ _EOL_ &$cb (@cb); } # on avertit les autres qu'on se barre - my $adr = $self->_inetAdrByName ($senderName) ; - warn "Notice in Ivy::_getMessages, received a suicide request from " . - "$senderName ($adr) ... exiting\n" if $^W; +# my $adr = $self->_inetAdrByName ($senderName) ; +# carp "Notice in Ivy::_getMessages, received a suicide request from " . "$senderName ($adr) ... exiting" if $^W; # adios Ivy::exit (); @@ -1385,8 +1383,10 @@ sub _inetAdrByName ($$) { keys %{$self->[cnnxion]}))[0]; return ("unknow") unless defined $addrInet; + print "$addrInet\n"; my ($addr,$port) = $addrInet =~ /(.{4}):(.*)/; - + + print "$addr,$port\n"; my $host = (gethostbyaddr ($addr, AF_INET))[0] ; return "$host:$port"; } @@ -1438,7 +1438,7 @@ sub _removeFileDescriptor ($$) keys %{$self->[cnnxion]}))[0]; unless (defined $addrInet) { - die "Error in Ivy::_removeFileDescriptor, disconnection of $diedAppName with ". + croak "Error in Ivy::_removeFileDescriptor, disconnection of $diedAppName with ". "addrInet not defined\n"; return; } @@ -1621,7 +1621,7 @@ sub _parseIvyBusParam ($) my ($ivyNetworks, $ivyPort) = $ivyBus =~ /^(.*):(.*)/; - die ("Error in Ivy::_parseIvyBusParam, illegal bus address format: $ivyBus\n") + croak ("Error in Ivy::_parseIvyBusParam, illegal bus address format: $ivyBus\n") unless $ivyPort =~ /^\d+$/; my @ivyAddrInet = (); @@ -1825,7 +1825,7 @@ messages. =item B<-onDieFunc =E [$an_object, \&a_method, @parameters]> A callback or method called when your application receives a suicide request. -Do not call exit() in the callback, Ivy will do it for you. +DO NOT CALL exit() in the callback, Ivy will do it for you. The prototype of your callback must be as follows: sub MyCallback { @@ -1851,7 +1851,9 @@ before running. =item B<-statusFunc =E sub {}> -A callback which will be called every time an appli is connected on the bus, deconnected from the bus or subscribes to a regexp. The first 3 parameters are a reference to an array of connected appli, a reference to an array of not connected appli (according to the "-neededApp" argument of the new method/function), a reference to a hash table of connected appli (giving the number of such appli). These 3 parameters are maintained for upwards compatibility but should no more be used, since the following three parameters are much easier to use: the name of an appearing/disapearing or subscribing/unsubscribing appli, its status either "new" or "died" or "subscribing" or "unsubscribing", and the hostname where this appli is running/dying OR the subscribed / unsubscribed regexp. +A callback which is called every time an appli connects on the bus, disconnects from the bus or subscribes to a regexp. When an application is stopping, this function is also called for every disconnecting agent on the bus. The first 3 parameters are a reference to an array of connected appli, a reference to an array of not connected appli (according to the "-neededApp" argument of the new method / function), a reference to a hash table of connected appli (giving the number of such appli). These 3 parameters are maintained for upwards compatibility but should no more be used, since the following three parameters are much easier to use: the name of an appearing / disapearing or subscribing / unsubscribing appli, its status either "new" or "died" or "subscribing" or "unsubscribing", and the hostname where this appli is running / dying OR the subscribed / unsubscribed regexp. + + Your callback could be: @@ -1924,7 +1926,7 @@ and before you really communicate. The method returns the $ivyobj. $ivyobj->sendMsgs(@messages); Ivy::sendMsgs(@messages); -Send a list of messages +Send a list of messages. A message should not contain a '\n' or it will not be delivered. Example : $ivyobj->sendMsgs("Hello", "Don't Bother", "Y2K is behind us"); @@ -1934,7 +1936,7 @@ Send a list of messages $ivyobj->sendAppNameMsgs(@messages); Ivy::sendAppNameMsgs(@messages); -Send a list of messages preceded by your application's name. +Send a list of messages preceded by your application's name. A message should not contain a '\n' or it will not be delivered. Example : $ivyobj->sendMsgs("Hello World"); @@ -1961,7 +1963,7 @@ one argument, the regexp. $ivyobject->bindRegexp("\w+ (\d+)", [\&callback, @cb_parameters]); # Your callback will be called with one more parameter which will be - # the name of appli who send the message + # the name of appli which send the message # Your callback and method must be like: sub callback { @@ -1984,7 +1986,7 @@ one argument, the regexp. $ivyobj->sendDirectMsgs($to, $id, @msgs); Ivy::sendDirectMsgs($to, $id, @msgs); -Send a message a message to appli $to. This appli must have done a bindDirect before to accept this message. regexp matching is not used with direct Messages +Send a message a message to appli $to. This appli must have done a bindDirect before to accept this message. regexp matching is not used with direct Messages. A message should not contain a '\n' or it will not be delivered. =item B @@ -2026,28 +2028,28 @@ Send a ping message and wait until timeout to receive a pong. $after_id = $ivyobj->after($timeAfter, \@callbacks_list); $after_id = Ivy::after($timeAfter, \@callbacks_list); -Call a list of callbacks after $timeAfter milliseconds. +Call a list of callbacks after $timeAfter milliseconds. To be used only in conjonction with the 'LOCAL' Mainloop (see the Init method). When using the TK mainloop, you must use the Tk::after method. =item B $repeat_id = $ivyobj->repeat($timeAfter, \@callbacks_list); $repeat_id = Ivy:repeat($timeAfter, \@callbacks_list); -Have a list of callbacks repeatedly called every $timeAfter milliseconds. +Have a list of callbacks repeatedly called every $timeAfter milliseconds. To be used only in conjonction with the 'LOCAL' Mainloop (see the Init method). When using the TK mainloop, you must use the Tk::repeat method. =item B $ivyobj->afterCancel($after_or_repeat_id); Ivy::afterCancel($after_or_repeat_id); -Cancel an after callback call. +Cancel an after callback call. To be used only in conjonction with the 'LOCAL' Mainloop (see the Init method). When using the TK mainloop, you must use the Tk::afterCancel method. =item B $ivyobj->afterResetTimer($after_id); Ivy::afterResetTimer($after_id); -Reset a timer if this timer has not yet been triggered. +Reset a timer if this timer has not yet been triggered. To be used only in conjonction with the 'LOCAL' Mainloop (see the Init method). =item B @@ -2055,7 +2057,7 @@ Reset a timer if this timer has not yet been triggered. Ivy::fileEvent($fd, $cb); Add a fileEvent handler (or remove any handler associated to $fd if $cb paramter is omitted). -The callback $cb will get the filehandle $fd as parameter. +The callback $cb will get the filehandle $fd as parameter. To be used only in conjonction with the 'LOCAL' Mainloop (see the Init method). When using the TK mainloop, you must use the Tk::fileevent method. =item B @@ -2071,6 +2073,8 @@ The stop method does not work! In the statusFunc, an agent is identified by its name which is not garantted as unique +A message to be sent should contain no '\n' char, because the '\n' is the message separator. + No other known bugs at this time. If you find one, please report them to the authors. =head1 SEE ALSO -- cgit v1.1