bprun

   1 #!/usr/bin/perl
   2 # Batch EXecutor 2.0 -- Parallel Execution Using Screen
   3 # (c) 2011 Martin Mares <mj@ucw.cz>
   4
   5 use strict;
   6 use warnings;
   7 use Getopt::Long;
   8 use POSIX;
   9
  10 use lib 'lib';
  11 use BEX;
  12
  13 my $queue_name;
  14 my $text_mode;
  15
  16 GetOptions(
  17         "q|queue=s" => \$queue_name,
  18         "text!" => \$text_mode,
  19 ) or die <<AMEN ;
  20 Usage: bprun [<options>] [[!]<machine-or-class> ...]
  21
  22 Options:
  23 -q, --queue=<name>      Run jobs in the given queue
  24     --text              Use textual user interface instead of curses
  25 AMEN
  26
  27 $ENV{'STY'} or die "Please run me under Screen\n";
  28 my @machines = BEX::Config::parse_machine_list(@ARGV ? @ARGV : '*');
  29 my $queue = BEX::Queue->new($queue_name);
  30
  31 my $fifo_name = $queue->{'Name'} . '/status-fifo';
  32 unlink $fifo_name;
  33 mkfifo $fifo_name, 0700 or die "Cannot create $fifo_name: $!";
  34 open FIFO, '+<', $fifo_name or die "Cannot open $fifo_name: $!";
  35
  36 my $ui = ($text_mode ? BEX::bprun::text->new : BEX::bprun::curses->new);
  37
  38 my %running = ();
  39 my $max = $BEX::Config::max_parallel_jobs;
  40
  41 while (keys %running || @machines) {
  42         if (@machines && keys %running < $max) {
  43                 my $mach = shift @machines;
  44                 my @jobs = $queue->scan($mach);
  45                 @jobs or next;
  46                 $ui->update($mach, undef, 'START');
  47                 system 'screen', '-t', $mach, './brun', "--status-fifo=$fifo_name", $mach;
  48                 !$? or $ui->update($mach, undef, 'INTERR');
  49                 $running{$mach} = 'START';
  50                 next;
  51         }
  52         $_ = <FIFO>;
  53         chomp;
  54         my ($mach, $jid, $stat) = /^! (\S+) (\S+) (\S+)$/;
  55         if (!defined $stat) {
  56                 $ui->err("Received invalid status message <$_>");
  57                 next;
  58         }
  59         if (!defined $running{$mach}) {
  60                 $ui->err("Received status message <$_> for a machine which does not run");
  61                 next;
  62         }
  63         $running{$mach} = $stat;
  64         $ui->update($mach, ($jid eq '-' ? undef : $jid), $stat);
  65         if ($stat eq 'DONE') {
  66                 delete $running{$mach};
  67         }
  68 }
  69
  70 close FIFO;
  71 unlink $fifo_name;
  72 $ui->done;
  73
  74 package BEX::bprun::text;
  75
  76 sub new($) {
  77         return bless {};
  78 }
  79
  80 sub done($) {
  81 }
  82
  83 sub update($$$$) {
  84         my ($ui, $mach, $jid, $stat) = @_;
  85         print +($mach // '-'), (defined($jid) ? ":$jid" : ""), " $stat\n";
  86 }
  87
  88 sub err($$) {
  89         my ($ui, $msg) = @_;
  90         print STDERR "ERROR: $msg\n";
  91 }
  92
  93 package BEX::bprun::curses;
  94
  95 use Curses;
  96
  97 my $C;
  98
  99 my $nrows;
 100 my @by_row = ();
 101 my %by_host = ();
 102
 103 sub new($) {
 104         $C = new Curses;
 105         start_color;
 106         has_colors && COLORS >= 8 && COLOR_PAIRS >= 8 or die "Your terminal is too dumb for me\n";
 107         cbreak; noecho;
 108         $C->intrflush(0);
 109         $C->keypad(1);
 110         $C->meta(1);
 111         $C->clear;
 112         $nrows = $C->getmaxy - 2;
 113         if ($BEX::Config::max_parallel_jobs > $nrows) {
 114                 $BEX::Config::max_parallel_jobs = $nrows;
 115         }
 116         return bless {};
 117 }
 118
 119 sub done($)
 120 {
 121         endwin;
 122 }
 123
 124 sub get_slot($) {
 125         my ($mach) = @_;
 126         if (defined $by_host{$mach}) {
 127                 return $by_host{$mach};
 128         }
 129         my $s = {
 130                 'Host' => $mach,
 131         };
 132         my $i = 0;
 133         while (defined $by_row[$i]) { $i++; }
 134         $s->{'Row'} = $i;
 135         $by_row[$i] = $s;
 136         $by_host{$mach} = $s;
 137         return $s;
 138 }
 139
 140 sub delete_slot($) {
 141         my ($s) = @_;
 142         delete $by_host{$s->{'Host'}};
 143         $by_row[$s->{'Row'}] = undef;
 144 }
 145
 146 sub redraw_slot($) {
 147         my ($s) = @_;
 148         my $mach = $s->{'Host'};
 149         my $stat = $s->{'Status'} // "?";
 150         my $jid = $s->{'Job'} // "";
 151         my $text = sprintf("%-20s %-10s %s", $mach, $stat, $jid);
 152         $C->addnstr($s->{'Row'}, 0, $text, $C->getmaxx);
 153         $C->clrtoeol;
 154         $C->refresh;
 155 }
 156
 157 sub update($$$$) {
 158         my ($ui, $mach, $jid, $stat) = @_;
 159         my $s = get_slot($mach);
 160         $s->{'Job'} = $jid;
 161         $s->{'Status'} = $stat;
 162         redraw_slot($s);
 163         if ($stat eq 'DONE') { delete_slot($s); }
 164 }