ebauche de code pour l'edition des lignes

1 files changed, 77 insertions, 73 deletions

diff --git a/example/ivyprobe.pl b/example/ivyprobe.pl
index 2cc1d51..72e3439 100755
--- a/example/ivyprobe.pl
+++ b/example/ivyprobe.pl
@@ -26,6 +26,13 @@ use Ivy;
 use Getopt::Long;
 use Term::ReadLine;
 use Tk;
+use Carp;
+
+my $term = Term::ReadLine->new("ivyprobe.pl");
+$term->tkRunning;
+
+my $OUT = $term->OUT || $STDOUT;
+#my $OUT = $STDOUT;
 
 my $appliname = "IVYPROBE.PL";
 my $bus;
@@ -38,31 +45,22 @@ my %where_applications;
 
 &check_options;
 
-if (defined $bus) {
-    Ivy->init (-ivyBus => $bus,
-	       -appName => $appliname,
-#	       -loopMode => 'TK',
-	       -loopMode => 'LOCAL',
-	       -messWhenReady => "$appliname READY",
-	       ); }
-else {
-    Ivy->init (-appName => $appliname,
-#	       -loopMode => 'TK',
-	       -loopMode => 'LOCAL',
-	       -messWhenReady => "$appliname READY",
-	       );
-}
+Ivy->init (-ivyBus => (defined $bus) ? $bus : undef,
+	   -appName => $appliname,
+#	   -loopMode => 'TK',
+	   -loopMode => 'LOCAL',
+	   -messWhenReady => "$appliname READY",
+	   );
 
 my $Ivyobj = Ivy->new(-statusFunc => \&statusFunc,
 		      );
 
 foreach my $regexp (@ARGV) {
-    print "binding to $regexp\n";
+    print $OUT "binding to $regexp\n";
     if ($regexp =~ /'(.*)'/) { $regexp = $1; }
     $Ivyobj->bindRegexp($regexp, [ "unused", \&callback] );
 }
 
-my $term = Term::ReadLine->new("ivyprobe.pl");
 
 $Ivyobj->start;
 
@@ -71,9 +69,20 @@ my $IN = $term->IN;
 use strict 'subs';
 
 
-Ivy->fileEvent($IN, \&cb);
 
+sub cb {
+    my $line = $term->readline("> ");
+    $term->addhistory($line);
+    chomp $line;
+    exit if (&interpret_line ($line));
+}
+
+Ivy->fileEvent($IN, \&cb);
 Ivy->mainLoop;
+#my $mw = MainWindow->new();
+#$mw->fileevent($IN, 'readable' => \&cb);
+#MainLoop;
+
 
 
 # this function has 3 additionnal parameters till Ivy Version 4.6
@@ -83,44 +92,37 @@ sub statusFunc {
     my ($ref_ready, $ref_nonReady, $ref_hashReady, $appname, $status, $host_or_regexp) = @_;
 
     if ($status eq "new") {
-	print "$appname connected from $host_or_regexp\n";
+	print $OUT "$appname connected from $host_or_regexp\n";
 	$where_applications{"$appname:$host_or_regexp"}++;
     }
     elsif ($status eq "died") {
-	print "$appname disconnected from $host_or_regexp\n";
+	print $OUT "$appname disconnected from $host_or_regexp\n";
 	$where_applications{"$appname:$host_or_regexp"}--;
     }
     elsif ($status eq 'subscribing') {
-	print "$appname subscribed to '$host_or_regexp'\n";
+	print $OUT "$appname subscribed to '$host_or_regexp'\n";
     }
     elsif ($status eq 'unsubscribing') {
-	print "$appname unsubscribed to '$host_or_regexp'\n";
+	print $OUT "$appname unsubscribed to '$host_or_regexp'\n";
     }
     else {
-	print "Bug: unkown status; $status in &statusFunc\n";
+	print $OUT "Bug: unkown status; $status in &statusFunc\n";
     }
     
     %connected_applications = %$ref_hashReady;
 }
 
 
-sub cb {
-    my $str = <$IN>;
-    chomp $str;
-    exit if (&interpret_line ($str));
-}
-
-
 
 # return 1 if exit!
 sub interpret_line {
     my ($str) = @_;
-    if ($str eq "") { return 0; }
+    if ($str eq "") { return 0; } print "$str\n";
     if ($str =~ /^([^\.])/) {
 	my $count=$Ivyobj->sendMsgs($str);
-	print "-> Sent to $count peer";
-	if ($count > 1) { print "s" }
-	print "\n";
+	print $OUT "-> Sent to $count peer";
+	if ($count > 1) { print $OUT "s" }
+	print $OUT "\n";
 	return 0;
     }
     if ($str =~ /^\.q(uit)?\s*$/) {
@@ -131,15 +133,15 @@ sub interpret_line {
 	return 0;
     }
 
-    if ($str =~ /^\.die\s+(\w+)$/) {
-	$Ivyobj->sendDieTo($2);
+    if ($str =~ /^\.die\s+(\S*)/) {
+	$Ivyobj->sendDieTo($1);
 	return 0;
     }
 
     if ($str =~ /^.b(ind)?\s+(.*)$/) {
 	my $regexp = $2;
 	if ($regexp =~ /'(.*)'/) { $regexp = $1; }
-	print "binding $regexp\n";
+	print $OUT "binding $regexp\n";
 	$Ivyobj->bindRegexp($regexp, [ "unused", \&callback] );
 	return 0;
     }
@@ -147,14 +149,14 @@ sub interpret_line {
     if ($str =~ /^.u(nbind)?\s+(.*)$/) {
 	my $regexp = $2;
 	if ($regexp =~ /'(.*)'/) { $regexp = $1; }
-	print "unbinding $regexp\n";
+	print $OUT "unbinding $regexp\n";
 	$Ivyobj->bindRegexp($regexp);
 	return 0;
     }
 
     if ($str =~ /^.db(ind)?\s+(.*)$/) {
 	my $id = $2;
-	print "direct binding id $id\n";
+	print $OUT "direct binding id $id\n";
 	$Ivyobj->bindDirect($id, [\&directCallback] );
 	return 0;
     }
@@ -163,7 +165,7 @@ sub interpret_line {
 	my $appname = $2;
 	my $id = $3;
 	my $data = $4;
-	print "send direct to $appname id=$id $data\n";
+	print $OUT "send direct to $appname id=$id $data\n";
 	$Ivyobj->sendDirectMsgs($appname, $id, $data);
 	return 0;
     }
@@ -171,20 +173,20 @@ sub interpret_line {
     if ($str =~ /^.p(ing)?\s+(\S+)\s+(\d+)\s*$/) {
 	my $appname = $2;
 	my $timeout = $3;
-	print "ping $appname timeout=$timeout\n";
+	print $OUT "ping $appname timeout=$timeout\n";
 	my $res = $Ivyobj->ping($appname, $timeout);
-	print "$res\n";
+	print $OUT "$res\n";
 	return 0;
     }
 
     if ($str =~ /^.who\s*$/) {
-	print "Apps:";
+	print $OUT "Apps:";
 	foreach my $app (sort keys %connected_applications) {
 	    for (my $i=0; $i<$connected_applications{$app} ; $i++) {
-		print " $app";
+		print $OUT " $app";
 	    }
 	}
-	print "\n";
+	print $OUT "\n";
 	return 0;
     }
 
@@ -195,16 +197,16 @@ sub interpret_line {
 	    my ($app,$host) = $app_host =~ /(.+):(.*)/ ;
 	    if ($app eq $appli) {
 		for (my $i=0; $i<$where_applications{$app_host}; $i++) {
-		    print "Application $app on $host\n";
+		    print $OUT "Application $app on $host\n";
 		    $found = 1;
 		}
 	    }
 	}
-	print "No Application $appli\n" unless ($found);
+	print $OUT "No Application $appli\n" unless ($found);
 	return 0;
     }
 
-    print "bad command. Type '.help' for a list of commands\n";
+    print $OUT "bad command. Type '.help' for a list of commands\n";
     return 0;
     
 }
@@ -214,7 +216,7 @@ sub callback {
 
     my $paramString = "";
     if (scalar @param) { $paramString = join ("' '", @param); }
-    print "$appname sent '", $paramString, "'\n";
+    print $OUT "$appname sent '", $paramString, "'\n";
 }
 
 sub directCallback {
@@ -222,7 +224,7 @@ sub directCallback {
 
     my $paramString = "";
     if (scalar @param) { $paramString = join ("|", @param); }
-    print "directMessage received '", $paramString, "'\n";
+    print $OUT "directMessage received '", $paramString, "'\n";
 }
 
 
@@ -238,33 +240,33 @@ sub check_options {
 
 
 sub usage {
-    print "ivyprobe [-h] [ -b <network>:<port> ]  ['regexp']*\n";
-    print " ivyprobe is a simple test application for the ivy-perl library\n";
-    print " Its is based on a similar appplication available with ivy-c\n";
-    print " It waits for messages on the bus, messages writtten on the command line\n";
-    print " or commands issued on the comnand line\n";
-    print " a help for the command line is available through\n";
-    print " the command .help or .h\n";
-    print "   -h   print this help\n";
-    print "   -b   <network>:<port>\n";
-    print "        to defined the network adress and the port number\n";
-    print "        defaulted to 127:2010\n";
+    print $OUT "ivyprobe.pl [-h] [ -b <network>:<port> ]  ['regexp']*\n";
+    print $OUT " ivyprobe.pl is a simple test application for the ivy-perl library\n";
+    print $OUT " Its is based on a similar appplication available with ivy-c\n";
+    print $OUT " It waits for messages on the bus, messages writtten on the command line\n";
+    print $OUT " or commands issued on the comnand line\n";
+    print $OUT " Help for the command line is available through the command\n";
+    print $OUT " .help or .h\n";
+    print $OUT "   -h   print this help\n";
+    print $OUT "   -b   <network>:<port>\n";
+    print $OUT "        to defined the network adress and the port number\n";
+    print $OUT "        defaulted to 127:2010\n";
     exit;
 }
 
 
-sub line_command_usage {
-    print "Commands list:\n";
-    print "	.h[elp]				- this help\n";
-    print "	.q[uit]				- terminate this application\n";
-    print "	.b[ind] regexp			- add a msg to receive\n";
-    print "	.u[nbind] regexp		- remove a msg to receive\n";
-    print "	.die appname			- send die msg to appname\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 "	.where appname			- on which host is/are appname\n";
-    print "	.who				- who is on the bus\n";
+sub line_command_usage { print "tutu\n";
+    print $OUT "Commands list:\n";
+    print $OUT "	.h[elp]				- this help\n";
+    print $OUT "	.q[uit]				- terminate this application\n";
+    print $OUT "	.b[ind] regexp			- add a msg to receive\n";
+    print $OUT "	.u[nbind] regexp		- remove a msg to receive\n";
+    print $OUT "	.die appname			- send die msg to appname\n";
+    print $OUT "	.db[ind] id			- add a direct msg to receive\n";
+    print $OUT "	.d[irect] appname id args	- send direct msg to appname\n";
+    print $OUT "	.p[ing] appname timeout		- ping appname with a delay of timeout ms NYI\n";
+    print $OUT "	.where appname			- on which host is/are appname\n";
+    print $OUT "	.who				- who is on the bus\n";
 }
 
 
@@ -333,6 +335,8 @@ to get the list of all connected applications
 
 It is currently not possible to send a message which begin with a dot. It will be interpreted as a command (usually unknown!)
 
+It sould be possible to use line editing capabilities, but does not work currently.
+
 No other know bugs at this time. Report them to author.
 
 
@@ -346,6 +350,6 @@ Christophe Mertz <mertz@cena.fr>
 
 =head1 COPYRIGHT
 
-CENA (C) 2000-2001
+CENA (C) 2000-2002
 
 =cut