From 803b22c9ab3a282c10ae8cda996921b00c26c56d Mon Sep 17 00:00:00 2001
From: mertz
Date: Tue, 19 Dec 2000 15:30:07 +0000
Subject: version initiale de l'équivalent d'ivyprobe en C

---
 example/ivyprobe.pl | 204 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 204 insertions(+)
 create mode 100755 example/ivyprobe.pl

(limited to 'example/ivyprobe.pl')

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";
+}
+
-- 
cgit v1.1