#!/usr/bin/perl
use warnings;
use strict;

my $forks;
my @childs;
my $zero = 0;

while ($ARGV[0] =~ /^-(\d+)$/) {
	if ($1 > 0) {
		$forks = $1;
	} else {
		$zero=1;
		$/ = "\0";
	}
	shift(@ARGV);
}

if (!$forks) {
	my @cpus = </sys/devices/system/cpu/cpu[0-9]*/.>;
	$forks = @cpus+1;
}

my @prog = (shift(@ARGV));
while ($ARGV[0] =~ /^-/)
	{ push(@prog, shift(@ARGV)); }

if ($prog[0] =~ /^-/) {
	die "usage: $0 prog -options arg1 ...";
}

for my $arg (@ARGV) {

	while (@childs >= $forks) {
#		print "Daddy waiting\n";
		my $job = wait();
		if ($job && $?) {
			print "Job exited with code $?\n"
		}
		@childs = grep { kill 0, $_ } @childs;
#		print "Lost son\n";
	}

	forkagain:
	my $job = fork();
	if ($job) {
		push(@childs, $job);
#		@childs = grep { kill 0, $_ } @childs; # better debug output
#		print "now ", scalar @childs," childs: ", join(', ', @childs), "\n";
	} elsif(!defined $job) {
		sleep 2;
		goto forkagain;
	} else {
		open (STDIN, '<', "/dev/null") || die;
		exec { $prog[0] } (@prog, $arg);
		exit 127;
	}
}

done:

print "waiting for jobs to finish\n";
while (@childs) {
	my $job = wait();
	@childs = grep { kill 0, $_ } @childs;
}