summaryrefslogtreecommitdiff
path: root/example/ivyprobe.pl
diff options
context:
space:
mode:
authormertz2000-12-19 15:30:07 +0000
committermertz2000-12-19 15:30:07 +0000
commit803b22c9ab3a282c10ae8cda996921b00c26c56d (patch)
treec37ad397393e7d0df1a2d3d45a61eb8713e3eb16 /example/ivyprobe.pl
parentfb6f100007454ef8fe8d5ab09d706490266de096 (diff)
downloadivy-perl-803b22c9ab3a282c10ae8cda996921b00c26c56d.zip
ivy-perl-803b22c9ab3a282c10ae8cda996921b00c26c56d.tar.gz
ivy-perl-803b22c9ab3a282c10ae8cda996921b00c26c56d.tar.bz2
ivy-perl-803b22c9ab3a282c10ae8cda996921b00c26c56d.tar.xz
version initiale de l'équivalent d'ivyprobe en C
Diffstat (limited to 'example/ivyprobe.pl')
-rwxr-xr-xexample/ivyprobe.pl204
1 files changed, 204 insertions, 0 deletions
diff --git a/example/ivyprobe.pl b/example/ivyprobe.pl
new file mode 100755
index 0000000..d12a2c2
--- /dev/null
+++ b/example/ivyprobe.pl
@@ -0,0 +1,204 @@
+#!/usr/bin/perl -w
+
+# $Source$
+# $Revision$
+#
+# $Author$
+# $Date$
+
+use strict;
+use Ivy;
+use Getopt::Long;
+use Term::ReadLine;
+use Tk;
+
+my $bus;
+
+my %connected_applis;
+# a hash code each key is a connected appli_name and the value the number of
+# applis with this name.
+
+
+&check_options;
+
+
+sub check_options {
+ # on traite la ligne de commande
+ my ($opt_help, $opt_gf);
+ GetOptions("help" => \$opt_help,
+ "b" => \$bus,
+ );
+
+ &usage if ($opt_help && $opt_help);
+}
+
+if (defined $bus) {
+ Ivy->init (-ivyBus => $bus,
+ -appName => "IVYPROBE.PL",
+# -loopMode => 'TK',
+ -loopMode => 'LOCAL',
+ -messWhenReady => 'IVYPROBE READY',
+ ); }
+else {
+ Ivy->init (-appName => "IVYPROBE.PL",
+# -loopMode => 'TK',
+ -loopMode => 'LOCAL',
+ -messWhenReady => 'IVYPROBE READY',
+ );
+}
+
+my $Ivyobj = Ivy->new(-statusFunc => \&statusFunc,
+ );
+
+foreach my $regexp (@ARGV) {
+ print "binding to $regexp\n";
+ $Ivyobj->bindRegexp($regexp, [ "unused", \&callback] );
+}
+
+my $term = Term::ReadLine->new("ivyprobe.pl");
+
+$Ivyobj->start;
+
+no strict 'subs';
+my $IN = $term->IN;
+use strict 'subs';
+
+
+Ivy->fileEvent($IN, \&cb);
+
+Ivy->mainLoop;
+
+sub statusFunc {
+ my ($ref_ready, $ref_nonReady, $ref_hashReady) = @_;
+# print "App: $appname\tStatus: $status\taddr: $addr\n";
+# print "statusFunc!!\n";
+# print "ready : ", join (' ', @$ref_ready), "\n";
+# print "NonReady : ", join (' ', @$ref_nonReady), "\n";
+# print "hashReady : ", join (' ', %$ref_hashReady), "\n";
+# print "connected_applis : ", join (' ', %connected_applis), "\n";
+ while (my ($appli, $nb) = each (%$ref_hashReady)) {
+ if (!defined $connected_applis{$appli} || $connected_applis{$appli} < $nb) {
+ print "$appli connected\n";
+ }
+ elsif ($connected_applis{$appli} > $nb) {
+ print "$appli disconnected\n";
+ }
+ delete $connected_applis{$appli};
+ }
+ while (my ($appli, $nb) = each (%connected_applis)) {
+ print "$appli disconnected\n";
+ }
+
+ undef %connected_applis;
+ while (my ($appli, $nb) = each (%$ref_hashReady)) {
+ if (defined $nb && $nb > 0) {
+ $connected_applis{$appli} = $nb;
+ }
+ }
+
+}
+
+
+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 =~ /^([^\.])/) {
+ my $count=$Ivyobj->sendMsgs($str);
+ print "-> Sent to $count peer";
+ if ($count > 1) { print "s" }
+ print "\n";
+ return 0;
+ }
+ if ($str =~ /^\.q(uit)?\s*$/) {
+ return 1;
+ }
+ if ($str =~ /^\.h(elp)?\s*$/) {
+ &line_command_usage;
+ return 0;
+ }
+
+ if ($str =~ /^\.die\s+(\w+)$/) {
+ $Ivyobj->sendDieTo($2);
+ return 0;
+ }
+
+ if ($str =~ /^.b(ind)?\s+(.*)$/) {
+ my $regexp = $2;
+ if ($regexp =~ /'(.*)'/) { $regexp = $1; }
+ print "binding $regexp\n";
+ $Ivyobj->bindRegexp($regexp, [ "unused", \&callback] );
+ return 0;
+ }
+
+ if ($str =~ /^.db(ind)?\s+(.*)$/) {
+ my $id = $2;
+ print "direct binding id $id\n";
+ $Ivyobj->bindDirect($id, [\&directCallback] );
+ return 0;
+ }
+
+ if ($str =~ /^.d(irect)?\s+(\S+)\s+(\S+)\s+(.*)$/) {
+ my $appname = $2;
+ my $id = $3;
+ my $data = $4;
+ print "send direct to $appname id=$id $data\n";
+ $Ivyobj->sendDirectMsgs($appname, $id, $data);
+ return 0;
+ }
+ print "bad command: .help for list of commands\n";
+ return 0;
+
+}
+
+sub callback {
+ my ($unused, $appname, @param) = @_;
+
+ my $paramString = "";
+ if (scalar @param) { $paramString = join (" ", @param); }
+ print "$appname sent '", $paramString, "'\n";
+}
+
+sub directCallback {
+ my (@param) = @_;
+
+ my $paramString = "";
+ if (scalar @param) { $paramString = join (" ", @param); }
+ print "directMessage sent '", $paramString, "'\n";
+}
+
+sub usage {
+ print "ivyprobe [ -b <network>:<port> ] [-h] 'regexp'\n";
+ print " ivyprobe is a simple test application for\n";
+ print " based a a similar appplication available with ivy-c\n";
+ print " It waits for messages on the bus and commands\n";
+ print " issued on the command 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";
+}
+
+
+sub line_command_usage {
+ print "Commands list:\n";
+ print " .h[elp] - this help\n";
+ print " .q[uit] - terminate this application\n";
+ print " .die appname - send die msg to appname\n";
+ print " .d[irect] appname id args - send direct msg to appname\n";
+ print " .where appname - on which host is appname\n";
+ print " .b[ind] regexp - add a msg to receive\n";
+ print " .db[ind] id - add a direct msg to receive\n";
+ print " .who - who is on the bus\n";
+}
+