#! /usr/bin/perl -w

use strict ;

my $OUT = 'out' ;

my $prog = substr($0,rindex($0,'/')+1) ;
my $Usage = <<USAGE ;
Usage: $prog [-v] [-q] [-d] N P
option v : be verbose
option q : be quiet
option d : show debug info
-------------------------------------------------------------
Do N jobs ; do at most P jobs in parallel
-------------------------------------------------------------
USAGE
sub Usage { die "$_[0]$Usage" ; }
sub Error { die "$prog: $_[0]\n" ; }
sub Warn  { warn "$prog: $_[0]\n" ; }

# usage: &GetOptions(ARG,ARG,..) defines $opt_ID as 1 or user spec'ed value
# usage: &GetOptions(\%opt,ARG,ARG,..) defines $opt{ID} as 1 or user value
# ARG = 'ID' | 'ID=SPC' | 'ID:SPC' for no-arg, required-arg or optional-arg
# ID  = perl identifier
# SPC = i|f|s for integer, fixedpoint real or string argument

use Getopt::Long ;
Getopt::Long::config('no_ignore_case') ;
my %opt = () ; Usage('') unless GetOptions
  ( \%opt, qw(v q d) ) ;
Usage("Arg count\n") unless @ARGV == 2 ;

my $N   = shift ;
my $PAR = shift ;

#setup N jobs ; $jobs has the pid's of the children
my @QUE = ( 1 .. $N ) ;
my $jobs = {} ;
my $fh ;

# clear the log
open $fh, '>', $OUT or Error "can't write $OUT ($!)" ; close $fh ;

# open the log for all to append to
open $fh, '>>', $OUT or Error "can't append $OUT ($!)" ;

sub count { my $hash = shift ; scalar keys %$hash ; }

sub child
  { my $num = shift ;
    my $rand = int ( rand 10 ) ;
    my $msg = sprintf "...     job %3d : sleep %2d ; %s\n"
      , $num, $rand, $$ ;
    print $msg ;
    sleep $rand ;
    # want msgs appended to file, so don't use buffered io
    syswrite $fh, $msg ;
    close $fh ;
    exit ;
  }

while ( @QUE or count $jobs )
  { if ( @QUE and count ( $jobs ) < $PAR )
      { # some work to fork
        my $num = shift @QUE ;
        my $pid = fork ;
        Error "can't fork" unless defined $pid ;
        if ( $pid )
          { # parent
            $jobs -> { $pid } = $num ;
            printf "started job %3d ; active %2d\n", $num , count $jobs ;
          }
        else
          { # child ; the work goes here
	    child $num ;
          }
      }
    else
      { my $pid = wait ;
        my $num = delete $jobs -> { $pid } ;
        printf "ended   job %3d ; active %2d\n", $num, count $jobs ;
      }
  }

close $fh ;