ajout de la fonction bindRegexpOneShot qui permet de s'abonner pour un seul message,

le desabonnement devenant donc automatique.

1 files changed, 58 insertions, 14 deletions

diff --git a/Ivy.pm b/Ivy.pm
index 0441d4e..34caf57 100644
--- a/Ivy.pm
+++ b/Ivy.pm
@@ -46,7 +46,7 @@ use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
 # 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 = '1.42' ; # for Makefile.PL
+$VERSION = '1.44' ; # for Makefile.PL
 ($VERSION) = $TAG =~ /^\D*([\d_]+)/ ;
 if (defined $VERSION and $VERSION ne "_") {
     $VERSION =~ s/_/\./g;
@@ -78,15 +78,18 @@ sub start;		# debut de l'integration au bus :
 		 	# - envoie le "no de port"
 		 	# - bind le file descriptor de la socket de
 			#   supervision a la fonction getBonjour pour
-			#   traiter les bonjours
+			#   traiter les 1bonjours
 		 	# - bind le fd de connection sur la fonction
 			#   getConnections
 			#   pour etablir les connections "application"
 
 sub DESTROY ($);		# - envoie un BYE et clôt les connections
 
-sub bindRegexp ($$$;$) ;   # permet d'associer une regexp avec un callBack
+sub bindRegexp ($$$;$$) ;   # permet d'associer une regexp avec un callBack
 			# ou d'annuler une precedente association
+sub bindRegexpOneShot ($$$); #  permet d'associer une regexp avec un callBack avec
+			     # desabonnement automatique après reception du premier
+			     # message qui matche
 
 sub changeRegexp ($$$); # permet de changer une regexp d'un abonnement
 			# precedemment fait avec bindRegexp
@@ -205,6 +208,9 @@ use constant AFTER	=> 0;
 use constant REPEAT	=> 1;
 use constant TK_MAINLOOP => 0;
 use constant LOCAL_MAINLOOP => 1;
+use constant CALL_BY_VALUE => 0;
+use constant CALL_BY_REF => 1;
+use constant BIND_ONCE => 2;
 use constant MAX_TIMOUT => 1000;
 
 # pour pouvoir employer les regexps perl. Attention lors de l'utilisation
@@ -803,14 +809,23 @@ sub start
 
 
 ############### PROCEDURE	BIND REGEXP
-sub bindRegexp ($$$;$)
+sub bindRegexp ($$$;$$)
 {
   my $self = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
-  my ($regexp, $cb, $callByRef) = @_;
+  my ($regexp, $cb, $callByRef, $bindOnce) = @_;
   my $id;
 
-  $callByRef = defined $callByRef ? 1 : 0;
+  $callByRef = 0 unless defined $callByRef ;
+  $bindOnce = 0 unless defined $bindOnce ;
 
+  my $extraParam;
+  if ($bindOnce) {
+    $extraParam = BIND_ONCE;
+  } else {
+     $extraParam = $callByRef ? CALL_BY_REF : CALL_BY_VALUE;
+  }
+
+#  print ("DBG> bindRegexp:: self=$self, regexp=$regexp, extraParam=$extraParam\n");
 #  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
@@ -859,7 +874,7 @@ sub bindRegexp ($$$;$)
     for ($id=0; $id <= ($#{$self->[recCbList]}+1); $id++)  {
       last unless  (defined $self->[recCbList][$id]) && @{$self->[recCbList][$id]->[1]};
     }
-    $self->[recCbList][$id] =  [$regexp, $cb, $callByRef];
+    $self->[recCbList][$id] =  [$regexp, $cb, $extraParam];
 
     # on envoie les messages regexps aux processus deja connectes
     _sendLastRegexpToAllreadyConnected ($self, $id) ;
@@ -885,7 +900,13 @@ sub bindRegexp ($$$;$)
   return ($id);
 } # end bindRegexp
 
-############### PROCEDURE	BIND REGEXP
+############### PROCEDURE	BIND REGEXP ONCE
+sub bindRegexpOneShot ($$$)
+{
+  Ivy::bindRegexp ($_[0], $_[1], $_[2], 0, 1);
+}
+
+############### PROCEDURE	CHANGE REGEXP
 sub changeRegexp ($$$)
 {
   my $self = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
@@ -911,9 +932,14 @@ sub changeRegexp ($$$)
     };
   }
 
-  $self->[recCbList][$regexpId]->[0] =  $regexp;
-  _sendLastRegexpToAllreadyConnected ($self, $regexpId) ;
-  return ($regexpId);
+  unless (exists $self->[recCbList][$regexpId]) {
+    warn ("Warning in Ivy::changeRegexp, invalid regexpId\n");
+    return (-1);
+  } else {
+    $self->[recCbList][$regexpId]->[0] =  $regexp;
+    _sendLastRegexpToAllreadyConnected ($self, $regexpId) ;
+    return ($regexpId);
+  }
 } # end changeRegexp
 
 ############### METHODE	BIND REGEXP
@@ -1460,7 +1486,7 @@ sub _getMessages ($$)
 	  $senderName = $0 if ($senderName =~ /\004(.*)/);
 	  # bindRegexp avancé : on envoie une liste nom adresse port au lieu du nom
 	  $senderName = [$senderName, _getHostByAddr ($addr), $peerPort]
-	    if ($self->[recCbList][$id]->[2]);
+	    if ($self->[recCbList][$id]->[2] == CALL_BY_REF);
 
 	  if (ref($cb) ne 'CODE') {
 	    my $method = shift @cb;
@@ -1470,11 +1496,20 @@ sub _getMessages ($$)
 	  else {
 	    &$cb ($senderName, @cb, split ("\003", $valeurs)) ;
 	  }
+	  if ($self->[recCbList][$id]->[2] == BIND_ONCE) {
+	    # on vire la regexp des regexps verifiées
+	    # print ("DBG> receive BIND ONCE message\n");
+	    $self->[recCbList][$id]->[1] = [];
+	    # on envoie le mesage delregexp
+	    foreach my $fd (values %{$self->[sockList]}) {
+	      _univSend ($self, $fd, sprintf (MSG_FMT, DELREGEXP, $id, ""));
+	    }
+	  }
 	}
 	else {
 	  #_sendErrorTo ($appSock, "REEGXP ID $id inconnue");
-	  carp ("Warning in Ivy::_getMessages, received an unknown message ".
-		"with id $id from $senderName :\n\"$mess\"");
+	  carp ("Warning in Ivy::_getMessages, received an unknown or double one shot message ".
+		"with id $id from $senderName :\n\"$mess\"") if $^W;
 	}
       }
       elsif ($type == BYE) {
@@ -2672,6 +2707,15 @@ Return value : regexpId
    # to unbind:
    $ivyobject->bindRegexp("\w+ (\d+)");
 
+=item B<bindRegexpOneShot>
+
+ $ivyobject->bindRegexpOneShot($regexp, [\&callback, @cb_parameters]);
+ Ivy::bindRegexpOneShot($regexp, [\&callback, @cb_parameters]);
+
+ bindRegexpOneShot behavior is similar at bindRegexp one, except that
+ the callback is called once, it is similar as a  bindRegexp with an unbind in the callback
+ but is simpler to write.
+
 =item B<changeRegexp>
 
  $regexpId = $ivyobject->bindRegexp("initialRegexp", [\&callback, @cb_parameters]);