summaryrefslogtreecommitdiff
path: root/Ivy.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Ivy.pm')
-rw-r--r--Ivy.pm97
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