gearman-top.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 use IO::Socket::INET;
   6 use Data::Dump qw(dump);
   7
   8 my $sock = IO::Socket::INET->new(
   9         PeerAddr => '127.0.0.1',
  10         PeerPort => 4730,
  11         Proto    => 'tcp'
  12 ) || die $1;
  13
  14 print "\e[2J"; # Erase Screen
  15
  16 my $t = time();
  17 my $max;
  18 my $erase_screen = 1;
  19 my $last_content = '?';
  20
  21 while(1) {
  22         my $uptime = time() - $t;
  23         if ( $erase_screen ) {
  24                 print "\e[2J";
  25                 $erase_screen = 0;
  26         }
  27         print "\e[0;0H"; # Cursor Home
  28         print "Gearman " . localtime(time()) . "\t\e[34mmax update: $uptime\e[0m\n";
  29         printf "\e[4mqueued  running  wrk function\e[0m\n";
  30
  31         print $sock "STATUS\n";
  32
  33         my $content;
  34
  35         while ( my $line = <$sock> ) {
  36                 chomp $line;
  37 #               warn "# [$line]\n";
  38                 last if $line eq '.';
  39                 next if $line =~ m/\t0$/; # ignore functions which don't have active workers
  40                 my ( $name, $queued, $running, $workers ) = split(/\t/,$line,4);
  41                 $max->{$name}->{$_} ||= 0 foreach qw(queued running);
  42                 $max->{$name}->{queued}  = $queued  if $queued > $max->{$name}->{queued};
  43                 $max->{$name}->{running} = $running if $running > $max->{$name}->{running};
  44                 my $line = sprintf "%3d \e[34m%-3d\e[0m %3d \e[34m%-3d\e[0m %3d  %s"
  45                         , $queued,  $max->{$name}->{queued}
  46                         , $running, $max->{$name}->{running}
  47                         , $workers
  48                         , $name
  49                 ;
  50                 print "$line\n";
  51                 $content .= $line;
  52         }
  53
  54 =for workers
  55         print $sock "WORKERS\n";
  56
  57         while ( my $line = <$sock> ) {
  58                 chomp $line;
  59                 warn "# [$line]\n";
  60                 last if $line eq '.';
  61         }
  62 =cut
  63
  64         if ( $content ne $last_content ) {
  65                 $erase_screen = 1;
  66                 $last_content = $content;
  67         }
  68
  69         sleep 1;
  70 }