submit/remote-status

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 BEGIN {
   7         defined $ENV{"MO_ROOT"} or die "Please set MO_ROOT to the contest root directory first.\n";
   8 }
   9 use lib $ENV{"MO_ROOT"} . "/lib/perl5";
  10 use lib ".";            ### FIXME
  11
  12 use MO::Submit;
  13 use Sherlock::Object;
  14 use POSIX;
  15
  16 @ARGV == 0 or die "Usage: remote-status\n";
  17
  18 my $conn = new MO::Submit;
  19 $conn->connect or die $conn->{"error"} . "\n";
  20
  21 sub or_die($) {
  22         my $r = shift @_;
  23         if (!defined $r) { die $conn->{"error"} . "\n"; }
  24         my $err = $r->get("-");
  25         if ($err) { die "$err\n"; }
  26 }
  27
  28 my $r = new Sherlock::Object("!" => "STATUS");
  29 $r = $conn->request($r);
  30 or_die($r);
  31 #$r->write_indented(*STDOUT);
  32
  33 my %tasks = map { $_->get("T") => $_ } $r->getarray("(T");
  34 foreach my $task (sort keys %tasks) {
  35         my $t = $tasks{$task};
  36         my %parts = map { $_->get("P") => $_ } $t->getarray("(P");
  37         my @pp = keys %parts;
  38         if (@pp != 1) {
  39                 @pp = sort { $a <=> $b } @pp;   # We expect that the parts are numeric
  40         }
  41         foreach my $part (@pp) {
  42                 my $p = $parts{$part};
  43                 my $name = $task;
  44                 $part eq $task or $name .= "/$part";
  45                 printf "%-16s", $name;
  46
  47                 my $current_ver = $p->get("V");
  48                 my $printed = 0;
  49                 foreach my $v ($p->getarray("(V")) {
  50                         if ($v && $v->get("V") == $current_ver) {
  51                                 my $time = strftime("%H:%M:%S", localtime $v->get("T"));
  52                                 print "OK (",
  53                                         "$part.", $v->get("X"), ", ",
  54                                         $v->get("L"), " bytes, ",
  55                                         $v->get("S"), " $time)\n";
  56                                 $printed = 1;
  57                         }
  58                 }
  59                 $printed or print "---\n";
  60         }
  61 }
  62
  63 $conn->disconnect;