lib/PublicInbox/Qspawn.pm

   1 # Copyright (C) 2016 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # Limits the number of processes spawned
   5 # This does not depend on Danga::Socket or any other external
   6 # scheduling mechanism, you just need to call start and finish
   7 # appropriately
   8 package PublicInbox::Qspawn;
   9 use strict;
  10 use warnings;
  11 use PublicInbox::Spawn qw(popen_rd);
  12
  13 sub new ($$$;) {
  14         my ($class, $cmd, $env, $opt) = @_;
  15         bless { args => [ $cmd, $env, $opt ] }, $class;
  16 }
  17
  18 sub _do_spawn {
  19         my ($self, $cb) = @_;
  20         my $err;
  21
  22         ($self->{rpipe}, $self->{pid}) = popen_rd(@{$self->{args}});
  23         if (defined $self->{pid}) {
  24                 $self->{limiter}->{running}++;
  25         } else {
  26                 $self->{err} = $!;
  27         }
  28         $cb->($self->{rpipe});
  29 }
  30
  31 sub finish ($) {
  32         my ($self) = @_;
  33         my $limiter = $self->{limiter};
  34         if (delete $self->{rpipe}) {
  35                 my $pid = delete $self->{pid};
  36                 $self->{err} = $pid == waitpid($pid, 0) ? $? :
  37                                 "PID:$pid still running?";
  38                 $limiter->{running}--;
  39         }
  40         if (my $next = shift @{$limiter->{run_queue}}) {
  41                 _do_spawn(@$next);
  42         }
  43         $self->{err};
  44 }
  45
  46 sub start {
  47         my ($self, $limiter, $cb) = @_;
  48         $self->{limiter} = $limiter;
  49
  50         if ($limiter->{running} < $limiter->{max}) {
  51                 _do_spawn($self, $cb);
  52         } else {
  53                 push @{$limiter->{run_queue}}, [ $self, $cb ];
  54         }
  55 }
  56
  57 package PublicInbox::Qspawn::Limiter;
  58 use strict;
  59 use warnings;
  60
  61 sub new {
  62         my ($class, $max) = @_;
  63         bless {
  64                 # 32 is same as the git-daemon connection limit
  65                 max => $max || 32,
  66                 running => 0,
  67                 run_queue => [],
  68         }, $class;
  69 }
  70
  71 1;