summaryrefslogtreecommitdiff
path: root/Ivy.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Ivy.pm')
-rw-r--r--Ivy.pm398
1 files changed, 200 insertions, 198 deletions
diff --git a/Ivy.pm b/Ivy.pm
index 0a78821..223b064 100644
--- a/Ivy.pm
+++ b/Ivy.pm
@@ -1,6 +1,6 @@
#
-# Ivy, Perl interface
-#
+# Ivy, Perl interface
+#
# Copyright 1997-2002
# Centre d'Études de la Navigation Aérienne
#
@@ -17,20 +17,18 @@
# modify it under the terms of the GNU LGPL Libray General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
-#
+#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
-#
+#
# You should have received a copy of the GNU Library General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA,
# or refer to http://www.gnu.org/copyleft/lgpl.html
#
-# $Id$
-# $Name$
-#############################################################################
+##################################################################
package Ivy ;
@@ -43,7 +41,7 @@ use IO::Socket::Multicast;
use vars qw($VERSION);
-# to compute the VERSION from the CVS tag (or if no tag, as the cvs file revision)
+# to compute the VERSION from the CVS tag (or if no tag, as the cvs file revision)
my $TAG= q$Name$;
my $REVISION = q$Revision$ ;
($VERSION) = $TAG =~ /^\D*([\d_]+)/ ;
@@ -71,17 +69,17 @@ sub new ($%); # verifie la validite de tous les parametres,
# de new qui prevalent
sub start; # debut de l'integration au bus :
- # - cree la socket d'application, recupere le no
+ # - cree la socket d'application, recupere le no
# de port
# - cree la socket supervision
# - envoie le "no de port"
- # - bind le file descriptor de la socket de
- # supervision a la fonction getBonjour pour
+ # - bind le file descriptor de la socket de
+ # supervision a la fonction getBonjour pour
# traiter les bonjours
- # - bind le fd de connection sur la fonction
+ # - bind le fd de connection sur la fonction
# getConnections
# pour etablir les connections "application"
-
+
sub DESTROY ($); # - envoie un BYE et clot les connections
#sub bindRegexp ($$$) ; # permet d'associer une regexp avec un callBack
@@ -89,7 +87,7 @@ sub DESTROY ($); # - envoie un BYE et clot les connections
sub bindDirect; # permet d'associer un identifiant de msg direct
# avec une fonction de callBack, ou de l'annuler
-
+
sub sendMsgs; # envoie une liste de messages
sub sendAppNameMsgs; # envoie une liste de messages precedes
# du nom de l'application
@@ -97,13 +95,13 @@ sub sendDirectMsgs; # envoie une liste de messages directs a une appli
sub sendDieTo; # envoie un <<kill>> a une appli
sub ping; # teste qu'une appli soit encore vivante
sub mainLoop (); # la mainloop locale (sans tk)
-sub stop (); # methode de classe : on delete les bus, mais
+sub stop (); # methode de classe : on delete les bus, mais
# on reste dans la mainloop
sub exit (); # methode de classe : on delete tous les
# bus (donc on ferme proprement toutes les
# connexions).
- # Si on est en mainloop locale on sort de la
- # mainloop, le code qui suit l'appel mainLoop
+ # Si on est en mainloop locale on sort de la
+ # mainloop, le code qui suit l'appel mainLoop
# sera execute.
# par contre si on est en mainloop Tk,
# il faut en plus detruire la mainwindow
@@ -131,7 +129,7 @@ sub _sendWantedRegexp ($$); # envoie les regexp a l'appli distante
sub _sendLastRegexpToAllreadyConnected ($$) ; # envoie la derniere regexp
# pushee dans @recCbList
- # a toutes les applis deja
+ # a toutes les applis deja
# connectees
sub _removeFileDescriptor ($$); # on vire un fd et les structures associees
sub _sendErrorTo ($$$); #(fd, error) envoie un message d'erreur a un fd
@@ -141,18 +139,18 @@ 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
- # appelle la fonction $statusFunc
-sub _inetAdrByName ($$); # transforme une adresse inet native en chaine
+sub _scanConnStatus ($$$$); # verifie les connections effectuees et
+ # appelle la fonction $statusFunc
+sub _inetAdrByName ($$); # transforme une adresse inet native en chaine
# $host:$port
sub _toBePruned ($$$);
sub _parseIvyBusParam ($); # prends une adresse de bus de la forme
# 143.196.53,DGAC-CENATLS:2010 et
# renvoie une liste de deux elements :
- # un numero de port et une ref sur une
+ # un numero de port et une ref sur une
# liste d'adresses addr_inet
-sub _substituteEscapedChar ($$); #permet de transformer une regexp etendue
+sub _substituteEscapedChar ($$); #permet de transformer une regexp etendue
# 'perl' en regexp de base
#############################################################################
@@ -187,9 +185,9 @@ use constant REG_PERLISSISME => ('w' => '[a-zA-Z0-9_]',
'W' => '[^a-zA-Z0-9_]',
's' => "[\t ]",
'S' => "[^\t ]",
- 'd' => '[0-9]',
+ 'd' => '[0-9]',
'D' => '[^0-9]',
- 'n' => '', # Il ne faut pas mettre d'\n :
+ 'n' => '', # Il ne faut pas mettre d'\n :
# c'est un delimiteur pour le bus
'e' => '[]') ;
@@ -238,24 +236,24 @@ my $constantIndexer =0;
# pointeur sur la fonction permettant d'associer
# des callbacks a un file desc, (ainsi que de les enlever)
-my $fileEventFunc;
+my $fileEventFunc;
# dans le cas ou l'on soit dans une mainLoop
# locale, cette var pointe une un objet
# de type IO::Select;
-my $localLoopSel;
+my $localLoopSel;
# table d'ass. handle -> callback
-my %localBindByHandle;
+my %localBindByHandle;
-# tableau d'ass [AFTER ou REPEAT,
+# tableau d'ass [AFTER ou REPEAT,
# timeTotal, deadLine, [callback, arg, arg, ...]]
-my %afterList=();
+my %afterList=();
-my $afterId = 0;
+my $afterId = 0;
# timeout le plus petit pour le select
-my $selectTimout = MAX_TIMOUT;
+my $selectTimout = MAX_TIMOUT;
# liste des bus actifs
@@ -291,7 +289,7 @@ use constant cnnxion => $constantIndexer++;
use constant buffByConn => $constantIndexer++;
use constant broadcastPort => $constantIndexer++;
use constant broadcastBuses => $constantIndexer++;
-use constant useMulticast => $constantIndexer++;
+use constant useMulticast => $constantIndexer++;
use constant appName => $constantIndexer++;
use constant messWhenReady => $constantIndexer++;
@@ -301,7 +299,7 @@ use constant messWhenReady => $constantIndexer++;
sub init
{
my $class = shift if (@_ and $_[0] eq __PACKAGE__);
- my (%options) = @_;
+ my (%options) = @_;
# valeurs par defaut pour le parametre : variable d'environnement
# ou valeur cablee, a defaut
@@ -310,26 +308,26 @@ sub init
BROADCAST_ADDRS.':'.BROADCAST_PORT;
my %optionsAndDefaults = ( #PARAMETRES OBLIGATOIRES
- -loopMode => undef,
+ -loopMode => undef,
# TK ou LOCAL
-
- -appName => undef,
+
+ -appName => undef,
# nom de l'appli
-
+
# PARAMETRES FACULTATIFS (avec valeurs par defaut)
-
+
# les adresses de reseau sur lesquelles ont broadcaste
# suivies du No de port :
# exemples : "143.196.1.255,143.196.2.255:2010"
# "DGAC-CENATLS-PII:DGAC-CENATLS:2010"
# ":2010" <= dans ce cas c'est la valeur
- # de reseau de broadcast par defaut qui est prise :
+ # de reseau de broadcast par defaut qui est prise :
# 127.255.255.255 c.a.d local a la machine
-ivyBus => $default_ivyBus,
-messWhenReady => "_APP NAME READY",
# message de synchro a envoyer quand pret
-
+
-onDieFunc => [sub {}],
# fonction de cb appelee lorsque l'appli a recu l'ordre
# de quitter, on peut dans ce callback fermer
@@ -341,7 +339,7 @@ sub init
# optimisation : si l'on connait les sujets des messages
# qu'on envoie, on fournit la liste des sujets
# et les regexps qui ne matchent pas
- # ces sujets sont eliminees.
+ # ces sujets sont eliminees.
) ;
# on examine toutes les options possibles
@@ -357,7 +355,7 @@ sub init
}
}
- # on examine toutes les options fournies, pour detecter les inutiles
+ # on examine toutes les options fournies, pour detecter les inutiles
foreach my $opt (keys %options) {
unless (exists ($optionsAndDefaults{$opt})) {
carp "Warning in Ivy::init: option $opt is unknown";
@@ -392,14 +390,14 @@ sub init
} # end init
############# METHODE DE CLASSE NEW
-sub new ($%)
+sub new ($%)
{
- my ($class, %options) = @_;
+ my ($class, %options) = @_;
my $self = [];
$#{$self} = $constantIndexer; # on predimensionne le tableau
bless ($self, $class);
- # on verifie que la methode de classe init ait ete appelee
+ # on verifie que la methode de classe init ait ete appelee
unless ((defined $appName) && ($appName ne '')) {
croak "Error in Ivy::new, you should have called Ivy->init () first.";
}
@@ -437,7 +435,7 @@ sub new ($%)
# tableau ass de liste du type
# sockId => [fonction, fonction, ...]
# pour savoir quoi envoyer a qui
- # les fonctions anonymes sont compilees
+ # les fonctions anonymes sont compilees
# dynamiquement a la reception des messages REGEXP
# et filtrent les mess a envoyer et les envoient
# au besoin
@@ -448,11 +446,11 @@ sub new ($%)
# pour connaitre la valeur des regexp meme apres compilation
$self->[sendRegListSrc] = {};
- # liste des topics qu'on envoie si on
+ # liste des topics qu'on envoie si on
# filtre les regexps
$self->[topicRegexps] = [];
- # liste de ref sur des couples
+ # liste de ref sur des couples
# (regexp,callBack) les callbacks
# sont appeles lors de
# la reception de messages en fonction
@@ -474,39 +472,39 @@ sub new ($%)
# pas par \n, de maniere a resegmenter les messages
$self->[buffByConn] = {};
-
- my %optionsAndDefaults = (
+
+ my %optionsAndDefaults = (
-appName => $appName,
# nom de l'appli
-
+
# PARAMETRES FACULTATIFS (avec valeurs par defaut)
-messWhenReady => $messWhenReady,
# message de synchro a envoyer quand pret
-
+
# PARAMETRES FACULTATIFS (avec valeurs par defaut)
-
+
# les adresses de reseau sur lesquelles ont broadcaste
# suivies du No de port :
# exemples : "143.196.1.255,143.196.2.255:2010"
# "DGAC-CENATLS-PII:DGAC-CENATLS:2010"
# ":2010" <= dans ce cas c'est la valeur
- # de reseau de broadcast par defaut qui est prise :
+ # de reseau de broadcast par defaut qui est prise :
# 127.255.255.255 c.a.d local a la machine
-ivyBus => $ivyBus,
-
+
-neededApp => [],
# liste des appplis necessaires
-
+
-statusFunc => sub {},
# fonction de callBack qui sera appelee tant que
# toutes les applis necessaires ne sont pas presentes,
- # et des que toutes les applis necessaires sont
+ # et des que toutes les applis necessaires sont
# presentes, et si une appli necessaire se deconnecte
# les trois parametres passes sont :
- # [liste des applis presentes],
+ # [liste des applis presentes],
# [liste des applis absentes],
- # [table de hash, clefs = applis presentes,
+ # [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
@@ -516,10 +514,10 @@ sub new ($%)
# optimisation : si l'on connait les sujets des messages
# qu'on envoie, on fournit la liste des sujets
# et les regexps qui ne matchent pas
- # ces sujets sont eliminees.
+ # 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
@@ -532,8 +530,8 @@ sub new ($%)
croak "Error in Ivy::new: option $opt is mandatory\n";
}
}
-
- # on examine toutes les options fournies, pour detecter les inutiles
+
+ # on examine toutes les options fournies, pour detecter les inutiles
foreach my $opt (keys %options) {
unless (exists ($optionsAndDefaults{$opt})) {
carp "Warning in Ivy::new, option $opt is unknown";
@@ -548,10 +546,10 @@ sub new ($%)
$self->[topicRegexps] = $options{-pruneRegexp} ;
$allBuses{$self} = $self;
- ($self->[useMulticast], $self->[broadcastPort], $self->[broadcastBuses]) =
+ ($self->[useMulticast], $self->[broadcastPort], $self->[broadcastBuses]) =
_parseIvyBusParam ($options{-ivyBus});
-
+
return ($self);
} # end new
@@ -564,7 +562,7 @@ sub DESTROY ($)
# pour toutes les connections
foreach my $fd (values %{$self->[sockList]}) {
- # send ($fd, sprintf (MSG_FMT, BYE, 0, ""), 0)
+ # 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 DO NOT work with ivy-c api.
@@ -582,7 +580,7 @@ sub DESTROY ($)
$self->[supSock]->close() if ($self->[supSock] and $self->[supSock]->connected());
delete $allBuses{$self};
- # on clot la socket de connection
+ # on clot la socket de connection
# 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
@@ -600,7 +598,7 @@ sub stop ()
############## METHODE DE CLASSE EXIT
-sub exit ()
+sub exit ()
{
Ivy::stop ();
if (defined $localLoopSel) {
@@ -637,14 +635,18 @@ sub start
# on memorise tout ca, ce qui evitera par la suite de se
# repondre a soi-meme. On le fait sous nos deux noms :
# le nom de machine et 'localhost'
- my $hostAddr = (gethostbyname (hostname()))[4] ;
+ my ($n, $al, $t, $l, @hostAddrs) = gethostbyname (hostname());
+ foreach my $a (@hostAddrs) {
+ # print STDERR "DBG> I am ", unpack ('CCCC', $a), $connSock->sockport, "\n";
+ $self->[cnnxion]->{"$a:". $connSock->sockport} = "\004";
+ }
+
my $localhostAddr = (gethostbyname ('localhost'))[4] ;
- $self->[cnnxion]->{"$hostAddr:". $connSock->sockport} = "\004";
$self->[cnnxion]->{"$localhostAddr:". $connSock->sockport} = "\004";
-
+
# le message de bonjour à envoyer: "no de version no de port"
my $bonjourMsg = sprintf ("%d %d\n", IVY_PROTOCOLE_VERSION, $connSock->sockport());
-
+
if (!$self->[useMulticast]) {
# cree la socket de broadcast
$self->[supSock] = IO::Socket::INET->new
@@ -655,7 +657,7 @@ sub start
$self->[supSock]->sockopt (SO_BROADCAST, 1);
foreach my $netBroadcastAddr (@{$self->[broadcastBuses]}) {
# print "BroadcastBus: --", $netBroadcastAddr, "--\n";
- send ($self->[supSock], $bonjourMsg, 0, $netBroadcastAddr) or
+ send ($self->[supSock], $bonjourMsg, 0, $netBroadcastAddr) or
carp "Warning in Ivy::start, broadcast of Hello message failed: $!";
}
}
@@ -664,36 +666,36 @@ sub start
$self->[supSock] = IO::Socket::Multicast->new
(LocalPort => $self->[broadcastPort],
ReuseAddr => 1);
-
- # Multicast datagrams with initial TTL 0 are restricted to the same host.
- # Multicast datagrams with initial TTL 1 are restricted to the same subnet.
- # Multicast datagrams with initial TTL 32 are restricted to the same site.
- # Multicast datagrams with initial TTL 64 are restricted to the same region.
- # Multicast datagrams with initial TTL 128 are restricted to the same continent.
- # Multicast datagrams with initial TTL 255 are unrestricted in scope.
+
+ # Multicast datagrams with initial TTL 0 are restricted to the same host.
+ # Multicast datagrams with initial TTL 1 are restricted to the same subnet.
+ # Multicast datagrams with initial TTL 32 are restricted to the same site.
+ # Multicast datagrams with initial TTL 64 are restricted to the same region.
+ # Multicast datagrams with initial TTL 128 are restricted to the same continent.
+ # Multicast datagrams with initial TTL 255 are unrestricted in scope.
$self->[supSock]->mcast_ttl(64);
# $self->[supSock]->mcast_loopback(1); must be 1, which is the default
-
+
foreach my $netMulticastAddr (@{$self->[broadcastBuses]}) {
my ($port,$multicastGroupI) = sockaddr_in ($netMulticastAddr);
my $multicastGroup = inet_ntoa($multicastGroupI);
# print "DBG> MulticastBus: --", $multicastGroup,":$port", "--\n";
$self->[supSock]->mcast_add($multicastGroup);
- $self->[supSock]->mcast_send($bonjourMsg, $multicastGroup.":".$port) or
+ $self->[supSock]->mcast_send($bonjourMsg, $multicastGroup.":".$port) or
carp "Warning in Ivy::start, multicast of Hello message failed: $!";
}
}
# callback pour traiter la reception des bonjours
&$fileEventFunc ($self->[supSock], [\&_getBonjour, $self]) ;
-
+
# callback pour traiter les demandes de cxion
&$fileEventFunc ($self->[connSock], [\&_getConnections, $self]) ;
return $self;
} # end start
-
-############### PROCEDURE BIND REGEXP
+
+############### PROCEDURE BIND REGEXP
sub bindRegexp
{
my $self = ref($_[0]) eq __PACKAGE__ ? shift : $globalIvy;
@@ -705,9 +707,9 @@ sub bindRegexp
# qu'une appli distante non perl comprenne ces regexp.
$regexp =~ s|
(
- (?<!\\) \[ # le premier crochet ouvrant non precede d'un \
+ (?<!\\) \[ # le premier crochet ouvrant non precede d'un \
.*? # ce qu'il y a dans le crochet, en mode frugal
- (?<!\\) \] # le premier crochet fermant non precede d'un \
+ (?<!\\) \] # le premier crochet fermant non precede d'un \
)
|
_substituteEscapedChar ('inside', $1)
@@ -716,14 +718,14 @@ sub bindRegexp
$regexp = _substituteEscapedChar ('outside', $regexp);
# print ("DBG> regexp = $regexp\n");
- eval {my $test = "a" =~ /$regexp/ } ; # testing the regexp for avoiding
+ eval {my $test = "a" =~ /$regexp/ } ; # testing the regexp for avoiding
if ($@) { carp "Warning in Ivy::bindRegexp, ill-formed regexp: '$original_regexp'" ; return };
if ($cb) {
my $id;
# on rajoute le couple $regexp, $cb dans la liste des messages
# qu'on prend
-
+
# on commence par tester si on a un id libere dans le tableau
for ($id=0; $id <= ($#{$self->[recCbList]}+1); $id++) {
last unless (defined $self->[recCbList][$id]) && @{$self->[recCbList][$id]->[1]};
@@ -734,32 +736,32 @@ sub bindRegexp
_sendLastRegexpToAllreadyConnected ($self, $id) ;
}
else {
-
+
# on vire le callback, et on se desabonne de cette regexp
for (my $id=0; $id <= $#{$self->[recCbList]}; $id++) {
-
+
next unless (defined $self->[recCbList][$id]) &&
@{$self->[recCbList][$id]->[1]};
-
+
if ($self->[recCbList][$id]->[0] eq $regexp) {
-
+
$self->[recCbList][$id]->[1] = [];
# on envoie le mesage delregexp
foreach my $fd (values %{$self->[sockList]}) {
send ($fd, sprintf (MSG_FMT, DELREGEXP, $id,""), 0)
- or $self->_removeFileDescriptor ($fd);
+ or $self->_removeFileDescriptor ($fd);
}
}
}
}
} # end bindRegexp
-############### METHODE BIND REGEXP
-sub bindDirect
+############### METHODE BIND REGEXP
+sub bindDirect
{
my $self = ref($_[0]) eq __PACKAGE__ ? shift : $globalIvy;
my ($id, $cb) = @_;
-
+
if ($cb) {
# on rajoute la $cb dans la liste des messages
# qu'on prend
@@ -769,8 +771,8 @@ sub bindDirect
undef $self->[directCbList][$id];
}
} # end bindDirect
-
-############### PROCEDURE SEND MSGS
+
+############### PROCEDURE SEND MSGS
sub sendMsgs
{
my $self = ref($_[0]) eq __PACKAGE__ ? shift : $globalIvy;
@@ -780,7 +782,7 @@ sub sendMsgs
# pour tous les messages
foreach my $msg (@msgs) {
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
@@ -796,7 +798,7 @@ sub sendMsgs
return $total;
} # end sendMsgs
-############### PROCEDURE SEND MSGS
+############### PROCEDURE SEND MSGS
sub sendAppNameMsgs
{
my $self = ref($_[0]) eq __PACKAGE__ ? shift : $globalIvy;
@@ -825,12 +827,12 @@ sub sendAppNameMsgs
-############### PROCEDURE SEND DIRECT MSGS
+############### PROCEDURE SEND DIRECT MSGS
sub sendDirectMsgs
{
my $self = ref($_[0]) eq __PACKAGE__ ? shift : $globalIvy;
my ($to, $id, @msgs) = @_;
-
+
if (defined $to and defined ($self->[appliList]{$to})) {
my @fds = @{$self->[appliList]{$to}};
# pour tous les messages
@@ -839,7 +841,7 @@ sub sendDirectMsgs
foreach my $fd (@fds) {
send ($fd, sprintf (MSG_FMT, DIRECT_MSG, $id, "$msg"), 0)
- or $self->_removeFileDescriptor ($fd);
+ or $self->_removeFileDescriptor ($fd);
}
}
return 1;
@@ -852,7 +854,7 @@ sub sendDirectMsgs
} # end sendDirectMsgs
-############### METHOD SEND DIE TO
+############### METHOD SEND DIE TO
sub sendDieTo
{
my $self = ref($_[0]) eq __PACKAGE__ ? shift : $globalIvy;
@@ -861,7 +863,7 @@ sub sendDieTo
if (defined $to and defined $self->[appliList]{$to}) {
my @fds = @{$self->[appliList]{$to}};
- carp "Attention : in Ivy::sendDieTo big BUG \@fds is empty"
+ carp "Attention : in Ivy::sendDieTo big BUG \@fds is empty"
if (scalar (@fds) == 0);
# pour tous les messages
@@ -878,12 +880,12 @@ sub sendDieTo
} # end sendDieTo
-############### METHOD PING
+############### METHOD PING
sub ping
{
my $self = ref($_[0]) eq __PACKAGE__ ? shift : $globalIvy;
my ($to, $timeout) = @_;
-
+
if (defined $to and defined ($self->[appliList]{$to})) {
my @fds = @{$self->[appliList]{$to}};
@@ -891,7 +893,7 @@ sub ping
# pour tous les messages
foreach my $fd (@fds) {
send ($fd, sprintf (MSG_FMT, PING, 0, " "), 0)
- or $self->_removeFileDescriptor ($fd);
+ or $self->_removeFileDescriptor ($fd);
}
}
else {
@@ -908,7 +910,7 @@ sub mainLoop ()
unless defined $localLoopSel;
my ($fd, @ready, @allDesc);
-
+
while (defined $localLoopSel) {
@ready = IO::Select::can_read ($localLoopSel, $selectTimout) ;
_scanAfter () ;
@@ -926,7 +928,7 @@ sub mainLoop ()
} # end mainLoop
-############### METHODE AFTER
+############### METHODE AFTER
sub after ($$;$)
{
# test du premier argument au cas où la fonction est
@@ -934,13 +936,13 @@ sub after ($$;$)
# de classe
shift if ((ref ($_[0]) eq __PACKAGE__) || ($_[0] eq __PACKAGE__)) ;
- my ($timeAfter, $cbListRef) = @_;
+ my ($timeAfter, $cbListRef) = @_;
$timeAfter /= 1000;
$selectTimout = $timeAfter if $timeAfter < $selectTimout;
# si la valeur de timout est negative : c'est un after sinon
# c'est un repeat
- $afterList{++$afterId} = [AFTER, $timeAfter,
+ $afterList{++$afterId} = [AFTER, $timeAfter,
timeofday()+$timeAfter, $cbListRef];
return ($afterId);
@@ -959,21 +961,21 @@ sub repeat ($$;$)
$timeAfter /= 1000;
$selectTimout = $timeAfter if $timeAfter < $selectTimout;
- $afterList{++$afterId}= [REPEAT, $timeAfter, timeofday()+$timeAfter,
+ $afterList{++$afterId}= [REPEAT, $timeAfter, timeofday()+$timeAfter,
$cbListRef];
return ($afterId);
} # end repeat
-############### METHODE AFTER CANCEL
+############### METHODE AFTER CANCEL
sub afterCancel ($;$)
{
# test du premier argument au cas où la fonction est
# appelee de maniere objet : premier argument = class ou une instance
# de classe
shift if ((ref ($_[0]) eq __PACKAGE__) || ($_[0] eq __PACKAGE__)) ;
-
+
my $id = shift;
-
+
if (defined ($id) && defined $afterList{$id}) {
if ($afterList{$id}->[1] <= $selectTimout) {
delete $afterList{$id} ;
@@ -1008,20 +1010,20 @@ sub afterResetTimer ($;$)
} # end afterResetTimer
-############### METHODE FILE EVENT
+############### METHODE FILE EVENT
sub fileEvent ($$;$)
{
# test du premier argument au cas où la fonction est
# appelee de maniere objet : premier argument = class ou une instance
# de classe
shift if ((ref ($_[0]) eq __PACKAGE__) || ($_[0] eq __PACKAGE__)) ;
-
+
my ($fd, $cb) = @_;
-
-
+
+
unless (defined $localLoopSel) {
croak ("Error in Ivy::fileEvent, Ivy should have been initialised in LOCAL loop mode\n");
- }
+ }
if ($cb) {
# adding the handler
@@ -1040,7 +1042,7 @@ sub fileEvent ($$;$)
#############################################################################
-############### METHODE GET BONJOUR
+############### METHODE GET BONJOUR
sub _getBonjour ($)
{
my $self = shift;
@@ -1054,9 +1056,9 @@ sub _getBonjour ($)
carp "Warning in Ivy::_getBonjour, recv error, Hello message discarded";
return;
}
-
+
my $addr = (unpack_sockaddr_in ($inetAddr))[1];
-
+
my $peerName = gethostbyaddr ($addr, AF_INET) || inet_ntoa($addr);
# on force $peerPort a etre vu comme une valeur numerique
@@ -1073,30 +1075,30 @@ sub _getBonjour ($)
IVY_PROTOCOLE_VERSION ;
return;
}
-
+
+
# on verifie qu'on ne se repond pas et qu'on ne
# se reconnecte pas a un process deja connecte
if (exists ($self->[cnnxion]{"$addr:$peerPort"})) {
#print "DBG> bonjour de $peerName:$peerPort : DEJA CONNECTE\n" ;
return ;
- }
- else {
+ } else {
#print "DBG> reception de $peerName : bonjour $peerPort\n" ;
}
-
-# on verifie que l'adresse fasse partie de l'ensemble de reseau
+
+ # on verifie que l'adresse fasse partie de l'ensemble de reseau
# definis par ivybus
my $addrInIvyBus = 0;
- my @ivyBusAddrList = map ( (unpack_sockaddr_in ($_))[1],
+ my @ivyBusAddrList = map ( (unpack_sockaddr_in ($_))[1],
@{$self->[broadcastBuses]});
- # Bon dans cette version on reponds aux bonjour emis par
+ # Bon dans cette version on reponds aux bonjour emis par
# la machine locale, on ne peut donc pas avoir
# une appli qui ne causerait qu'a des machines sur une
# autre reseau, si ca embete qqun, qu'il me le dise
push (@ivyBusAddrList, pack ("CCCC", 127,255,255,255));
push (@ivyBusAddrList, (gethostbyname (hostname()))[4]);
foreach my $ivyBusAddr (@ivyBusAddrList) {
- $addrInIvyBus = 1 unless (grep ($_ != 0, unpack ("CCCC",
+ $addrInIvyBus = 1 unless (grep ($_ != 0, unpack ("CCCC",
($addr & $ivyBusAddr) ^ $addr)));
}
@@ -1110,7 +1112,7 @@ sub _getBonjour ($)
my $appSock = IO::Socket::INET->new (PeerAddr => $peerName,
PeerPort => $peerPort,
Proto => 'tcp');
-
+
if ($appSock) {
# on cree une entree pour $appSock dans la liste des regexp
$self->[cnnxion]{"$addr:$peerPort"} = 1;
@@ -1142,11 +1144,11 @@ sub _getConnections ($)
return;
}
else {
-# printf "accepting connection from %s:%d\n",
+# printf "accepting connection from %s:%d\n",
# (gethostbyaddr ($appSock->peeraddr(),AF_INET))[0],
$appSock->peerport() if $^W;
}
-
+
# callback pour traiter la reception des messages
&$fileEventFunc ($appSock, [\&_getMessages, $self, $appSock]) ;
@@ -1186,7 +1188,7 @@ sub _getMessages ($$)
return;
}
-
+
if (length ($self->[buffByConn]{$appSock})) {
$buffer = $self->[buffByConn]{$appSock} . $buffer ;
$self->[buffByConn]{$appSock} = '';
@@ -1196,24 +1198,24 @@ sub _getMessages ($$)
($buffer =~ /\n$/) ;
# if (defined $appSock->peername) {
- $addr = $appSock->peeraddr();
+ $addr = $appSock->peeraddr();
$peerPort = $appSock->peerport() ;
$senderName = $self->[cnnxion]{"$addr:$peerPort"} ;
$senderName = "NONAME" unless $senderName;
foreach my $mess (@messages) {
# print "DBG> mess from $senderName '$mess'\n";
-
+
# on recupere les 3 champs : le type, le numero de regexp, les valeurs
- my ($type, $id, $valeurs) = $mess =~ /^(\d+)
+ my ($type, $id, $valeurs) = $mess =~ /^(\d+)
\s+
(\d+)
\002
(.*)/x ;
-
+
# si ca a chie on rale
(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
# on recupere le couple call back, regexp correspondant
@@ -1224,7 +1226,7 @@ sub _getMessages ($$)
# cleaning $sendername with previous \004 used for connection status
if ($senderName =~ /\004(.*)/) {$senderName = $0;}
-
+
if (ref($cb) ne 'CODE') {
my $method = shift @cb;
# on split sur ETX
@@ -1244,7 +1246,7 @@ sub _getMessages ($$)
#print "reception d'un bye\n";
$self->_removeFileDescriptor ($appSock); # B Y E
}
- elsif ($type == REGEXP) { # R E G E X P
+ elsif ($type == REGEXP) { # R E G E X P
# on ajoute une fonction traitant la regexp et envoyant le
# message sur le bon fd dans la liste des fonctions de filtrage
# ca permet de compiler les regexp avec 'once' donc une
@@ -1270,9 +1272,9 @@ sub _getMessages ($$)
}
};
_EOL_
- }
+ }
else {
- # l'id de la regexp etait deja utilise,
+ # l'id de la regexp etait deja utilise,
# et n'a pas ete libere par un message delregexp,
# on renvoie donc un message d'erreur
$self->_sendErrorTo($appSock, "ID $id deja utilisee");
@@ -1313,7 +1315,7 @@ _EOL_
my $host = (gethostbyaddr ($addr, AF_INET))[0] || inet_ntoa($addr);
$self->_scanConnStatus ($senderName, "new", "$host");
}
- elsif ($type == APP_NAME) {
+ elsif ($type == APP_NAME) {
# etat Connecte
if (($self->[appName] eq $valeurs) && $^W) {
carp "\033[1mWarning in Ivy::_getMessages, there is already an instance of ".
@@ -1321,7 +1323,7 @@ _EOL_
}
$senderName = $valeurs;
- $self->[cnnxion]{"$addr:$peerPort"} = "\004$valeurs";
+ $self->[cnnxion]{"$addr:$peerPort"} = "\004$valeurs";
}
elsif ($type == DIRECT_MSG) {
@@ -1372,19 +1374,19 @@ _EOL_
warn ("Warning in Ivy::_getMessages, received a message of unknown ".
" type $type from $senderName :\n\"$mess\"");
}
- }
+ }
return 0;
} # end _getMessages
-############### METHODE SEND WANTED REGEXP
+############### METHODE SEND WANTED REGEXP
sub _sendWantedRegexp ($$)
{
my ($self, $appSock) = @_;
-
+
# on envoie le message "Nom appli"
send ($appSock, sprintf (MSG_FMT, APP_NAME, 0, $self->[appName]), 0)
or $self->_removeFileDescriptor ($appSock) ;
-
+
# on envoie les regexps
for (my $id = 0; $id <= $#{$self->[recCbList]}; $id++) {
next unless defined $self->[recCbList][$id]->[1]->[0];
@@ -1392,11 +1394,11 @@ sub _sendWantedRegexp ($$)
send ($appSock,
sprintf (MSG_FMT, REGEXP, $id, $self->[recCbList][$id]->[0]),
0) or $self->_removeFileDescriptor ($appSock) ;
- # print sprintf ("DBG> %s %d %s\n",
+ # print sprintf ("DBG> %s %d %s\n",
# 'REGEXP', $id, $self->[recCbList][$id]->[0]);
}
# on envoie le message de fin d'envoi de regexps
- send ($appSock, sprintf (MSG_FMT, ENDREGEXP, 0, ""), 0)
+ send ($appSock, sprintf (MSG_FMT, ENDREGEXP, 0, ""), 0)
or $self->_removeFileDescriptor ($appSock) ;
} # end _sendWantedRegexp
@@ -1404,9 +1406,9 @@ sub _sendWantedRegexp ($$)
sub _sendLastRegexpToAllreadyConnected ($$)
{
my ($self, $id) = @_;
-
+
foreach my $fd (values %{$self->[sockList]}) {
- send ($fd, sprintf (MSG_FMT, REGEXP, $id, $self->[recCbList][$id]->[0]),
+ send ($fd, sprintf (MSG_FMT, REGEXP, $id, $self->[recCbList][$id]->[0]),
0) or $self->_removeFileDescriptor ($fd) ;
}
} # end _sendLastRegexpToAllreadyConnected
@@ -1415,10 +1417,10 @@ sub _sendLastRegexpToAllreadyConnected ($$)
sub _inetAdrByName ($$) {
my ($self, $appName) = @_;
-
+
my $addrInet = (grep ($self->[cnnxion]{$_} eq $appName,
keys %{$self->[cnnxion]}))[0];
-
+
return ("unknow") unless defined $addrInet;
my ($addr,$port) = $addrInet =~ /(.{4}):(.*)/;
@@ -1431,13 +1433,13 @@ sub _inetAdrByName ($$) {
sub _removeFileDescriptor ($$)
{
my ($self, $fd) = @_;
-
+
my $diedAppName;
-
+
# on s'est deja occupe de lui
return unless exists $self->[sockList]->{$fd};
# printf ("DBG> _removeFileDescriptor IN thread %s\n", ${Thread->self});
-
+
# on efface les structures de donnees associees au fd
# on vire ce fd des fd a scruter dans la bcle d'evenements
# uniquement si on est dans le thread principal
@@ -1446,9 +1448,9 @@ sub _removeFileDescriptor ($$)
delete $self->[sendRegList]{$fd};
delete $self->[sockList]{$fd};
delete $self->[buffByConn]->{$fd};
-
+
$fd->close();
-
+
EXT_LOOP:
foreach my $name (keys %{$self->[appliList]}) {
foreach my $fdp (@{$self->[appliList]{$name}}) {
@@ -1463,28 +1465,28 @@ sub _removeFileDescriptor ($$)
}
}
}
-
+
unless (defined $diedAppName) {
warn "Ivy::__removeFileDescriptor : disconnection of NONAME\n" if $^W;
return;
}
-
+
my $addrInet = (grep ($self->[cnnxion]{$_} eq $diedAppName,
keys %{$self->[cnnxion]}))[0];
-
+
unless (defined $addrInet) {
croak "Error in Ivy::_removeFileDescriptor, disconnection of $diedAppName with ".
"addrInet not defined\n";
return;
}
-
+
#printf "DBG> _removeFileDescriptor : deconnection de %s ($diedAppName)\n", _inetAdrByName ($diedAppName);
delete $self->[cnnxion]{$addrInet};
-
+
# on vire l'entree correspondant a ce canal dans la liste des
# regexps par canal
-
+
my $addr = substr ($addrInet,0,4);
my $host = (gethostbyaddr ($addr, AF_INET))[0] || inet_ntoa($addr);
$self->_scanConnStatus ($diedAppName, "died", $host) ;
@@ -1495,8 +1497,8 @@ sub _removeFileDescriptor ($$)
sub _sendErrorTo ($$$)
{
my ($self, $fd, $error) = @_;
-
- send ($fd, join (' ', ERROR, "0\002$error\n"), 0)
+
+ send ($fd, join (' ', ERROR, "0\002$error\n"), 0)
or $self->_removeFileDescriptor ($fd);
} # end _sendErrorTo
@@ -1506,7 +1508,7 @@ sub _pong ($$)
{
my ($self, $fd) = @_;
- send ($fd, join (' ', PONG, "0\002 \n"), 0)
+ send ($fd, join (' ', PONG, "0\002 \n"), 0)
or $self->_removeFileDescriptor ($fd);
} # end _pong
@@ -1515,8 +1517,8 @@ sub _pong ($$)
sub _sendDieTo ($$)
{
my ($self, $fd) = @_;
-
- send ($fd, join (' ', DIE, "0\002\n"), 0)
+
+ send ($fd, join (' ', DIE, "0\002\n"), 0)
or $self->_removeFileDescriptor ($fd);
} # end _sendDieTo
@@ -1533,11 +1535,11 @@ sub _sendMsgTo ($$$)
} # end _sendMsgTo
-############### PROCEDURE TK FILE EVENT
+############### PROCEDURE TK FILE EVENT
sub _tkFileEvent ($$)
{
my ($fd, $cb) = @_;
-
+
Tk::fileevent ('', $fd, 'readable', $cb) ;
} # end _tkFileEvent
@@ -1563,7 +1565,7 @@ sub _scanAfter ()
if ($af->[0]) {
$af->[2] = $stamp + $af->[1] ;
$selectTimout = $af->[1] if $af->[1] < $selectTimout;
- }
+ }
else {
# si c'est un after on le vire
afterCancel ($afk);
@@ -1577,7 +1579,7 @@ sub _scanAfter ()
} # end _scanAfter
-############### METHODE SCAN CONN STATUS
+############### METHODE SCAN CONN STATUS
sub _scanConnStatus ($$$$)
{
my ($self, $appname, $status, $addr) = @_;
@@ -1588,11 +1590,11 @@ sub _scanConnStatus ($$$$)
next if $_ eq "1";
$readyApp{$_}++ unless /^\004/; # connecte mais pas ready
}
-
+
foreach (@{$self->[neededApp]}) {
push (@nonReadyApp, $_) unless exists $readyApp{$_};
}
-
+
# par compatibilite avec l'ancienne version, on envoie comme
# deux premiers arguments une ref sur la liste des applis presentes,
# une ref de la liste des applis absentes, mais on rajoute comme troisieme
@@ -1614,28 +1616,28 @@ sub _toBePruned ($$$)
my ($self, $from, $regexp) = @_;
# for message purposes, removing the \004 which indicates the connection status
-
+
my ($cleaned_from) = $from =~ /\004?(.*)/ ;
# print "DBG> $from s'abonne à nouvelle regexp '$regexp'\n";
-
+
# testing the received regexp for avoiding illformed regexp
eval {my $test = "a" =~ /$regexp/ } ;
if ($@) {
warn "Warning in Ivy::_toBePruned, receiving ill-formed regexp: '$regexp' from '$cleaned_from'" ;
return 1};
-
+
&_scanConnStatus ($self, $cleaned_from, 'subscribing', $regexp);
-
+
# si il n'y a pas de liste de sujets, on ne
# filtre pas
return 0 unless @{$self->[topicRegexps]};
-
+
unless ($regexp =~ /^\^/) {
#print "DBG> regexp non ANCREE de $from : $regexp\n";
return (0);
}
-
+
if ($regexp =~ /^\^(\w+)/) {
my $topic = $1;
if (grep (/$topic/, @{$self->[topicRegexps]})) {
@@ -1643,7 +1645,7 @@ sub _toBePruned ($$$)
#print "DBG> on garde de $from : $regexp\n";
return (0);
}
- #print "DBG> on ELIMINE de $from : $regexp\n";
+ #print "DBG> on ELIMINE de $from : $regexp\n";
return (1);
}
else {
@@ -1661,7 +1663,7 @@ sub _parseIvyBusParam ($)
my ($ivyNetworks, $ivyPort) = $ivyBus =~ /^(.*):(.*)/;
my $useMulticast = 0;
-
+
croak ("Error in Ivy::_parseIvyBusParam, illegal bus address format: $ivyBus\n")
unless $ivyPort =~ /^\d+$/;
@@ -1671,7 +1673,7 @@ sub _parseIvyBusParam ($)
my @broadcastAddrs = split (',', $ivyNetworks);
foreach my $netAddr (@broadcastAddrs) {
- $netAddr = BROADCAST_ADDRS if
+ $netAddr = BROADCAST_ADDRS if
(($netAddr eq '') || ($netAddr =~ /^127/) || ($netAddr =~ /^loopback/));
# deux cas de figure : on a un nom de sous reseau, ou
@@ -1699,11 +1701,11 @@ sub _parseIvyBusParam ($)
while (!$dummyNetAddr[0]) {
# tant que le premier octet est 0, on decale vers la gauche et
# ont fait rentrer un 255 sur la droite
- shift @dummyNetAddr;
+ shift @dummyNetAddr;
push (@dummyNetAddr, 255);
- }
+ }
$netAddrInet = pack ("CCCC", @dummyNetAddr);
- } else {
+ } else {
# on a deja une adresse ip, on rajoute les .255
# a la fin s'ils ont ete omis.
($netAddr .= ".255.255.255") =~ s/^((\d+\.){3}\d+).*/$1/;
@@ -1740,7 +1742,7 @@ sub _parseIvyBusParam ($)
return ($useMulticast, $ivyPort, \@ivyAddrInet);
} # end _parseIvyBusParam
-
+
############# Procedure _SUBSTITUTE ESCAPED CHAR
sub _substituteEscapedChar ($$)
{
@@ -1749,7 +1751,7 @@ sub _substituteEscapedChar ($$)
my %escapeRegexp = REG_PERLISSISME;
# Si on fait la substitution dans une classe de caractere
# on elimine les crochets.
- grep ($escapeRegexp{$_} =~ s/[\[\]]//g, keys %escapeRegexp)
+ grep ($escapeRegexp{$_} =~ s/[\[\]]//g, keys %escapeRegexp)
if ($scope eq 'inside') ;
$reg =~ s/\\([wWsSdDne])/$escapeRegexp{$1}/ge;
@@ -1809,7 +1811,7 @@ Name of your application used to identify on ivy bus.
A list of domains (may be empty), followed by a port number where to broadcast messages.
If the domain list is empty (i.e. parameter is ':port number'), broadcast will be done
on localhost (i.e. '127:port number'). Default is the value of the environment variable
-IVYBUS and if it is not defined the default is 127:2010.
+IVYBUS and if it is not defined the default is 127:2010.
Since V4.12, it is possible to use multicast (ie. with a domain between 224.0.0.0 and 239.255.255.255). You must be aware than when multicast is used, udp broadcast (defined in the B<-ivyBus> paramter) are skipped. You should also probably avoid using the 244.x.x.x domain often used for networking management.
@@ -2012,7 +2014,7 @@ This allows you to bind a regular expression to a
callback or method. The callback or method will be called for every
message that matches the regexp (case insensitive).
See perlre(1) to find how to write regexps.
-Use the bracketing construct ( ... ) so that your callback is
+Use the bracketing construct ( ... ) so that your callback is
called with the captured bits of text as parameters.
To unbind callback(s) associated to a regexp use bindRegexp with only
one argument, the regexp. Note that doing the same binding more than