#
#	Ivy, Perl interface 
# 
#	Copyright 1997-2002
#	Centre d'Études de la Navigation Aérienne
#
#	Authors: Alexandre Bustico <bustico@cena.fr>
#		Stéphane Chatty <chatty@cena.fr>
#		Hervé Damiano <damiano@cena.fr>
#		Christophe Mertz <mertz@cena.fr>
#
#	All functions
#
#	$Id$
#
#	This program is free software; you can redistribute it and/or
#	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 ;

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

use vars qw($VERSION);

# 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_]+)/ ;
if (defined $VERSION and $VERSION ne "_") {
    $VERSION =~ s/_/\./g;
}
else {
    $VERSION = $REVISION;
}

#############################################################################
####                    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 afterResetTimer ($;$); # pour ré-armer un timer non-encore déclenché à sa valeur initiale
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 transformer 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' => "[\t ]",
				 'S' => "[^\t ]",
				 '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                             #####
#############################################################################

# l'objet Ivy utilise par defaut quand le programmeur
# utilise le mode de compatibilite de la version 3, et ne
# manipule pas d'objets
my $globalIvy ;

# 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 threadList  	=> $constantIndexer++;
use constant appliList  	=> $constantIndexer++;
use constant sendRegList  	=> $constantIndexer++;
use constant sendRegListSrc  	=> $constantIndexer++;
use constant topicRegexps  	=> $constantIndexer++;
use constant recCbList  	=> $constantIndexer++;
use constant directCbList 	=> $constantIndexer++;
use constant cnnxion   		=> $constantIndexer++;
use constant buffByConn   	=> $constantIndexer++;
use constant broadcastPort  	=> $constantIndexer++;
use constant broadcastBuses	=> $constantIndexer++;
use constant appName		=> $constantIndexer++;
use constant messWhenReady 	=> $constantIndexer++;

#############################################################################
####                    METHODES      PUBLIQUES                     #####
#############################################################################
sub init
{
  my $class = shift if (@_ and $_[0] eq __PACKAGE__);
  my (%options) = @_;  

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

  my %optionsAndDefaults = ( #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 faire 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. 
		       ) ;

  # on examine toutes les options possibles
  foreach my $opt  (keys %optionsAndDefaults) {
    # si un parametre a ete fourni, ignorer les valeurs par defaut
    next if defined $options{$opt} ;
    # sinon, prendre la valeur par defaut si elle existe
    if (defined $optionsAndDefaults{$opt}) {
      $options{$opt} = $optionsAndDefaults{$opt} ;
    # sinon, on jette l'eponge
    } else {
      croak "Error in Ivy::init: option $opt is mandatory\n";
    }
  }

  # on examine toutes les options fournies, pour detecter les inutiles  
  foreach my $opt (keys %options) {
    unless (exists ($optionsAndDefaults{$opt})) {
      carp "Warning in Ivy::init:  option $opt is unknown";
    }
  }

  my $loopMode = $options{-loopMode};
  $ivyBus = $options{-ivyBus};
  $appName = $options{-appName} ;
  $onDieFunc = $options{-onDieFunc} ;
  @topicRegexps = @{$options{-pruneRegexp}};
  $messWhenReady =  $options{-messWhenReady} eq "_APP NAME READY" ?
			"$appName READY" :
			$options{-messWhenReady};


  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 {
    croak "Error in Ivy::init, argument loopMode must be either TK or 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 '')) {
    croak  "Error in Ivy::new,  you should have called Ivy->init () first.";
  }

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

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

  # callback prenant en param 3 refs sur des listes :
  # [applis presentes, appli absentes, hash_applis_present]
  # cette fonction est appelee :
  # - tout les pollingTime tant que toutes les applis
  #   ne sont pas presentes
  # - des qu'une appli se connecte
  # - 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] = {};

  # tableau ass de liste  du type
  # sockId => ["regexp"...]
  # pour connaitre la valeur des regexp meme apres compilation
  $self->[sendRegListSrc] = {};

  # 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 lecture ne se termine
  # pas par \n, de maniere a resegmenter les messages
  $self->[buffByConn] = {};

  
  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 : 
			# 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. 
		       ) ;
  
  
  # on examine toutes les options possibles
  foreach my $opt  (keys %optionsAndDefaults) {
    # si un parametre a ete fourni, ignorer les valeurs par defaut
    next if defined $options{$opt} ;
    # sinon, prendre la valeur par defaut si elle existe
    if (defined $optionsAndDefaults{$opt}) {
      $options{$opt} = $optionsAndDefaults{$opt} ;
    # sinon, on jette l'eponge
    } else {
      croak "Error in Ivy::new: option $opt is mandatory\n";
    }
  }
  
  # on examine toutes les options fournies, pour detecter les inutiles  
  foreach my $opt (keys %options) {
    unless (exists ($optionsAndDefaults{$opt})) {
      carp "Warning in Ivy::new, option $opt is unknown";
    }
  }


  $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]}) {
    #      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 DONOT work with ivy-c api.
    # the 2 next lines works. This has to been validated! CM 21/12/2000
    send ($fd, sprintf (MSG_FMT, BYE, 0, ""), 0);
    $self->_removeFileDescriptor ($fd);
    print "";  # this line strangely avoids some bugs with perl-tk 800.024
  }

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

  # on clot 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;

  # compatibility for version 3 interface, ie. no objects manipulated by programmer
  if (not @_ or ref ($_[0]) ne __PACKAGE__) {
    init (@_);
    $self = $globalIvy = new Ivy;
  } else {
    $self = shift;
  }

  if ($self->[connSock]) {
      print "*** the Ivy bus is already started\n";
      return;
  }
    # 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 
	    carp "Warning in Ivy::start, broadcast 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;
}

	   
############### PROCEDURE	BIND REGEXP	   
sub bindRegexp
{
  my $self = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
  my ($regexp, $cb) = @_;

  my $original_regexp = $regexp;
  # 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");

  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]};
    }
    $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 = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
  my ($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
{
  my $self = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
  my @msgs = @_;
  my $total = 0;

  # 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
      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
{
  my $self = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
  my @msgs = @_;
  my $total = 0;

  # pour tous les messages
  foreach (@msgs) {
    carp "Warning in Ivy::sendAppNameMsgs, a message contains a '\\n'. Skipping it:\n'$_'" if ($_ =~ /\n/);

    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 = 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
    foreach my $msg (@msgs) {
      carp "Warning in Ivy::sendDirectMsgs, a message contains a '\\n'. Skipping it:\n'$msg'" if ($msg =~ /\n/);

      foreach my $fd (@fds) {
	send ($fd, sprintf (MSG_FMT, DIRECT_MSG, $id, "$msg"), 0)
	  or $self->_removeFileDescriptor ($fd); 
      }
    }
    return 1;
  }
  else {
    my $to_appli = (defined $to) ? $to : '';
    carp "Warning in Ivy::sendDirectMsgs, application $to_appli unknown";
    return 0;
  }
}


############### METHOD	SEND DIE TO	    
sub sendDieTo
{
  my $self = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
  my ($to) = @_;

  if (defined $to and defined $self->[appliList]{$to}) {
    my @fds = @{$self->[appliList]{$to}};

    carp "Attention : in Ivy::sendDieTo big BUG \@fds is empty" 
      if (scalar (@fds) == 0);

    # pour tous les messages
    foreach my $fd (@fds) {
      $self->_sendDieTo($fd);
    }
    return 1;
  }
  else {
    my $to_appli = (defined $to) ? $to : '';
    carp "Warning in Ivy::sendDieTo, application '$to_appli' is unknown" if $^W;
    return 0;
  }
}


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

    # pour tous les messages
    foreach my $fd (@fds) {
      send ($fd, sprintf (MSG_FMT, PING, 0, " "), 0)
	or $self->_removeFileDescriptor ($fd); 
    }
  }
  else {
    my $to_appli = (defined $to) ? $to : '';
    carp "Warning in Ivy::ping, application '$to_appli' is unknown" if $^W;
    return 0;
  }
}

###############   METHODE     MAINLOOP
sub mainLoop ()
{
  croak "Error in Ivy::mainLoop, Ivy should have been initialised with LOCAL loop mode \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)
      }
    }
  }
}

#sub MainLoop () { mainLoop ();} # Alias pour avoir la meme syntaxe que Tk

############### METHODE	AFTER	
sub after ($$;$)
{
  # 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 ($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 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__)) ;

  # 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 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} ;
      # 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 AFTER RESET TIMER
# permet de gérer des timout plus facilement en permettant de
# réarmer un after non encore déclenché à sa valeur initiale
# cela évite le aftercancel suivi d'un nouvel after
sub afterResetTimer ($;$)
{
 # 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}) {
    $afterList{$id}->[2] = $afterList{$id}->[1] + timeofday();
  }
}


############### 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
    $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) {
    carp "Warning in Ivy::_getBonjour, recv error, Hello message discarded";
    return;
  }
  
  my $addr = (unpack_sockaddr_in ($inetAddr))[1];
  
  my $peerName = gethostbyaddr ($addr, AF_INET);

  # on force $peerPort a etre vu comme une valeur numerique
  my ($version, $peerPort) = $bonjourMsg =~ /^(\d+)\s+(\d+)/;

  unless (defined ($version) && defined ($peerPort)) {
    carp "Warning in Ivy::_getBonjour, ill-formed Hello message \"$bonjourMsg\"" ;
    return;
  }

  if ($version != IVY_PROTOCOLE_VERSION) {
    carp "Warning in Ivy::_getBonjour,  connection request from ".
	"$peerName with protocol version $version,\ncurrent version is " .
	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 {
    #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) {
    carp "Warning: Hello message from $peerName ignored,\n".
	"this guy is outside our emission zone\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->[sendRegListSrc]{$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 {
    carp "Warning in Ivy::_getBonjour, connection to " .
      "$peerName:$peerPort is impossible" ;
  }
}


############### PROCEDURE	GET CONNECTIONS
sub _getConnections ($)
{
  my $self = shift;

  my $appSock = $self->[connSock]->accept();

  unless (defined $appSock) {
    carp "Warning in Ivy::_getConnections, \$appSock not defined";
    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->[sendRegListSrc]{$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
      (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
	# 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;

	  # 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
	    $cb->$method($senderName, @cb, split ("\003", $valeurs)) ;
	  }
	  else {
	    &$cb ($senderName, @cb, split ("\003", $valeurs)) ;
	  }
	}
	else {
	  #_sendErrorTo ($appSock, "REEGXP ID $id inconnue");
	  carp ("Warning in Ivy::_getMessages, received an unknown message ".
		"with id $id from $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
#	  print "DBG>REGEXP from $senderName '$id' '$valeurs'\n";
	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->[sendRegListSrc]{$appSock}->[$id] = $valeurs;
	  $self->[sendRegList]{$appSock}->[$id] = eval <<'_EOL_';
	  sub  {
	    use strict;
	    if (my @args = ${$_[0]} =~ /($valeurs)/io) {
	      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
	carp ("Warning in Ivy::_getMessages, error message received from ".
	    "$senderName : \"$valeurs\"");
      }
      elsif ($type == DELREGEXP) {			# D E L   R E G E X P
	# on vire la regexp des regexps verifiées
	  $self->[sendRegList]{$appSock}->[$id] = undef ;
	  my $regexp = $self->[sendRegListSrc]{$appSock}->[$id];
	  # cleaning $sendername with previous \004 used for connection status
	  if ($senderName =~ /\004(.*)/) {
	      $senderName = $0;
	  }
          $self->[sendRegListSrc]{$appSock}->[$id] = undef;
          &_scanConnStatus ($self, $senderName, 'unsubscribing', $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
	$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;
	}

        my $host = (gethostbyaddr ($addr, AF_INET))[0] ;
        $self->_scanConnStatus ($senderName, "new", "$host");
      }
      elsif ($type == APP_NAME) {	
	# etat Connecte
	if (($self->[appName] eq $valeurs) && $^W) {
	  carp "\033[1mWarning in Ivy::_getMessages, there is already an instance of ".
	    "$self->[appName] \033[m" ;
	}

	$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;
	  if (ref($cb) ne 'CODE') {
	    my $method = shift @cb;
	    $cb->$method(@cb, $valeurs);
	  }
	  else {
	    &$cb (@cb, $valeurs);
	  }
	}
	else {
	  $self->_sendErrorTo ($appSock, "DIRECT ID $id inconnue");
	  carp "Warning in Ivy::_getMessages, received a DIRECT message with ".
	    "unknown id $id from $senderName :\n\"$mess\"";
	}
      } elsif ($type == DIE) {
	# il faut quitter
	# on commence par appeler la callback de fin
	my @cb = @{$onDieFunc};
	my $cb = shift @cb;
	if (ref($cb) 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) ;
#	carp "Notice in Ivy::_getMessages,  received a suicide request from " . "$senderName ($adr) ... exiting" 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 ("Warning in Ivy::_getMessages, received a message of unknown ".
		" type $type from $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;
  print "$addrInet\n";
  my ($addr,$port) = $addrInet =~ /(.{4}):(.*)/;

  print "$addr,$port\n";
  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 : 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] ;
  $self->_scanConnStatus ($diedAppName, "died", $host) ;
}


############### 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, $appname, $status, $addr) = @_;

  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, $appname, $status, $addr);
}


############### METHODE	TO BE PRUNED
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]})) {
      # 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 =~ /^(.*):(.*)/;

  croak ("Error in Ivy::_parseIvyBusParam, illegal bus address format: $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 ("Warning in Ivy::_parseIvyBusParam, network $netAddr is unknown\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 ete omis.
      ($netAddr .= ".255.255.255") =~ s/^((\d+\.){3}\d+).*/$1/;
      $netAddrInet =  inet_aton ($netAddr);
    }
    
    push (@ivyAddrInet,  pack_sockaddr_in ($ivyPort, $netAddrInet));	
  }

  unless (scalar @ivyAddrInet) {
      push (@ivyAddrInet,  pack_sockaddr_in ($ivyPort, inet_aton(BROADCAST_ADDRS)));
  }

  foreach my $ivyAddr (@ivyAddrInet) {
      my ($port, $iaddr) = unpack_sockaddr_in($ivyAddr);
      my $iaddrH = unpack ("H8",$iaddr);
      my $iaddrInt = join (".", unpack ("C4", $iaddr));
      
      print "Broadcasting on network $iaddrInt ($iaddrH) on port $ivyPort\n";
  }

  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 that provides easy
communication between applications. Messages are broadcast 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

=over 2

=item B<init>

 Ivy->init(...);
 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 (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. 


=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 your application receive a suicide request.
Do not call exit() in the callback, Ivy will do it for you.

The prototype of your callback must be as follows:

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

The prototype of your method must be as follows:

 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

=item B<new>

 Ivy::new(...);
 Ivy->new(...);

Check parameters, and create an Ivy bus object. You must call
Ivy->init before creating a bus.

Parameters are :

=over 4

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

Name of your application used to identify it with other applications
connected on the same 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:2010

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

Synchronisation message sent when your 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 called when your application receives a suicide request.
DO NOT CALL exit() in the callback, Ivy will do it for you.
The prototype of your callback must be as follows:

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

The prototype of your method must be as follows:

 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 applications that your application needs present on the bus
before running.

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

A callback which is called every time an appli connects on the bus, disconnects from the bus or subscribes to a regexp. When an application is stopping, this function is also called for every disconnecting agent on the bus. The first 3 parameters are a reference to an array of connected appli, a reference to an array of not connected appli (according to the "-neededApp" argument of the new method / function), a reference to a hash table of connected appli (giving the number of such appli). These 3 parameters are maintained for upwards compatibility but should no more be used, since the following three parameters are much easier to use: the name of an appearing / disapearing or subscribing / unsubscribing appli, its status either "new" or "died" or "subscribing" or "unsubscribing", and the hostname where this appli is running / dying OR the subscribed / unsubscribed regexp.



Your callback could be:

 sub MyCallback {
   my ($ref_array_present, $ref_array_absent, $ref_hash_present,
       $appname, $status, $host_or_regexp) = @_;

   # $status is either new or died

   my %present=%$ref_hash_present;
   foreach my $remoteapp (keys %present) {
     if ($present{$remoteapp} > 1) {
       print "n apps $remoteapp are presents on bus\n";
     }
   }
   if ($status eq "new") {
     print "$appname connected from $host_or_regexp\n";
   }
   elsif ($status eq "died") {
     print "$appname disconnected from $host_or_regexp\n";
   }
   elsif ($status eq "subscribing") {
	print "$appname subscribes to $host_or_regexp\n";
   }
   elsif ($status eq "unsubscribing") {
	print "$appname unsubscribed to $host_or_regexp\n";
   }
 }


Example:

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

=back

=item B<mainLoop>

 Ivy->mainLoop;
 Ivy::mainLoop;

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

=item B<stop>

 $ivyobj->stop;
 Ivy::stop;

To stop the Ivy main loop.

=back

=head1 OBJECT METHODS

=over 2

=item B<start>

 $ivyobj->start;
 Ivy::start;

You must call this after you are ready to communicate through an Ivy bus
and before you really communicate. The method returns the $ivyobj.

=item B<sendMsgs>

 $ivyobj->sendMsgs(@messages);
 Ivy::sendMsgs(@messages);

Send a list of messages. A message should not contain a '\n' or it will not be delivered.

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

=item B<sendAppNameMsgs>

 $ivyobj->sendAppNameMsgs(@messages);
 Ivy::sendAppNameMsgs(@messages);

Send a list of messages preceded by your application's name.  A message should not contain a '\n' or it will not be delivered.

 Example :
   $ivyobj->sendMsgs("Hello World");
   # it will send "$appName Hello World" over the Ivy bus

=item B<bindRegexp>

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

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

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 
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.

 Example :
   $ivyobject->bindRegexp("\w+ (\d+)", [\&callback, @cb_parameters]);

   # Your callback will be called with one more parameter which will be
   # the name of appli which send the message

   # Your callback and method must be like:
   sub callback {
     my ($sendername, @cb_parameters,
	 @matched_regexps_in_brackets) = @_;
     ...
   }

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

   # to unbind:
   $ivyobject->bindRegexp("\w+ (\d+)");

=item B<sendDirectMsgs>

 $ivyobj->sendDirectMsgs($to, $id, @msgs);
 Ivy::sendDirectMsgs($to, $id, @msgs);

Send a message a message to appli $to. This appli must have done a bindDirect before to accept this message. regexp matching is not used with direct Messages.  A message should not contain a '\n' or it will not be delivered.

=item B<bindDirect>

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

The callback will be called with both the @msgs and the @cb_parameters.

 Example :
   $ivyobject->bindDirectMessage("id1", [\&callback, @cb_parameters]);

   # Your callback and method must be like:
   sub cb {
     my (@cb_parameters, @msgs) = @_;
     ...
   }

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

=item B<sendDieTo>

 $ivyobj->sendDieTo($to);
 Ivy::sendDieTo($to);

Send a suicide to the application named $to.

=item B<ping>

 $ivyobj->ping($to, $timeout);
 Ivy::ping($to, $timeout);

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

=item B<after>

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

Call a list of callbacks after $timeAfter milliseconds. To be used only in conjonction with the 'LOCAL' Mainloop (see the Init method). When using the TK mainloop, you must use the Tk::after method.

=item B<repeat>

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

Have a list of callbacks repeatedly called every $timeAfter milliseconds. To be used only in conjonction with the 'LOCAL' Mainloop (see the Init method). When using the TK mainloop, you must use the Tk::repeat method.

=item B<afterCancel>

 $ivyobj->afterCancel($after_or_repeat_id);
 Ivy::afterCancel($after_or_repeat_id);

Cancel an after callback call. To be used only in conjonction with the 'LOCAL' Mainloop (see the Init method). When using the TK mainloop, you must use the Tk::afterCancel method.

=item B<afterResetTimer>

 $ivyobj->afterResetTimer($after_id);
 Ivy::afterResetTimer($after_id);

Reset a timer if this timer has not yet been triggered. To be used only in conjonction with the 'LOCAL' Mainloop (see the Init method).

=item B<fileEvent>

 $ivyobj->fileEvent($fd, $cb);
 Ivy::fileEvent($fd, $cb);

Add a fileEvent handler (or remove any handler associated to $fd if $cb paramter is omitted).
The callback $cb will get the filehandle $fd as parameter.  To be used only in conjonction with the 'LOCAL' Mainloop (see the Init method). When using the TK mainloop, you must use the Tk::fileevent method.

=item B<DESTROY>

 $ivyobj->DESTROY;

Destroy the $ivyobj object. No other method should be applied to the reference of this deleted object. This method should not be used directly.

=back

=head1 BUGS

The stop method does not work!

In the statusFunc, an agent is identified by its name which is not garantted as unique

A message to be sent should contain no '\n' char, because the '\n' is the message separator.

No other known bugs at this time. If you find one, please report them to the authors.

=head1 SEE ALSO

perl(1), perlre(1), ivyprobe.pl(1)

=head1 AUTHORS

Alexandre Bustico <bustico@cena.fr>, Herve Damiano <damiano@cena.fr>,
Stephane Chatty <chatty@cena.fr>, Christophe Mertz <mertz@cena.fr>

=head1 COPYRIGHT

CENA (C) 1997-2002

=head1 HISTORY

=cut