summaryrefslogtreecommitdiff
path: root/example/testCongestionTk.pl
diff options
context:
space:
mode:
authorbustico2006-06-27 11:14:22 +0000
committerbustico2006-06-27 11:14:22 +0000
commita22fbfd2903894b44b871d88c3f1c8a52e13bc23 (patch)
treefdfadad8c189033f2469147b365d498a83db33d8 /example/testCongestionTk.pl
parent158f28aebb59ed0487d856589c2b9fab0ff25cc2 (diff)
downloadivy-perl-a22fbfd2903894b44b871d88c3f1c8a52e13bc23.zip
ivy-perl-a22fbfd2903894b44b871d88c3f1c8a52e13bc23.tar.gz
ivy-perl-a22fbfd2903894b44b871d88c3f1c8a52e13bc23.tar.bz2
ivy-perl-a22fbfd2903894b44b871d88c3f1c8a52e13bc23.tar.xz
° fix a bug : not all the send where completed in non blocking mode when non blocking
mode was requested ° Optimisation : remove buffer copy when it's possible ivyprobe.pl : ° use non blocking mode, ° fix bug with the use of gnu readline : now editing previous entries is possible ° add -regexpFile regexpfile option : ivyprobe.pl will bind qll the regexp which are in the file given in argument. ° add -filter class1,classe2,...,classeN : add the possibility to filter messages for test/debug purpose. testCongestionTk.pl : simple demo which demonstrate non blocking mode with Tk
Diffstat (limited to 'example/testCongestionTk.pl')
-rwxr-xr-xexample/testCongestionTk.pl140
1 files changed, 140 insertions, 0 deletions
diff --git a/example/testCongestionTk.pl b/example/testCongestionTk.pl
new file mode 100755
index 0000000..aa3d21a
--- /dev/null
+++ b/example/testCongestionTk.pl
@@ -0,0 +1,140 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Getopt::Long;
+use Ivy;
+use Time::HiRes;
+use Tk;
+
+sub defaultOption ($$);
+
+my %options;
+my $numberOfSentMsg = 0;
+my $numberOfSentMsgWhenCongestion = 1e6;
+END {Ivy::stop ();}
+
+
+# cet exemple lance deux agents un qui envoie vite de gros messages, et un autre
+# qui les reçoit. Lors des 10 premières receptions il attend une seconde après
+# chaque message, ensuite il depile aussi vite qu'il peut, cet exemple permet
+# de tester le bon fonctionnement du mode non bloquant.
+
+
+
+#OPTIONS
+GetOptions (\%options, "send", "receive");
+
+unless ((exists $options{send}) || (exists $options{receive})) {
+ if (fork () == 0) {
+ sleep (1);
+ exec (qw (./testCongestionTk.pl -send));
+ } else {
+ exec (qw (./testCongestionTk.pl -receive));
+ }
+}
+
+defaultOption ("bus", $ENV{IVYBUS});
+if (exists ($options{send})) {
+ defaultOption ("ivyname", "TESTSEND");
+} else {
+ defaultOption ("ivyname", "TESTRECEIVE");
+}
+
+my $t0;
+my $cbAppelee = 0;
+# IVY
+
+Ivy->init (-loopMode => 'TK',
+ -appName => $options{ivyname},
+ -ivyBus => $options{bus},
+ -filterRegexp => [$options{ivyname}]
+ ) ;
+
+my $bus = Ivy->new (-statusFunc => \&statusFunc,
+ -slowAgentFunc=> \&congestionFunc,
+ -blockOnSlowAgent => 0,
+ -neededApp => exists $options{send} ?
+ ["TESTRECEIVE"] : ["TESTSEND"]);
+
+my $mw = MainWindow->new;
+my $tx1 = $mw->Text;
+my $tx2 = $mw->Text (-height => 3);
+$tx2->pack (-fill => 'both', -expand => 'false');
+$tx1->pack (-fill => 'both', -expand => 'true');
+$mw->title ($options{ivyname});
+
+unless (exists ($options{send})) {
+ $bus->bindRegexp ('TESTSEND SEND (\d+) (.*)', [\&receiveSend]);
+}
+
+if (exists ($options{send})) {
+ $mw->repeat (10, [\&send]);
+}
+
+$bus->start ();
+
+$bus->mainLoop ();
+#Tk::MainLoop ();
+
+
+# PROCEDURES
+
+
+sub receiveSend ($$)
+{
+ my ($app, $iter) = @_;
+ $tx1->insert ('end', "RECEIVE $iter\n");
+ $tx1->yviewScroll (1, 'units');
+ $tx1->idletasks();
+ sleep (1) if ($cbAppelee++ < 10);
+}
+
+
+sub send ()
+{
+ $t0 = Time::HiRes::gettimeofday;
+ #print ("DBG> send $t0\n");
+
+ if ($numberOfSentMsg++ < ($numberOfSentMsgWhenCongestion+100)) {
+ $tx1->insert ('end', "SEND $numberOfSentMsg\n");
+ $tx1->yviewScroll (1, 'units');
+ $bus->sendAppNameMsgs ("SEND $numberOfSentMsg " . 'a' x 1020);
+ }
+}
+
+
+sub defaultOption ($$)
+{
+ my ($option, $default) = @_;
+ unless (defined $options{$option}) {
+# warn "option $option non spécifiéee : utilision de $default\n";
+ $options{$option} = $default;
+ }
+}
+
+
+sub statusFunc ($$)
+{
+ my ($ready, $notReady) = @_;
+
+ if (@{$notReady}) {
+ printf "appli manquantes : %s\n", join (' ', @{$notReady});
+ } else {
+ printf ("Toutes applis OK !!\n");
+ }
+}
+
+sub congestionFunc ($$$)
+{
+ my ($name, $addr, $state) = @_;
+
+ if ($state == 1) {
+ $tx2->insert ('end', sprintf ("$name [$addr] %s will stop at N=%d\n", $state ? "CONGESTION" : "OK",
+ $numberOfSentMsg+100));
+ $numberOfSentMsgWhenCongestion = $numberOfSentMsg;
+ } else {
+ $tx2->insert ('end', sprintf ("$name [$addr] %s\n", $state ? "CONGESTION" : "OK"));
+ }
+ $tx2->update();
+}
+