summaryrefslogtreecommitdiff
path: root/src/Agent.pm
diff options
context:
space:
mode:
Diffstat (limited to 'src/Agent.pm')
-rw-r--r--src/Agent.pm64
1 files changed, 54 insertions, 10 deletions
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;