diff options
| -rwxr-xr-x | example/ivyprobe.pl | 150 |
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 |