summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Ivy.pm72
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]);