summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xexample/ivyprobe.pl150
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