bin/analysis-worker.pl

   1 #!/usr/bin/perl
   2
   3 # use 5.010;
   4 use strict;
   5 use warnings;
   6
   7 =head1 NAME
   8
   9
  10
  11 =head1 SYNOPSIS
  12
  13
  14
  15 =head1 OPTIONS
  16
  17 =over 8
  18
  19 =cut
  20
  21 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  22
  23 =item B<--dry-run|n!>
  24
  25 Tells us what it would do and exits.
  26
  27 =item B<--help|h!>
  28
  29 This help
  30
  31 =back
  32
  33 =head1 DESCRIPTION
  34
  35 Work until nothing to do or we have worked for a full day. Looks into
  36 the redis queue C<analysis:jobqueue:q> for C<distv> names and calls a
  37 --pick job, one after the other. Concurrency is managed by
  38 IPC::ConcurrencyLimit.
  39
  40 =cut
  41
  42
  43 use FindBin;
  44 use lib "$FindBin::Bin/../CPAN-Blame/lib";
  45 BEGIN {
  46     push @INC, qw(       );
  47 }
  48 use CPAN::Blame::Config::Cnntp;
  49
  50 use Dumpvalue;
  51 use File::Basename qw(dirname);
  52 use File::Path qw(mkpath);
  53 use File::Spec;
  54 use File::Temp;
  55 use Getopt::Long;
  56 use Pod::Usage;
  57 use Hash::Util qw(lock_keys);
  58 use Time::Moment;
  59
  60 our %Opt;
  61 lock_keys %Opt, map { /([^=|!]+)/ } @opt;
  62 GetOptions(\%Opt,
  63            @opt,
  64           ) or pod2usage(1);
  65 if ($Opt{help}) {
  66     pod2usage(0);
  67 }
  68
  69 my($workdir);
  70 BEGIN {
  71     $workdir = File::Spec->catdir
  72         ($CPAN::Blame::Config::Cnntp::Config->{solver_vardir},
  73          "workdir");
  74 }
  75 use IPC::ConcurrencyLimit;
  76
  77 my($basename) = File::Basename::basename(__FILE__);
  78 my $limit = IPC::ConcurrencyLimit->new
  79     (
  80      # Note: the next code line is parsed by catalyst for mgmt.tt, so
  81      # keep it matching /\bmax_procs\s*(?:=>|,)\s*(\d+)/;
  82      max_procs => 3,
  83      # 2014-01-06: 8 made the normal requests slow
  84      # 2014-01-29: 6 was still demanding on disk
  85      # 2014-08-22: 5 was very good, but it seems that 4 will be good enough too
  86      # 2015-06-03: 4 was wasting cycles, 5 will speed up calculating,
  87      #   lowered swappiness seems to help the webserver
  88      # 2016-02-19: setting to 4 again, would prefer better response
  89      #   times; if we are not calculating quickly enough, users can
  90      #   schedule by clicking nowadays
  91      # 2016-07-08: too much swapping on analysis decreasing to 3
  92      path      => "$workdir/IPC-ConcurrencyLimit-$basename",
  93     );
  94 my $limitid = $limit->get_lock;
  95 if (not $limitid) {
  96     warn "Another process appears to be still running. Exiting.";
  97     exit(0);
  98 }
  99
 100 my $logfile = __FILE__ . ".log";
 101 sub appendlog {
 102     my($what) = @_;
 103     $what =~ s/\s*\z//;
 104     my $tm = Time::Moment->now_utc;
 105     open my $fh, ">>", $logfile or die "Could not open '$logfile': $!";
 106     print $fh "$tm $what\n";
 107     close $fh or die "Could not close '$logfile': $!";
 108 }
 109
 110 use Redis;
 111 use Time::HiRes qw(sleep);
 112 my $redis = Redis->new(reconnect => 120, every => 1000);
 113 my($found_one) = 0;
 114 setpriority(0, 0, 5); # renice
 115 appendlog("Starting as $$");
 116 LOOP: while () {
 117     my $qlen = $redis->zcard("analysis:jobqueue:q");
 118     last LOOP if $qlen < 1;
 119     my($distv) = $redis->zrevrange("analysis:jobqueue:q",0,0);
 120     $found_one = 1;
 121     if ($Opt{"dry-run"}) {
 122         warn "Found $qlen items in q. Would now try to remove $distv and process it. But dry-run, leaving";
 123         last LOOP;
 124     }
 125     if ($redis->zrem("analysis:jobqueue:q", $distv)) {
 126         appendlog("As $$ $distv");
 127         0==system qq{ionice -n 7 "$^X" "$FindBin::Bin/cnntp-solver.pl" "--pick" "$distv" >> $logfile 2>&1} or die "problem running cnntp-solver, giving up";
 128         sleep 3; # as a precaution that we do not throw away the whole
 129                  # queue too quickly in case of a bug
 130     } else {
 131         sleep 0.3;
 132     }
 133     if (time - $^T > 86400) {
 134         last LOOP;
 135     }
 136 }
 137 if (! $found_one) {
 138     if ($Opt{"dry-run"}) {
 139         warn "Queue seems to be empty, would just leave";
 140     }
 141 }
 142 appendlog("Finished as $$");
 143
 144 # Local Variables:
 145 # mode: cperl
 146 # cperl-indent-level: 4
 147 # End: