]> mj.ucw.cz Git - bex.git/blob - bq
Rationalized logging
[bex.git] / bq
1 #!/usr/bin/perl
2 # Batch EXecutor 2.0 -- Show Queued Jobs
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 $op_by_job;
14 my $op_by_host;
15 my $op_rm;
16 my $op_move_to;
17
18 my $queue_name;
19 my $given_job;
20
21 GetOptions(
22         "by-job!" => \$op_by_job,
23         "h|by-host!" => \$op_by_host,
24         "rm!" => \$op_rm,
25         "move-to=s" => \$op_move_to,
26         "j|job=s" => \$given_job,
27         "q|queue=s" => \$queue_name,
28 ) or die <<AMEN ;
29 Usage: bq [<options and actions>] [[!]<machine-or-class> ...]
30
31 Actions:
32     --by-job            Show jobs sorted by job ID (default)
33 -h, --by-host           Show jobs sorted by host
34     --rm                Remove jobs from the queue
35     --move-to=<queue>   Move jobs to a different queue
36
37 Options:
38 -j, --job=<id>          Act on the specified job (default: on all)
39 -q, --queue=<name>      Act on the given queue
40 AMEN
41
42 my @machines = BEX::Config::parse_machine_list(@ARGV ? @ARGV : '*');
43 my $queue = BEX::Queue->new($queue_name);
44
45 # Select jobs
46 my %jobs = ();
47 my %machs = ();
48 for my $m (@machines) {
49         for my $j ($queue->scan($m)) {
50                 if (defined $given_job) {
51                         next if $j ne $given_job;
52                 }
53                 push @{$jobs{$j}}, $m;
54                 push @{$machs{$m}}, $j;
55         }
56 }
57
58 sub do_ls();
59 sub do_rm();
60 sub do_move_to();
61
62 my $ops = 0 + defined($op_by_host) + defined($op_by_job) + defined($op_rm) + defined($op_move_to);
63 if ($ops > 1) { die "Multiple actions are not allowed\n"; }
64
65 if ($op_rm) { do_rm(); }
66 elsif (defined $op_move_to) { do_move_to(); }
67 else { do_ls(); }
68 exit 0;
69
70 sub do_ls()
71 {
72         my %stat = ();
73         my %mach_locked = ();
74         for my $m (keys %machs) {
75                 $mach_locked{$m} = $queue->is_locked($m, undef);
76                 for my $j (@{$machs{$m}}) {
77                         my $st = $queue->read_job_status($m, $j);
78                         if (defined($st->{'Time'}) && defined($st->{'Status'})) {
79                                 $stat{$m}{$j} = ' [' . $st->{'Status'} . ' on ' .
80                                                 POSIX::strftime('%Y-%m-%d', localtime $st->{'Time'}) . ']';
81                         } else {
82                                 $stat{$m}{$j} = '';
83                         }
84                         if ($mach_locked{$m} || $queue->is_locked($m, $j)) {
85                                 $stat{$m}{$j} .= ' [LOCKED]';
86                         }
87                 }
88         }
89
90         if ($queue->is_locked(undef, undef)) {
91                 print "### Queue lock present\n\n";
92         }
93
94         if ($op_by_host) {
95                 for my $m (sort keys %machs) {
96                         print "$m", ($mach_locked{$m} ? ' [LOCKED]' : ''), "\n";
97                         for my $j (@{$machs{$m}}) {
98                                 print "\t" . $queue->job_name($j) . $stat{$m}{$j}, "\n";
99                         }
100                 }
101         } else {
102                 for my $j (sort keys %jobs) {
103                         print $queue->job_name($j), "\n";
104                         for my $m (sort @{$jobs{$j}}) {
105                                 print "\t$m", $stat{$m}{$j}, "\n";
106                         }
107                 }
108         }
109 }
110
111 sub do_rm()
112 {
113         my $err = 0;
114         for my $m (sort keys %machs) {
115                 for my $j (sort @{$machs{$m}}) {
116                         if (!$queue->lock($m, $j)) {
117                                 print STDERR "Cannot remove $m:", $queue->job_name($j), ", it is locked\n";
118                                 $err = 1;
119                         } else {
120                                 $queue->update_job_status($m, $j, 'REMOVED');
121                                 $queue->remove($m, $j);
122                                 print "Removed $m:", $queue->job_name($j), "\n";
123                         }
124                 }
125         }
126         $queue->unlock;
127         exit $err;
128 }
129
130 sub do_move_to()
131 {
132         my $err = 0;
133         my $dest = BEX::Queue->new($op_move_to);
134         $dest->{'Name'} ne $queue->{'Name'} or die "Moving to the same queue is not permitted\n";
135         for my $j (sort keys %jobs) {
136                 my $job = BEX::Job->new_from_file($queue->job_file($j));
137                 for my $m (sort @{$jobs{$j}}) {
138                         if (!$queue->lock($m, $j)) {
139                                 print STDERR "Cannot move $m:", $queue->job_name($j), ", it is locked\n";
140                                 $err = 1;
141                         } else {
142                                 my $enq = $dest->enqueue($m, $job);
143                                 if ($enq) {
144                                         $dest->update_job_status($m, $job->id, 'NEW', 'Moved to this queue');
145                                 } else {
146                                         $dest->log($m, $job->id, 'REQUEUE', 'Moved to this queue');
147                                 }
148                                 $queue->update_job_status($m, $job->id, 'REMOVED', 'Moved from this queue');
149                                 $queue->remove($m, $j);
150                                 print "Moved $m:", $dest->job_name($j);
151                                 print " (already queued)" if !$enq;
152                                 print "\n";
153                         }
154                 }
155         }
156         $queue->unlock;
157         exit $err;
158 }