add protocol messages DUMP_TABLES and DUMP_TABLES_FILE

theses new protocol messages are devoted to debug, when an agent
receive a DUMP_TABLES message, it creates a temporary file
dump his regexps table on it, and send the name of the temporary file
with a DUMP_TABLES_FILE message.

2 files changed, 111 insertions, 6 deletions

diff --git a/Ivy.pm b/Ivy.pm
index a243e9c..d64c60f 100644
--- a/Ivy.pm
+++ b/Ivy.pm
@@ -38,6 +38,7 @@ use strict;
 use Time::HiRes qw(gettimeofday);
 use Carp;
 use IO::Socket::Multicast;
+use File::Temp;
 
 use vars qw($VERSION);
 use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
@@ -103,6 +104,8 @@ sub sendAppNameMsgs;	# envoie une liste de messages precedes
 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 dumpTable ($$\&);		  # demande à une appli de dumper sa table de regexps dans
+				  # un fichier à des fins de debug
 sub mainLoop (;$);        # la mainloop locale (sans tk)
 sub stop ();		# methode de classe : on delete les bus, mais
 			# on reste dans la mainloop
@@ -146,6 +149,7 @@ 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 _dumpTable ($$$); # (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
@@ -202,6 +206,8 @@ use constant DIRECT_MSG	 => 7;
 use constant DIE	 => 8;
 use constant PING	 => 9;
 use constant PONG	 => 10;
+use constant DUMP_TABLES => 11;
+use constant DUMP_TABLES_FILE => 12;
 use constant IVY_PROTOCOLE_VERSION => 3;
 
 use constant AFTER	=> 0;
@@ -576,10 +582,13 @@ sub new ($%)
   # identifiant unique
   $self->[uuid] = sprintf ("%d%d", time(), rand()*(2**31));
 
-  # queue de gestion des pings :
+  # queue de gestion des pings et des dumpTable:
   # clef : socket fd, valeur  :liste [timestamp, machine:port, callBack]
   $self->[pongQueue] = {};
 
+
+
+
   my %optionsAndDefaults = (
 			-appName	  =>  $appName,
 			# nom de l'appli
@@ -1141,6 +1150,36 @@ sub ping ($$\&)
   return ($pingId++);
 } # end ping
 
+############### METHOD	DUMP_TABLE
+sub dumpTable ($$\&)
+{
+  my $self = ref($_[0]) eq __PACKAGE__  ? shift : $globalIvy;
+  my ($to, $dumpTableCbRef) = @_;
+  my @fds;
+
+  return unless defined $to;
+
+  if (defined ($self->[appliList]{$to})) {
+    @fds = @{$self->[appliList]{$to}};
+  } else {
+    my %handleByName = reverse %nameByHandle;
+#    printf "DBG>>> all names : %s\n", join (', ', keys %handleByName);
+    if (exists $handleByName{$to}) {
+      @fds = ($handleByName{$to});
+    } else {
+      carp "Warning in Ivy::ping, application '$to' is unknown" if $^W;
+      return 0;
+    }
+  }
+
+  # pour tous les messages
+  foreach my $fd (@fds) {
+#    print ("DBG>> dumpTable : send to fd $fd\n");
+    $self->[pongQueue]->{$fd} = [$pingId, $dumpTableCbRef];
+    _univSend ($self, $self->[sockList]->{$fd}, sprintf (MSG_FMT, DUMP_TABLES, $pingId, ""));
+  }
+  return ($pingId++);
+} # end ping
 ###############   METHODE     MAINLOOP
 sub mainLoop (;$)
 {
@@ -1725,10 +1764,6 @@ sub _getMessages ($$)
 	$self->_pong ($appSock, $id);
       }
 
-
-# le traitement est basique, ne fonctionne que si le recepteur traite le pong
-# avant qu'il n'envoie un deuxieme ping. Si les pings sont envoyés trop rapidement,
-# aucun pong ne sera émit.
      elsif ($type == PONG) {
 	if (exists $self->[pongQueue]->{$appSock}) {
 	  my ($pingid, $time, $funcRef) =  @{$self->[pongQueue]->{$appSock}};
@@ -1739,6 +1774,22 @@ sub _getMessages ($$)
 	}
       }
 
+     elsif ($type == DUMP_TABLES) {
+	# si on recois un ping, on envoie un pong
+	$self->_dumpTable ($appSock, $id);
+      }
+
+     elsif ($type == DUMP_TABLES_FILE) {
+	if (exists $self->[pongQueue]->{$appSock}) {
+	  my ($pingid, $funcRef) =  @{$self->[pongQueue]->{$appSock}};
+#	  printf ("DBG>>> stocked Id = $pingid;; message id = $id valeur=$valeurs\n");
+	  &$funcRef ($valeurs, $nameByHandle{$appSock})
+	    if ($pingid == $id);
+	  delete $self->[pongQueue]->{$appSock};
+	}
+      }
+
+
       else  {
 	_$self->sendErrorTo ($appSock, "TYPE DE MESS $type inconnu");
 	warn ("Warning in Ivy::_getMessages, received a message of unknown ".
@@ -1885,6 +1936,46 @@ sub _pong ($$$)
   _univSend ($self, $fd,  sprintf (MSG_FMT, PONG, $pongId, ""));
 } # end _pong
 
+############### METHODE	_DUMP_TABLE
+sub _dumpTable ($$$)
+{
+  my ($self, $fd, $pongId) = @_;
+  my ($fh, $tmpFileName) = File::Temp::tempfile("IvyTable_XXXXX",  SUFFIX => '.txt', DIR => $ENV{'TMPDIR'});
+#  print ("DBG> tmpFileName=$tmpFileName\n");
+  my $ofs = $,;
+  $, = ', ';
+  print $fh <<EOF;
+ivyBus = $ivyBus
+appName = $self->[appName]
+selectTimout = $selectTimout
+loopMode = $loopMode
+messWhenReady = $self->[messWhenReady]
+blockOnSlowAgent = $self->[blockOnSlowAgent]
+topicRegexps = @{$self->[topicRegexps]}
+useMulticast = $self->[useMulticast]
+broadcastPort = $self->[broadcastPort]
+readyToSend = $self->[readyToSend]
+neededApp = @{$self->[neededApp]}
+
+TABLE DE REGEXPS :
+
+EOF
+
+  foreach my $appSock (keys  %{$self->[sendRegListSrc]}) {
+#    my $appName = $self->_getNameByFileDes ($appSock);
+    print $fh "POUR l'application  $nameByHandle{$appSock} : \n";
+    print $fh join ("\n", @{$self->[sendRegListSrc]{$appSock}});
+    print $fh "\n-----------------------------------\n";
+  }
+
+  close ($fh);
+  $, = $ofs;
+
+
+#  printf ("DBG>>> DUMP_TABLE Id = $pongId tmpFile= $tmpFileName\n"); 
+  _univSend ($self, $fd,  sprintf (MSG_FMT, DUMP_TABLES_FILE, $pongId, $tmpFileName));
+} # end _pong
+
 
 ############### METHODE	SEND ERROR TO
 sub _sendDieTo ($$)
diff --git a/example/ivyprobe.pl b/example/ivyprobe.pl
index 1ec8449..f25e9a0 100755
--- a/example/ivyprobe.pl
+++ b/example/ivyprobe.pl
@@ -252,6 +252,19 @@ sub interpret_line {
 	return 0;
     }
 
+    if ($str =~ /^.du(mp)?\s+(\S+)\s*$/) {
+	my $appname = $2;
+	&printtime;
+	print  "dumptable $appname\n";
+	my $res = $Ivyobj->dumpTable($appname, sub {
+				  my ($fileName, $name) = @_;
+				  print ("dumpTable from ${appname}[$name] fileName=$fileName\n");
+				}
+			       );
+	print  "$res\n";
+	return 0;
+    }
+
     if ($str =~ /^.who\s*$/) {
 	print  "Apps:";
 	foreach my $app (sort keys %connected_applications) {
@@ -366,7 +379,8 @@ sub line_command_usage { print "tutu\n";
     print  "	.die appname1 appname2 ...	- send die msg to appnameN\n";
     print  "	.db[ind] id			- add a direct msg to receive\n";
     print  "	.d[irect] appname id args	- send direct msg to appname\n";
-    print  "	.p[ing] appname timeout		- ping appname with a delay of timeout ms NYI\n";
+    print  "	.p[ing] appname 		- ping appname\n";
+    print  "	.du[mp] appname 		- ask appname to dump internal table for debug\n";
     print  "	.where appname			- on which host is/are appname\n";
     print  "	.who				- who is on the bus\n";
 }