diff options
Diffstat (limited to 'src/Agent.pm')
-rw-r--r-- | src/Agent.pm | 64 |
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; |