diff options
| -rw-r--r-- | Ivy.pm | 72 |
1 files changed, 58 insertions, 14 deletions
@@ -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]); |