CN Perl Advent Calendar 2009-12-18

Parallel::Prefork 和 SIG

by Fayland Lam

如果一个 daemon 处理队列太慢（或其他情况），Parallel::ForkManager 和 Parallel::Prefork 都是很不错的选择。

下面的代码来自我们实际运行中的一个 TheSchwartz worker 的 daemon, 实际上很大一部分都是拷贝自 http://d.hatena.ne.jp/tokuhirom/20081110/1226291955

   1 use strict;
   2 use warnings;
   3 
   4 my $has_proc_pid_file
   5     = eval 'use Proc::PID::File; 1;';    ## no critic (ProhibitStringyEval)
   6 my $has_home_dir
   7     = eval 'use File::HomeDir; 1;';      ## no critic (ProhibitStringyEval)
   8 if ( $has_proc_pid_file and $has_home_dir ) {
   9     # If already running, then exit
  10     if ( Proc::PID::File->running( { dir => File::HomeDir->my_home } ) ) {
  11         exit(0);
  12     }
  13 }
  14 
  15 use UNIVERSAL::require;
  16 use Parallel::Prefork;
  17 
  18 my @workers = qw/
  19     TheSchwartz::JobA
  20     TheSchwartz::JobB
  21     TheSchwartz::JobC
  22 /;
  23 foreach my $worker (@workers) {
  24     print "setup $worker\n";
  25     $worker->use or die $@;
  26 }
  27 
  28 sub MaxRequestsPerChild () { 2 }
  29 
  30 print "start prefork\n";
  31 my $pm = Parallel::Prefork->new({
  32     max_workers  => 3,
  33     fork_delay   => 1,
  34     trap_signals => {
  35         TERM => 'TERM',
  36         HUP  => 'TERM',
  37     },
  38 });
  39 
  40 while ($pm->signal_received ne 'TERM') {
  41     $pm->start and next;
  42     print "spawn $$\n";
  43 
  44     my $client = TheSchwartz::Moosified->new( databases => [$dbh] );
  45     $client->can_do($_) foreach @wokers;
  46     
  47     my $reqs_before_exit = MaxRequestsPerChild;
  48     $SIG{TERM} = sub { $reqs_before_exit = 0 };
  49     while ($reqs_before_exit > 0) {
  50         if ($client->work_once) {
  51             print "work $$\n";
  52             --$reqs_before_exit;
  53         } else {
  54             sleep 10;
  55         }
  56     }
  57 
  58     print "FINISHED $$\n";
  59     $pm->finish;
  60 }
  61 
  62 
  63 $pm->wait_all_children;
  64 
  65 die "HMM????";

代码是自解释的。:)

但是有时候我们需要停止它的时候（它由 crontab 启动），根据代码我们需要发送 TERM 给脚本，然后脚本才会优雅地退出。这时候 Proc::ProcessTable 就派上大用场了。

   1 use Proc::ProcessTable;
   2 
   3 my $p = new Proc::ProcessTable( 'cache_ttys' => 1 );
   4 my $all = $p->table;
   5 foreach my $one (@$all) {
   6     if ($one->cmndline =~ /TheSchwartz/) {
   7         next if ( $one->cmndline =~ /TheSchwartz_restart/ ); # itself
   8         my $pid = $one->pid;
   9         print "kill -15 $pid\n";
  10         `kill -15 $pid`; # send TERM
  11     }
  12 }

Proc::ProcessTable 类似于 ps, 我们找到 pid 后，发送 TERM 过去就大功告成了。

谢谢。