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         my $running;
  35         if (delete $self->{rpipe}) {
  36                 my $pid = delete $self->{pid};
  37                 $self->{err} = $pid == waitpid($pid, 0) ? $? :
  38                                 "PID:$pid still running?";
  39                 $running = --$limiter->{running};
  40         }
  41
  42         # limiter->{max} may change dynamically
  43         if (($running || $limiter->{running}) < $limiter->{max}) {
  44                 if (my $next = shift @{$limiter->{run_queue}}) {
  45                         _do_spawn(@$next);
  46                 }
  47         }
  48         $self->{err};
  49 }
  50
  51 sub start {
  52         my ($self, $limiter, $cb) = @_;
  53         $self->{limiter} = $limiter;
  54
  55         if ($limiter->{running} < $limiter->{max}) {
  56                 _do_spawn($self, $cb);
  57         } else {
  58                 push @{$limiter->{run_queue}}, [ $self, $cb ];
  59         }
  60 }
  61
  62 package PublicInbox::Qspawn::Limiter;
  63 use strict;
  64 use warnings;
  65
  66 sub new {
  67         my ($class, $max) = @_;
  68         bless {
  69                 # 32 is same as the git-daemon connection limit
  70                 max => $max || 32,
  71                 running => 0,
  72                 run_queue => [],
  73         }, $class;
  74 }
  75
  76 1;