Version 4.5 : API backward compatibility with version 3 was added

1 files changed, 70 insertions, 38 deletions

diff --git a/Ivy.pm b/Ivy.pm
index 4810a4f..13bfe9f 100644
--- a/Ivy.pm
+++ b/Ivy.pm
@@ -12,25 +12,37 @@
 #
 #	$Id$
 #
-#	Please refer to the debian/copyright file for the
-#	copyright notice regarding this software
+#	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
 #
 
 package Ivy ;
 
 use Sys::Hostname;
 use IO::Socket;
-use strict ;
-use Time::Gettimeofday ;
+use strict;
+use Time::Gettimeofday;
 
 
 use vars qw($VERSION);
-$VERSION = '4.4';
+$VERSION = '4.5';
 
 #############################################################################
 ####                    PROTOTYPES                                      #####
 #############################################################################
-sub init ($%);		# methode de classe, permet de renseigner
+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.
@@ -43,7 +55,7 @@ sub new ($%);           # verifie la validite de tous les parametres,
 			# donnes dans init, dans ce cas, ce sont ceux
 			# de new qui prevalent
 
-sub start ($);		# debut de l'integration au bus :
+sub start;		# debut de l'integration au bus :
 		 	# - cree la socket d'application, recupere le no 
 			#   de port
 		 	# - cree la socket supervision
@@ -57,18 +69,18 @@ sub start ($);		# debut de l'integration au bus :
 	   
 sub DESTROY ($);		# - envoie un BYE et clot les connections
 
-sub bindRegexp ($$$) ;   # permet d'associer une regexp avec un callBack
+#sub bindRegexp ($$$) ;   # permet d'associer une regexp avec un callBack
 			# ou d'annuler une precedente association
 
-sub bindDirect ($$$);    # permet d'associer un identifiant de msg direct
+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
+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 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
@@ -169,6 +181,10 @@ use constant REG_PERLISSISME => ('w' => '[a-zA-Z0-9_]',
 ####                    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
@@ -265,9 +281,10 @@ use constant messWhenReady 	=> $constantIndexer++;
 #############################################################################
 ####                    METHODES      PUBLIQUES                     #####
 #############################################################################
-sub init ($%) 
+sub init
 {
-  my ($class, %options) = @_;  
+  my $class = shift if (@_ and $_[0] eq __PACKAGE__);
+  my (%options) = @_;  
 
   # valeurs par defaut pour le parametre : variable d'environnement
   # ou valeur cablee, a defaut
@@ -354,7 +371,7 @@ sub init ($%)
     die "Error in Ivy::init, argument loopMode must be either TK or LOCAL\n";
   }
 
- $SIG{'PIPE'}	= 'IGNORE' ;
+ $SIG{'PIPE'} = 'IGNORE' ;
 }
 
 ############# METHODE DE CLASSE NEW
@@ -569,9 +586,17 @@ sub exit ()
 }
 
 ############### PROCEDURE	BUS START
-sub start ($) 
+sub start
 {
-  my $self = shift;
+  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;
+  }
 
     # cree la socket de connexion, recupere le no de port
     my $connSock = $self->[connSock] = IO::Socket::INET->new(Listen => 128,
@@ -611,8 +636,10 @@ sub start ($)
 
 	   
 ############### PROCEDURE	BIND REGEXP	   
-sub bindRegexp ($$$) {
-  my ($self, $regexp, $cb) = @_;
+sub bindRegexp
+{
+  my $self = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
+  my ($regexp, $cb) = @_;
 
   # on substitue les meta caracteres des regexps perl : \d, \w, \s, \e
   # par les classes de caracteres corespondantes de maniere a ce
@@ -666,9 +693,10 @@ sub bindRegexp ($$$) {
 }
 
 ############### METHODE	BIND REGEXP	   
-sub bindDirect ($$$)	   
+sub bindDirect 	   
 {
-  my ($self, $id, $cb) = @_;
+  my $self = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
+  my ($id, $cb) = @_;
   
   if ($cb) {
     # on rajoute la $cb dans la liste des messages
@@ -681,11 +709,12 @@ sub bindDirect ($$$)
 }
 	   
 ############### PROCEDURE	SEND MSGS	    
-sub sendMsgs ($@)
+sub sendMsgs
 {
   use attrs qw(locked);
 
-  my ($self, @msgs) = @_;
+  my $self = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
+  my @msgs = @_;
   my $total = 0;
 
   # pour tous les messages
@@ -706,11 +735,12 @@ sub sendMsgs ($@)
 }
 
 ############### PROCEDURE	SEND MSGS	    
-sub sendAppNameMsgs ($@)
+sub sendAppNameMsgs
 {
   use attrs qw(locked);
 
-  my ($self, @msgs) = @_;
+  my $self = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
+  my @msgs = @_;
   my $total = 0;
 
   # pour tous les messages
@@ -734,9 +764,10 @@ sub sendAppNameMsgs ($@)
 
 
 ############### PROCEDURE	SEND DIRECT MSGS	    
-sub sendDirectMsgs ($$$@)
+sub sendDirectMsgs
 {
-  my ($self, $to, $id, @msgs) = @_;
+  my $self = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
+  my ($to, $id, @msgs) = @_;
     
   if (defined ($self->[appliList]{$to})) {
     my @fds = @{$self->[appliList]{$to}};
@@ -756,10 +787,11 @@ sub sendDirectMsgs ($$$@)
 
 
 ############### METHOD	SEND DIE TO	    
-sub sendDieTo ($$)
+sub sendDieTo
 {
   use attrs qw(locked);
-  my ($self, $to) = @_;
+  my $self = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
+  my ($to) = @_;
     
   if (defined ($self->[appliList]{$to})) {
     my @fds = @{$self->[appliList]{$to}};
@@ -781,11 +813,11 @@ sub sendDieTo ($$)
 
 
 ############### METHOD	PING    
-sub ping ($$$)
+sub ping
 {
   use attrs qw(locked);
-
-  my ($self, $to, $timeout) = @_;
+  my $self = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
+  my ($to, $timeout) = @_;
     
   if (defined ($self->[appliList]{$to})) {
 
@@ -830,7 +862,7 @@ 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')) ;
+  shift if ((ref ($_[0]) eq __PACKAGE__) || ($_[0] eq __PACKAGE__)) ;
 
   my ($timeAfter,  $cbListRef) = @_;   
   $timeAfter /= 1000;
@@ -850,8 +882,8 @@ 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 __PACKAGE__) || ($_[0] eq __PACKAGE__)) ;
 
-  shift if ((ref ($_[0]) eq 'Ivy') || ($_[0] eq 'Ivy')) ;
   # on passe le temps en secondes pour le select
   my ($timeAfter,  $cbListRef) = @_;
   $timeAfter /= 1000;
@@ -868,7 +900,7 @@ 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')) ;
+  shift if ((ref ($_[0]) eq __PACKAGE__) || ($_[0] eq __PACKAGE__)) ;
   
   my $id = shift;
     
@@ -894,7 +926,7 @@ 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')) ;
+  shift if ((ref ($_[0]) eq __PACKAGE__) || ($_[0] eq __PACKAGE__)) ;
   
   my ($fd, $cb) = @_;