#
#	Ivy, Perl interface 
# 
#	Copyright 1997-2000
#	Centre d'Études de la Navigation Aérienne
#
#	Authors: Alexandre Bustico <bustico@tls.cena.fr>
#		 Stéphane Chatty <chatty@tls.cena.fr>
#                Hervé Damiano <damiano@tls.cena.fr>
#
#	All functions
#
#	$Id$
#
#      Please refer to the debian/copyright file for the
#      copyright notice regarding this software
#

package Ivy2 ;

use Sys::Hostname;
use IO::Socket;
use strict ;
use Time::Gettimeofday ;


use vars qw($VERSION);
$VERSION = '4.3';

#############################################################################
####                    PROTOTYPES                                      #####
#############################################################################
sub init ($%);		# methode de classe, permet de renseigner
			# tous les parametres globaux. Ces parametres
			# seront utilises par new si ils ne sont pas
			# donnes lors de l'appel de new.


sub new ($%);           # verifie la validite de tous les parametres,
			# cree et retourne un objet Ivy. Les parametres
			# appName, networks, messWhenReady, peuvent
			# etre donnes, meme si ils ont deja ete
			# donnes dans init, dans ce cas, ce sont ceux
			# de new qui prevalent

sub start ($);		# debut de l'integration au bus :
		 	# - 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 
			#   traiter les bonjours
		 	# - 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
			# ou d'annuler une precedente association

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
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 
			# 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 
			# sera execute.
			# par contre si on est en mainloop Tk,
			# il faut en plus detruire la mainwindow
			# pour sortir de la mainloop;
sub after ($$;$);		# temps en millisecondes, callback
sub repeat ($$;$);	# temps en millisecondes, callback
sub afterCancel ($;$); # l'id d'un cancel ou d'un repeat
sub fileEvent ($$;$); # associe un fd a un callback pour la mainloop locale


################ PRIVEE ####################################################
sub _getBonjour ($); # lit le (ou les) bonjour(s) sur le canal de supervision
		# et se connecte, verifie qu'il ne se reponds pas lui
		# meme, ni qu'il ne repond pas a un service deja connecte

sub _getConnections ($); # est appele lors d'une demande de connection :
		    # accepte la connection et mets a jour  @sendRegList
		    # rajoute le fd du canal aux fd a scruter dans la
		    # boucle d'evenements

sub _getMessages ($$);   # est appele lorqu'un message arrive

sub _sendWantedRegexp ($$); # envoie les regexp  a l'appli distante

sub _sendLastRegexpToAllreadyConnected ($$) ; # envoie la derniere regexp
					    # pushee dans @recCbList
					    # 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
sub _sendDieTo ($$); #(fd) envoie un message de demande de suicide a un fd
sub _sendMsgTo ($$$);  # (fd, message)
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 
			 # $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 
			   # liste d'adresses addr_inet

sub _substituteEscapedChar ($$); #permet de transormer une regexp etendue 
				# 'perl' en regexp de base

#############################################################################
####                    CONSTANTES                                      #####
#############################################################################
use constant MSG_FMT => "%d %d\002%s\n";

# par defaut, on diffuse le bonjour en local
use constant BROADCAST_ADDRS => "127.255.255.255" ;
use constant BROADCAST_PORT => "2010";

use constant BYE	 => 0;
use constant REGEXP	 => 1;
use constant MSG	 => 2;
use constant ERROR	 => 3;
use constant DELREGEXP	 => 4;
use constant ENDREGEXP	 => 5;
use constant APP_NAME    => 6;
use constant DIRECT_MSG	 => 7;
use constant DIE	 => 8;
use constant PING	 => 9;
use constant PONG	 => 10;
use constant IVY_PROTOCOLE_VERSION => 3;

use constant AFTER	=> 0;
use constant REPEAT	=> 1;
use constant MAX_TIMOUT => 1000;

# pour pouvoir employer les regexps perl. Attention lors de l'utilisation
# ne pas mettre un \n dans une chaine entre "" car l'\n sera interprete.
use constant REG_PERLISSISME => ('w' => '[a-zA-Z0-9_]',
				 'W' => '[^a-zA-Z0-9_]',
				 's' => '[		]',
				 'S' => '[^		]',
				 'd' => '[0-9]',     
				 'D' => '[^0-9]',
				 'n' => '', # Il ne faut pas mettre d'\n : 
				            # c'est un delimiteur pour le bus
				 'e' => '[]') ;

#############################################################################
####                    VARIABLES de CLASSE                             #####
#############################################################################


# optimisation : si l'on connait les sujets des messages
# qu'on envoie, cette variable contient une liste de
# sujets qui doivent matcher les regexps d'abonnement
# pour que celle ci se soient pas eliminees
my @topicRegexps;

# 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 : 127.255.255.255
# c.a.d local a la machine
my $ivyBus ;

# le nom de l'appli pour le bus
my $appName ;

# message a envoyer a un canal lorsqu'on
# a recu le message endregexp.
my $messWhenReady ;

# 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,
# c'est le bus qui s'en charge
my $onDieFunc;


# permet de donner des valeurs successives aux constantes permettant
# d'acceder aux differents champs de l'objet
my $constantIndexer =0;

# pointeur sur la fonction permettant d'associer
# des callbacks a un file desc, (ainsi que de les enlever)
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;      

# table d'ass. handle -> callback
my %localBindByHandle;  

# tableau d'ass [AFTER ou REPEAT, 
#   timeTotal, deadLine, [callback, arg, arg, ...]]
my %afterList=();       

my $afterId = 0;	

# timeout le plus petit pour le select
my $selectTimout = MAX_TIMOUT;  


# liste des bus actifs
my %allBuses = ();


#############################################################################
####                    CLEFS DES VARIABLES D'INSTANCE                  #####
####									#####
#### l'objet Ivy sera 'blessed' sur une reference sur un array et non	#####
#### sur une table de hash comme pratique courament de facon a		#####
#### 1/ optimiser au niveau vitesse					#####
#### 2/ avoir des clefs sous forme de symboles (use constant...)	#####
####	et nom des clefs sous forme de chaines de caracteres		#####
####	de facon a eviter des erreurs					#####
####									#####
####									#####
#############################################################################
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 queueList  	=> $constantIndexer++;	
use constant threadList  	=> $constantIndexer++;	
use constant appliList  	=> $constantIndexer++;   
use constant sendRegList  	=> $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++; 

#############################################################################
####                    METHODES        PUBLIQUES                     #####
#############################################################################
sub init ($%) 
{
  my ($class, %options) = @_;  

  # valeurs par defaut pour le parametre : variable d'environnement
  # ou valeur cablee, a defaut
  my $default_ivyBus = defined $ENV{"IVYBUS"} ? $ENV{"IVYBUS"} : "";

  my %defaultOptions = ( #PARAMETRES OBLIGATOIRES
			-loopMode         => undef, 
			# TK ou LOCAL
			
			-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 : 
			# 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
			# proprement les ressources avant de sortir.
			# ps : ne pas fasire d'exit dans le callback,
			# c'est le bus qui s'en charge

			-pruneRegexp => [],
		     # 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. 
		       ) ;
  
  
  foreach my $opt  (keys %defaultOptions) {
    # si un parametre n'a pas ete defini
    next if defined $options{$opt} ;
    # est-il facultatif
    if (defined $defaultOptions{$opt}) {
      $options{$opt} = $defaultOptions{$opt} ;
    }
    else {
      # parametre obligatoire
      die "ERREUR Ivy::init vous devez specifier ".
	"l'option $opt\n";
    }
  }
  
  foreach my $opt  (keys %options) {
    die "ERREUR Ivy::init option $opt inconnue\n" unless
      exists ($defaultOptions{$opt});
  }
  
  my $loopMode =	$options{-loopMode};
  $ivyBus =		$options{-ivyBus} ne "" ? $options{-ivyBus} : undef;
  $appName =		$options{-appName} ;
  $messWhenReady =       
    $options{-messWhenReady} eq "_APP NAME READY" ?
      "$appName READY" : $options{-messWhenReady};

  $onDieFunc =	   $options{-onDieFunc} ;
  @topicRegexps = @{$options{-pruneRegexp}};

  if ($loopMode =~ /local/i) {
    # mode boucle d'evenement locale
    use IO::Select;
    $fileEventFunc = \&fileEvent ;
    $localLoopSel = IO::Select->new ();
  } elsif ($loopMode =~ /tk/i) {
    # mode boucle d'evenement de TK
    $fileEventFunc = \&_tkFileEvent ;
  } else {
    die "l'argument \"mainloop mode\" doit etre TK ou LOCAL\n";
  }

 $SIG{'PIPE'}	= 'IGNORE' ;  
}

############# METHODE DE CLASSE NEW
sub new ($%) 
{
  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 
  unless ((defined $appName) && ($appName ne '')) {
    die  "ERREUR Ivy::new vous devez initialiser le module via Ivy->init ()";
  }

  # No de port tcp du serveur
  $self->[servPort] = '';

  # liste des applis necessaires a l'appli locale
  $self->[neededApp] = [];

  # callback prenant en param 2 refs sur des listes :
  # [applis presentes, appli absentes]
  # cette fonction est appelee :
  # - tout les pollingTime tant que toutes les applis
  #   ne sont pas presentes
  # - des que toutes les applis sont presentes
  # - lorsqu'une appli se deconnecte
  $self->[statusFunc] = '';

  # callback prenant en param 1 refs sur une liste :
  #  [ref sur fonction, parametres]

  # socket de supervision en lecture/ecriture
  $self->[supSock] = '';

  # socket de connexion tcp
  $self->[connSock] = '';

  # tab ass : nom du fd => fd
  $self->[sockList] = {};

  # tab ass : nom de l'appli => fd
  $self->[appliList] = {};

  # tableau ass de liste  du type
  # sockId => [fonction, fonction, ...]
  # pour savoir quoi envoyer a qui
  # les fonctions anonymes sont compilees 
  # dynamiquement a la reception des messages REGEXP
  # et filtrent les mess a envoyer et les envoient
  # au besoin
  $self->[sendRegList] = {};

  # liste des topics qu'on envoie si on 
  # filtre les regexps
  $self->[topicRegexps] = [];

  # liste de ref sur des couples 
  # (regexp,callBack) les callbacks
  # sont appeles lors de
  # la reception de messages en fonction
  # du numero de regexp.
  $self->[recCbList] = [];

  # liste de callBack pour les messages directs
  $self->[directCbList] = [];

  # tableau ass : clef = nom:numero_de port
  # permet de verifier qu'on ne se connecte pas
  # sur nous meme et qu'on ne se reconnecte
  # pas sur un service en cas de bonjours repetes
  # valeur : nom de l'application
  $self->[cnnxion] = {};

  # tableau associatif, clef => file desc,
  # valeur :buffer au cas ou la lacture ne se termine
  # pas par \n, de maniere a resegmenter les messages
  $self->[buffByConn] = {};

  
  my %defaultOptions = ( 
			-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 : 
			# 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 
			# presentes, et si une appli necessaire se deconnecte
			# les trois parametres passes 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 !!

			-pruneRegexp => [@topicRegexps],
		     # 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. 
		       ) ;
  
  
  foreach my $opt  (keys %defaultOptions) {
    # si un parametre n'a pas ete defini
    next if defined $options{$opt} ;
    # est-il facultatif
    if (defined $defaultOptions{$opt}) {
      $options{$opt} = $defaultOptions{$opt} ;
    } else {
      # parametre obligatoire
      die "ERREUR Ivy::new vous devez specifier ".
	"l'option $opt\n";
    }
  }
  
  foreach my $opt  (keys %options) {
    die "ERREUR Ivy::start option $opt inconnue\n" unless
      exists ($defaultOptions{$opt});
  }
  


  $self->[appName] =    $options{-appName} ;
  $self->[messWhenReady] =    $options{-messWhenReady} ;
  @{$self->[neededApp]} =           @{$options{-neededApp}} ;
  $self->[statusFunc] =          $options{-statusFunc} ;
  $self->[topicRegexps] = $options{-pruneRegexp} ;
  $allBuses{$self}  = $self;

  ($self->[broadcastPort], $self->[broadcastBuses]) = 
    _parseIvyBusParam ($options{-ivyBus});

  
  return ($self);
}

############### METHODE	IVY DESTROY
sub DESTROY ($)
{
  my $self = shift;
  return unless exists $allBuses{$self};

  # print ("DBG DESTROY appele sur l'objet $self\n");

  # pour toutes les connections
  foreach my $fd (values %{$self->[sockList]}) {
    next unless exists ($self->[queueList]->{$fd});

    foreach my $fd (values %{$self->[sockList]}) {
      send ($fd, sprintf (MSG_FMT, BYE, 0, ""), 0) 
	or $self->_removeFileDescriptor ($fd);
    }
  }

  #  on clos la socket de signalisation (UDP)
  # print "DBG> fermeture de supSock\n";
  $self->[supSock]->close() if $self->[supSock];
  delete $allBuses{$self};

  # on clos la socket de connection 
  # print "DBG> fermeture de connSock\n";
  $self->[connSock]->close() if  $self->[connSock];
  undef (@$self);
}

############### METHODE DE CLASSE STOP
sub stop ()
{
  foreach my $bus (values %allBuses) {
    $bus->DESTROY();
  }  # pour toutes les connections
}


############## METHODE DE CLASSE EXIT
sub exit () 
{
  Ivy::stop ();
  if (defined $localLoopSel) {
    # boucle locale, on sait faire
    # printf ("DBG> undefining localLoopSel\n");
    undef  $localLoopSel;
  }
  else {
    Tk::exit ();
  }
}

############### PROCEDURE	BUS START
sub start ($) 
{
  my $self = shift;

    # cree la socket de connexion, recupere le no de port
    my $connSock = $self->[connSock] = IO::Socket::INET->new(Listen => 128,
							     Proto    => 'tcp',
							     Reuse   => 1) ;
    # 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 $localhostAddr = (gethostbyname ('localhost'))[4] ;
    $self->[cnnxion]->{"$hostAddr:". $connSock->sockport} = "\004";
    $self->[cnnxion]->{"$localhostAddr:". $connSock->sockport} = "\004";
    
    # cree la socket de broadcast
    $self->[supSock] = IO::Socket::INET->new
      (LocalPort  => $self->[broadcastPort],
       Proto      => 'udp',
       Type       => SOCK_DGRAM,
       Reuse      => 1);
    
    $self->[supSock]->sockopt (SO_BROADCAST, 1);

    
    # et on envoie envoie le bonjour : "no de version no de port"
    my $bonjourMsg = sprintf ("%d %d\n", IVY_PROTOCOLE_VERSION, $connSock->sockport());
    
    foreach my $netBroadcastAddr (@{$self->[broadcastBuses]}) {
	send ($self->[supSock], $bonjourMsg, 0, $netBroadcastAddr) or 
	    warn "Ivy::start envoi du bonjour a echoue sur : $!\n";
    }    
    # callback pour traiter la reception des bonjours
    &$fileEventFunc ($self->[supSock], [\&_getBonjour, $self]) ;
    
    # callback pour traiter les demandes de cxion
    &$fileEventFunc ($self->[connSock], [\&_getConnections, $self]) ;
}

	   
############### PROCEDURE	BIND REGEXP	   
sub bindRegexp ($$$) {
  my ($self, $regexp, $cb) = @_;

  # on substitue les meta caracteres des regexps perl : \d, \w, \s, \e
  # par les classes de caracteres corespondantes de maniere a ce
  # qu'une appli distante non perl comprenne ces regexp.
  $regexp =~ s|
    (
     (?<!\\) \[	# 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 \ 
    )
      |
	_substituteEscapedChar ('inside', $1)
	  |xge;
  
  $regexp = _substituteEscapedChar ('outside', $regexp);
  # print ("DBG regexp = $regexp\n");
  
  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]};
    }
    $self->[recCbList][$id] =  [$regexp, $cb];

    # on envoie les messages regexps aux processus deja connectes
    _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); 
	}
      }
    }
  }
}

############### METHODE	BIND REGEXP	   
sub bindDirect ($$$)	   
{
  my ($self, $id, $cb) = @_;
  
  if ($cb) {
    # on rajoute la $cb dans la liste des messages
    # qu'on prend
    $self->[directCbList][$id] =  $cb;
  } else {
    # on vire le callback
    undef $self->[directCbList][$id];
  }
}
	   
############### PROCEDURE	SEND MSGS	    
sub sendMsgs ($@)
{
  use attrs qw(locked);

  my ($self, @msgs) = @_;
  my $total = 0;

  # pour tous les messages
  foreach my $msg (@msgs) {
    study ($msg);

    # 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;
      }
    }
  }
  #    print "DBG> sended $total times\n";
  return $total;
}

############### PROCEDURE	SEND MSGS	    
sub sendAppNameMsgs ($@)
{
  use attrs qw(locked);

  my ($self, @msgs) = @_;
  my $total = 0;

  # pour tous les messages
  foreach (@msgs) {
    my $msg = "$self->[appName] $_";
    study ($msg);

    # 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;
      }
    }
  }
  #    print "DBG> sended $total times\n";
  return $total;
}



############### PROCEDURE	SEND DIRECT MSGS	    
sub sendDirectMsgs ($$$@)
{
  my ($self, $to, $id, @msgs) = @_;
    
  if (defined ($self->[appliList]{$to})) {
    my @fds = @{$self->[appliList]{$to}};
    # pour tous les messages
    foreach my $msg (@msgs) {
      foreach my $fd (@fds) {
	send ($fd, sprintf (MSG_FMT, DIRECT_MSG, $id, "$msg"), 0)
	  or $self->_removeFileDescriptor ($fd); 
      }
    }
    return 1;
  } else {
    warn "Ivy::sendDirectMsgs appli $to inconnue\n";
    return 0;
  }
}


############### METHOD	SEND DIE TO	    
sub sendDieTo ($$)
{
  use attrs qw(locked);
  my ($self, $to) = @_;
    
  if (defined ($self->[appliList]{$to})) {
    my @fds = @{$self->[appliList]{$to}};

    warn "Attention : Ivy::sendDieTo gros BUG \@fds est vide \n" 
      if (scalar (@fds) == 0);

    # pour tous les messages
    foreach my $fd (@fds) {
      $self->_sendDieTo($fd);
    }
    return 1;
  }
  else {
    warn "Ivy::sendDieTo appli $to inconnue\n" if $^W;
    return 0;
  }
}


############### METHOD	PING    
sub ping ($$$)
{
  use attrs qw(locked);

  my ($self, $to, $timeout) = @_;
    
  if (defined ($self->[appliList]{$to})) {

    my @fds = @{$self->[appliList]{$to}};

    # pour tous les messages
    foreach my $fd (@fds) {
      send ($fd, sprintf (MSG_FMT, PING, 0, " "), 0)
	or $self->_removeFileDescriptor ($fd); 
    }
  }
}

###############   METHODE     MAINLOOP
sub mainLoop ()
{
  die "Erreur Ivy->mainLoop, Ivy doit etre initialise en mode".
    " loopMode local\n"   unless defined  $localLoopSel;

  my ($fd, @ready, @allDesc);
  
  while (defined  $localLoopSel) {
    @ready = IO::Select::can_read ($localLoopSel, $selectTimout) ;
    _scanAfter () ;

    foreach my $fd (@ready) {
      if (ref $localBindByHandle{$fd} eq 'CODE') {
	&{$localBindByHandle{$fd}} ;
      }
      else {
	my ($cb, @arg) = @{$localBindByHandle{$fd}} ;
	&$cb (@arg)
      }
    }
  }
}
 

############### METHODE	AFTER	
sub after ($$;$)
{
  # test du premier argument au cas ou la fonction soit
  # appelee de maniere objet : premier argument = class ou une instance
  # de classe
  shift if ((ref ($_[0]) eq 'Ivy') || ($_[0] eq 'Ivy')) ;

  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, 
			    timeofday()+$timeAfter, $cbListRef];

  return ($afterId);
}

############### METHODE	REPEAT
sub repeat ($$;$)
{
  # test du premier argument au cas ou la fonction soit
  # appelee de maniere objet : premier argument = class ou une instance
  # de classe

  shift if ((ref ($_[0]) eq 'Ivy') || ($_[0] eq 'Ivy')) ;
  # on passe le temps en secondes pour le select
  my ($timeAfter,  $cbListRef) = @_;
  $timeAfter /= 1000;
  $selectTimout = $timeAfter if $timeAfter < $selectTimout;

  $afterList{++$afterId}= [REPEAT, $timeAfter, timeofday()+$timeAfter, 
			   $cbListRef];
  return ($afterId);
}

############### METHODE	AFTER CANCEL	
sub afterCancel ($;$)
{
  # test du premier argument au cas ou la fonction soit
  # appelee de maniere objet : premier argument = class ou une instance
  # de classe
  shift if ((ref ($_[0]) eq 'Ivy') || ($_[0] eq 'Ivy')) ;
  
  my $id = shift;
    
  if (defined ($id) && defined $afterList{$id}) {
    if ($afterList{$id}->[1] <= $selectTimout) {
      delete $afterList{$id} ;
      # le timout de l'after/repeat etait le plus petit des timout
      # on cherche donc le plus petit parmi ceux qui restent;
      $selectTimout = MAX_TIMOUT;
      foreach my $af (values %afterList) {
	$selectTimout = $af->[1] if $af->[1] < $selectTimout ;
      }
    }
    else {
      delete $afterList{$id} ;
    }
  }
}

############### METHODE	FILE EVENT 	
sub fileEvent ($$;$)
{
  # test du premier argument au cas ou la fonction soit
  # appelee de maniere objet : premier argument = class ou une instance
  # de classe
  shift if ((ref ($_[0]) eq 'Ivy') || ($_[0] eq 'Ivy')) ;
  
  my ($fd, $cb) = @_;
  
  
  unless (defined $localLoopSel) {
    die ("Erreur Ivy::fileEvent : Ivy::fileEvent n'est utilisable qu'en ".
	 "mode mainLoop	LOCALE\n");
  } 

  if ($cb) {
    # adding the handler
    $localBindByHandle{$fd} = $cb;
    $localLoopSel->add ($fd);
  } else  {
    # deleting the handler
    delete $localBindByHandle{$fd};
    # print ("DBG: Ivy::fileEvent : removing fd from the select\n");
    $localLoopSel->remove ($fd);
  }
}

#############################################################################
####                     METHODES       PRIVEES                       #####
#############################################################################


############### METHODE	GET BONJOUR 	
sub _getBonjour ($)
{
  my $self = shift;

  my $bonjourMsg = '';

  # l'hote distant
  my $inetAddr = $self->[supSock]->recv ($bonjourMsg, 1024, 0);

  unless (length $inetAddr) {
    warn "Attention : Ivy::_getBonjour recv error, bonjour non traite\n";
    return;
  }
  
  my $addr = (unpack_sockaddr_in ($inetAddr))[1];
  
  my $peerName = gethostbyaddr ($addr, AF_INET);
  print "peerName=$peerName\n";
  # on force $peerPort a etre vu comme une valeur numerique
  my ($version, $peerPort) = $bonjourMsg =~ /^(\d+)\s+(\d+)/;

  unless (defined ($version) && defined ($peerPort)) {
    warn "Attention : Ivy::_getBonjour  format du message bonjour incorrect\n".
      "message = $bonjourMsg\n" ;
    return;
  }

  if ($version != IVY_PROTOCOLE_VERSION) {
    warn "Attention : Ivy::_getBonjour VERSION: demande de connexion de ".
      "$peerName\n version courrante : " . IVY_PROTOCOLE_VERSION . ", recue : $version\n" ;
    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 {
    #print "DBG> : reception de $peerName : bonjour $peerPort\n" ;
  }
   
# 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], 
				@{$self->[broadcastBuses]});
  # 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", 
			      ($addr & $ivyBusAddr) ^ $addr)));
  }

  if ($addrInIvyBus == 0) {
    warn "bonjour de $peerName ignore, ne fait pas partie des ivyBus\n" if $^W;
    return;
  }

  # ouverture du canal de communication
  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;
    $self->[sendRegList]{$appSock} = [];
    $self->[buffByConn]{$appSock} = '';
    $self->[sockList]{$appSock} = $appSock;
    &$fileEventFunc ($appSock, [\&_getMessages, $self, $appSock]) ;

    # on balance les regexps qui nous interessent a l'appli distante
    $self->_sendWantedRegexp ($appSock);
  }
  else {
    warn "Attention Ivy::_getBonjour impossible de se connecter au serveur" .
      "$peerName:$peerPort\n" ;
  }
}


############### PROCEDURE	GET CONNECTIONS
sub _getConnections ($)
{
  my $self = shift;
  print "_getConnections\n";
  my $appSock = $self->[connSock]->accept();

  unless (defined $appSock) {
    warn "Attention Ivy::_getConnections, \$appSock not defined\n";
    return;
  }
  else {
    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]) ;

  # on cree une entree pour $appSock dans la liste des regexp
  $self->[sendRegList]{$appSock} = [];
  $self->[buffByConn]{$appSock} = '';
  $self->[sockList]{$appSock} = $appSock;
  # on balance les regexps qui nous interessent a l'appli distante
  $self->_sendWantedRegexp ($appSock);
}


############### METHODE	GET MESSAGES
sub _getMessages ($$)
{
    my ($self, $appSock) = @_;
    my $mess;
    my $buffer = '';
    my ($addr, $peerPort, $senderName);

    # on recupere le message
    recv ($appSock, $buffer, 65536, 0) ;
    unless (length $buffer) {
      # message null : broken pipe, ça s'est deconnecte a l'autre bout
      # on vire ce fd de la boucle d'evenements
      # print ("DBG : _getMessages, recv err, calling removeFileDesc.\n");
      # Bon la il faudra un jour clarifier ce bordel, lister toutes
      # les facons dont un couple d'applis connectee peuevent sortir et
      # eviter les dead lock qui doivent subsister.
      if (defined ($localLoopSel)) {
	$self->_removeFileDescriptor ($appSock);
      }
      else {
	$self->_removeFileDescriptor ($appSock);
      }
      return;
    }
    
    if (length ($self->[buffByConn]{$appSock})) {
	$buffer = $self->[buffByConn]{$appSock} . $buffer ;
	$self->[buffByConn]{$appSock} = '';
    }
    my @messages = split ('\n', $buffer) ;
    $self->[buffByConn]{$appSock} = pop (@messages) unless
      ($buffer =~ /\n$/) ;

    #     if (defined $appSock->peername) {
    $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+) 
	\s+
	  (\d+)
	    \002
	      (.*)/x ;
	
	# si ca a chie on rale
      (warn "Attention Ivy::_getMessages malformated message $mess\n" 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
	# a l'identifiant et on appelle la fonction avec les parametres
	# traites par la regexp
	if (my @cb = @{$self->[recCbList][$id]->[1]}) {
	  my $cb = shift @cb;
	  my $refcb = ref($cb);
	  if ($refcb ne 'CODE') {
	    my $method = shift @cb;
	    # on split sur ETX
	    $cb->$method($senderName, @cb, split ("\003", $valeurs)) ;
	  }
	  else {
	    &$cb ($senderName, @cb, split ("\003", $valeurs)) ;
	  }
	}
	else {
	  #_sendErrorTo ($appSock, "REEGXP ID $id inconnue");
	  warn ("Attention Ivy::_getMessages reception d'un message ".
		"MSG : id $id inconnu de $senderName :\n«$mess»");
	}
      }
      elsif ($type == BYE) {
	#print "reception d'un bye\n";
	$self->_removeFileDescriptor ($appSock);		        # B Y E
      }
      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
	# fois pour toute, et ainsi optimiser la vitesse de
	# filtrage des messages a envoyer
	next if $self->_toBePruned ($senderName, $valeurs);
	unless (defined $self->[sendRegList]{$appSock}->[$id]) {
	  # si l'id de regexp n'etait pas utilisee c'est tout bon
	  # on affecte la nouvelle regexp a un id
	  $self->[sendRegList]{$appSock}->[$id] = eval <<'_EOL_';
	  sub  {
	    use strict;
	    if (my @args = ${$_[0]} =~ /($valeurs)/o) {
	      shift @args;
	      $args[$#args] .= "\003" if @args;
	      send ($appSock, sprintf (MSG_FMT,
				       MSG, $id, join ("\003",@args)), 0)
		or $self->_removeFileDescriptor ($appSock) ;
	      #print join (' ', "DBG > J'envoie MSG", $id, @args, "\n");
	      return 1;
	    }
	  };
_EOL_
        } 
	else {
	  # 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");
	}
      }
      elsif ($type == ERROR) {				# E R R O R
	warn ("Attention Ivy::_getMessages ERREUR recue de ".
	    "$senderName : «$valeurs»\n");
      }
      elsif ($type == DELREGEXP) {			# D E L   R E G E X P
	# on vire la regexp des regexps vefifier
	$self->[sendRegList]{$appSock}->[$id] = undef ;
      }
      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
	$self->_sendMsgTo ($appSock, $self->[messWhenReady]);

	# on passe de l'etat Connecte a l'etat Ready
	$self->[cnnxion]{"$addr:$peerPort"} =~ s/^\004//;
	$senderName = $self->[cnnxion]{"$addr:$peerPort"};

	unless (exists $self->[appliList]{$senderName}) {
	  $self->[appliList]{$senderName} = [$appSock];
	}
	else {
	  push @{$self->[appliList]{$senderName}},  $appSock;
	}

	$self->_scanConnStatus ();
      }
      elsif ($type == APP_NAME) {	
	# etat Connecte
	if (($self->[appName] eq $valeurs) && $^W) {
	  warn "\033[1mATTENTION : Ivy::_getMessages une instance de ".
	    "$self->[appName] existe deja\033[m\n" ;
	}

	$senderName = $valeurs;
	$self->[cnnxion]{"$addr:$peerPort"} = "\004$valeurs";	
      }
      elsif ($type == DIRECT_MSG) {

	if (defined $self->[directCbList][$id]) {
	  my @cb = @{$self->[directCbList][$id]};
	  my $cb = shift @cb;
	  my $refcb = ref($cb);
	  if ($refcb ne 'CODE') {
	    my $method = shift @cb;
	    $cb->$method(@cb, $valeurs);
	  }
	  else {
	    &$cb (@cb, $valeurs);
	  }
	}
	else {
	  $self->_sendErrorTo ($appSock, "DIRECT ID $id inconnue");
	  warn "Attention Ivy::_getMessages reception d'un message ".
	    "DIRECT d'id $id inconnue de $senderName :\n«$mess»";
	}
      } elsif ($type == DIE) {
	# il faut quitter
	# on commence par appeler la callback de fin
	my @cb = @{$onDieFunc};
	my $cb = shift @cb;
	my $refcb = ref($cb);
	if ($refcb ne 'CODE') {
	  my $method = shift @cb;
	  $cb->$method(@cb);
	}
	else {
	  &$cb (@cb);
	}
	# on avertit les autres qu'on se barre
	my $adr = $self->_inetAdrByName ($senderName) ;
	warn "Attention Ivy::_getMessages reception d'un ordre " .
	  "de suicide de $senderName ($adr) ... exiting\n" if $^W;
	# adios
	Ivy::exit ();

      }
      elsif ($type == PING) {
	# si on recois un ping, on envoie un pong
	$self->_pong ($appSock);
      }
      elsif ($type == PONG) {
	return PONG;
      }
      else  {
	_$self->sendErrorTo ($appSock, "TYPE DE MESS $type inconnu");
	warn ("reception d'un message de type $type inconnu de " . 
	      "$senderName :\n«$mess»");
      }
    } 
    return 0;
  }

############### 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];

    send ($appSock,
	  sprintf (MSG_FMT, REGEXP, $id, $self->[recCbList][$id]->[0]),
	  0) or $self->_removeFileDescriptor ($appSock) ;
    #	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)  
    or $self->_removeFileDescriptor ($appSock) ;
}

############### METHODE	SEND LAST REGEXP TO ALLREADY CONNECTED
sub _sendLastRegexpToAllreadyConnected ($$)
{
  my ($self, $id) = @_;
  
  foreach my $fd (values %{$self->[sockList]}) {
    send ($fd, sprintf (MSG_FMT, REGEXP, $id, $self->[recCbList][$id]->[0]), 
	  0) or $self->_removeFileDescriptor ($fd) ;
  }
}

############### METHODE	INET ADR BY NAME
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}):(.*)/;
  
  my $host = (gethostbyaddr ($addr, AF_INET))[0] ;
  return "$host:$port";
}


############### PROCEDURE	REMOVE FILE DESCRIPTOR
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
  # sinon le select merde salement sur ce coup
  &$fileEventFunc ($fd, '') ;
  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}}) {
      if ($fd eq $fdp) {
	$diedAppName = $name;
	@{$self->[appliList]{$name}} =
	  grep ($_ ne $fdp, @{$self->[appliList]{$name}});
	if (scalar (@{$self->[appliList]{$name}}) == 0) {
	  delete $self->[appliList]->{$name}
	}
	last EXT_LOOP;
      }
    }
  }
  
  unless (defined $diedAppName) {
    warn "Ivy::__removeFileDescriptor : deconnection de NONAME\n" if $^W;
    return;
  }
  
  my $addrInet = (grep ($self->[cnnxion]{$_} eq $diedAppName,
			keys %{$self->[cnnxion]}))[0];
  
  unless (defined $addrInet) {
    die "ERREUR _removeFileDescriptor deconnection de $diedAppName ".
      "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
  $self->_scanConnStatus () ;
}


############### METHODE	SEND ERROR TO
sub _sendErrorTo ($$$)
{
  my ($self, $fd, $error) = @_;
  
  send ($fd, join (' ', ERROR, "0\002$error\n"), 0) 
    or $self->_removeFileDescriptor ($fd);
}


############### METHODE	PONG
sub _pong ($$)
{
  my ($self, $fd) = @_;

  send ($fd, join (' ', PONG, "0\002 \n"), 0) 
    or $self->_removeFileDescriptor ($fd);
}


############### METHODE	SEND ERROR TO
sub _sendDieTo ($$)
{
  my ($self, $fd) = @_;
  
  send ($fd, join (' ', DIE, "0\002\n"), 0) 
    or $self->_removeFileDescriptor ($fd);
}


############### METHODE	SEND MSG TO
sub _sendMsgTo ($$$)
{
  my ($self, $fd, $msg) = @_;

  # pour toutes les fonctions de filtrage de regexp
  foreach my $regexpFunc (@{$self->[sendRegList]{$fd}}) {
    &{$regexpFunc} (\$msg) if defined $regexpFunc;
  }
}


############### PROCEDURE TK FILE EVENT	
sub _tkFileEvent ($$)
{
  my ($fd, $cb) = @_;
    
  Tk::fileevent ('', $fd, 'readable', $cb) ;
}


############### PROCEDURE SCAN AFTER
sub _scanAfter ()
{
  my $stamp = timeofday ();
  $selectTimout = MAX_TIMOUT;
  foreach my $afk (keys %afterList) {
    my $af = $afterList{$afk};
    # si ce timer est a declencher
    if ($af->[2] <= $stamp) {
      # on traite : le temps de declencher le cb est arrive
      if (ref  $af->[3] eq 'CODE') {
	&{$af->[3]};
      }
      else {
	my ($cb, @args) = @{$af->[3]};
	&$cb (@args);
      }
      # si c'est un repeat on le reconduit
      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);
      }
    }
    else {
      my $timeTotrigg = $af->[2] - $stamp;
      $selectTimout = $timeTotrigg if $timeTotrigg < $selectTimout;
    }
  }
}


############### METHODE	SCAN CONN STATUS	
sub _scanConnStatus ($)
{
  my $self = shift;

  my (%readyApp, @nonReadyApp);

  foreach (values %{$self->[cnnxion]}) {
    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,
  # la liste des applis absentes, mais on rajoute comme troisieme
  # argument une ref sur une table de hash : comme clef les
  # applis presentes, comme valeur le nombre d'applis ayant ce nom,
  # 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);
}


############### METHODE	TO BE PRUNED
sub _toBePruned ($$$)
{
  my ($self, $from, $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]})) {
      # on a trouve ce topic : on ne filtre pas la regexp
      #print "DBG> on garde de $from : $regexp\n";
      return (0);
    }
    #print "DBG> on ELIMINE de $from : $regexp\n";	
    return (1);
  }
  else {
    #print "DBG> on garde de $from : $regexp\n";
    return (0);
  }
}


############### PROCEDURE PARSE IVY BUS PARAM
sub _parseIvyBusParam ($) 
{
  my $ivyBus = shift;

  my ($ivyNetworks, $ivyPort) = $ivyBus =~ /^(.*):(.*)/;

  die ("Erreur Ivy::_parseIvyBusParam format de l'adresse ou ".
       "no de port incorrect : $ivyBus\n")
    unless  $ivyPort =~ /^\d+$/;

  my @ivyAddrInet = ();

  $ivyNetworks =~ s/ //g;
  my @broadcastAddrs = split (',', $ivyNetworks);

  foreach my $netAddr (@broadcastAddrs) {
    $netAddr = BROADCAST_ADDRS if 
    (($netAddr eq '') || ($netAddr =~ /^127/) || 
     ($netAddr =~ /^loopback/));

    # deux cas de figure : on a un nom de sous reseau, ou
    # une adresse ip de la forme \d+.\d+....
    my $netAddrInet;

    if ($netAddr !~ /^(\d+\.)+\d+/) {
      # on a un nom de reseau, il faut trouver son adresse ip
      # on contourne un bug : Si les adresses sont incompletes
      # dans la map network : 143.196.53 au lieu de 143.196.53.255
      # getbyname renvoie une adresse de type 0.143.196.53.
      # on doit donc faire un decalage des octets vers la gauche,
      # chaque 0 qui sort a gauche est remplace par un 255 a droite.
      my $networkAddr = getnetbyname ($netAddr);
      unless (defined $networkAddr) {
	warn ("Ivy::_parseIvyBusParam reseau inconnu :  $netAddr\n");
	next;
      }

      my @dummyNetAddr = unpack ("CCCC", pack ('N', $networkAddr));
      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; 
	push (@dummyNetAddr, 255);
      } 
      $netAddrInet = pack ("CCCC", @dummyNetAddr);
    } else { 
      # on a deja une adresse ip, on rajoute les .255
      # a la fin s'ils ont etes omis.
      ($netAddr .= ".255.255.255") =~ s/^((\d+\.){3}\d+).*/$1/;
      $netAddrInet =  inet_aton ($netAddr);
    }
    
    push (@ivyAddrInet,  pack_sockaddr_in ($ivyPort, $netAddrInet));	
  }
  return ($ivyPort, \@ivyAddrInet);
}
  
############# Procedure _SUBSTITUTE ESCAPED CHAR
sub _substituteEscapedChar ($$)
{
  my ($scope, $reg) = @_;

  my %escapeRegexp = REG_PERLISSISME;
  # Si on fait la substitution dans une classe de caractere
  # on elimine les crochets.
  grep ($escapeRegexp{$_} =~ s/[\[\]]//g, keys %escapeRegexp) 
    if ($scope eq 'inside') ;

  $reg =~ s/\\([wWsSdDne])/$escapeRegexp{$1}/ge;
  return $reg;
}

1;

__END__

=head1 NAME

Ivy - Perl extension for implementing a software bus

=head1 SYNOPSIS

use Ivy;

=head1 DESCRIPTION

The Ivy perl module implements a software bus to provide with an easy
communication between applications. Messages are broadcasted as ASCII strings
over a network defined by a list of domains and a port.
Messages are received if they match a regular expressions and if your application
is on the same network as remote ones.
Before receive or send message you must call 'init', and 'new' class methods,
followed by 'start' method.
When you quit your application don't forget to call 'exit' class methods.

=head1 CLASS METHODS

=head2 Ivy->init(...)

Allows one to define global parameters which may be used as default ones
at object creation time.

Parameters are :

=over 4

=item B<-loopMode =E<gt> 'TK'|'LOCAL'>

Mode of events loop among TK or LOCAL. According to this mode, you must
use Ivy->mainLoop or Tk::MainLoop(3)

=item B<-appName =E<gt> 'your app ivy name'>

Name of your application used to identify on ivy bus.

=item B<-ivyBus =E<gt> 'domain 1,...,domain n:port number'>

A list of domains, followed by port number where to broadcast messages.
Default is 127.255.255.255:2010

=item B<-messWhenReady =E<gt> 'your message when ready'>

Synchronisation message sent when application is ready to receive and send
messages.

=item B<-onDieFunc =E<gt> [\&yourdiefunc, @parameters]>

=item B<-onDieFunc =E<gt> [$an_object, \&a_method, @parameters]>

A callback or method to call when application receive die message.
Don't make an exit in callback, ivy we'll do it for you.

Prototype of your callback must be :

sub MyCallback {
  my @parameters = @_;

  ...
}

Prototype of your method must be :

sub MyMethod {
  my ($self, @parameters) = @_;

  ...
}

=item B<-pruneRegexp =E<gt> ['subject 1', ..., 'subject n']>

Optimize communication using this option. Regexps which don't match these subjects are removed.

Example :

	Ivy->init(-loopMode =E<gt> 'TK',
		  -appName =E<gt> 'MyWonderfulApp',
                  -onDieFunc =E<gt> [\&restorecontext]);

=back

=head2 Ivy->new(...);

Check parameters, and create an ivy bus object. You must call Ivy->init before
this one.

Parameters are :

=over 4

=item B<-appName =E<gt> 'your app ivy name'>

Name of your application used to identify on ivy bus.

=item B<-ivyBus =E<gt> 'domain 1,...,domain n:port number'>

A list of domains, followed by port number where to broadcast messages.
Default is 127.255.255.255:2010

=item B<-messWhenReady =E<gt> 'your message when ready'>

Synchronisation message sent when application is ready to receive and send
messages.

=item B<-onDieFunc =E<gt> [\&yourdiefunc, @parameters]>

=item B<-onDieFunc =E<gt> [$an_object, \&a_method, @parameters]>

A callback or method to call when application receive die message.
Don't make an exit in callback, ivy we'll do it for you.
Prototype of your callback must be :

	sub MyCallback {
	  my @parameters = @_;
	  ...
	}

Prototype of your method must be :

	sub MyMethod {
	  my ($self, @parameters) = @_;
	  ...
	}

=item B<-pruneRegexp =E<gt> ['subject 1', ..., 'subject n']>

Optimize communication using this option. Regexps which don't match these subjects are removed.

=item B<-neededApp =E<gt> ['app 1', ..., 'app n']>

A list of application your own one needs to correctly run.

=item B<-statusFunc =E<gt> sub {}>

A callback which will be called until every needed app is present on bus.

Your callback could be :

	sub MyCallback {
	  my ($present, $absent, %present) = @_;
	
	  foreach my $remoteapp (keys %present) {
	    if ($present{$remoteapp} > 1) {
	      print "n apps $remoteapp are presents on bus\n";
	    }
	  }

Example :

	Ivy->new(-ivyBus => '156.255.255.255,157.255.255.255:2204',
                 -onDieFunc => [\&restorecontext],
                 -neededApp => ["DataServer", "HMI"],
                 -statusFunc => \&startwhenpresents);

=back

=head2 Ivy->mainLoop;

Local main events loop. Use it if you don't use Tk library.

=head2 $ivyobj->stop;

=head1 OBJECT METHODS

=head2 $ivyobj->start;

You must call it after you are ready to communicate through ivy bus
and before you really communicate.

=head2 $ivyobj->sendMsgs(@messages);

Send a list of messages

Example :

	$ivyobj->sendMsgs("Hello World", "Don't Bother", "Y2K is behind us");

=head2 $ivyobj->sendAppNameMsgs(@messages);

Send a list of messages precedeed by ivy application name.

Example :

	$ivyobj->sendMsgs("Hello World");
	# it will send "$appName Hello World" over ivy bus

=head2 $ivyobject->bindRegexp($regexp, [\&callback, @cb_parameters]);

=head2 $ivyobject->bindRegexp($regexp, [$an_obj, \&method, @cb_parameters]);

Allow one to associate a message which matches a regular expression and a
callback or method. See perlre(1), to find how to write regexps.
Use the bracketing construct ( ... ), so that ivy perl will call
callback with matched patterns as parameters.

Example :

	$ivyobject->bindRegexp("\w+ (\d+)", [\&callback, @cb_parameters]);
	# You callback will be called with one more parameter which will be
	# a number precedeed by a word, because of bracketed regexp.

Your callback and method protos must be :

	sub cb {
	  my ($sendername, @cb_parameters,
		 @matched_regexps_in_brackets) = @_;
	  ...
	}

	sub method {
	  my ($self, $sendername, @cb_parameters,
		 @matched_regexps_in_brackets) = @_;
	  ...
	}

=head2 $ivyobj->sendDirectMsgs($to, $id, @msgs);

Send a message but Ask Alex to find what are $to and $id

=head2 $ivyobj->bindDirect($regexp, $id, [\&callback, @cb_parameters]);

=head2 $ivyobj->bindDirect($regexp, $id, [$an_obj, \&method, @cb_parameters]);

Same as bindRegexp method but Ask Alex to find what is $id.

=head2 $ivyobj->sendDieTo($to)

send a die message to $to application name.

=head2 $ivyobj->ping($to, $timeout);

send a ping message and wait until timeout to receive a pong.

=head2 $after_id = $ivyobj->after($timeAfter, \@callbacks_list);

Call a list of callbacks after $timeAfter mseconds.

=head2 $repeat_id = $ivyobj->repeat($timeAfter, \@callbacks_list);

Repeat calls of a list of callbacks after $timeAfter mseconds.

=head2 $ivyobj->afterCancel($after_or_repeat_id);

Cancel an after callback call.

=head2 $ivyobj->fileEvent($fd, $cb);

Ask Alex

=head2 $ivyobj->DESTROY;

=head1 BUGS

No know bugs at this time. Report them to author.

=head1 SEE ALSO

perl(1), perlre(1)

=head1 AUTHORS

Alexandre Bustico <bustico@tls.cena.fr>, Herve Damiano <damiano@tls.cena.fr>

=head1 COPYRIGHT

CENA (C) 1997-2000

=head1 HISTORY

=cut