21 my @opt = <<'=back' =~ /B<--(\S+)>/g;
25 Tells us what it would do and exits.
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.
44 use lib
"$FindBin::Bin/../CPAN-Blame/lib";
48 use CPAN
::Blame
::Config
::Cnntp
;
51 use File
::Basename
qw(dirname);
52 use File
::Path
qw(mkpath);
57 use Hash
::Util
qw(lock_keys);
61 lock_keys
%Opt, map { /([^=|!]+)/ } @opt;
71 $workdir = File
::Spec
->catdir
72 ($CPAN::Blame
::Config
::Cnntp
::Config
->{solver_vardir
},
75 use IPC
::ConcurrencyLimit
;
77 my($basename) = File
::Basename
::basename
(__FILE__
);
78 my $limit = IPC
::ConcurrencyLimit
->new
80 # Note: the next code line is parsed by catalyst for mgmt.tt, so
81 # keep it matching /\bmax_procs\s*(?:=>|,)\s*(\d+)/;
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",
94 my $limitid = $limit->get_lock;
96 warn "Another process appears to be still running. Exiting.";
100 my $logfile = __FILE__
. ".log";
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': $!";
111 use Time
::HiRes
qw(sleep);
112 my $redis = Redis
->new(reconnect
=> 120, every
=> 1000);
114 setpriority(0, 0, 5); # renice
115 appendlog
("Starting as $$");
117 my $qlen = $redis->zcard("analysis:jobqueue:q");
118 last LOOP
if $qlen < 1;
119 my($distv) = $redis->zrevrange("analysis:jobqueue:q",0,0);
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";
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
133 if (time - $^T
> 86400) {
138 if ($Opt{"dry-run"}) {
139 warn "Queue seems to be empty, would just leave";
142 appendlog
("Finished as $$");
146 # cperl-indent-level: 4