diff options
| -rw-r--r-- | src/Agent.pm | 561 |
1 files changed, 280 insertions, 281 deletions
diff --git a/src/Agent.pm b/src/Agent.pm index 3c0b835..d1a6fc1 100644 --- a/src/Agent.pm +++ b/src/Agent.pm @@ -20,132 +20,131 @@ my ($x0, $y0, $wmax, $dx, $dy, $cmin, $rmax, @matrix, @hosts, $tempo_id, # configure the class : graphic parameters, geometry and ivy bus sub configure { - shift; - ($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; - + shift; + ($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; + } # end configure # kill an named agent sub kill { - my ($class, $appname) = @_; - IvyIO::kill($appname); + my ($class, $appname) = @_; + IvyIO::kill($appname); } # end kill; # kill all agents sub killall { - my ($class) = @_; - my $nb = 0; - for(@instances) { - if ($_->{status} > 0) { - IvyIO::kill($_->{appname}); - $nb++; - } - } - return $nb; + my ($class) = @_; + my $nb = 0; + for(@instances) { + if ($_->{status} > 0) { + IvyIO::kill($_->{appname}); + $nb++; + } + } + return $nb; } # end killall; # set usable hosts list for executing agents sub hosts { - shift; - @hosts = @_; + shift; + @hosts = @_; } # end hosts # callback called when an agent connects sub connect { - my ($class, $appname, $host) = @_; - if ($instances{$appname}) { - if ($instances{$appname}->{status} == 1) { - $instances{$appname}->addtwin; - } else { - $instances{$appname}->on; - } - } else { - $class->new($appname, $host, undef, undef, 1); - } + my ($class, $appname, $host) = @_; + if ($instances{$appname}) { + if ($instances{$appname}->{status} == 1) { + $instances{$appname}->addtwin; + } else { + $instances{$appname}->on; + } + } else { + $class->new($appname, $host, undef, undef, 1); + } } # end connect # callback called when an agent disconnects sub disconnect { - my ($class, $appname, $host) = @_; - if ($instances{$appname}) { - if ($instances{$appname}->{number} > 1) { - $instances{$appname}->removetwin; - } else { - $instances{$appname}->off; - } - } else { - $class->new($appname, $host, undef, undef, 0); - } + my ($class, $appname, $host) = @_; + if ($instances{$appname}) { + if ($instances{$appname}->{number} > 1) { + $instances{$appname}->removetwin; + } else { + $instances{$appname}->off; + } + } else { + $class->new($appname, $host, undef, undef, 0); + } } # 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;} - } + my ($class, $appname, $host, $pingtime) = @_; + #print "pingtime=$pingtime\n"; + if ($instances{$appname}) { + # if pingtime > $pingThreshold status is changed + if ($pingtime > $pingThreshold) { + $instances{$appname}->pb; + } elsif ($instances{$appname}->{status} == 2) { + $instances{$appname}->nopb; + } } } # end pingcb # class constructor sub new { - my ($class, $appname, $host, $command, $params, $status) = @_; - if ($instances{$appname}) { - $instances{$appname}->addtwin; - return; - } - my $self = {}; - bless $self; - - # set object attributes - $self->{appname} = $appname; - $self->{status} = $status; - $self->{host} = $host; - $self->{command} = $command; - $self->{params} = $params; - $self->{number} = 1; - $self->{led} = undef; - $self->{label} = undef; - - # reset positions before adding new instance - if (@instances >= ($rmax*$cmin)) { - $cmin++; - $class->_updatepositions; - } - # set class variables - $instances{$appname} = $self; - push(@instances, $self); - - # graphical updates - $self->createlabel; - $self->on if $status; - - $class->_alphabeticsort(); - - return $self; + my ($class, $appname, $host, $command, $params, $status) = @_; + if ($instances{$appname}) { + $instances{$appname}->addtwin; + return; + } + my $self = {}; + bless $self; + + # set object attributes + $self->{appname} = $appname; + $self->{status} = $status; + $self->{host} = $host; + $self->{command} = $command; + $self->{params} = $params; + $self->{number} = 1; + $self->{led} = undef; + $self->{label} = undef; + + # reset positions before adding new instance + if (@instances >= ($rmax*$cmin)) { + $cmin++; + $class->_updatepositions; + } + # set class variables + $instances{$appname} = $self; + push(@instances, $self); + + # graphical updates + $self->createlabel; + $self->on if $status; + + $class->_alphabeticsort(); + + return $self; } # end new @@ -159,39 +158,39 @@ sub new { # called when several agent instances are detected sub addtwin { - my $self = shift; - $self->{number}++; - $self->{label}->configure(-text => $self->formatlabel); + my $self = shift; + $self->{number}++; + $self->{label}->configure(-text => $self->formatlabel); } # end addtwin # called when an instance of a not single agent dies sub removetwin { - my $self = shift; - return if $self->{number} == 1; - $self->{number}--; - $self->{label}->configure(-text => $self->formatlabel); + my $self = shift; + return if $self->{number} == 1; + $self->{number}--; + $self->{label}->configure(-text => $self->formatlabel); } # end addtwin # graphical effect when a known agent connects sub on { - my $self = shift; - $self->nopb; - $self->{label}->raise; - $self->{label}->configure(-highlightthicknes => 2); - $tempo_id = $mw->after(2000, sub { - $self->{label}->configure(-highlightthicknes => 0); - }); + my $self = shift; + $self->nopb; + $self->{label}->raise; + $self->{label}->configure(-highlightthicknes => 2); + $tempo_id = $mw->after(2000, sub { + $self->{label}->configure(-highlightthicknes => 0); + }); } # end on # graphical effect when a known agent disconnects sub off { - my $self = shift; - $self->{status} = 0; - $self->{led}->configure(-image => $off_img); + my $self = shift; + $self->{status} = 0; + $self->{led}->configure(-image => $off_img); } # end off @@ -225,100 +224,100 @@ sub nopb { # label placement sub setposition { - my $self = shift; - my ($r, $c); - for (my $i=0; $i<@matrix; $i++) { - for (my $j=0; $j<=$#{$matrix[$i]}; $j++) { - unless ($matrix[$i][$j]->[0]) { - ($r, $c) = ($i, $j); - last; - } - } - last if defined $r; - } - $matrix[$r][$c]->[0] = $self; - my ($x, $y) = ($matrix[$r][$c]->[1], $matrix[$r][$c]->[2]); - my $y2 = $y - 5*$coef; - $y2 -= 12*$coef if ($self->{label}->cget(-text) =~ /\n/); - - if ($self->{command}) { - $self->{led}->configure(-highlightthickness => 6*$coef); - $self->{led}->place(-x => $x+3*$coef, -y => $y+3*$coef); - } else { - $self->{led}->configure(-highlightthickness => 2*$coef); - $self->{led}->place(-x => $x+6*$coef, -y => $y+6*$coef); - } - $self->{label}->place(-x => $x + 38, -y => $y2); + my $self = shift; + my ($r, $c); + for (my $i=0; $i<@matrix; $i++) { + for (my $j=0; $j<=$#{$matrix[$i]}; $j++) { + unless ($matrix[$i][$j]->[0]) { + ($r, $c) = ($i, $j); + last; + } + } + last if defined $r; + } + $matrix[$r][$c]->[0] = $self; + my ($x, $y) = ($matrix[$r][$c]->[1], $matrix[$r][$c]->[2]); + my $y2 = $y - 5*$coef; + $y2 -= 12*$coef if ($self->{label}->cget(-text) =~ /\n/); + + if ($self->{command}) { + $self->{led}->configure(-highlightthickness => 6*$coef); + $self->{led}->place(-x => $x+3*$coef, -y => $y+3*$coef); + } else { + $self->{led}->configure(-highlightthickness => 2*$coef); + $self->{led}->place(-x => $x+6*$coef, -y => $y+6*$coef); + } + $self->{label}->place(-x => $x + 38, -y => $y2); } # end setposition # label creation sub createlabel { - my ($self) = @_; - $self->{led} = - $mw->Label(-image => $off_img, - -highlightbackground => $hlbg, - -borderwidth => 0, - ); - $self->{label} = - $mw->Label(-text => $self->formatlabel, - -pady => 10*$coef, - -justify => 'left', - -relief => 'flat', - -highlightthickness => 0, - -background => $darkbg, - -foreground => $fg, - @fontspec, - ); - $self->{led}->bind('<1>', [\&_cbOnPress, $self]); - $self->{label}->bind('<1>', [\&_cbOnPress, $self]); + my ($self) = @_; + $self->{led} = + $mw->Label(-image => $off_img, + -highlightbackground => $hlbg, + -borderwidth => 0, + ); + $self->{label} = + $mw->Label(-text => $self->formatlabel, + -pady => 10*$coef, + -justify => 'left', + -relief => 'flat', + -highlightthickness => 0, + -background => $darkbg, + -foreground => $fg, + @fontspec, + ); + $self->{led}->bind('<1>', [\&_cbOnPress, $self]); + $self->{label}->bind('<1>', [\&_cbOnPress, $self]); } # end createlabel # label format : affects too long labels and not single agents sub formatlabel { - my ($self) = @_; - my $im_width = 38; - my $dx = $dx - $im_width; - my $appname = $self->{appname}; - # for not single agents - $appname = '['.$self->{number}.'] '.$appname if $self->{number} > 1; - my $width = $mw->fontMeasure($fontspec[1], $appname); - my $appnametext; - # for too long names - while ($width > 2*$dx) { - $appname = substr($appname, 0, -1); - $width = $mw->fontMeasure($fontspec[1], $appname); - } - if ($width > $dx) { - my $hlen = int(length($appname)/2); - my @fields = split(/:/, $appname); - if (@fields > 1) { - my $len = 0; - my $imax = -1; - for (my $i=0; $i<@fields; $i++) { - $len += length($fields[$i]); - if ($len > $hlen) { - $imax = $i - 1; - last; - } - } - if ($imax >= 0) { - $appnametext = join(':', (@fields)[0..$imax])."\n". - join(':', (@fields)[$imax+1..$#fields]); - } - } - $appnametext = substr($appname, 0, $hlen)."\n".substr($appname, $hlen) - unless $appnametext; - } else { - my @fields = split(/:/, $appname); - if (@fields > 1) { - $appnametext = $fields[0].":\n ".join(':', (@fields)[1..$#fields]); - } - } - $appnametext = $appname unless $appnametext; - return $appnametext; + my ($self) = @_; + my $im_width = 38; + my $dx = $dx - $im_width; + my $appname = $self->{appname}; + # for not single agents + $appname = '['.$self->{number}.'] '.$appname if $self->{number} > 1; + my $width = $mw->fontMeasure($fontspec[1], $appname); + my $appnametext; + # for too long names + while ($width > 2*$dx) { + $appname = substr($appname, 0, -1); + $width = $mw->fontMeasure($fontspec[1], $appname); + } + if ($width > $dx) { + my $hlen = int(length($appname)/2); + my @fields = split(/:/, $appname); + if (@fields > 1) { + my $len = 0; + my $imax = -1; + for (my $i=0; $i<@fields; $i++) { + $len += length($fields[$i]); + if ($len > $hlen) { + $imax = $i - 1; + last; + } + } + if ($imax >= 0) { + $appnametext = join(':', (@fields)[0..$imax])."\n". + join(':', (@fields)[$imax+1..$#fields]); + } + } + $appnametext = substr($appname, 0, $hlen)."\n".substr($appname, $hlen) + unless $appnametext; + } else { + my @fields = split(/:/, $appname); + if (@fields > 1) { + $appnametext = $fields[0].":\n ".join(':', (@fields)[1..$#fields]); + } + } + $appnametext = $appname unless $appnametext; + return $appnametext; } # end formatlabel @@ -329,120 +328,120 @@ sub formatlabel { # #---------------------------------------------------------------------- sub _resetmatrix { - $dx = $wmax/$cmin; - for(my $r=0; $r<$rmax; $r++) { - for(my $c=0; $c<$cmin; $c++) { - $matrix[$r][$c] = [undef, $x0 + $c*$dx, $y0 + $r*$dy]; - } - } + $dx = $wmax/$cmin; + for(my $r=0; $r<$rmax; $r++) { + for(my $c=0; $c<$cmin; $c++) { + $matrix[$r][$c] = [undef, $x0 + $c*$dx, $y0 + $r*$dy]; + } + } } # end _resetmatrix sub _updatepositions { - &_resetmatrix; - for (@instances) { - $_->setposition(); - $_->{label}->configure(-text => $_->formatlabel); - } + &_resetmatrix; + for (@instances) { + $_->setposition(); + $_->{label}->configure(-text => $_->formatlabel); + } } # end _updatepositions sub _alphabeticsort { - &_resetmatrix; - for (sort {uc($a->{appname}) cmp uc($b->{appname})} @instances) { - $_->setposition(); - } + &_resetmatrix; + for (sort {uc($a->{appname}) cmp uc($b->{appname})} @instances) { + $_->setposition(); + } } # end _alphabeticsort # callback invoked when user press on label sub _cbOnPress { - shift; - my $self = shift; - $self->{label}->configure(-foreground => $hlbg); - if ($self->{status} == 1) { - IvyIO::kill($self->{appname}); - $mw->after(400, sub {$self->{label}->configure(-foreground => $fg);}); - } elsif ($self->{command}) { - my ($x, $y) = ($self->{label}->rootx, $self->{label}->rooty); - my $host = &_hostsmenu($x, $y, $self->{host}); - $self->{label}->configure(-foreground => $fg); - return unless $host; - FugueConfig::launchAgent($self->{appname}, $host, - $self->{command}, $self->{params}, $bus); - print "$self->{appname} launched\n"; - } else { - $mw->bell; - $mw->after(400, sub {$self->{label}->configure(-foreground => $fg);}); - } + shift; + my $self = shift; + $self->{label}->configure(-foreground => $hlbg); + if ($self->{status} > 0) { + IvyIO::kill($self->{appname}); + $mw->after(400, sub {$self->{label}->configure(-foreground => $fg);}); + } elsif ($self->{command}) { + my ($x, $y) = ($self->{label}->rootx, $self->{label}->rooty); + my $host = &_hostsmenu($x, $y, $self->{host}); + $self->{label}->configure(-foreground => $fg); + return unless $host; + FugueConfig::launchAgent($self->{appname}, $host, + $self->{command}, $self->{params}, $bus); + print "$self->{appname} launched\n"; + } else { + $mw->bell; + $mw->after(400, sub {$self->{label}->configure(-foreground => $fg);}); + } } # end _cbOnPress # create and show hosts menu sub _hostsmenu { - my $x = shift; - my $y = shift; - $x += 50; - - my $preselected_host = shift; - return $preselected_host if @hosts <= 1; - $hosts_tl->destroy if Tk::Exists($hosts_tl); - $hosts_tl = $mw->Toplevel(-background => $darkbg); - $hosts_tl->resizable(0,0); - $hosts_tl->title('ivycontrolpanel'); - my $hosts_fm = $hosts_tl->Frame(-background => $darkbg, - -highlightthickness => 3, - -highlightbackground => $hlbg, - )->pack(-side => 'top', -padx => 0, -pady => 0); - my @lattr = (-padx => 10, - -pady => 10, - -relief => 'flat', - -highlightthickness => 0, - -background => $darkbg, - -foreground => $fg, - -borderwidth => 0, - @fontspec); - my @battr = (@lattr, - -width => 4, -height => 1, - -highlightthickness => 3, - -highlightbackground => $hlbg, - -activebackground => $darkbg, - -activeforeground => $fg, - ); - my @rattr = (@lattr, - -activebackground => $darkbg, - -activeforeground => $fg, - -selectcolor => $selcolor); - - $hosts_fm->Label(@lattr, -text => "restart on :" - )->pack(-side => 'top', -padx => 20, -pady => 20); - for(@hosts) { - $hosts_fm->Radiobutton(@rattr, - -variable => \$preselected_host, - -value => $_, - -text => $_, - )->pack(-side => 'top'); - } - my $fm = $hosts_fm->Frame(-background => $darkbg)->pack(-side => 'bottom'); - $fm->Button(@battr, - -command => sub {$hosts_tl->destroy}, - -text => 'ok')->pack(-side => 'left', -padx => 10, -pady => 20); - $fm->Button(@battr, - -command => sub {$preselected_host = undef; $hosts_tl->destroy}, - -text => 'cancel')->pack(-side => 'left', -padx => 10, -pady => 20); - $hosts_tl->update; - my ($X, $Y) = ($mw->rootx, $mw->rooty); - my ($w, $h) = ($hosts_tl->width, $hosts_tl->height); - my ($W, $H) = ($mw->width, $mw->height); - $x = $X + $W - $w if ($x + $w) > $X + $W; - $y = $Y + $H - $h if ($y + $h) > $Y + $H; - $hosts_tl->geometry('+'.$x.'+'.$y); - $hosts_tl->waitWindow(); - return $preselected_host; + my $x = shift; + my $y = shift; + $x += 50; + + my $preselected_host = shift; + return $preselected_host if @hosts <= 1; + $hosts_tl->destroy if Tk::Exists($hosts_tl); + $hosts_tl = $mw->Toplevel(-background => $darkbg); + $hosts_tl->resizable(0,0); + $hosts_tl->title('ivycontrolpanel'); + my $hosts_fm = $hosts_tl->Frame(-background => $darkbg, + -highlightthickness => 3, + -highlightbackground => $hlbg, + )->pack(-side => 'top', -padx => 0, -pady => 0); + my @lattr = (-padx => 10, + -pady => 10, + -relief => 'flat', + -highlightthickness => 0, + -background => $darkbg, + -foreground => $fg, + -borderwidth => 0, + @fontspec); + my @battr = (@lattr, + -width => 4, -height => 1, + -highlightthickness => 3, + -highlightbackground => $hlbg, + -activebackground => $darkbg, + -activeforeground => $fg, + ); + my @rattr = (@lattr, + -activebackground => $darkbg, + -activeforeground => $fg, + -selectcolor => $selcolor); + + $hosts_fm->Label(@lattr, -text => "restart on :" + )->pack(-side => 'top', -padx => 20, -pady => 20); + for(@hosts) { + $hosts_fm->Radiobutton(@rattr, + -variable => \$preselected_host, + -value => $_, + -text => $_, + )->pack(-side => 'top'); + } + my $fm = $hosts_fm->Frame(-background => $darkbg)->pack(-side => 'bottom'); + $fm->Button(@battr, + -command => sub {$hosts_tl->destroy}, + -text => 'ok')->pack(-side => 'left', -padx => 10, -pady => 20); + $fm->Button(@battr, + -command => sub {$preselected_host = undef; $hosts_tl->destroy}, + -text => 'cancel')->pack(-side => 'left', -padx => 10, -pady => 20); + $hosts_tl->update; + my ($X, $Y) = ($mw->rootx, $mw->rooty); + my ($w, $h) = ($hosts_tl->width, $hosts_tl->height); + my ($W, $H) = ($mw->width, $mw->height); + $x = $X + $W - $w if ($x + $w) > $X + $W; + $y = $Y + $H - $h if ($y + $h) > $Y + $H; + $hosts_tl->geometry('+'.$x.'+'.$y); + $hosts_tl->waitWindow(); + return $preselected_host; } # end hostsmenu |