changement d'api :

° bindRegexp : 3eme argument optionnel : si sa valeur est 0 ou undef, fonctionnement inchangé,
  si sa valeur est 1 le premier argument fourni à la callback est une liste
  [nom, adresse, n° port] au lieu juste du nom de l'agent qui envoie le message
° la callback statusFunc : est appelée avec 7 arguments au lieu de 6 : arg 1 à 5 inchangé,
  arg 6 $host_or_regexp changé par $host, $regexp, si il n'y a pas de regexp $regexp vaut undef

1 files changed, 61 insertions, 36 deletions

diff --git a/Ivy.pm b/Ivy.pm
index 638c6e0..d77b703 100644
--- a/Ivy.pm
+++ b/Ivy.pm
@@ -84,7 +84,7 @@ sub start;		# debut de l'integration au bus :
 
 sub DESTROY ($);		# - envoie un BYE et clôt les connections
 
-sub bindRegexp ($$$) ;   # permet d'associer une regexp avec un callBack
+sub bindRegexp ($$$;$) ;   # permet d'associer une regexp avec un callBack
 			# ou d'annuler une precedente association
 
 sub bindDirect;    # permet d'associer un identifiant de msg direct
@@ -142,10 +142,11 @@ sub _pong ($$); # (fd)
 sub _tkFileEvent ($$); # associe un fd a un callback pour la mainloop tk
 sub _scanAfter () ; # parse si il faut appeler un callback associe a un after
 sub _myCanRead (); # interface au select
-sub _scanConnStatus ($$$$); # verifie les connections effectuees et
+sub _scanConnStatus ($$$@); # verifie les connections effectuees et
 		     # appelle la fonction $statusFunc
 sub _inetAdrByName ($$); # transforme une adresse inet native en chaine
 			 # $host:$port
+sub  _getHostByAddr ($);
 sub _toBePruned ($$$);
 sub _parseIvyBusParam ($); # prends une adresse de bus de la forme
 			   # 143.196.53,DGAC-CENATLS:2010 et
@@ -280,6 +281,8 @@ my $loopMode;
 # liste des bus actifs
 my %allBuses = ();
 
+# cache des nom retournés par gethostbyaddr pour _getHostByAddr
+my %hostNameByAddr = ();
 
 #############################################################################
 ####                    CLEFS DES VARIABLES D'INSTANCE                  #####
@@ -551,14 +554,17 @@ sub new ($%)
 			# toutes les applis necessaires ne sont pas presentes,
 			# et des que toutes les applis necessaires sont
 			# presentes, et si une appli necessaire se deconnecte
-			# les trois parametres passes à la callback sont :
-			# [liste des applis presentes],
-			# [liste des applis absentes],
-			# [table de hash, clefs = applis presentes,
-			# valeurs = nombre d'applis .
-			# normalement ce nombre devrait etre 1, sinon
-			# ca veut dire que plus d'une appli de meme nom
-			# tourne sur le meme bus : danger !!
+			# les  parametres passes à la callback sont :
+			# °[liste des applis presentes],
+			# °[liste des applis absentes],
+			# °[table de hash, clefs = applis presentes, valeurs = nombre d'applis .
+			#    normalement ce nombre devrait etre 1, sinon
+			#    ca veut dire que plus d'une appli de meme nom
+			#    tourne sur le meme bus : danger !!
+			# ° nom de l'appli qui genere l'evenement
+			# ° evenement : 'subscribing'|'filtered'|'unsubscribing'|'died'|'new'
+			# ° adresse
+			# ° regexp si c'est un abonnement, un desabonnement ou un filtered
 
 			-blockOnSlowAgent =>  1,
 			# comportement lorque un ou plusieurs des agents connectés
@@ -771,10 +777,12 @@ sub start
 
 
 ############### PROCEDURE	BIND REGEXP
-sub bindRegexp ($$$)
+sub bindRegexp ($$$;$)
 {
   my $self = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
-  my ($regexp, $cb) = @_;
+  my ($regexp, $cb, $callByRef) = @_;
+
+  $callByRef = defined $callByRef ? 1 : 0;
 
   my $original_regexp = $regexp;
   # on substitue les meta caracteres des regexps perl : \d, \w, \s, \e
@@ -810,7 +818,7 @@ sub bindRegexp ($$$)
     for ($id=0; $id <= ($#{$self->[recCbList]}+1); $id++)  {
       last unless  (defined $self->[recCbList][$id]) && @{$self->[recCbList][$id]->[1]};
     }
-    $self->[recCbList][$id] =  [$regexp, $cb];
+    $self->[recCbList][$id] =  [$regexp, $cb, $callByRef];
 
     # on envoie les messages regexps aux processus deja connectes
     _sendLastRegexpToAllreadyConnected ($self, $id) ;
@@ -1184,7 +1192,7 @@ sub _getBonjour ($)
 
   my $addr = (unpack_sockaddr_in ($inetAddr))[1];
 
-  my $peerName = gethostbyaddr ($addr, AF_INET) || inet_ntoa($addr);
+  my $peerName = _getHostByAddr ($addr);
 
   # on force $peerPort a etre vu comme une valeur numerique
   my ($version, $peerPort, $udpAppName, $uuid) = 
@@ -1366,7 +1374,10 @@ sub _getMessages ($$)
 	  my $cb = shift @cb;
 
 	  # cleaning $sendername with previous \004 used for connection status
-	  if ($senderName =~ /\004(.*)/) {$senderName = $0;}
+	  $senderName = $0 if ($senderName =~ /\004(.*)/);
+	  # bindRegexp avancé : on envoie une liste nom adresse port au lieu du nom
+	  $senderName = [$senderName, _getHostByAddr ($addr), $peerPort]
+	    if ($self->[recCbList][$id]->[2]);
 
 	  if (ref($cb) ne 'CODE') {
 	    my $method = shift @cb;
@@ -1395,10 +1406,12 @@ sub _getMessages ($$)
 	# filtrage des messages a envoyer
 #	  print "DBG> REGEXP from $senderName '$id' '$valeurs'\n";
 	if ($self->_toBePruned ($senderName, $valeurs)) {
-	  &_scanConnStatus ($self, $senderName, 'filtered', $valeurs);
+	  &_scanConnStatus ($self, $senderName, 'filtered',
+			    join (':', _getHostByAddr ($addr), $peerPort), $valeurs);
 	  next;
 	} else {
-	  &_scanConnStatus ($self, $senderName, 'subscribing', $valeurs);
+	  &_scanConnStatus ($self, $senderName, 'subscribing',
+ 			    join (':', _getHostByAddr ($addr), $peerPort), $valeurs);
 	}
 	unless (defined $self->[sendRegList]{$appSock}->[$id]) {
 	  # si l'id de regexp n'etait pas utilisee c'est tout bon
@@ -1450,9 +1463,9 @@ sub _getMessages ($$)
 	      $senderName = $0;
 	  }
           $self->[sendRegListSrc]{$appSock}->[$id] = undef;
-          &_scanConnStatus ($self, $senderName, 'unsubscribing', $regexp);
-
-      }
+          &_scanConnStatus ($self, $senderName, 'unsubscribing', 
+			    join (':', _getHostByAddr ($addr), $peerPort), $regexp);
+	}
       elsif ($type == ENDREGEXP) {			# E N D   R E G E X P
 	# on envoie le message ready uniquement a celui qui nous
 	# a envoye le message endregexp
@@ -1469,8 +1482,8 @@ sub _getMessages ($$)
 	  push @{$self->[appliList]{$senderName}},  $appSock;
 	}
 
-        my $host = (gethostbyaddr ($addr, AF_INET))[0] || inet_ntoa($addr);
-        $self->_scanConnStatus ($senderName, "new", "$host");
+        my $host = _getHostByAddr ($addr);
+        $self->_scanConnStatus ($senderName, "new", "$host:$peerPort", undef);
       }
       elsif ($type == APP_NAME) {
 	# etat Connecte
@@ -1578,7 +1591,7 @@ sub _inetAdrByName ($$) {
 
   my ($port) = $addrInet =~ /:(.*)/;
   my $addr = substr ($addrInet,0,4);
-  my $host = (gethostbyaddr ($addr, AF_INET))[0] || inet_ntoa($addr);
+  my $host =  _getHostByAddr ($addr);
   return "$host:$port";
 } # end _inetAdrByName
 
@@ -1596,6 +1609,7 @@ sub _removeFileDescriptor ($$)
   # on vire ce fd des fd a scruter dans la bcle d'evenements
   # uniquement si on est dans le thread principal
   # sinon le select merde salement sur ce coup
+  my $peerPort = $fd->peerport() ;  
   &$fileEventFunc ($fd, '') ;
   delete $self->[sendRegList]{$fd};
   delete $self->[sockList]{$fd};
@@ -1626,8 +1640,8 @@ sub _removeFileDescriptor ($$)
   # regexps par canal
 
   my $addr = substr ($addrInet,0,4);
-  my $host = (gethostbyaddr ($addr, AF_INET))[0] || inet_ntoa($addr);
-  $self->_scanConnStatus ($diedAppName, "died", $host) ;
+  my $host =  _getHostByAddr ($addr);
+  $self->_scanConnStatus ($diedAppName, "died", "$host:$peerPort", undef) ;
 } # end _removeFileDescriptor
 
 
@@ -1785,9 +1799,9 @@ sub _scanAfter ()
 
 
 ############### METHODE	SCAN CONN STATUS
-sub _scanConnStatus ($$$$)
+sub _scanConnStatus ($$$@)
 {
-  my ($self, $appname, $status, $addr) = @_;
+  my ($self, $appname, $status, @addr) = @_;
 
   my (%readyApp, @nonReadyApp);
 
@@ -1811,7 +1825,8 @@ sub _scanConnStatus ($$$$)
   # le 4eme arg est l'appli nouvelle, deconnecté, qui s'abonne ou se desabonne
   # le 5eme arg est le statut (actuellement: 'subscribing'|'filtered'|'unsubscribing'|'died'|'new')
   # le 6eme arg est l'addresse de la machine sur laquelle tourne l'agent
-  &{$self->[statusFunc]} ([keys %readyApp], \@nonReadyApp, \%readyApp, $appname, $status, $addr);
+  # le 7eme arg est la regexp si c'est un abonnement ou desabonnement
+  &{$self->[statusFunc]} ([keys %readyApp], \@nonReadyApp, \%readyApp, $appname, $status, @addr);
 } # end _scanConnStatus
 
 
@@ -2023,6 +2038,16 @@ sub _getNameByFileDes ($$)
 }
 
 
+
+sub  _getHostByAddr ($)
+{
+  my $addr = shift;
+  return $hostNameByAddr{$addr} if (exists $hostNameByAddr{$addr}) ;
+
+   my $peerName = gethostbyaddr ($addr, AF_INET) || inet_ntoa($addr);
+  return ($hostNameByAddr{$addr}= $peerName);
+}
+
 1;
 
 __END__
@@ -2187,7 +2212,7 @@ connected agents Ci, a reference to an array of not connected agents
 (according to the "-neededApp" argument of the new method / function),
 a reference to a hash table of connected agents Ci (giving the number
 of each agent). These 3 parameters are maintained for upwards
-compatibility but should no more be used, since the following three
+compatibility but should no more be used, since the following four
 parameters are much easier to use: the name of an appearing /
 disapearing or subscribing / filtered / unsubscribing agent C, its status either
 "new" or "died" or "subscribing" or "unsubscribing", and the hostname
@@ -2201,7 +2226,7 @@ Your callback could be:
 
  sub MyCallback {
    my ($ref_array_present, $ref_array_absent, $ref_hash_present,
-       $appname, $status, $host_or_regexp) = @_;
+       $appname, $status, $host, $regexp) = @_;
 
    # $status is either new or died
 
@@ -2212,19 +2237,19 @@ Your callback could be:
      }
    }
    if ($status eq "new") {
-     print "$appname connected from $host_or_regexp\n";
+     print "$appname connected from $host\n";
    }
    elsif ($status eq "died") {
-     print "$appname disconnected from $host_or_regexp\n";
+     print "$appname disconnected from $host\n";
    }
    elsif ($status eq "subscribing") {
-	print "$appname subscribes to $host_or_regexp\n";
+	print "$appname subscribes to $regexp\n";
    }
    elsif ($status eq "filtered") {
-	print "$appname subscribes to FILTERED $host_or_regexp check -filterRegexp option\n";
+	print "$appname subscribes to FILTERED $regexp check -filterRegexp option\n";
    }
    elsif ($status eq "unsubscribing") {
-	print "$appname unsubscribed to $host_or_regexp\n";
+	print "$appname unsubscribed to $regexp\n";
    }
  }
 
@@ -2478,4 +2503,4 @@ CENA (C) 1997-2006
 
 =head1 HISTORY
 
-=cut
+=cu