From 32a06f16258c9345cafeda2cc3bd5edd666da934 Mon Sep 17 00:00:00 2001
From: etienne
Date: Thu, 28 Sep 2006 14:43:31 +0000
Subject: Ajout d'un ajout d'un systeme de polling pour detecter les pbms de
 perfo.

---
 src/Agent.pm | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 54 insertions(+), 10 deletions(-)

(limited to 'src/Agent.pm')

diff --git a/src/Agent.pm b/src/Agent.pm
index 4a38434..3c0b835 100644
--- a/src/Agent.pm
+++ b/src/Agent.pm
@@ -13,19 +13,21 @@ use strict;
 #
 #----------------------------------------------------------------------
 my ($x0, $y0, $wmax, $dx, $dy, $cmin, $rmax, @matrix, @hosts, $tempo_id,
-    $mw, $bg, $fg, $selcolor, $hlbg, $darkbg, $fontspec, @fontspec,
-    $on_img, $off_img, %instances, @instances, $bus, $coef,
-    $hosts_tl, $selected_host, $preselected_host);
+    $mw, $bg, $fg, $selcolor, $pbcolor, $hlbg, $darkbg, $fontspec, @fontspec,
+    $on_img, $off_img, $pb_img, %instances, @instances, $bus, $coef,
+    $hosts_tl, $selected_host, $preselected_host, $pingThreshold);
 
 
 # configure the class : graphic parameters, geometry and ivy bus
 sub configure {
     shift;
-    ($mw, $bg, $fg, $selcolor, $hlbg, $darkbg,
-     $fontspec, $x0, $y0, $wmax, $dy, $cmin, $rmax, $bus, $coef) = @_;
+    ($mw, $bg, $fg, $selcolor, $pbcolor, $hlbg, $darkbg,
+     $fontspec, $x0, $y0, $wmax, $dy, $cmin, $rmax, $bus, $coef, $pingThreshold) = @_;
     @fontspec = @$fontspec if $fontspec;
     $off_img = $mw->Bitmap('off', -file => Tk::findINC('led.bmp'),
 			  -foreground => $bg);
+    $pb_img = $mw->Bitmap('pb', -file => Tk::findINC('led.bmp'),
+			   -foreground => $pbcolor);
     $on_img = $mw->Bitmap('on', -file => Tk::findINC('led.bmp'),
 			   -foreground => $selcolor);
     &_resetmatrix;
@@ -93,6 +95,21 @@ sub disconnect {
     
 } # end disconnect
 
+# callback called when a ping/pong is received
+sub pingcb {
+    my ($class, $appname, $host, $pingtime) = @_;
+    #print "pingtime=$pingtime\n";
+    if ($instances{$appname}) {
+	# if pingtime > $pingThreshold status is changed
+	if ($pingtime > $pingThreshold) {
+	  $instances{$appname}->pb;
+	  } else {
+	   # print "Stat:".$instances{$appname}->{status}."\n";
+	   if ($instances{$appname}->{status} == 2) { $instances{$appname}->nopb;}
+	  }
+   }
+} # end pingcb
+
 # class constructor
 sub new {
     my ($class, $appname, $host, $command, $params, $status) = @_;
@@ -122,7 +139,7 @@ sub new {
     $instances{$appname} = $self;
     push(@instances, $self);
     
-    # graphical updates
+    # graphical updates 
     $self->createlabel;
     $self->on if $status;
 
@@ -160,12 +177,11 @@ sub removetwin {
 # graphical effect when a known agent connects
 sub on {
     my $self = shift;
-    $self->{status} = 1;
-    $self->{led}->configure(-image => $on_img);
+    $self->nopb;
     $self->{label}->raise;
     $self->{label}->configure(-highlightthicknes => 2);
-    $tempo_id = $mw->after(3000, sub {
-	$self->{label}->configure(highlightthicknes => 0);
+    $tempo_id = $mw->after(2000, sub {
+	$self->{label}->configure(-highlightthicknes => 0);
     });
     
 } # end on
@@ -179,6 +195,34 @@ sub off {
 
 } # end off
 
+# graphical effect when a know agent has a ping problem (latency)
+
+sub pb {
+   my $self = shift;
+   $self->{status} = 2;
+   $self->{led}->configure(-image => $pb_img);
+   my $i = 0;
+   my $id;
+   $id = $mw->repeat(100, sub {
+      if ($i == 4) {
+         $mw->afterCancel($id);
+      } elsif ($i % 2 == 0) {
+         $self->{led}->configure(-image => $on_img);
+      } else {
+         $self->{led}->configure(-image => $pb_img);      
+      }
+      $i++;
+   });
+
+} # end pb
+
+sub nopb {
+   my $self = shift;
+   $self->{status} = 1;
+   $self->{led}->configure(-image => $on_img);
+
+} # end pb
+
 # label placement
 sub setposition {
     my $self = shift;
-- 
cgit v1.1