git.rot13.org Git - safeq/blob - xwc-jobs.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 use Data::Dump qw(dump);
   6
   7 my $ip = shift @ARGV || '10.60.3.35';
   8 my $debug = $ENV{DEBUG} || 0;
   9 my $sep = $ENV{SEP} || "\t";
  10
  11 my $op = shift @ARGV || 'list';
  12
  13 my $url = 'jblist.htm';
  14 if ( $op =~ m/^l/i ) { # list
  15         $url = 'jblist.htm';
  16 } elsif ( $op =~ m/^h/i ) { # history
  17         $url = 'jbhist.htm';
  18 } elsif ( $op =~ m/^(d|c)/i ) { # delete/cancel
  19         my $job_id = shift @ARGV || die "expected job_id missing";
  20         open(my $curl, '-|', "curl --silent -XPOST -d OPR=CANCEL -d JOBS=$job_id/ http://$ip/JOBCTRL.cmd");
  21         while (<$curl>) {
  22                 if ( m/<title>/i ) {
  23                         chomp;
  24                         s/<[^>]*>//g;
  25                         print join($sep, $ip, $job_id, 'CANCEL', $_),"\n";
  26                 }
  27         }
  28         exit 0;
  29 } else {
  30         die "UNKNOWN op [$op]\n";
  31 }
  32
  33 warn "# $ip/$url" if $debug;
  34 open(my $curl, '-|', "curl --silent http://$ip/$url");
  35 my $info;
  36 while(<$curl>) {
  37         if ( m/var (stats|types|info|hdrs|stsAry|jHst)=(.*);/ ) {
  38                 my $json = $2;
  39                 my $v = eval $json; # this is not valid JSON, but perl's eval doesn't mind
  40                 #warn "# JSON $json -> ",dump($v);
  41                 $info->{$1} = $v;
  42         }
  43 }
  44
  45 warn "# info=",dump($info) if $debug;
  46
  47 my @headers = @{ $info->{hdrs} };
  48 unshift @headers, 'id' if $op eq 'list';
  49 unshift @headers, 'IP';
  50
  51 print join($sep, @headers),"\n";
  52
  53 foreach my $l ( @{ $info->{info} } ) {
  54         warn "## l=",dump($l) if $debug > 1;
  55
  56         $l->[3] .= ':' . $info->{stats}->[ $l->[3] ];
  57         $l->[4] .= ':' . $info->{types}->[ $l->[4] ];
  58
  59         print join($sep, $ip, @$l), "\n";
  60 }
  61
  62 foreach my $l ( @{ $info->{jHst} } ) {
  63         warn "## l=",dump($l) if $debug > 1;
  64
  65         $l->[2] .= ':' . $info->{stsAry}->[ $l->[2] ];
  66         $l->[3] .= ':' . $info->{types}->[ $l->[3] ];
  67
  68         print join($sep, $ip, @$l),"\n";
  69 }