#!/usr/bin/perl -w

use IPC::Open3;
use Symbol qw(gensym);
use IO::File;
use POSIX qw(:sys_wait_h setsid ceil);
use File::Temp qw(tempfile tempdir);
use Getopt::Long;
use strict;
use Carp;

$::oodebug=0;
$Global::original_sigterm = $SIG{TERM};
$SIG{TERM} = sub {}; # Dummy until jobs really start
open $Global::original_stderr, ">&STDERR" or die "Can't dup STDERR: $!";

do_not_reap();
parse_options();
my $number_of_args;
if($Global::max_number_of_args) {
    $number_of_args=$Global::max_number_of_args;
} elsif ($Global::Xargs or $Global::xargs) {
    $number_of_args = undef;
} else {
    $number_of_args = 1;
}

my @fhlist;
@fhlist = map { open_or_exit($_) } @::opt_a;
if(not @fhlist) {
    @fhlist = (*STDIN);
}
if($::opt_skip_first_line) {
    # Skip the first line for the first file handle
    my $fh = $fhlist[0];
    <$fh>;
}

my $command;
if(@ARGV) {
    if($Global::quoting) {
	$command = shell_quote(@ARGV);
    } else {
	$command = join(" ", @ARGV);
    }
}

$Global::JobQueue = JobQueue->new(
    $command,\@fhlist,$Global::Xargs,$number_of_args,\@Global::ret_files);
for my $sshlogin (values %Global::host) {
    $sshlogin->max_jobs_running();
}

init_run_jobs();
my $sem;
if($Global::semaphore) {
    $sem = acquire_semaphore();
}
$SIG{TERM} = \&start_no_new_jobs;
start_more_jobs();
reap_if_needed();
drain_job_queue();
cleanup();
if($Global::semaphore) {
    $sem->release();
}
if($::opt_halt_on_error) {
    wait_and_exit($Global::halt_on_error_exitstatus);
} else {
    wait_and_exit(min(undef_as_zero($Global::exitstatus),254));
}

sub acquire_semaphore {
    # Acquires semaphore. If needed: spawns to the background
    # Returns:
    #    The semaphore to be released when jobs is complete
    $Global::host{':'} = SSHLogin->new(":");
    my $sem = Semaphore->new($Semaphore::name,$Global::host{':'}->max_jobs_running());
    $sem->acquire();
    debug("run");
    if($Semaphore::fg) {
	# skip
    } else {
	# If run in the background, the PID will change
	# therefore release and re-acquire the semaphore
	$sem->release();
	if(fork()) {
	    exit(0);
	} else {
	    # child
	    # Get a semaphore for this pid
	    die "Can't start a new session: $!" if setsid() == -1;
	    $sem = Semaphore->new($Semaphore::name,$Global::host{':'}->max_jobs_running());
	    $sem->acquire();
	}
    }
    return $sem;
}

sub get_options_from_array {
    # Run GetOptions on @array
    # Returns:
    #   true if parsing worked
    #   false if parsing failed
    #   @array is changed
    my $array_ref = shift;
    # A bit of shuffling of @ARGV needed as GetOptionsFromArray is not
    # supported everywhere
    my @save_argv;
    my $this_is_ARGV = (\@::ARGV == $array_ref);
    if(not $this_is_ARGV) {
	@save_argv = @::ARGV;
	@::ARGV = @{$array_ref};
    }
    my @retval = GetOptions
	("debug|D" => \$::opt_D,
	 "xargs|m" => \$::opt_m,
	 "X" => \$::opt_X,
	 "v" => \@::opt_v,
	 "silent" => \$::opt_silent,
	 "keep-order|keeporder|k" => \$::opt_k,
	 "group|g" => \$::opt_g,
	 "ungroup|u" => \$::opt_u,
	 "null|0" => \$::opt_0,
	 "quote|q" => \$::opt_q,
	 "I=s" => \$::opt_I,
	 "extensionreplace|U=s" => \$::opt_U,
	 "basenamereplace=s" => \$::opt_basenamereplace,
	 "basenameextensionreplace=s" => \$::opt_basenameextensionreplace,
	 "jobs|j=s" => \$::opt_P,
	 "load=s" => \$::opt_load,
	 "max-line-length-allowed" => \$::opt_max_line_length_allowed,
	 "number-of-cpus" => \$::opt_number_of_cpus,
	 "number-of-cores" => \$::opt_number_of_cores,
	 "use-cpus-instead-of-cores" => \$::opt_use_cpus_instead_of_cores,
	 "nice=i" => \$::opt_nice,
	 "sshlogin|S=s" => \@::opt_sshlogin,
	 "sshloginfile=s" => \$::opt_sshloginfile,
	 "controlmaster|M" => \$::opt_controlmaster,
	 "return=s" => \@::opt_return,
	 "trc=s" => \@::opt_trc,
	 "transfer" => \$::opt_transfer,
	 "cleanup" => \$::opt_cleanup,
	 "basefile|B=s" => \@::opt_basefile,
	 "workdir|W=s" => \$::opt_workdir,
	 "tmpdir=s" => \$::opt_tmpdir,
	 "tempdir=s" => \$::opt_tmpdir,
	 "tty|T" => \$::opt_tty,
	 "halt-on-error|H=s" => \$::opt_halt_on_error,
	 "retries=i" => \$::opt_retries,
	 "dry-run|dryrun" => \$::opt_dryrun,
	 "progress" => \$::opt_progress,
	 "eta" => \$::opt_eta,
	 "arg-sep|argsep=s" => \$::opt_arg_sep,
	 "arg-file-sep|argfilesep=s" => \$::opt_arg_file_sep,
	 "trim=s" => \$::opt_trim,
	 "profile|J=s" => \$::opt_profile,
	 # xargs-compatibility - implemented, man, testsuite
	 "max-procs|P=s" => \$::opt_P,
	 "delimiter|d=s" => \$::opt_d,
	 "max-chars|s=i" => \$::opt_s,
	 "arg-file|a=s" => \@::opt_a,
	 "no-run-if-empty|r" => \$::opt_r,
	 "replace|i:s" => \$::opt_i,
	 "E=s" => \$::opt_E,
	 "eof|e:s" => \$::opt_E,
	 "max-args|n=i" => \$::opt_n,
	 "max-replace-args|N=i" => \$::opt_N,
	 "colsep|col-sep|C=s" => \$::opt_colsep,
	 "help|h" => \$::opt_help,
	 "L=i" => \$::opt_L,
	 "max-lines|l:i" => \$::opt_l,
	 "interactive|p" => \$::opt_p,
	 "verbose|t" => \$::opt_verbose,
	 "version|V" => \$::opt_version,
	 "show-limits" => \$::opt_show_limits,
	 "exit|x" => \$::opt_x,
	 # Semaphore
	 "semaphore" => \$::opt_semaphore,
	 "semaphoretimeout=i" => \$::opt_semaphoretimeout,
	 "semaphorename|id=s" => \$::opt_semaphorename,
	 "fg" => \$::opt_fg,
	 "bg" => \$::opt_bg,
	 "wait" => \$::opt_wait,
	 # Shebang #!/usr/bin/parallel -Yotheroptions
	 "Y|shebang|hashbang" => \$::opt_shebang,
	 "skip-first-line" => \$::opt_skip_first_line,
	);
    if(not $this_is_ARGV) {
	@{$array_ref} = @::ARGV;
	@::ARGV = @save_argv;
    }
    return @retval;
}

sub parse_options {
    # Returns: N/A
    # Defaults:
    $Global::version = 20110101;
    $Global::progname = 'parallel';
    $Global::infinity = 2**31;
    $Global::debug = 0;
    $Global::verbose = 0;
    $Global::grouped = 1;
    $Global::keeporder = 0;
    $Global::quoting = 0;
    $Global::replace{'{}'} = '{}';
    $Global::replace{'{.}'} = '{.}';
    $Global::replace{'{/}'} = '{/}';
    $Global::replace{'{/.}'} = '{/.}';
    $/="\n";
    $Global::ignore_empty = 0;
    $Global::interactive = 0;
    $Global::stderr_verbose = 0;
    $Global::default_simultaneous_sshlogins = 9;
    $Global::exitstatus = 0;
    $Global::halt_on_error_exitstatus = 0;
    $Global::arg_sep = ":::";
    $Global::arg_file_sep = "::::";
    $Global::trim = 'n';
    $Global::max_jobs_running = 0;

    @ARGV=read_options();

    if(defined @::opt_v) { $Global::verbose = $#::opt_v+1; } # Convert -v -v to v=2
    $Global::debug = (defined $::opt_D);
    if(defined $::opt_m) { $Global::xargs = 1; }
    if(defined $::opt_X) { $Global::Xargs = 1; }
    if(defined $::opt_silent) { $Global::verbose = 0; }
    if(defined $::opt_k) { $Global::keeporder = 1; }
    if(defined $::opt_g) { $Global::grouped = 1; }
    if(defined $::opt_u) { $Global::grouped = 0; }
    if(defined $::opt_0) { $/ = "\0"; }
    if(defined $::opt_d) { my $e="sprintf \"$::opt_d\""; $/ = eval $e; }
    if(defined $::opt_p) { $Global::interactive = $::opt_p; }
    if(defined $::opt_q) { $Global::quoting = 1; }
    if(defined $::opt_r) { $Global::ignore_empty = 1; }
    if(defined $::opt_verbose) { $Global::stderr_verbose = 1; }
    if(defined $::opt_I) { $Global::replace{'{}'} = $::opt_I; }
    if(defined $::opt_U) { $Global::replace{'{.}'} = $::opt_U; }
    if(defined $::opt_i and $::opt_i) { $Global::replace{'{}'} = $::opt_i; }
    if(defined $::opt_basenamereplace) { $Global::replace{'{/}'} = $::opt_basenamereplace; }
    if(defined $::opt_basenameextensionreplace) {
	$Global::replace{'{/.}'} = $::opt_basenameextensionreplace;
    }
    if(defined $::opt_E and $::opt_E) { $Global::end_of_file_string = $::opt_E; }
    if(defined $::opt_n and $::opt_n) { $Global::max_number_of_args = $::opt_n; }
    if(defined $::opt_N and $::opt_N) { $Global::max_number_of_args = $::opt_N; }
    if(defined $::opt_tmpdir) { $ENV{'TMPDIR'} = $::opt_tmpdir; }
    if(defined $::opt_help) { die_usage(); }
    if(defined $::opt_colsep) { $Global::trim = 'lr'; }
    if(defined $::opt_trim) { $Global::trim = $::opt_trim; }
    if(defined $::opt_arg_sep) { $Global::arg_sep = $::opt_arg_sep; }
    if(defined $::opt_arg_file_sep) { $Global::arg_file_sep = $::opt_arg_file_sep; }
    if(defined $::opt_number_of_cpus) { print SSHLogin::no_of_cpus(),"\n"; wait_and_exit(0); }
    if(defined $::opt_number_of_cores) {
	print SSHLogin::no_of_cores(),"\n"; wait_and_exit(0);
    }
    if(defined $::opt_max_line_length_allowed) {
	print Limits::Command::real_max_length(),"\n"; wait_and_exit(0);
    }
    if(defined $::opt_version) { version(); wait_and_exit(0); }
    if(defined $::opt_show_limits) { show_limits(); }
    if(defined @::opt_sshlogin) { @Global::sshlogin = @::opt_sshlogin; }
    if(defined $::opt_sshloginfile) { read_sshloginfile($::opt_sshloginfile); }
    if(defined @::opt_return) { push @Global::ret_files, @::opt_return; }
    if(defined $::opt_semaphore) { $Global::semaphore = 1; }
    if(defined $::opt_semaphoretimeout) { $Global::semaphore = 1; }
    if(defined $::opt_semaphorename) { $Global::semaphore = 1; }
    if(defined $::opt_fg) { $Global::semaphore = 1; }
    if(defined $::opt_bg) { $Global::semaphore = 1; }
    if(defined $::opt_wait) { $Global::semaphore = 1; }
    if(defined $::opt_tty) {
	# Defaults for --tty: -j1 -u
	# Can be overridden with -jXXX -g
	if(not defined $::opt_P) {
	    $::opt_P = 1;
	}
	if(not defined $::opt_g) {
	    $Global::grouped = 0;
	}
    }
    if(defined @::opt_trc) {
	push @Global::ret_files, @::opt_trc;
	$::opt_transfer = 1;
	$::opt_cleanup = 1;
    }
    if(defined $::opt_L and $::opt_L or defined $::opt_l) {
	$Global::max_lines = $::opt_l || $::opt_L || 1;
	$Global::max_number_of_args ||= $Global::max_lines;
    }
    %Global::replace_rev = reverse %Global::replace;

    if(grep /^$Global::arg_sep$/o, @ARGV) {
	# Deal with :::
	@ARGV=read_args_from_command_line();
    }

    if(grep /^$Global::arg_file_sep$/o, @ARGV) {
	# Deal with ::::
	@ARGV=convert_argfiles_from_command_line_to_multiple_opt_a();
    }

    # Semaphore defaults
    # Must be done before computing number of processes and max_line_length
    # because when running as a semaphore GNU Parallel does not read args
    $Global::semaphore ||= ($0 =~ m:(^|/)sem$:); # called as 'sem'
    if($Global::semaphore) {
	# A semaphore does not take input from neither stdin nor file
	@::opt_a = ("/dev/null");
	push(@Global::unget_argv, [Arg->new("")]);
	$Semaphore::timeout = $::opt_semaphoretimeout || 0;
	if(defined $::opt_semaphorename) {
	    $Semaphore::name = $::opt_semaphorename;
	} else {
	    $Semaphore::name = `tty`;
	    chomp $Semaphore::name;
	}
	$Semaphore::fg = $::opt_fg;
	$Semaphore::wait = $::opt_wait;
	$Global::default_simultaneous_sshlogins = 1;
    }
    if(defined $::opt_eta) {
	$::opt_progress = $::opt_eta;
    }

    parse_sshlogin();

    if(remote_hosts() and ($Global::xargs or $Global::Xargs)
       and not $::opt_N) {
	# As we do not know the max line length on the remote machine
	# long commands generated by xargs may fail
	# If opt_N is set, it is probably safe
	print STDERR ("Warning: using -X or -m with --sshlogin may fail\n");
    }

    if(not defined $::opt_P) {
	$::opt_P = "+0";
	#for my $sshlogin (values %Global::host) {
	#    $sshlogin->set_max_jobs_running($Global::default_simultaneous_sshlogins);
	#}
    }
}

sub read_options {
    # Read options from command line, profile and $PARALLEL
    # Returns:
    #   @ARGV without --options
    # This must be done first as this may exec myself
    if(defined $ARGV[0] and ($ARGV[0]=~/^-Y/ or $ARGV[0]=~/^--shebang / or
			     $ARGV[0]=~/^--hashbang /)) {
	# Program is called from #! line in script
	$ARGV[0]=~s/^-Y( |$)//; # remove -Y if on its own
	$ARGV[0]=~s/^-Y/-/; # remove -Y if bundled with other options
	$ARGV[0]=~s/^--shebang *//; # remove --shebang if it is set
	$ARGV[0]=~s/^--hashbang *//; # remove --hashbang if it is set
	my $argfile = pop @ARGV;
	# exec myself to split $ARGV[0] into separate fields
	exec "$0 --skip-first-line -a $argfile @ARGV";
    }

    Getopt::Long::Configure("bundling","pass_through");
    # Check if there is a --profile to set $::opt_profile
    GetOptions("profile|J=s" => \$::opt_profile) || die_usage();
    # Add options from .parallel/config and other profiles
    my @ARGV_profile = ();
    my @ARGV_env = ();
    my @config_profiles = ($ENV{'HOME'}."/.parallel/config",
			   $ENV{'HOME'}."/.parallelrc");
    my @profiles = @config_profiles;
    if($::opt_profile) {
	# --profile overrides default profiles
	@profiles = ($ENV{'HOME'}."/.parallel/".$::opt_profile);
    }
    for my $profile (@profiles) {
	if(-r $profile) {
	    open (IN, "<", $profile) || die;
	    while(<IN>) {
		/^\s*\#/ and next;
		chomp;
		push @ARGV_profile, shell_unquote(split/(?<![\\])\s/, $_);
	    }
	    close IN;
	} else {
	    if(grep /^$profile$/, @config_profiles) {
		# config file is not required to exist
	    } else {
		print STDERR "$profile not readable\n";
		wait_and_exit(255);
	    }
	}
    }
    Getopt::Long::Configure("bundling","require_order");
    get_options_from_array(\@ARGV_profile) || die_usage();
    # Add options from shell variable $PARALLEL
    $ENV{'PARALLEL'} and @ARGV_env = shell_unquote(split/(?<![\\])\s/, $ENV{'PARALLEL'});
    get_options_from_array(\@ARGV_env) || die_usage();
    get_options_from_array(\@ARGV) || die_usage();

    # Prepend non-options to @ARGV (such as commands like 'nice')
    unshift @ARGV, @ARGV_profile, @ARGV_env;
    return @ARGV;
}

sub read_args_from_command_line {
    # Arguments given on the command line after ::: ($Global::arg_sep)
    # Removes the arguments from @ARGV and puts it into the argument queue
    # Ignore STDIN by reading from /dev/null
    # or another file if user has given --arg-file
    # Returns:
    #    @ARGV without ::: and following args
    if(not @::opt_a) { push @::opt_a, "/dev/null"; }
    # Input: @ARGV = command option ::: arg arg arg
    my @new_argv = ();
    while(@ARGV) {
	my $arg = shift @ARGV;
	if($arg eq $Global::arg_sep) {
	    my $prepend="";
	    while(@ARGV) {
		my $arg = shift @ARGV;
		if($Global::ignore_empty) {
		    if($arg =~ /^\s*$/) { next; }
		}
		if($Global::end_of_file_string and
		   $arg eq $Global::end_of_file_string) {
		    # Ignore the rest of ARGV
		    @ARGV=();
		    if(defined $prepend) {
			push(@Global::unget_argv, [Arg->new($prepend)]);
		    }
		    last;
		}
		if(defined $prepend) {
		    $arg = $prepend.$arg; # For line continuation
		    $prepend = undef; #undef;
		}
		if($Global::max_lines) {
		    if($arg =~ /\s$/) {
			# Trailing space => continued on next line
			$prepend = $arg;
			redo;
		    }
		}
		push(@Global::unget_argv, [Arg->new($arg)]);
	    }
	    last;
	} else {
	    push @new_argv, $arg;
	}
    }
    # Output: @ARGV = command option
    return @new_argv;
}

sub convert_argfiles_from_command_line_to_multiple_opt_a {
    # Convert :::: to multiple -a
    # Remove :::: from @ARGV and move the following arguments to @::opt_a
    # Returns:
    #    @ARGV without :::: and following args
    my @new_argv = ();
    my @argument_files;
    while(@ARGV) {
	my $arg = shift @ARGV;
	if($arg eq $Global::arg_file_sep) {
	    @argument_files = @ARGV;
	    @ARGV=();
	} else {
	    push @new_argv, $arg;
	}
    }
    # Output: @ARGV = command option
    push @::opt_a, @argument_files;
    return @new_argv;
}

sub open_or_exit {
    # Returns:
    #   file handle to read-opened file
    #   exits if file cannot be opened otherwise
    my $file = shift;
    my $fh = gensym;
    if(not open($fh,"<",$file)) {
	print STDERR "$Global::progname: ".
	    "Cannot open input file `$file': ".
	    "No such file or directory\n";
	wait_and_exit(255);
    }
    return $fh;
}

sub cleanup {
    # Returns: N/A
    if(@::opt_basefile) {
	cleanup_basefile();
    }
}

#
# Generating the command line
#


sub shell_quote {
    my @strings = (@_);
    for my $a (@strings) {
	$a =~ s/([\002-\011\013-\032\\\#\?\`\(\)\*\>\<\~\|\; \"\!\$\&\'])/\\$1/g;
	$a =~ s/[\n]/'\n'/g; # filenames with '\n' is quoted using \'
    }
    return wantarray ? @strings : "@strings";
}

sub shell_quote_scalar {
    # Quote the string so shell will not expand any special chars
    # Returns:
    #   string quoted with \ as needed by the shell
    my $a = shift;
    $a =~ s/([\002-\011\013-\032\\\#\?\`\(\)\*\>\<\~\|\; \"\!\$\&\'])/\\$1/g;
    $a =~ s/[\n]/'\n'/g; # filenames with '\n' is quoted using \'
    return $a;
}

sub shell_unquote {
    # Unquote strings from shell_quote
    # Returns:
    #   string with shell quoting removed
    my @strings = (@_);
    my $arg;
    for $arg (@strings) {
	if(not defined $arg) {
	    $arg = "";
	}
	$arg =~ s/'\n'/\n/g; # filenames with '\n' is quoted using \'
	$arg =~ s/\\([\002-\011\013-\032])/$1/g;
	$arg =~ s/\\([\#\?\`\(\)\*\>\<\~\|\; \"\!\$\&\'])/$1/g;
	$arg =~ s/\\\\/\\/g;
    }
    return wantarray ? @strings : "@strings";
}

sub __NUMBER_OF_PROCESSES_FILEHANDLES_MAX_LENGTH_OF_COMMAND_LINE__ {}

sub enough_file_handles {
    # check that we have enough filehandles available for starting
    # another job
    # Returns:
    #   1 if ungrouped (thus not needing extra filehandles)
    #   0 if too few filehandles
    #   1 if enough filehandles
    if($Global::grouped) {
	my %fh;
	my $enough_filehandles = 1;
	# We need a filehandle for STDOUT and STDERR
	# open3 uses 2 extra filehandles temporarily
	for my $i (1..4) {
	    $enough_filehandles &&= open($fh{$i},"</dev/null");
	}
	for (values %fh) { close $_; }
	return $enough_filehandles;
    } else {
	return 1;
    }
}

#
# General useful library functions
#

sub min {
    # Returns:
    #   Minimum value of array
    my $min;
    for (@_) {
	# Skip undefs
	defined $_ or next;
	defined $min or do { $min = $_; next; }; # Set $_ to the first non-undef
	$min = ($min < $_) ? $min : $_;
    }
    return $min;
}

sub max {
    # Returns:
    #   Maximum value of array
    my $max;
    for (@_) {
	# Skip undefs
	defined $_ or next;
	defined $max or do { $max = $_; next; }; # Set $_ to the first non-undef
	$max = ($max > $_) ? $max : $_;
    }
    return $max;
}

sub sum {
    # Returns:
    #   Sum of values of array
    my @args = @_;
    my $sum = 0;
    for (@args) {
	# Skip undefs
	$_ and do { $sum += $_; }
    }
    return $sum;
}

sub undef_as_zero {
    my $a = shift;
    return $a ? $a : 0;
}


sub undef_as_empty {
    my $a = shift;
    return $a ? $a : "";
}

sub hostname {
    if(not $Private::hostname) {
	my $hostname = `hostname`;
	chomp($hostname);
	$Private::hostname = $hostname || "nohostname";
    }
    return $Private::hostname;
}

sub __RUNNING_AND_PRINTING_THE_JOBS__ {}

# Variable structure:
#
#    $Global::running{$pid} = Pointer to Job-object
#    $Global::host{$sshlogin} = Pointer to SSHLogin-object
#    $Global::total_running = total number of running jobs
#    $Global::total_started = total jobs started

sub init_run_jobs {
    # Remember the original STDOUT and STDERR
    # Returns: N/A
    open $Global::original_stdout, ">&STDOUT" or die "Can't dup STDOUT: $!";
    open $Global::original_stderr, ">&STDERR" or die "Can't dup STDERR: $!";
    open $Global::original_stdin, "<&STDIN" or die "Can't dup STDIN: $!";
    $Global::total_running = 0;
    $Global::total_started = 0;
    $Global::tty_taken = 0;
    $SIG{USR1} = \&list_running_jobs;
    $SIG{USR2} = \&toggle_progress;
    if(@::opt_basefile) {
	setup_basefile();
    }
}

sub __login_and_host {
    # Returns:
    #   login@hostname
    my $sshlogin = shift;
    $sshlogin =~ /(\S+$)/ or die;
    return $1;
}

sub drain_job_queue {
    # Returns: N/A
    if($::opt_progress) {
	do_not_reap();
	print $Global::original_stderr init_progress();
	reap_if_needed();
    }
    my $last_header="";
    do {
	while($Global::total_running > 0) {
	    debug("jobs running: ",$Global::total_running," Memory usage:".my_memory_usage()."\n");
	    sleep 1;
	    reaper(); # Some systems fail to catch the SIGCHLD
	    if($::opt_progress) {
		my %progress = progress();
		do_not_reap();
		if($last_header ne $progress{'header'}) {
		    print $Global::original_stderr "\n",$progress{'header'},"\n";
		    $last_header = $progress{'header'};
		}
		print $Global::original_stderr "\r",$progress{'status'};
		reap_if_needed();
	    }
	}
	if(not $Global::JobQueue->empty()) {
	    start_more_jobs(); # These jobs may not be started because of loadavg
	    sleep 1;
	}
    } while (not $Global::start_no_new_jobs and not $Global::JobQueue->empty());

    if($::opt_progress) {
	print $Global::original_stderr "\n";
    }
}

sub toggle_progress {
    # Turn on/off progress view
    # Returns: N/A
    $::opt_progress = not $::opt_progress;
    if($::opt_progress) {
	print $Global::original_stderr init_progress();
    }
}

sub init_progress {
    # Returns:
    #   list of computers for progress output
    $|=1;
    my %progress = progress();
    return ("\nComputers / CPU cores / Max jobs to run\n",
	    $progress{'workerlist'});
}

sub progress {
    # Returns:
    #   list of workers
    #   header that will fit on the screen
    #   status message that will fit on the screen
    my $termcols = terminal_columns();
    my ($status, $header) = ("x"x($termcols+1),"");
    my @workers = sort keys %Global::host;
    my %sshlogin = map { $_ eq ":" ? ($_=>"local") : ($_=>$_) } @workers;
    my $workerno = 1;
    my %workerno = map { ($_=>$workerno++) } @workers;
    my $workerlist = "";
    for my $w (@workers) {
	$workerlist .=
	$workerno{$w}.":".$sshlogin{$w} ." / ".
	    ($Global::host{$w}->ncpus() || "-")." / ".
	    $Global::host{$w}->max_jobs_running()."\n";
    }
    my $eta = "";
    if($::opt_eta) {
	my $completed = 0;
	for(@workers) { $completed += $Global::host{$_}->jobs_completed() }
	if($completed) {
	    $Private::first_completed ||= time;
	    my $avgtime = (time-$Private::first_completed)/$completed;
	    my $this_eta = ($Global::JobQueue->total_jobs() - $completed) * $avgtime;
	    $Private::eta ||= $this_eta;
	    # Smooth the eta so it does not jump wildly
	    $Private::eta = 0.98 * $Private::eta + 0.02 * $this_eta;
	    $eta = sprintf("ETA: %ds ", $Private::eta);
	}
    }

    if(length $status > $termcols) {
	# sshlogin1:XX/XX/XX%/XX.Xs sshlogin2:XX/XX/XX%/XX.Xs sshlogin3:XX/XX/XX%/XX.Xs
	$header = "Computer:jobs running/jobs completed/%of started jobs/Average seconds to complete";
	$status = $eta .
	    join(" ",map
		 {
		     if($Global::total_started) {
			 my $completed = ($Global::host{$_}->jobs_completed()||0);
			 my $running = $Global::host{$_}->jobs_running();
			 my $time = $completed ? (time-$^T)/($completed) : "0";
			 sprintf("%s:%d/%d/%d%%/%.1fs ",
				 $sshlogin{$_}, $running, $completed,
				 ($running+$completed)*100
				 / $Global::total_started, $time);
		     }
		 } @workers);
    }
    if(length $status > $termcols) {
	# 1:XX/XX/XX%/XX.Xs 2:XX/XX/XX%/XX.Xs 3:XX/XX/XX%/XX.Xs 4:XX/XX/XX%/XX.Xs
	$header = "Computer:jobs running/jobs completed/%of started jobs";
	$status = $eta .
	    join(" ",map
		 {
		     my $completed = ($Global::host{$_}->jobs_completed()||0);
		     my $running = $Global::host{$_}->jobs_running();
		     my $time = $completed ? (time-$^T)/($completed) : "0";
		     sprintf("%s:%d/%d/%d%%/%.1fs ",
			     $workerno{$_}, $running, $completed,
			     ($running+$completed)*100
			     / $Global::total_started, $time);
		 } @workers);
    }
    if(length $status > $termcols) {
	# sshlogin1:XX/XX/XX% sshlogin2:XX/XX/XX% sshlogin3:XX/XX/XX%
	$header = "Computer:jobs running/jobs completed/%of started jobs";
	$status = $eta .
	    join(" ",map
		 { sprintf("%s:%d/%d/%d%%",
			   $sshlogin{$_},
			   $Global::host{$_}->jobs_running(),
			   ($Global::host{$_}->jobs_completed()||0),
			   ($Global::host{$_}->jobs_running()+
			    ($Global::host{$_}->jobs_completed()||0))*100
			   / $Global::total_started) }
		 @workers);
    }
    if(length $status > $termcols) {
	# 1:XX/XX/XX% 2:XX/XX/XX% 3:XX/XX/XX% 4:XX/XX/XX% 5:XX/XX/XX% 6:XX/XX/XX%
	$header = "Computer:jobs running/jobs completed/%of started jobs";
	$status = $eta .
	    join(" ",map
		 { sprintf("%s:%d/%d/%d%%",
			   $workerno{$_},
			   $Global::host{$_}->jobs_running(),
			   ($Global::host{$_}->jobs_completed()||0),
			   ($Global::host{$_}->jobs_running()+
			    ($Global::host{$_}->jobs_completed()||0))*100
			   / $Global::total_started) }
		 @workers);
    }
    if(length $status > $termcols) {
	# sshlogin1:XX/XX/XX% sshlogin2:XX/XX/XX% sshlogin3:XX/XX sshlogin4:XX/XX
	$header = "Computer:jobs running/jobs completed";
	$status = $eta .
	    join(" ",map
		       { sprintf("%s:%d/%d",
				 $sshlogin{$_}, $Global::host{$_}->jobs_running(),
				 ($Global::host{$_}->jobs_completed()||0)) }
		       @workers);
    }
    if(length $status > $termcols) {
	# sshlogin1:XX/XX sshlogin2:XX/XX sshlogin3:XX/XX sshlogin4:XX/XX
	$header = "Computer:jobs running/jobs completed";
	$status = $eta .
	    join(" ",map
		       { sprintf("%s:%d/%d",
				 $sshlogin{$_}, $Global::host{$_}->jobs_running(),
				 ($Global::host{$_}->jobs_completed()||0)) }
		       @workers);
    }
    if(length $status > $termcols) {
	# 1:XX/XX 2:XX/XX 3:XX/XX 4:XX/XX 5:XX/XX 6:XX/XX
	$header = "Computer:jobs running/jobs completed";
	$status = $eta .
	    join(" ",map
		       { sprintf("%s:%d/%d",
				 $workerno{$_}, $Global::host{$_}->jobs_running(),
				 ($Global::host{$_}->jobs_completed()||0)) }
		       @workers);
    }
    if(length $status > $termcols) {
	# sshlogin1:XX sshlogin2:XX sshlogin3:XX sshlogin4:XX sshlogin5:XX
	$header = "Computer:jobs completed";
	$status = $eta .
	    join(" ",map
		       { sprintf("%s:%d",
				 $sshlogin{$_},
				 ($Global::host{$_}->jobs_completed()||0)) }
		       @workers);
    }
    if(length $status > $termcols) {
	# 1:XX 2:XX 3:XX 4:XX 5:XX 6:XX
	$header = "Computer:jobs completed";
	$status = $eta .
	    join(" ",map
		       { sprintf("%s:%d",
				 $workerno{$_},
				 ($Global::host{$_}->jobs_completed()||0)) }
		       @workers);
    }
    return ("workerlist" => $workerlist, "header" => $header, "status" => $status);
}

sub terminal_columns {
    # Get the number of columns of the display
    # Returns:
    #   number of columns of the screen
    if(not $Private::columns) {
	$Private::columns = $ENV{'COLUMNS'};
	if(not $Private::columns) {
	    my $resize = qx{ resize 2>/dev/null };
	    $resize =~ /COLUMNS=(\d+);/ and do { $Private::columns = $1; };
	}
	$Private::columns ||= 80;
    }
    return $Private::columns;
}

sub start_more_jobs {
    # Returns:
    #   number of jobs started
    my $jobs_started = 0;
    if(not $Global::start_no_new_jobs) {
	if($Global::max_procs_file) {
	    my $mtime = (stat($Global::max_procs_file))[9];
	    if($mtime > $Global::max_procs_file_last_mod) {
		$Global::max_procs_file_last_mod = $mtime;
		for my $sshlogin (values %Global::host) {
		    $sshlogin->set_max_jobs_running(undef);
		}
	    }
	}
	for my $sshlogin (values %Global::host) {
	    debug("Running jobs before on ".$sshlogin->string().": ".$sshlogin->jobs_running()."\n");
	    if($::opt_load and $sshlogin->loadavg_too_high()) {
		# The load is too high or unknown
		next;
	    }
	    while ($sshlogin->jobs_running() < $sshlogin->max_jobs_running()) {
		if($Global::JobQueue->empty()) {
		    last;
		}
		debug("Try starting a job on ".$sshlogin->string()."\n");
		if(start_another_job($sshlogin) == 0) {
		    # No more jobs to start on this $sshlogin
		    debug("Empty after retry: ",$Global::JobQueue->empty(),"\n");
		    last;
		}
		debug("Job started on ".$sshlogin->string()."\n");
		$sshlogin->inc_jobs_running();
		$jobs_started++;
	    }
	    debug("Running jobs after on ".$sshlogin->string().": ".$sshlogin->jobs_running()
		  ." of ".$sshlogin->max_jobs_running() ."\n");
	}
    }
    return $jobs_started;
}

sub start_another_job {
    # Grab a job from Global::JobQueue, start it at sshlogin
    # and remember the pid, the STDOUT and the STDERR handles
    # Returns:
    #   1 if another jobs was started
    #   0 otherwise
    my $sshlogin = shift;
    # Do we have enough file handles to start another job?
    if(enough_file_handles()) {
	if($Global::JobQueue->empty()) {
	    # No more commands to run
	    return 0;
	} else {
	    my $job = get_job_with_sshlogin($sshlogin);
	    if(not defined $job) {
		# No command available for that sshlogin
		return 0;
	    }
	    debug("Command to run on '".$job->sshlogin()."': '".$job->replaced()."'\n");
	    if($job->start()) {
		$Global::running{$job->pid()} = $job;
		debug("Started as seq ".$job->seq(),"\n");
		return 1;
	    } else {
		# If interactive says: Dont run the job, then skip it and run the next
		return start_another_job($sshlogin);
	    }
	}
    } else {
	# No more file handles
	return 0;
    }
}

sub __READING_AND_QUOTING_ARGUMENTS__ {}

sub get_job_with_sshlogin {
    # Returns:
    #   next command to run with ssh command wrapping if remote
    #   next command to run with no wrapping (clean_command)
    my $sshlogin = shift;

    if($::oodebug and $Global::JobQueue->empty()) {
	Carp::confess("get_job_with_sshlogin should never be called if empty");
    }

    my $job = $Global::JobQueue->get();
    if(not defined $job) {
	# No more jobs
	return undef;
    }

    if($::oodebug and not defined $job->{'commandline'}) {
	Carp::confess("get_job_with_sshlogin job->commandline should never be empty");
    }
    my $next_command_line = $job->replaced();
    my $clean_command = $next_command_line;
    if($clean_command =~ /^\s*$/) {
	# Do not run empty lines
	if(not $Global::JobQueue->empty()) {
	    return get_job_with_sshlogin($sshlogin);
	} else {
	    return undef;
	}
    }
    $job->set_sshlogin($sshlogin);
    if($::opt_retries and $clean_command and
       $job->failed_here()) {
	# This command with these args failed for this sshlogin
	my ($no_of_failed_sshlogins,$min_failures) = $job->min_failed();
	#::my_dump(($no_of_failed_sshlogins,$min_failures));
	if($no_of_failed_sshlogins == keys %Global::host and
	   $job->failed_here() == $min_failures) {
	    # It failed the same or more times on another host:
	    # run it on this host
	} else {
	    # If it failed fewer times on another host:
	    # Find another job to run
	    my $nextjob;
	    if(not $Global::JobQueue->empty()) {
		$nextjob = get_job_with_sshlogin($sshlogin);
	    }
	    # Push the command back on the queue
	    $Global::JobQueue->unget($job);
	    return $nextjob;
	}
    }
    return $job;
}

sub __REMOTE_SSH__ {}

sub read_sshloginfile {
    # Returns: N/A
    my $file = shift;
    if($file eq "..") {
	$file = $ENV{'HOME'}."/.parallel/sshloginfile";
    }
    open(IN, $file) || die "Cannot open $file";
    while(<IN>) {
	chomp;
	/^\s*#/ and next;
	/^\s*$/ and next;
	push @Global::sshlogin, $_;
    }
    close IN;
}

sub parse_sshlogin {
    # Returns: N/A
    my @login;
    if(not @Global::sshlogin) { @Global::sshlogin = (":"); }
    for my $sshlogin (@Global::sshlogin) {
	# Split up -S sshlogin,sshlogin
	for my $s (split /,/, $sshlogin) {
	    if ($s eq "..") {
		read_sshloginfile($s);
	    } else {
		push (@login, $s);
	    }
	}
    }
    for my $sshlogin_string (@login) {
	my $sshlogin = SSHLogin->new($sshlogin_string);
	$sshlogin->set_maxlength(Limits::Command::max_length());
	$Global::host{$sshlogin->string()} = $sshlogin;
    }
    #debug("sshlogin: ", my_dump(%Global::host),"\n");
    if($::opt_transfer or @::opt_return or $::opt_cleanup or @::opt_basefile) {
	if(not remote_hosts()) {
	    # There are no remote hosts
	    if(defined @::opt_trc) {
		print $Global::original_stderr
		    "Warning: --trc ignored as there are no remote --sshlogin\n";
	    } elsif (defined $::opt_transfer) {
		print $Global::original_stderr
		    "Warning: --transfer ignored as there are no remote --sshlogin\n";
	    } elsif (defined @::opt_return) {
		print $Global::original_stderr
		    "Warning: --return ignored as there are no remote --sshlogin\n";
	    } elsif (defined $::opt_cleanup) {
		print $Global::original_stderr
		    "Warning: --cleanup ignored as there are no remote --sshlogin\n";
	    } elsif (defined @::opt_basefile) {
		print $Global::original_stderr
		    "Warning: --basefile ignored as there are no remote --sshlogin\n";
	    }
	}
    }
}

sub remote_hosts {
    # Return sshlogins that are not ':'
    # Returns:
    #   list of sshlogins with ':' removed
    return grep !/^:$/, keys %Global::host;
}

sub setup_basefile {
    # Transfer basefiles to each $sshlogin
    # This needs to be done before first jobs on $sshlogin is run
    # Returns: N/A
    my $cmd = "";
    for my $sshlogin (values %Global::host) {
	if($sshlogin->string() eq ":") { next }
	my $sshcmd = $sshlogin->sshcommand();
	my $serverlogin = $sshlogin->serverlogin();
	my $rsync_opt = "-rlDzR -e".shell_quote_scalar($sshcmd);
	for my $file (@::opt_basefile) {
	    my $f = $file;
	    my $relpath = ($f !~ m:^/:); # Is the path relative?
	    # Use different subdirs depending on abs or rel path
	    my $rsync_destdir = ($relpath ? "./" : "/");
	    $f =~ s:/\./:/:g; # Rsync treats /./ special. We dont want that
	    $f = shell_quote_scalar($f);
	    $cmd .= "rsync $rsync_opt $f $serverlogin:$rsync_destdir &";
	}
    }
    $cmd .= "wait;";
    debug("basesetup: $cmd\n");
    print `$cmd`;
}

sub cleanup_basefile {
    # Remove the basefiles transferred
    # Returns: N/A
    my $cmd="";
    for my $sshlogin (values %Global::host) {
	if($sshlogin->string() eq ":") { next }
	my $sshcmd = $sshlogin->sshcommand();
	my $serverlogin = $sshlogin->serverlogin();
	for my $file (@::opt_basefile) {
	    $cmd .= "$sshcmd $serverlogin rm -f ".shell_quote_scalar(shell_quote_scalar($file))."&";
	}
    }
    $cmd .= "wait;";
    debug("basecleanup: $cmd\n");
    print `$cmd`;
}

sub __SIGNAL_HANDLING__ {}

sub list_running_jobs {
    # Returns: N/A
    for my $v (values %Global::running) {
	print $Global::original_stderr "$Global::progname: ",$v->replaced(),"\n";
    }
}

sub start_no_new_jobs {
    # Returns: N/A
    $SIG{TERM} = $Global::original_sigterm;
    print $Global::original_stderr
	("$Global::progname: SIGTERM received. No new jobs will be started.\n",
	 "$Global::progname: Waiting for these ", scalar(keys %Global::running),
	 " jobs to finish. Send SIGTERM again to stop now.\n");
    list_running_jobs();
    $Global::start_no_new_jobs++;
}

sub count_sig_child {
    # Returns: N/A
    $Global::sig_child_caught++;
}

sub do_not_reap {
    # This will postpone SIGCHILD for sections that cannot be distracted by a dying child
    # (Racecondition)
    # Returns: N/A
    $SIG{CHLD} = \&count_sig_child;
}

sub reap_if_needed {
    # Do the postponed SIGCHILDs if any and re-install normal reaper for SIGCHILD
    # (Racecondition)
    # Returns: N/A
    if($Global::sig_child_caught) {
	$Global::sig_child_caught = 0;
	reaper();
    }
    $SIG{CHLD} = \&reaper;
}

sub reaper {
    # A job finished.
    # Print the output.
    # Start another job
    # Returns: N/A
    do_not_reap();
    $Private::reaperlevel++;
    my $stiff;
    debug("Reaper called $Private::reaperlevel\n");
    while (($stiff = waitpid(-1, &WNOHANG)) > 0) {
	if($Global::sshmaster{$stiff}) {
	    # This is one of the ssh -M: ignore
	    next;
	}
	# Ignore processes that we did not start
	my $job = $Global::running{$stiff};
	$job or next;
	$job->set_exitstatus($? >> 8);
	debug("died (".$job->exitstatus()."): ".$job->seq());
	if($stiff == $Global::tty_taken) {
	    # The process that died had the tty => release it
	    $Global::tty_taken = 0;
	}

	if(not $job->should_be_retried()) {
	    # Force printing now if the job failed and we are going to exit
	    my $print_now = ($job->exitstatus() and
			     $::opt_halt_on_error and $::opt_halt_on_error == 2);
	    if($Global::keeporder and not $print_now) {
		$Private::print_later{$job->seq()} = $job;
		$Private::job_end_sequence ||= 1;
		debug("Looking for: $Private::job_end_sequence ".
		      "Current: ".$job->seq()."\n");
		while($Private::print_later{$Private::job_end_sequence}) {
		    debug("Found job end $Private::job_end_sequence");
		    $Private::print_later{$Private::job_end_sequence}->print();
		    delete $Private::print_later{$Private::job_end_sequence};
		    $Private::job_end_sequence++;
		}
	    } else {
		$job->print();
	    }
	    if($job->exitstatus()) {
		# The jobs had a exit status <> 0, so error
		$Global::exitstatus++;
		if($::opt_halt_on_error) {
		    if($::opt_halt_on_error == 1) {
			# If halt on error == 1 we should gracefully exit
			print $Global::original_stderr
			    ("$Global::progname: Starting no more jobs. ",
			     "Waiting for ", scalar(keys %Global::running),
			     " jobs to finish. This job failed:\n",
			     $job->replaced(),"\n");
			$Global::start_no_new_jobs++;
			$Global::halt_on_error_exitstatus = $job->exitstatus();
		    } elsif($::opt_halt_on_error == 2) {
			# If halt on error == 2 we should exit immediately
			print $Global::original_stderr
			    ("$Global::progname: This job failed:\n",
			     $job->replaced(),"\n");
			exit ($job->exitstatus());
		    }
		}
	    }
	}
	my $sshlogin = $job->sshlogin();
	$sshlogin->dec_jobs_running();
	$sshlogin->inc_jobs_completed();
	$Global::total_running--;
	delete $Global::running{$stiff};
	start_more_jobs();
    }
    reap_if_needed();
    debug("Reaper exit $Private::reaperlevel\n");
    $Private::reaperlevel--;
}

sub __USAGE__ {}

sub wait_and_exit {
    # If we do not wait, we sometimes get segfault
    # Returns: N/A
    wait();
    exit(shift);
}

sub die_usage {
    # Returns: N/A
    usage();
    wait_and_exit(255);
}

sub usage {
    # Returns: N/A
    print "Usage:\n";
    print "$Global::progname [options] [command [arguments]] < list_of_arguments\n";
    print "$Global::progname [options] [command [arguments]] ::: arguments\n";
    print "$Global::progname [options] [command [arguments]] :::: argfile(s)\n";
    print "\n";
    print "See 'man $Global::progname' for the options\n";
}

sub version {
    # Returns: N/A
    print join("\n",
	       "GNU $Global::progname $Global::version",
	       "Copyright (C) 2007,2008,2009,2010 Ole Tange and Free Software Foundation, Inc.",
	       "License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>",
	       "This is free software: you are free to change and redistribute it.",
	       "GNU $Global::progname comes with no warranty.",
	       "",
	       "Web site: http://www.gnu.org/software/${Global::progname}\n"
	);
}

sub show_limits {
    # Returns: N/A
    print("Maximal size of command: ",Limits::Command::real_max_length(),"\n",
	  "Maximal used size of command: ",Limits::Command::max_length(),"\n",
	  "\n",
	  "Execution of  will continue now, and it will try to read its input\n",
	  "and run commands; if this is not what you wanted to happen, please\n",
	  "press CTRL-D or CTRL-C\n");
}


sub __DEBUGGING__ {}

sub debug {
    # Returns: N/A
    $Global::debug or return;
    @_ = grep { defined $_ ? $_ : "" } @_;
    if($Global::original_stdout) {
	print $Global::original_stdout @_;
    } else {
	print @_;
    }
}

sub my_memory_usage {
    # Returns:
    #   memory usage if found
    #   0 otherwise
    use strict;
    use FileHandle;

    my $pid = $$;
    if(-e "/proc/$pid/stat") {
	my $fh = FileHandle->new("</proc/$pid/stat");

	my $data = <$fh>;
	chomp $data;
	$fh->close;

	my @procinfo = split(/\s+/,$data);

	return undef_as_zero($procinfo[22]);
    } else {
	return 0;
    }
}

sub my_size {
    # Returns:
    #   size of object if Devel::Size is installed
    #   -1 otherwise
    my @size_this = (@_);
    eval "use Devel::Size qw(size total_size)";
    if ($@) {
	return -1;
    } else {
	return total_size(@_);
    }
}

sub my_dump {
    # Returns:
    #   ascii expression of object if Data::Dump(er) is installed
    #   error code otherwise
    my @dump_this = (@_);
    eval "use Data::Dump qw(dump);";
    if ($@) {
        # Data::Dump not installed
        eval "use Data::Dumper;";
        if ($@) {
            my $err =  "Neither Data::Dump nor Data::Dumper is installed\n".
                "Not dumping output\n";
            print $Global::original_stderr $err;
            return $err;
        } else {
            return Dumper(@dump_this);
        }
    } else {
        eval "use Data::Dump qw(dump);";
        return (Data::Dump::dump(@dump_this));
    }
}

###
##### OO Parts below
###

package SSHLogin;

sub new {
    my $class = shift;
    my $sshlogin_string = shift;
    my $ncpus;
    if($sshlogin_string =~ s:^(\d*)/:: and $1) {
	# Override default autodetected ncpus unless zero or missing
	$ncpus = $1;
    }
    my $string = $sshlogin_string;
    my @unget = ();
    return bless {
	'string' => $string,
	'jobs_running' => 0,
	'jobs_completed' => 0,
	'maxlength' => undef,
	'max_jobs_running' => undef,
	'ncpus' => $ncpus,
	'sshcommand' => undef,
	'serverlogin' => undef,
	'control_path_dir' => undef,
	'control_path' => undef,
	'loadavg_file' => $ENV{'HOME'} . "/.parallel/tmp/" .
	    $$."-".$string,
	'loadavg' => undef,
    }, ref($class) || $class;
}

sub string {
    my $self = shift;
    return $self->{'string'};
}

sub jobs_running {
    my $self = shift;

    return ($self->{'jobs_running'} || "0");
}

sub inc_jobs_running {
    my $self = shift;
    $self->{'jobs_running'}++;
}

sub dec_jobs_running {
    my $self = shift;
    $self->{'jobs_running'}--;
}

#sub set_jobs_running {
#    my $self = shift;
#    $self->{'jobs_running'} = shift;
#}

sub set_maxlength {
    my $self = shift;
    $self->{'maxlength'} = shift;
}

sub maxlength {
    my $self = shift;
    return $self->{'maxlength'};
}

sub jobs_completed {
    my $self = shift;
    return $self->{'jobs_completed'};
}

sub inc_jobs_completed {
    my $self = shift;
    $self->{'jobs_completed'}++;
}

sub set_max_jobs_running {
    my $self = shift;
    if(defined $self->{'max_jobs_running'}) {
	$Global::max_jobs_running -= $self->{'max_jobs_running'};
    }
    $self->{'max_jobs_running'} = shift;
    $Global::max_jobs_running += $self->{'max_jobs_running'};
}

sub loadavg_too_high {
    my $self = shift;
    my $loadavg = $self->loadavg();
    return (not defined $loadavg or
	    $loadavg > $self->max_loadavg());
}

sub loadavg {
    # If the currently know loadavg is too old:
    #   Recompute a new one in the background
    # Returns:
    #   last load average computed
    my $self = shift;
    # Should we update the loadavg file?
    my $update_loadavg_file = 0;
    if(-r $self->{'loadavg_file'}) {
	open(UPTIME,"<".$self->{'loadavg_file'}) || die;
	my $uptime_out = <UPTIME>;
	close UPTIME;
	# load average: 0.76, 1.53, 1.45
	if($uptime_out =~ /load average: (\d+.\d+)/) {
	    $self->{'loadavg'} = $1;
	    ::debug("New loadavg: ".$self->{'loadavg'});
	}
	::debug("Last update: ".$self->{'last_loadavg_update'});
	if(time - $self->{'last_loadavg_update'} > 10) {
	    # last loadavg was started 10 seconds ago
	    ::debug("Older than 10 sec: ".$self->{'loadavg_file'});
	    $update_loadavg_file = 1;
	}
    } else {
	::debug("NXfile: ".$self->{'loadavg_file'});
	$self->{'loadavg'} = undef;
	$update_loadavg_file = 1;
    }
    if($update_loadavg_file) {
	::debug("Updating".$self->{'loadavg_file'});
	$self->{'last_loadavg_update'} = time;
	-e $ENV{'HOME'}."/.parallel" or mkdir $ENV{'HOME'}."/.parallel";
	-e $ENV{'HOME'}."/.parallel/tmp" or mkdir $ENV{'HOME'}."/.parallel/tmp";
	my $uptime;
	if($self->{'string'} eq ":") {
	    $uptime = "uptime";
	} else {
	    $uptime = $self->sshcommand() . " " . $self->serverlogin() . " uptime";
	}
	# Run uptime.
	# As the command can take long to run if run remote
	# save it to a tmp file before moving it to the correct file
	my $file = $self->{'loadavg_file'};
	my $tmpfile = $self->{'loadavg_file'}.$$;
	qx{ ($uptime > $tmpfile; mv $tmpfile $file) & };
    }
    return $self->{'loadavg'};
}

sub max_loadavg {
    my $self = shift;
    if(not defined $self->{'max_loadavg'}) {
	$self->{'max_loadavg'} =
	    $self->compute_max_loadavg($::opt_load);
    }
    ::debug("max_loadavg: ".$self->string()." ".$self->{'max_loadavg'});
    return $self->{'max_loadavg'};
}

sub compute_max_loadavg {
    # Parse the max loadaverage that the user asked for using --load
    # Returns:
    #   max loadaverage
    my $self = shift;
    my $loadspec = shift;
    my $load;
    if(defined $loadspec) {
	if($loadspec =~ /^\+(\d+)$/) {
	    # E.g. --load +2
	    my $j = $1;
	    $load =
		$self->ncpus() + $j;
	} elsif ($loadspec =~ /^-(\d+)$/) {
	    # E.g. --load -2
	    my $j = $1;
	    $load =
		$self->ncpus() - $j;
	} elsif ($loadspec =~ /^(\d+)\%$/) {
	    my $j = $1;
	    $load =
		$self->ncpus() * $j / 100;
	} elsif ($loadspec =~ /^(\d+(\.\d+)?)$/) {
	    $load = $1;
	    if($load == 0) {
		# --load 0 = infinity (or at least close)
		$load = 2**31;
	    }
	} elsif (-f $loadspec) {
	    # TODO this needs to be done for $loadspec
	    die;
	    $Global::max_procs_file = $loadspec;
	    $Global::max_procs_file_last_mod = (stat($Global::max_procs_file))[9];
	    if(open(IN, $Global::max_procs_file)) {
		my $opt_P_file = join("",<IN>);
		close IN;
		$load = $self->compute_max_loadavg($opt_P_file);
	    } else {
		print $Global::original_stderr "Cannot open $loadspec\n";
		exit(255);
	    }
	} else {
	    print $Global::original_stderr "Parsing of --load failed\n";
	    ::die_usage();
	}
	if($load < 0.01) {
	    $load = 0.01;
	}
    }
    return $load;
}

sub max_jobs_running {
    my $self = shift;
    if(not defined $self->{'max_jobs_running'}) {
	$self->set_max_jobs_running($self->compute_number_of_processes($::opt_P));
    }
    return $self->{'max_jobs_running'};
}

sub compute_number_of_processes {
    # Number of processes wanted and limited by system resources
    # Returns:
    #   Number of processes
    my $self = shift;
    my $opt_P = shift;
    my $wanted_processes = $self->user_requested_processes($opt_P);
    if(not defined $wanted_processes) {
	$wanted_processes = $Global::default_simultaneous_sshlogins;
    }
    ::debug("Wanted procs: $wanted_processes\n");
    my $system_limit =
	$self->processes_available_by_system_limit($wanted_processes);
    ::debug("Limited to procs: $system_limit\n");
    return $system_limit;
}

sub processes_available_by_system_limit {
    # If the wanted number of processes is bigger than the system limits:
    # Limit them to the system limits
    # Limits are: File handles, number of input lines, processes,
    # and taking > 1 second to spawn 10 extra processes
    # Returns:
    #   Number of processes
    my $self = shift;
    my $wanted_processes = shift;

    my $system_limit = 0;
    my @jobs = ();
    my $job;
    my @args = ();
    my $arg;
    my $more_filehandles = 1;
    my $max_system_proc_reached = 0;
    my $slow_spawining_warning_printed = 0;
    my $time = time;
    my %fh;
    my @children;
    ::do_not_reap();

    # Reserve filehandles
    # perl uses 7 filehandles for something?
    # parallel uses 1 for memory_usage
    for my $i (1..8) {
	open($fh{"init-$i"},"</dev/null");
    }
    my $count_jobs_already_read = $Global::JobQueue->next_seq();
    while(1) {
	$system_limit >= $wanted_processes and last;
	not $more_filehandles and last;
	$max_system_proc_reached and last;
	if($Global::semaphore) {
	} elsif(defined $::opt_retries and $count_jobs_already_read) {
	    # For retries we may need to run all jobs on this sshlogin
	    # so include the already read jobs for this sshlogin
	    $count_jobs_already_read--;
	} else {
	    if($::opt_X or $::opt_m) {
		# The arguments may have to be re-spread over several jobslots
		# So pessimistically only read one arg per jobslot
		# instead of a full commandline
		$Global::JobQueue->{'commandlinequeue'}->{'arg_queue'}->empty() and last;
		($arg) = $Global::JobQueue->{'commandlinequeue'}->{'arg_queue'}->get();
		push(@args, $arg);
	    } else {
		# If there are no more command lines, then we have a process
		# per command line, so no need to go further
		$Global::JobQueue->empty() and last;
		($job) = $Global::JobQueue->get();
		push(@jobs, $job);
	    }
	}
	$system_limit++;

	# Every simultaneous process uses 2 filehandles when grouping
	$more_filehandles = open($fh{$system_limit*2},"</dev/null")
	    && open($fh{$system_limit*2+1},"</dev/null");

	# System process limit
	$system_limit % 10 or $time=time;
	my $child;
	if($child = fork()) {
	    push (@children,$child);
	} elsif(defined $child) {
	    # The child takes one process slot
	    # It will be killed later
	    $SIG{TERM} = $Global::original_sigterm;
	    sleep 100000;
	    wait_and_exit(0);
	} else {
	    $max_system_proc_reached = 1;
	}
	::debug("Time to fork ten procs: ", time-$time, " (processes so far: ", $system_limit,")\n");
	if(time-$time > 2 and not $slow_spawining_warning_printed) {
	    # It took more than 2 second to fork ten processes.
	    # Give the user a warning. He can press Ctrl-C if this
	    # sucks.
	    print $Global::original_stderr
		("Warning: Starting 10 extra processes takes > 2 sec.\n",
		 "Consider adjusting -j. Press CTRL-C to stop.\n");
	    $slow_spawining_warning_printed = 1;
	}
    }
    if($system_limit < $wanted_processes and not $more_filehandles) {
	print $Global::original_stderr
	    ("Warning: Only enough filehandles to run ",
	     $system_limit, " jobs in parallel. ",
	     "Raising ulimit -n may help\n");
    }
    if($system_limit < $wanted_processes and $max_system_proc_reached) {
	print $Global::original_stderr
	    ("Warning: Only enough available processes to run ",
	     $system_limit, " jobs in parallel.\n");
    }
    # Cleanup: Close the files
    for (values %fh) { close $_ }
    # Cleanup: Kill the children
    for my $pid (@children) {
	kill 9, $pid;
	waitpid($pid,0);
    }
    #wait();
    # Cleanup: Unget the command_lines or the @args
    $Global::JobQueue->{'commandlinequeue'}->{'arg_queue'}->unget(@args);
    $Global::JobQueue->unget(@jobs);
    if($self->string() ne ":" and
       $system_limit > $Global::default_simultaneous_sshlogins) {
	$system_limit =
	    $self->simultaneous_sshlogin_limit($system_limit);
    }
    return $system_limit;
}

sub simultaneous_sshlogin_limit {
    # Test by logging in wanted number of times simultaneously
    # Returns:
    #   min($wanted_processes,$working_simultaneous_ssh_logins-1)
    my $self = shift;
    my $wanted_processes = shift;
    # Try twice because it guesses wrong sometimes
    # Choose the minimal
    my $ssh_limit =
	::min($self->simultaneous_sshlogin($wanted_processes),
	    $self->simultaneous_sshlogin($wanted_processes));
    if($ssh_limit < $wanted_processes) {
	my $serverlogin = $self->serverlogin();
	print $Global::original_stderr
	    ("Warning: ssh to $serverlogin only allows ",
	     "for $ssh_limit simultaneous logins.\n",
	     "You may raise this by changing ",
	     "/etc/ssh/sshd_config:MaxStartup on $serverlogin\n",
	     "Using only ",$ssh_limit-1," connections ",
	     "to avoid race conditions\n");
    }
    # Race condition can cause problem if using all sshs.
    if($ssh_limit > 1) { $ssh_limit -= 1; }
    return $ssh_limit;
}


sub simultaneous_sshlogin {
    # Using $sshlogin try to see if we can do $wanted_processes
    # simultaneous logins
    # (ssh host echo simultaneouslogin & ssh host echo simultaneouslogin & ...)|grep simul|wc -l
    # Returns:
    #   Number of succesful logins
    my $self = shift;
    my $wanted_processes = shift;
    my $sshcmd = $self->sshcommand();
    my $serverlogin = $self->serverlogin();
    my $cmd = "$sshcmd $serverlogin echo simultaneouslogin 2>&1 &"x$wanted_processes;
    ::debug("Trying $wanted_processes logins at $serverlogin");
    open (SIMUL, "($cmd)|grep simultaneouslogin | wc -l|") or die;
    my $ssh_limit = <SIMUL>;
    close SIMUL;
    chomp $ssh_limit;
    return $ssh_limit;
}

sub set_ncpus {
    my $self = shift;
    $self->{'ncpus'} = shift;
}

sub user_requested_processes {
    # Parse the number of processes that the user asked for using -j
    # Returns:
    #   the number of processes to run on this sshlogin
    my $self = shift;
    my $opt_P = shift;
    my $processes;
    if(defined $opt_P) {
	if($opt_P =~ /^\+(\d+)$/) {
	    # E.g. -P +2
	    my $j = $1;
	    $processes =
		$self->ncpus() + $j;
	} elsif ($opt_P =~ /^-(\d+)$/) {
	    # E.g. -P -2
	    my $j = $1;
	    $processes =
		$self->ncpus() - $j;
	} elsif ($opt_P =~ /^(\d+)\%$/) {
	    my $j = $1;
	    $processes =
		$self->ncpus() * $j / 100;
	} elsif ($opt_P =~ /^(\d+)$/) {
	    $processes = $1;
	    if($processes == 0) {
		# -P 0 = infinity (or at least close)
		$processes = $Global::infinity;
	    }
	} elsif (-f $opt_P) {
	    $Global::max_procs_file = $opt_P;
	    $Global::max_procs_file_last_mod = (stat($Global::max_procs_file))[9];
	    if(open(IN, $Global::max_procs_file)) {
		my $opt_P_file = join("",<IN>);
		close IN;
		$processes = $self->user_requested_processes($opt_P_file);
	    } else {
		print $Global::original_stderr "Cannot open $opt_P\n";
		exit(255);
	    }
	} else {
	    print $Global::original_stderr "Parsing of --jobs/-j/--max-procs/-P failed\n";
	    ::die_usage();
	}
	if($processes < 1) {
	    $processes = 1;
	}
    }
    return $processes;
}

sub ncpus {
    my $self = shift;
    if(not defined $self->{'ncpus'}) {
	my $sshcmd = $self->sshcommand();
	my $serverlogin = $self->serverlogin();
	if($serverlogin eq ":") {
	    if($::opt_use_cpus_instead_of_cores) {
		$self->{'ncpus'} = no_of_cpus();
	    } else {
		$self->{'ncpus'} = no_of_cores();
	    }
	} else {
	    my $ncpu;
	    if($::opt_use_cpus_instead_of_cores) {
		$ncpu = qx(echo|$sshcmd $serverlogin parallel --number-of-cpus);
		chomp($ncpu);
	    } else {
		$ncpu = qx(echo|$sshcmd $serverlogin parallel --number-of-cores);
		chomp($ncpu);
	    }
	    if($ncpu =~ /^[0-9]+$/) {
		$self->{'ncpus'} = $ncpu;
	    } else {
		print $Global::original_stderr
		    ("Warning: Could not figure out ",
		     "number of cpus on $serverlogin. Using 1\n");
		$self->{'ncpus'} = 1;
	    }
	}
    }
    return $self->{'ncpus'};
}

sub no_of_cpus {
    # Returns:
    #   Number of physical CPUs
    local $/="\n"; # If delmiiter is set, then $/ will be wrong
    my $no_of_cpus = (no_of_cpus_freebsd()
		      || no_of_cpus_darwin()
		      || no_of_cpus_solaris()
		      || no_of_cpus_gnu_linux()
	);
    if($no_of_cpus) {
	return $no_of_cpus;
    } else {
	warn("Cannot figure out number of cpus. Using 1");
	return 1;
    }
}

sub no_of_cores {
    # Returns:
    #   Number of CPU cores
    local $/="\n"; # If delimiter is set, then $/ will be wrong
    my $no_of_cores = (no_of_cores_freebsd()
		       || no_of_cores_darwin()
		       || no_of_cores_solaris()
		       || no_of_cores_gnu_linux()
	);
    if($no_of_cores) {
	return $no_of_cores;
    } else {
	warn("Cannot figure out number of CPU cores. Using 1");
	return 1;
    }
}

sub no_of_cpus_gnu_linux {
    # Returns:
    #   Number of physical CPUs on GNU/Linux
    my $no_of_cpus;
    if(-e "/proc/cpuinfo") {
	$no_of_cpus = 0;
	my %seen;
	open(IN,"cat /proc/cpuinfo|") || return undef;
	while(<IN>) {
	    if(/^physical id.*[:](.*)/ and not $seen{$1}++) {
		$no_of_cpus++;
	    }
	}
	close IN;
    }
    return $no_of_cpus;
}

sub no_of_cores_gnu_linux {
    # Returns:
    #   Number of CPU cores on GNU/Linux
    my $no_of_cores;
    if(-e "/proc/cpuinfo") {
	$no_of_cores = 0;
	open(IN,"cat /proc/cpuinfo|") || return undef;
	while(<IN>) {
	    /^processor.*[:]/ and $no_of_cores++;
	}
	close IN;
    }
    return $no_of_cores;
}

sub no_of_cpus_darwin {
    # Returns:
    #   Number of physical CPUs on Mac Darwin
    my $no_of_cpus = `sysctl -a hw 2>/dev/null | grep -w physicalcpu | awk '{ print \$2 }'`;
    return $no_of_cpus;
}

sub no_of_cores_darwin {
    # Returns:
    #   Number of CPU cores on Mac Darwin
    my $no_of_cores = `sysctl -a hw  2>/dev/null | grep -w logicalcpu | awk '{ print \$2 }'`;
    return $no_of_cores;
}

sub no_of_cpus_freebsd {
    # Returns:
    #   Number of physical CPUs on FreeBSD
    my $no_of_cpus = `sysctl hw.ncpu 2>/dev/null | awk '{ print \$2 }'`;
    return $no_of_cpus;
}

sub no_of_cores_freebsd {
    # Returns:
    #   Number of CPU cores on FreeBSD
    my $no_of_cores = `sysctl -a hw  2>/dev/null | grep -w logicalcpu | awk '{ print \$2 }'`;
    return $no_of_cores;
}

sub no_of_cpus_solaris {
    # Returns:
    #   Number of physical CPUs on Solaris
    if(-x "/usr/sbin/psrinfo") {
	my @psrinfo = `/usr/sbin/psrinfo`;
	if($#psrinfo >= 0) {
	    return $#psrinfo +1;
	}
    }
    if(-x "/usr/sbin/prtconf") {
	my @prtconf = `/usr/sbin/prtconf | grep cpu..instance`;
	if($#prtconf >= 0) {
	    return $#prtconf +1;
	}
    }
    return undef;
}

sub no_of_cores_solaris {
    # Returns:
    #   Number of CPU cores on Solaris
    if(-x "/usr/sbin/psrinfo") {
	my @psrinfo = `/usr/sbin/psrinfo`;
	if($#psrinfo >= 0) {
	    return $#psrinfo +1;
	}
    }
    if(-x "/usr/sbin/prtconf") {
	my @prtconf = `/usr/sbin/prtconf | grep cpu..instance`;
	if($#prtconf >= 0) {
	    return $#prtconf +1;
	}
    }
    return undef;
}

sub sshcommand {
    my $self = shift;
    if (not defined $self->{'sshcommand'}) {
	$self->sshcommand_of_sshlogin();
    }
    return $self->{'sshcommand'};
}

sub serverlogin {
    my $self = shift;
    if (not defined $self->{'serverlogin'}) {
	$self->sshcommand_of_sshlogin();
    }
    return $self->{'serverlogin'};
}

sub sshcommand_of_sshlogin {
    # 'server' -> ('ssh -S /tmp/parallel-ssh-RANDOM/host-','server')
    # 'user@server' -> ('ssh','user@server')
    # 'myssh user@server' -> ('myssh','user@server')
    # 'myssh -l user server' -> ('myssh -l user','server')
    # '/usr/local/bin/myssh -l user server' -> ('/usr/local/bin/myssh -l user','server')
    # Returns:
    #   sshcommand - defaults to 'ssh'
    #   login@host
    my $self = shift;
    my ($sshcmd, $serverlogin);
    if($::oodebug and not defined $self->{'string'}) {
	Carp::confess("No sshlogin");
	die;
    }
    if($self->{'string'} =~ /(.+) (\S+)$/) {
	# Own ssh command
	$sshcmd = $1; $serverlogin = $2;
    } else {
	# Normal ssh
	if($::opt_controlmaster) {
	    # Use control_path to make ssh faster
	    my $control_path = $self->control_path_dir()."/ssh-%r@%h:%p";
	    $sshcmd = "ssh -S ".$control_path;
	    $serverlogin = $self->{'string'};
	    #my $master = "ssh -MTS ".control_path_dir()."/ssh-%r@%h:%p ".$serverlogin;
#	    my $master = "ssh -MTS ".$self->control_path_dir()."/ssh-%r@%h:%p ".$serverlogin." sleep 1";
	    my $master = "ssh -MTS $control_path $serverlogin sleep 1";
	    if(not $self->{'control_path'}{$control_path}++) {
		# Master is not running for this control_path
		# Start it
		my $pid = fork();
		if($pid) {
		    $Global::sshmaster{$pid}++;
		} else {
		    ::debug($master,"\n");
		    `$master`;
		    ::wait_and_exit(0);
		}
	    }
	} else {
	    $sshcmd = "ssh"; $serverlogin = $self->{'string'};
	}
    }
    $self->{'sshcommand'} = $sshcmd;
    $self->{'serverlogin'} = $serverlogin;
}


sub control_path_dir {
    # Returns:
    #   path to directory
    my $self = shift;
    if(not defined $self->{'control_path_dir'}) {
	-e $ENV{'HOME'}."/.parallel" or mkdir $ENV{'HOME'}."/.parallel";
	-e $ENV{'HOME'}."/.parallel/tmp" or mkdir $ENV{'HOME'}."/.parallel/tmp";
	$self->{'control_path_dir'} =
	    File::Temp::tempdir($ENV{'HOME'}."/.parallel/tmp/control_path_dir-XXXX",
		    CLEANUP => 1);
    }
    return $self->{'control_path_dir'};
}



package JobQueue;

sub new {
    my $class = shift;
    my $command = shift;
    my $read_from = shift;
    my $context_replace = shift;
    my $max_number_of_args = shift;
    my $return_files = shift;
    my $commandlinequeue = CommandLineQueue->new(
	$command,$read_from,$context_replace,$max_number_of_args,$return_files);
    my @unget = ();
    return bless {
	'unget' => \@unget,
	'commandlinequeue' => $commandlinequeue,
	'total_jobs' => undef,
	'next_seq' => 1,
    }, ref($class) || $class;
}

sub get {
    my $self = shift;

    if(@{$self->{'unget'}}) {
	my $job = shift @{$self->{'unget'}};
	return ($job);
    } else {
	my $commandline = $self->{'commandlinequeue'}->get();
	if(defined $commandline) {
	    my $job = Job->new($commandline);
	    $job->set_seq($self->{'next_seq'});
	    $self->{'next_seq'}++;
	    return $job;
	} else {
	    return undef;
	}
    }
}

sub unget {
    my $self = shift;
    unshift @{$self->{'unget'}}, @_;
}

sub empty {
    my $self = shift;
    my $empty = (not @{$self->{'unget'}}) && $self->{'commandlinequeue'}->empty();
    ::debug("JobQueue->empty $empty\n");
    return $empty;
}

sub total_jobs {
    my $self = shift;
    if(not defined $self->{'total_jobs'}) {
	my $job;
	my @queue;
	while($job = $self->get()) {
	    push @queue, $job;
	}
	$self->unget(@queue);
	$self->{'total_jobs'} = $#queue+1;
    }
    return $self->{'total_jobs'};
}

sub next_seq {
    my $self = shift;

    return $self->{'next_seq'};
}

sub quote_args {
    my $self = shift;
    return $self->{'commandlinequeue'}->quote_args();
}


package Job;

sub new {
    my $class = shift;
    my $commandline = shift;
    return bless {
	'commandline' => $commandline,
	'workdir' => undef,
	'seq' => undef,
	'stdout' => undef,
	'stderr' => undef,
	'pid' => undef,
	# hash of { SSHLogins => number of times the command failed there }
	'failed' => undef,
	'sshlogin' => undef,
	# The commandline wrapped with rsync and ssh
	'sshlogin_wrap' => undef,
	'exitstatus' => undef,
    }, ref($class) || $class;
}

sub replaced {
    my $self = shift;
    return $self->{'commandline'}->replaced();
}

sub set_seq {
    my $self = shift;
    my $seq = shift;
    $self->{'seq'} = $seq;
}

sub seq {
    my $self = shift;
    return $self->{'seq'};
}

sub set_stdout {
    my $self = shift;
    my $stdout = shift;
    $self->{'stdout'} = $stdout;
}

sub stdout {
    my $self = shift;
    return $self->{'stdout'};
}

sub stderr {
    my $self = shift;
    return $self->{'stderr'};
}

sub set_stderr {
    my $self = shift;
    my $stderr = shift;
    $self->{'stderr'} = $stderr;
}

sub pid {
    my $self = shift;
    return $self->{'pid'};
}

sub set_pid {
    my $self = shift;
    my $pid = shift;
    $self->{'pid'} = $pid;
}

sub failed {
    # return number of times failed for this $sshlogin
    my $self = shift;
    my $sshlogin = shift;
    return $self->{'failed'}{$sshlogin};
}

sub failed_here {
    # return number of times failed for the current $sshlogin
    my $self = shift;
    return $self->{'failed'}{$self->sshlogin()};
}

sub add_failed {
    # increase the number of times failed for this $sshlogin
    my $self = shift;
    my $sshlogin = shift;
    $self->{'failed'}{$sshlogin}++;
}

sub add_failed_here {
    # increase the number of times failed for the current $sshlogin
    my $self = shift;
    $self->{'failed'}{$self->sshlogin()}++;
}

sub reset_failed {
    # increase the number of times failed for this $sshlogin
    my $self = shift;
    my $sshlogin = shift;
    delete $self->{'failed'}{$sshlogin};
}

sub reset_failed_here {
    # increase the number of times failed for this $sshlogin
    my $self = shift;
    delete $self->{'failed'}{$self->sshlogin()};
}

sub min_failed {
    # Returns:
    #   the number of sshlogins this command has failed on
    #   the minimal number of times this command has failed
    my $self = shift;
    my $min_failures =
	::min(map { $self->{'failed'}{$_} }
		keys %{$self->{'failed'}});
    my $number_of_sshlogins_failed_on = scalar keys %{$self->{'failed'}};
    return ($number_of_sshlogins_failed_on,$min_failures);
}

sub total_failed {
    # Returns:
    #   the number of times this command has failed
    my $self = shift;
    my $total_failures = 0;
    for (values %{$self->{'failed'}}) {
	$total_failures += $_;
    }
    return ($total_failures);
}

sub set_sshlogin {
    my $self = shift;
    my $sshlogin = shift;
    $self->{'sshlogin'} = $sshlogin;
    delete $self->{'sshlogin_wrap'}; # If sshlogin is changed the wrap is wrong
}

sub sshlogin {
    my $self = shift;
    return $self->{'sshlogin'};
}

sub sshlogin_wrap {
    # Wrap the command with the commands needed to run remotely
    my $self = shift;
    if(not defined $self->{'sshlogin_wrap'}) {
	my $sshlogin = $self->sshlogin();
	if($::oodebug and not defined $sshlogin) {
	    Carp::confess("No sshlogin");
	    die;
	}
	my $sshcmd = $sshlogin->sshcommand();
	my $serverlogin = $sshlogin->serverlogin();
	my $next_command_line = $self->replaced();
	my ($pre,$post,$cleanup)=("","","");
	if($serverlogin eq ":") {
	    $self->{'sshlogin_wrap'} = $next_command_line;
	} else {
	    # --transfer
	    $pre .= $self->sshtransfer();
	    # --return
	    $post .= $self->sshreturn();
	    # --cleanup
	    $post .= $self->sshcleanup();
	    if($post) {
		# We need to save the exit status of the job
		$post = '_EXIT_status=$?; '.$post.' exit $_EXIT_status;';
	    }
	    my $parallel_env = 'PARALLEL_SEQ=$PARALLEL_SEQ\;export PARALLEL_SEQ\;'.
		'PARALLEL_PID=$PARALLEL_PID\;export PARALLEL_PID\;';
	    if($::opt_workdir) {
		$self->{'sshlogin_wrap'} = ($pre . "$sshcmd $serverlogin $parallel_env "
					    . ::shell_quote_scalar("cd ".$self->workdir()." && ")
					    . ::shell_quote_scalar($next_command_line).";".$post);
	    } else {
		$self->{'sshlogin_wrap'} = ($pre . "$sshcmd $serverlogin $parallel_env "
					    .::shell_quote_scalar($next_command_line).";".$post);
	    }
	}
    }
    return $self->{'sshlogin_wrap'};
}

sub transfer {
    # Files to transfer
    my $self = shift;
    my @transfer = ();
    if($::opt_transfer) {
	for my $record (@{$self->{'commandline'}{'arg_list'}}) {
	    # Merge arguments from records into args
	    for my $arg (@$record) {
		CORE::push @transfer, $arg->orig();
	    }
	}
    }
    return @transfer;
}

sub sshtransfer {
    my $self = shift;
    my $sshlogin = $self->sshlogin();
    my $sshcmd = $sshlogin->sshcommand();
    my $serverlogin = $sshlogin->serverlogin();
    my $rsync_opt = "-rlDzRE -e".::shell_quote_scalar($sshcmd);
    my $pre = "";
    for my $file ($self->transfer()) {
	$file =~ s:/\./:/:g; # Rsync treats /./ special. We dont want that
	$file =~ s:^\./::g; # Remove ./ if any
	my $relpath = ($file !~ m:^/:); # Is the path relative?
	# Use different subdirs depending on abs or rel path
	# Abs path: rsync -rlDzRE /home/tange/dir/subdir/file.gz server:/
	# Rel path: rsync -rlDzRE ./subdir/file.gz server:.parallel/tmp/tempid/
	# Rel path: rsync -rlDzRE ./subdir/file.gz server:$workdir/
	my $remote_workdir = $self->workdir($file);
	my $rsync_destdir = ($relpath ? $remote_workdir : "/");
	if($relpath) {
	    $file = "./".$file;
	}
	if(-r $file) {
	    my $mkremote_workdir =
		$remote_workdir eq "." ? "true" : "ssh $serverlogin mkdir -p $rsync_destdir";
	    $pre .= "$mkremote_workdir; rsync $rsync_opt ".::shell_quote_scalar($file)." $serverlogin:$rsync_destdir;";
	} else {
	    print $Global::original_stderr
		"Warning: $file is not readable and will not be transferred\n";
	}
    }
    return $pre;
}

sub return {
    # Files to return
    # Quoted and with {...} substituted
    my $self = shift;
    my @return = ();
    for my $return (@{$self->{'commandline'}{'return_files'}}) {
	CORE::push @return, $self->{'commandline'}->replace_placeholders($return,1);
    }
    return @return;
}

sub sshreturn {
    my $self = shift;
    my $sshlogin = $self->sshlogin();
    my $sshcmd = $sshlogin->sshcommand();
    my $serverlogin = $sshlogin->serverlogin();
    my $rsync_opt = "-rlDzRE -e".::shell_quote_scalar($sshcmd);
    my $pre = "";
    for my $file ($self->return()) {
	$file =~ s:/\./:/:g; # Rsync treats /./ special. We dont want that
	$file =~ s:^\./::g; # Remove ./ if any
	my $relpath = ($file !~ m:^/:); # Is the path relative?
	# Use different subdirs depending on abs or rel path
	
	# Return or cleanup
	my @cmd = ();
	my $rsync_destdir = ($relpath ? "./" : "/");
	my $ret_file = $file;
	my $remove = $::opt_cleanup ? "--remove-source-files" : "";
	# If relative path: prepend workdir/./ to avoid problems if the dir contains ':'
	# and to get the right relative return path
	my $replaced = ($relpath ? $self->workdir()."/./" : "") . $file;
	# --return
	# Abs path: rsync -rlDzRE server:/home/tange/dir/subdir/file.gz /
	# Rel path: rsync -rlDzRE server:./subsir/file.gz ./
	$pre .= "rsync $rsync_opt $remove $serverlogin:".
	     ::shell_quote_scalar($replaced) . " ".$rsync_destdir.";";
    }
    return $pre;
}

sub sshcleanup {
    # Return the sshcommand needed to remove the file
    # Returns:
    #   ssh command needed to remove files from sshlogin
    my $self = shift;
    my $sshlogin = $self->sshlogin();
    my $sshcmd = $sshlogin->sshcommand();
    my $serverlogin = $sshlogin->serverlogin();
    my $workdir = $self->workdir();
    my $removeworkdir = "";
    my $cleancmd = "";

    for my $file ($self->cleanup()) {
	my @subworkdirs = parentdirs_of($file);
	$file = ::shell_quote_scalar($file);
	if(@subworkdirs) {
	    $removeworkdir = "; rmdir 2>/dev/null ".
		join(" ",map { ::shell_quote_scalar($workdir."/".$_) } @subworkdirs);
	}
	my $relpath = ($file !~ m:^/:); # Is the path relative?
	my $cleandir = ($relpath ? $workdir."/" : "");
	$cleancmd .= "$sshcmd $serverlogin rm -f ".::shell_quote_scalar($cleandir.$file.$removeworkdir).";";
    }
    return $cleancmd;
}

sub cleanup {
    # Returns:
    #   Files to remove at cleanup
    my $self = shift;
    if($::opt_cleanup) {
	my @transfer = $self->transfer();
	return @transfer;
    } else {
	return ();
    }
}

sub workdir {
    # Returns:
    #   the workdir on a remote machine
    my $self = shift;
    if(not defined $self->{'workdir'}) {
	my $workdir;
	if(defined $::opt_workdir) {
	    if($::opt_workdir ne "...") {
		$workdir = $::opt_workdir;
		$workdir =~ s:/\./:/:g; # Rsync treats /./ special. We dont want that
		$workdir =~ s:/+$::; # Remove ending / if any
		$workdir =~ s:^\./::g; # Remove starting ./ if any
	    } else {
		$workdir = ".parallel/tmp/".::hostname()."-".$$."-".$self->{'seq'};
	    }
	} else {
	    $workdir = ".";
	}
	$self->{'workdir'} = $workdir;
    }
    return $self->{'workdir'};
}

sub parentdirs_of {
    # Return:
    #   all parentdirs except . of this dir or file - sorted descending by length
    my $d = shift;
    my @parents = ();
    while($d =~ s:/[^/]+$::) {
	if($d ne ".") {
	    push @parents, $d;
	}
    }
    return @parents;
}

sub start {
    # Setup STDOUT and STDERR for a job and start it.
    # Returns:
    #   job-object or undef if job not to run
    my $job = shift;
    if($::oodebug and $job->{'commandline'}->{'commandline'}) {
	Carp::confess($job);
	die "jkj2";
    }
    my $command = $job->sshlogin_wrap();
    my $pid;
    if($Global::grouped) {
	my ($outfh,$errfh,$name);
	# To group we create temporary files for STDOUT and STDERR
	# To avoid the cleanup unlink the files immediately (but keep them open)
	($outfh,$name) = ::tempfile(SUFFIX => ".par");
	unlink $name;
	($errfh,$name) = ::tempfile(SUFFIX => ".par");
	unlink $name;

	open STDOUT, '>&', $outfh or die "Can't redirect STDOUT: $!";
	open STDERR, '>&', $errfh or die "Can't dup STDOUT: $!";
	$job->set_stdout($outfh);
	$job->set_stderr($errfh);
    }

    if($Global::interactive or $Global::stderr_verbose) {
	if($Global::interactive) {
	    print $Global::original_stderr "$command ?...";
	    open(TTY,"/dev/tty") || die;
	    my $answer = <TTY>;
	    close TTY;
	    my $run_yes = ($answer =~ /^\s*y/i);
	    if (not $run_yes) {
		open STDOUT, ">&", $Global::original_stdout
		    or die "Can't dup \$oldout: $!";
		open STDERR, ">&", $Global::original_stderr
		    or die "Can't dup \$oldout: $!";
		$command = "true"; # Run the command 'true'
	    }
	} else {
	    print $Global::original_stderr "$command\n";
	}
    }
    if(($::opt_dryrun or $Global::verbose) and not $Global::grouped) {
	if($Global::verbose <= 1) {
	    print STDOUT $job->replaced(),"\n";
	} else {
	    # Verbose level > 1: Print the rsync and stuff
	    print STDOUT $command,"\n";
	}
    }
    if($::opt_dryrun) {
	$command = "true";
    }
    $Global::total_running++;
    $Global::total_started++;
    $ENV{'PARALLEL_SEQ'} = $job->seq();
    $ENV{'PARALLEL_PID'} = $$;
    ::debug("$Global::total_running processes. Starting (".$job->seq()."): $command\n");
    if(@::opt_a and $job->seq() == 1) {
	# Give STDIN to the first job if using -a
	$pid = ::open3("<&STDIN", ">&STDOUT", ">&STDERR", $command) ||
	    die("open3 (with -a) failed. Report a bug to <bug-parallel\@gnu.org>\n");
	# Re-open to avoid complaining
	open STDIN, "<&", $Global::original_stdin
	    or die "Can't dup \$Global::original_stdin: $!";
    } elsif ($::opt_tty and not $Global::tty_taken and -c "/dev/tty" and
	     open(DEVTTY, "/dev/tty")) {
	# Give /dev/tty to the command if no one else is using it
	$pid = ::open3("<&DEVTTY", ">&STDOUT", ">&STDERR", $command) ||
	    die("open3 (with /dev/tty) failed. Report a bug to <bug-parallel\@gnu.org>\n");
	$Global::tty_taken = $pid;
	close DEVTTY;
    } else {
	$pid = ::open3(::gensym, ">&STDOUT", ">&STDERR", $command) ||
	    die("open3 (with gensym) failed. Report a bug to <bug-parallel\@gnu.org>\n");
    }
    $job->set_pid($pid);
    open STDOUT, ">&", $Global::original_stdout
	or die "Can't dup \$Global::original_stdout: $!";
    open STDERR, ">&", $Global::original_stderr
	or die "Can't dup \$Global::original_stderr: $!";
    return $job;
}

sub should_be_retried {
    # Should this job be retried?
    # Returns
    #   0 - do not retry
    #   1 - job queued for retry
    my $self = shift;
    if (not $::opt_retries) {
	return 0;
    }
    if(not $self->exitstatus()) {
	# Completed with success. If there is a recorded failure: forget it
	$self->reset_failed_here();
	return 0
    } else {
	# The job failed. Should it be retried?
	$self->add_failed_here();
	if($self->total_failed() == $::opt_retries) {
	    # This has been retried enough
	    return 0;
	} else {
	    # This command should be retried
	    $Global::JobQueue->unget($self);
	    ::debug("Retry ".$self->seq()."\n");
	    return 1;
	}
    }
}

sub print {
    # Print the output of the jobs
    # Returns: N/A

    my $self = shift;
    ::debug(">>joboutput ".$self->replaced()."\n");
    # Only relevant for grouping
    $Global::grouped or return;
    my $out = $self->stdout();
    my $err = $self->stderr();
    my $command = $self->sshlogin_wrap();

    if(($::opt_dryrun or $Global::verbose) and $Global::grouped) {
	if($Global::verbose <= 1) {
	    print STDOUT $self->replaced(),"\n";
	} else {
	    # Verbose level > 1: Print the rsync and stuff
	    print STDOUT $command,"\n";
	}
	# If STDOUT and STDERR are merged, we want the command to be printed first
	# so flush to avoid STDOUT being buffered
	flush STDOUT;
    }
    seek $_, 0, 0 for $out, $err;
    if($Global::debug) {
	print STDERR "ERR:\n";
    }
    my $buf;
    while(sysread($err,$buf,1000_000)) {
	print STDERR $buf;
    }
    flush STDERR;
    if($Global::debug) {
	print STDOUT "OUT:\n";
    }
    while(sysread($out,$buf,1000_000)) {
	print STDOUT $buf;
    }
    flush STDOUT;
    ::debug("<<joboutput $command\n");
    close $out;
    close $err;
}

sub exitstatus {
    my $self = shift;
    return $self->{'exitstatus'};
}

sub set_exitstatus {
    my $self = shift;
    my $exitstatus = shift;
    $self->{'exitstatus'} = $exitstatus;
}


package CommandLine;

sub new {
    my $class = shift;
    my $command = ::undef_as_empty(shift);
    my $arg_queue = shift;
    my $context_replace = shift;
    my $max_number_of_args = shift; # for -N and normal (-N1)
    my $return_files = shift;
    my $len = {
	'{}' => 0, # Total length of all {} replaced with all args
	'{/}' => 0, # Total length of all {/} replaced with all args
	'{.}' => 0, # Total length of all {.} replaced with all args
	'{/.}' => 0, # Total length of all {/.} replaced with all args
	'no_args' => undef, # Length of command with all replacement args removed
	'context' => undef, # Length of context of an additional arg
    };
    my($sum,%replacecount);
    ($sum,$len->{'no_args'},$len->{'context'},$len->{'contextgroups'},%replacecount) =
	number_of_replacements($command,$context_replace);
    if($sum == 0) {
	if($command eq "") {
	    $command = $Global::replace{'{}'};
	} else {
	    $command .=" ".$Global::replace{'{}'}; # Add {} to the command if there are no {...}'s
        }
    }
    ($sum,$len->{'no_args'},$len->{'context'},$len->{'contextgroups'},%replacecount) =
	number_of_replacements($command,$context_replace);
    my %positional_replace;
    my %multi_replace;
    for my $used (keys %replacecount) {
	if($used =~ /^{(\d+)(\D*)}$/) {
	    $positional_replace{$1} = '{'.$2.'}';
	} else {
	    $multi_replace{$used} = $used;
	}
    }

    return bless {
	'command' => $command,
	'len' => $len,
	'arg_list' => [],
	'arg_queue' => $arg_queue,
	'max_number_of_args' => $max_number_of_args,
	'replacecount' => \%replacecount,
	'context_replace' => $context_replace,
	'return_files' => $return_files,
	'positional_replace' => \%positional_replace,
	'multi_replace' => \%multi_replace,
	'replaced' => undef,
    }, ref($class) || $class;
}

sub populate {
    # Add arguments from arg_queue until the number of arguments or
    # max line length is reached
    my $self = shift;
#    my $first_time_empty = 1;
    my $next_arg;
    while (not $self->{'arg_queue'}->empty()) {
	$next_arg = $self->{'arg_queue'}->get();
	if(not defined $next_arg) {
	    next;
	}
	$self->push($next_arg);
	#::debug("if(".$self->len()." >= ".Limits::Command::max_length().") ".length $self->replaced()."\n");
	if($self->len() >= Limits::Command::max_length()) {
	    # TODO stuff about -x opt_x
	    if($self->number_of_args() > 1) {
		# There is something to work on
		$self->{'arg_queue'}->unget($self->pop());
		last;
	    } else {
		my $args = join(" ", map { $_->orig() } @$next_arg);
		print STDERR ("Command line too long (",
			      $self->len(), " >= ",
			      Limits::Command::max_length(),
			      ") at number ",
			      $self->{'arg_queue'}->arg_number(),
			      ": ".
			      (substr($args,0,50))."...\n");
		$self->{'arg_queue'}->unget($self->pop());
		::wait_and_exit(255);
	    }
	}
	
	if(defined $self->{'max_number_of_args'}) {
	    if($self->number_of_args() >= $self->{'max_number_of_args'}) {
		last;
	    }
	}
    }
    if($self->{'arg_queue'}->empty() and not $CommandLine::already_spread) {
	# EOF => Spread the arguments over all jobslots (unless they
	# are already spread)
	$CommandLine::already_spread++;
	if($self->number_of_args() > 1) {
	    $self->{'max_number_of_args'} =
		::ceil($self->number_of_args()/$Global::max_jobs_running);
	    $Global::JobQueue->{'commandlinequeue'}->{'max_number_of_args'} =
		$self->{'max_number_of_args'};
	    $self->{'arg_queue'}->unget($self->pop_all());
	    while($self->number_of_args() < $self->{'max_number_of_args'}) {
		$self->push($self->{'arg_queue'}->get());
	    }
	}
    }

    if($self->number_of_args() > 0) {
	# Fill up if we have a half completed line
	if(defined $self->{'max_number_of_args'}) {
	    # If you want a number of args and do not have it then fill out the rest with empties
	    # so magic strings like '{2}' will be replaced with empty.
	    while($self->number_of_args() < $self->{'max_number_of_args'}) {
		$self->push([Arg->new("")]);
	    }
	}
    }
}

sub push {
    # Add one or more records as arguments
    my $self = shift;
    my $record = shift;
    push @{$self->{'arg_list'}}, $record;
    #::my_dump($record);
    my $arg_no = ($self->number_of_args()-1) * ($#$record+1);

    for my $arg (@$record) {
	$arg_no++;
	if(defined $arg) {
	    if($self->{'positional_replace'}{$arg_no}) {
		for my $used (keys %{$self->{'replacecount'}}) {
		    my $replacementfunction = $self->{'positional_replace'}{$arg_no}; # {} {/} {.} or {/.}
		    # Find the single replacements
		    $self->{'len'}{$used} += length $arg->replace($replacementfunction);
		}
	    }
	    for my $used (keys %{$self->{'multi_replace'}}) {
		# Add to the multireplacement
		$self->{'len'}{$used} += length $arg->replace($used);
	    }
	}
    }
}

sub pop {
    # Remove last argument
    my $self = shift;
    my $record = pop @{$self->{'arg_list'}};
    for my $arg (@$record) {
	if(defined $arg) {
	    for my $replacement_string qw(keys %{$self->{'replacecount'}}) {
		$self->{'len'}{$replacement_string} -= length $arg->replace($replacement_string);
	    }
	}
    }
    return $record;
}

sub pop_all {
    # Remove all arguments
    my $self = shift;
    my @popped = @{$self->{'arg_list'}};
    for my $replacement_string qw(keys %{$self->{'replacecount'}}) {
	$self->{'len'}{$replacement_string} = 0;
    }
    $self->{'arg_list'} = [];
    return @popped;
}

sub number_of_args {
    my $self = shift;
    # This is really number of records
    return $#{$self->{'arg_list'}}+1;
}

sub len {
    # The length of the command line with args substituted
    my $self = shift;
    my $len = 0;
    # Add length of the original command with no args
    $len += $self->{'len'}{'no_args'};
    if($self->{'context_replace'}) {
	$len += $self->number_of_args()*$self->{'len'}{'context'};
	for my $replstring (keys %{$self->{'replacecount'}}) {
	    if(defined $self->{'len'}{$replstring}) {
		$len += $self->{'len'}{$replstring} * $self->{'replacecount'}{$replstring};
	    }
	}
	$len += ($self->number_of_args()-1) * $self->{'len'}{'contextgroups'};
    } else {
	# Each replacement string may occur several times
	# Add the length for each time
	for my $replstring (keys %{$self->{'replacecount'}}) {
	    if(defined $self->{'len'}{$replstring}) {
		$len += $self->{'len'}{$replstring} *
		    $self->{'replacecount'}{$replstring};
	    }
	    if($Global::replace{$replstring}) {
		# This is a multi replacestring ({} {/} {.} {/.})
		# Add each space between two arguments
		my $number_of_args = ($#{$self->{'arg_list'}[0]}+1)*$self->number_of_args();
		$len += ($number_of_args-1) * $self->{'replacecount'}{$replstring};
	    }
	}
    }
    if($::opt_nice) {
	# Pessimistic length if --nice is set
	# Worse than worst case: every char needs to be quoted with \
	$len *= 2;
    }
    return $len;
}

sub multi_regexp {
    if(not $CommandLine::multi_regexp) {
	$CommandLine::multi_regexp =
	"(?:".
	join("|",map {my $a=$_; $a =~ s/(\W)/\\$1/g; $a}
	     ($Global::replace{"{}"},
	      $Global::replace{"{.}"},
	      $Global::replace{"{/}"},
	      $Global::replace{"{/.}"})
	).")";
    }
    return $CommandLine::multi_regexp;
}

sub number_of_replacements {
    # Returns:
    #  sum_of_count, length_of_command_with_no_args, length_of_context { 'replacementstring' => count }
    my $command = shift;
    my $context_replace = shift;
    my %count = ();
    my $sum = 0;
    my $cmd = $command;
    my $multi_regexp = 	multi_regexp();
    my $replacement_regexp =
	"(?:".
	'\{\d+/?\.?\}'. # {n}, {n.} {n/.} {n/}
	'|'.
	join("|",map {$a=$_;$a=~s/(\W)/\\$1/g; $a} values %Global::replace).
	")";
    while($cmd =~ s/($replacement_regexp)/\0/o) {
	# substitute with \0 to avoid {{}} being interpreted as two {}'s
	if(defined $Global::replace_rev{$1}) {
	    $count{$Global::replace_rev{$1}}++;
	} else {
	    $count{$1}++;
	}
	$sum++;
    }

    my $number_of_context_groups = 0;
    my $no_args;
    my $context;
    if($context_replace) {
	$cmd = $command;
	while($cmd =~ s/\S*$multi_regexp\S*//o) {
	    $number_of_context_groups++;
	}
	$no_args = length $cmd;
	$context = length($command) - $no_args;
    } else {
	$cmd = $command;
	$cmd =~ s/$multi_regexp//go;
	$cmd =~ s/$replacement_regexp//go;
	$no_args = length($cmd);
	$context = length($command) - $no_args;
    }
    for my $k (keys %count) {
	if(defined $Global::replace{$k}) {
	    # {} {/} {.} {/.}
	    $context -= (length $Global::replace{$k}) * $count{$k};
	} else {
	    # {#}
	    $context -= (length $k) * $count{$k};
	}
    }
    return ($sum,$no_args,$context,$number_of_context_groups,%count);
}

sub replaced {
    my $self = shift;
    if(not defined $self->{'replaced'}) {
	$self->{'replaced'} = $self->replace_placeholders($self->{'command'},0);
	if($::opt_nice) {
	    # Prepend nice -n19 bash -c
	    # and quote
	    $self->{'replaced'} = "nice -n".$::opt_nice." bash -c ".::shell_quote_scalar($self->{'replaced'});
	}
    }
    if($::oodebug and length($self->{'replaced'}) != ($self->len())) {
	::my_dump($self);
	Carp::cluck("replaced len=".length($self->{'replaced'})." computed=".($self->len()));
    }
    return $self->{'replaced'};
}

sub replace_placeholders {
    my $self = shift;
    my $target = shift;
    my $quote_special_chars = shift;
    my $context_replace = $self->{'context_replace'};

    my $context_regexp = $context_replace ? '\S*' : ''; # Regexp to match surrounding context
    if($self->number_of_args() == 0) {
	Carp::confess("0 args should never call replaced");
    }

    my %replace;
    my %replace_single;
    my %replace_multi;
    my @replace_context;
    my @args=();
    my @used_multi;

    for my $record (@{$self->{'arg_list'}}) {
	# Merge arguments from records into args
	CORE::push @args, @$record;
    }
    for my $used (keys %{$self->{'replacecount'}}) {
	if($used =~ /^{(\d+)(\D*)}$/) {
	    my $positional = $1; # number if any
	    my $replacementfunction = "{".::undef_as_empty($2)."}"; # {} {/} {.} or {/.}
	    # Find the single replacements
	    if(defined $args[$positional-1]) {
		# we have a matching argument for {n}
		$replace_single{$used} = $args[$positional-1]->replace($replacementfunction);
	    }
	} elsif($used =~ /^{\D*}$/) {
	    # Add to the multireplacement
	    my $replacementfunction = $used; # {} {/} {.} or {/.}
	    CORE::push @used_multi, $replacementfunction;
	    if($self->{'context_replace'}) {
		for my $n (0 .. $#args) {
		    $replace_context[$n]{$replacementfunction} =
			$args[$n]->replace($replacementfunction);
		}
	    } else {
		CORE::push(@{$replace_multi{$replacementfunction}},
			   map { $args[$_]->replace($replacementfunction) }
			   0 .. $#args);
	    }
	} else {
	    die('This should not happen. Contact <parallel@gnu.org>.');
	}
    }

    my $replacements = 0;
    if(%replace_single) {
	my $single_regexp = join('|', map { $_=~s/(\W)/\\$1/g; $_} sort keys %replace_single);
	$replacements += ($target =~ s/($single_regexp)/$replace_single{$1}/ge);
    }
    my $orig_target = $target;
    if(@used_multi) {
	my $multi_regexp = join('|', map {
	    $a=$Global::replace{"$_"};
	    $a=~s/(\W)/\\$1/g; $a
				} @used_multi);
	my %wordargs;
	if($quote_special_chars) {
	    while($target =~ s/(.*($multi_regexp).*)/\0/o) {
		my $wordarg = $1;
		my $pattern = $2;
		if($self->{'context_replace'}) {
		    my $substituted = $wordarg;
		    my @all=();
		    for my $argref (@replace_context) {
			# for each argument convert a{}b to a1b a2b
			my $substituted = $wordarg;
			$substituted =~ s/($multi_regexp)/$argref->{$Global::replace_rev{$1}}/g;
			CORE::push @all,$substituted;
		    }
		    $wordargs{$wordarg} = join" ",@all;
		    return @all;
		} else {
		    my $substituted = $wordarg;
		    $substituted =~ s/($multi_regexp)/join(" ",map {$_} @{$replace_multi{$Global::replace_rev{$1}}})/eg;
		    $wordargs{$wordarg} = $substituted;
		}
	    }
	} else {
	    while($target =~ s/(\S*($multi_regexp)\S*)/\0/o) {
		my $wordarg = $1;
		my $pattern = $2;
		if($self->{'context_replace'}) {
		    my $substituted = $wordarg;
		    my @all=();
		    for my $argref (@replace_context) {
			# for each argument convert a{}b to a1b a2b
			my $substituted = $wordarg;
			$substituted =~ s/($multi_regexp)/$argref->{$Global::replace_rev{$1}}/g;
			CORE::push @all,$substituted;
		    }
		    $wordargs{$wordarg} = join" ",@all;
		} else {
		    my $substituted = $wordarg;
		    $substituted =~ s/($multi_regexp)/join(" ",map {$_} @{$replace_multi{$Global::replace_rev{$1}}})/eg;
		    $wordargs{$wordarg} = $substituted;
		}
	    }
	}

	my @k=keys %wordargs;
	for(@k) {s/(\W)/\\$1/g};
	my $regexp=join("|",@k);
	if($quote_special_chars) {
	    # When --return'ing a file with added special chars
	    # they need to be quoted.
	    # E.g. --trc 'a {}'
	    # Not really pretty. Can this be done better?
	    $orig_target =~s/($regexp)/::shell_unquote($wordargs{$1})/ge;
	    $orig_target = ::shell_quote_scalar($orig_target);
	} else {
	    $orig_target =~s/($regexp)/$wordargs{$1}/g;
	}
    }
    return $orig_target;
}


package CommandLineQueue;

sub new {
    my $class = shift;
    my $command = shift;
    my $read_from = shift;
    my $context_replace = shift;
    my $max_number_of_args = shift;
    my $return_files = shift;
    my @unget = ();
    return bless {
	'unget' => \@unget,
	'command' => $command,
	'arg_queue' => RecordQueue->new($read_from,$::opt_colsep),
	'context_replace' => $context_replace,
	'max_number_of_args' => $max_number_of_args,
	'size' => undef,
	'return_files' => $return_files,
    }, ref($class) || $class;
}

sub quote_args {
    my $self = shift;
    # If there is not command emulate |bash
    return $self->{'command'};
}

sub get {
    my $self = shift;
    if(@{$self->{'unget'}}) {
	my $cmd_line = shift @{$self->{'unget'}};
	return ($cmd_line);
    } else {
	my $cmd_line;
	$cmd_line = CommandLine->new($self->{'command'},
				     $self->{'arg_queue'},
				     $self->{'context_replace'},
				     $self->{'max_number_of_args'},
				     $self->{'return_files'},
	    );
	$cmd_line->populate();
	::debug("cmd_line->number_of_args ".$cmd_line->number_of_args()."\n");
	if($cmd_line->number_of_args() == 0) {
	    # We did not get more args - maybe at EOF string?
	    return undef;
	} else {
	    return ($cmd_line);
	}
    }
}

sub unget {
    my $self = shift;
    unshift @{$self->{'unget'}}, @_;
}

sub empty {
    my $self = shift;
    my $empty = (not @{$self->{'unget'}}) && $self->{'arg_queue'}->empty();
    ::debug("CommandLineQueue->empty $empty\n");
    return $empty;
}

sub size {
    my $self = shift;
    if(not $self->{'size'}) {
	my @all_lines = ();
	while(not $self->{'arg_queue'}->empty()) {
	    push @all_lines, CommandLine->new($self->{'command'},
					      $self->{'arg_queue'},
					      $self->{'context_replace'},
					      $self->{'max_number_of_args'});
	}
	$self->{'size'} = @all_lines;
	$self->unget(@all_lines);
    }
    return $self->{'size'};
}


package Limits::Command;

# Maximal command line length (for -m and -X)
sub max_length {
    # Find the max_length of a command line
    # Returns:
    #   number of chars on the longest command line allowed
    if(not $Limits::Command::line_max_len) {
	if($::opt_s) {
	    if(is_acceptable_command_line_length($::opt_s)) {
		$Limits::Command::line_max_len = $::opt_s;
	    } else {
		# -s is too long: Find the correct
		$Limits::Command::line_max_len = binary_find_max_length(0,$::opt_s);
	    }
	    if($::opt_s <= $Limits::Command::line_max_len) {
		$Limits::Command::line_max_len = $::opt_s;
	    } else {
		print STDERR "$Global::progname: ",
		"value for -s option should be < $Limits::Command::line_max_len\n";
	    }
	} else {
	    $Limits::Command::line_max_len = real_max_length();
	}
    }
    return $Limits::Command::line_max_len;
}

sub real_max_length {
    # Returns:
    #   The maximal command line length
    # Use an upper bound of 8 MB if the shell allows for for infinite long lengths
    my $upper = 8_000_000;
    my $len = 8;
    do {
	if($len > $upper) { return $len };
	$len *= 16;
    } while (is_acceptable_command_line_length($len));
    # Then search for the actual max length between 0 and upper bound
    return binary_find_max_length(int($len/16),$len);
}

sub binary_find_max_length {
    # Given a lower and upper bound find the max_length of a command line
    # Returns:
    #   number of chars on the longest command line allowed
    my ($lower, $upper) = (@_);
    if($lower == $upper or $lower == $upper-1) { return $lower; }
    my $middle = int (($upper-$lower)/2 + $lower);
    ::debug("Maxlen: $lower,$upper,$middle\n");
    if (is_acceptable_command_line_length($middle)) {
	return binary_find_max_length($middle,$upper);
    } else {
	return binary_find_max_length($lower,$middle);
    }
}

sub is_acceptable_command_line_length {
    # Test if a command line of this length can run
    # Returns:
    #   0 if the command line length is too long
    #   1 otherwise
    my $len = shift;

    $CommandMaxLength::is_acceptable_command_line_length++;
    ::debug("$CommandMaxLength::is_acceptable_command_line_length $len\n");
    local *STDERR;
    open (STDERR,">/dev/null");
    system "true "."x"x$len;
    close STDERR;
    ::debug("$len $?\n");
    return not $?;
}

package RecordQueue;

sub new {
    my $class = shift;
    my $fhs = shift;
    my $colsep = shift;
    my @unget = ();
    my $arg_sub_queue;
    if($colsep) {
	# Open one file with colsep
	$arg_sub_queue = RecordColQueue->new($fhs);
    } else {
	# Open one or more files if multiple -a
	$arg_sub_queue = MultifileQueue->new($fhs);
    }
    return bless {
	'unget' => \@unget,
	'arg_number' => 0,
	'arg_sub_queue' => $arg_sub_queue,
    }, ref($class) || $class;
}

sub get {
    my $self = shift;
    if(@{$self->{'unget'}}) {
	return shift @{$self->{'unget'}};
    }
    $self->{'arg_number'}++;
    return $self->{'arg_sub_queue'}->get();
}

sub unget {
    my $self = shift;
    ::debug("RecordQueue-unget '@_'\n");
    $self->{'arg_number'}--;
    unshift @{$self->{'unget'}}, @_;
}

sub empty {
    my $self = shift;
    my $empty = not @{$self->{'unget'}};
    $empty &&= $self->{'arg_sub_queue'}->empty();
    ::debug("RecordQueue->empty $empty\n");
    return $empty;
}

sub arg_number {
    my $self = shift;
    return $self->{'arg_number'};
}

package RecordColQueue;

sub new {
    my $class = shift;
    my $fhs = shift;
    my @unget = ();
    my $arg_sub_queue = MultifileQueue->new($fhs);
    return bless {
	'unget' => \@unget,
	'arg_sub_queue' => $arg_sub_queue,
    }, ref($class) || $class;
}

sub get {
    my $self = shift;
    if(@{$self->{'unget'}}) {
	return shift @{$self->{'unget'}};
    }
    my $unget_ref=$self->{'unget'};
    if($self->{'arg_sub_queue'}->empty()) {
	return undef;
    }
    my $in_record = $self->{'arg_sub_queue'}->get();
    if(defined $in_record) {
	my @out_record = ();
	for my $arg (@$in_record) {
	    ::debug("RecordColQueue::arg $arg\n");
	    my $line = $arg->orig();
	    ::debug("line='$line'\n");
	    if($line ne "") {
		for my $s (split /$::opt_colsep/o, $line) {
		    push @out_record, Arg->new($s);
		}
	    } else {
		push @out_record, Arg->new("");
	    }
	}
	return \@out_record;
    } else {
	return undef;
    }
}

sub unget {
    my $self = shift;
    ::debug("RecordColQueue-unget '@_'\n");
    unshift @{$self->{'unget'}}, @_;
}

sub empty {
    my $self = shift;
    my $empty = (not @{$self->{'unget'}} and $self->{'arg_sub_queue'}->empty());
    ::debug("RecordColQueue->empty $empty");
    return $empty;
}



package MultifileQueue;

@Global::unget_argv=();

sub new {
    my $class = shift;
    my $fhs = shift;
    for my $fh (@$fhs) {
	if(-t $fh) {
	    print STDERR "$Global::progname: Input is tty. Press CTRL-D to exit.\n";
	}
    }
    return bless {
	'unget' => \@Global::unget_argv,
	'fhs' => $fhs,
    }, ref($class) || $class;
}

sub get {
    my $self = shift;
    if(@{$self->{'unget'}}) {
	return shift @{$self->{'unget'}};
    }
    my @record = ();
    my $prepend = undef;
    my $empty = 1;
    for my $fh (@{$self->{'fhs'}}) {
	if(eof($fh)) {
	    if(defined $prepend) {
		push @record, Arg->new($prepend);
		$empty = 0;
	    } else {
		push @record, Arg->new($prepend||"");
	    }
	    next;
	}
	my $arg = <$fh>;
	# Remove delimiter
	$arg =~ s:$/$::;
	if($Global::end_of_file_string and
	   $arg eq $Global::end_of_file_string) {
	    # Ignore the rest of input file
	    while (<$fh>) {}
	    ::debug("EOF-string $arg\n");
	    if(defined $prepend) {
		push @record, Arg->new($prepend);
		$empty = 0;
	    } else {
		push @record, Arg->new($prepend);
	    }
	    ::debug("Is empty? $empty");
	    next;
	}
	if(defined $prepend) {
	    $arg = $prepend.$arg; # For line continuation
	    $prepend = undef; #undef;
	}
	if($Global::ignore_empty) {
	    if($arg =~ /^\s*$/) {
		redo; # Try the next line
	    }
	}
	if($Global::max_lines) {
	    if($arg =~ /\s$/) {
		# Trailing space => continued on next line
		$prepend = $arg;
		redo;
	    }
	}
	push @record, Arg->new($arg);
	$empty = 0;
    }
    if($empty) {
	return undef;
    } else {
	return \@record;
    }
}

sub unget {
    my $self = shift;
    ::debug("MultifileQueue-unget '@_'\n");
    unshift @{$self->{'unget'}}, @_;
}

sub empty {
    my $self = shift;
    my $empty = (not @Global::unget_argv
		 and not @{$self->{'unget'}});
    for my $fh (@{$self->{'fhs'}}) {
	$empty &&= eof($fh);
    }
    ::debug("MultifileQueue->empty $empty\n");
    return $empty;
}

package Arg;

sub new {
    my $class = shift;
    my $orig = shift;
    if($::oodebug and not defined $orig) {
	Carp::cluck($orig);
    }
    return bless {
	'orig' => $orig,
    }, ref($class) || $class;
}

sub replace {
    my $self = shift;
    my $replacement_string = shift; # {} {/} {.} {/.}
    if(not defined $self->{$replacement_string}) {
	my $s;
	if($Global::trim eq "n") {
	    $s = $self->{'orig'};
	} else {
	    $s = trim_of($self->{'orig'});
	}
	if($replacement_string eq "{}") {
	    # skip
	} elsif($replacement_string eq "{.}") {
	    $s =~ s:\.[^/\.]*$::; # Remove .ext from argument
	} elsif($replacement_string eq "{/}") {
	    $s =~ s:^.*/([^/]+)/?$:$1:; # Remove dir from argument. If ending in /, remove final /
	} elsif($replacement_string eq "{/.}") {
	    $s =~ s:^.*/([^/]+)/?$:$1:; # Remove dir from argument. If ending in /, remove final /
	    $s =~ s:\.[^/\.]*$::; # Remove .ext from argument
	}
	if($Global::JobQueue->quote_args()) {
	    $s = ::shell_quote_scalar($s);
	}
	$self->{$replacement_string} = $s;
    }
    return $self->{$replacement_string};
}

sub orig {
    my $self = shift;
    return $self->{'orig'};
}

sub trim_of {
    # Removes white space as specifed by --trim:
    # n = nothing
    # l = start
    # r = end
    # lr|rl = both
    # Returns:
    #   string with white space removed as needed
    my @strings = map { defined $_ ? $_ : "" } (@_);
    my $arg;
    if($Global::trim eq "n") {
	# skip
    } elsif($Global::trim eq "l") {
	for $arg (@strings) { $arg =~ s/^\s+//; }
    } elsif($Global::trim eq "r") {
	for $arg (@strings) { $arg =~ s/\s+$//; }
    } elsif($Global::trim eq "rl" or $Global::trim eq "lr") {
	for $arg (@strings) { $arg =~ s/^\s+//; $arg =~ s/\s+$//; }
    } else {
	print STDERR "$Global::progname: --trim must be one of: r l rl lr\n";
	::wait_and_exit(255);
    }
    return wantarray ? @strings : "@strings";
}


package Semaphore;

# This package provides a counting semaphore
#
# If a process dies without releasing the semaphore the next process
# that needs that entry will clean up dead semaphores
#
# The semaphores are stored in ~/.parallel/semaphores/id-<name> Each
# file in ~/.parallel/semaphores/id-<name>/ is the process ID of the
# process holding the entry. If the process dies, the entry can be
# taken by another process.

use Fcntl qw(:DEFAULT :flock);

sub new {
    my $class = shift;
    my $id = shift;
    my $count = shift;
    $id=~s/([^-_a-z0-9])/unpack("H*",$1)/ige; # Convert non-word chars to hex
    $id="id-".$id; # To distinguish it from a process id
    my $parallel_dir = $ENV{'HOME'}."/.parallel";
    -d $parallel_dir or mkdir $parallel_dir;
    my $parallel_locks = $parallel_dir."/semaphores";
    -d $parallel_locks or mkdir $parallel_locks;
    my $lockdir = "$parallel_locks/$id";
    my $lockfile = $lockdir.".lock";
    if($count < 1) { die "Semaphore count = $count"; }
    return bless {
	'lockfile' => $lockfile,
	'lockfh' => Symbol::gensym(),
	'lockdir' => $lockdir,
	'id' => $id,
	'idfile' => $lockdir."/".$id,
	'pid' => $$,
	'pidfile' => $lockdir."/".$$,
	'count' => $count + 1 # nlinks returns a link for the 'id-' as well
    }, ref($class) || $class;
}

sub acquire {
    my $self = shift;
    while(1) {
	$self->atomic_link_if_count_less_than() and last;
	::debug("Remove dead locks");
	my $lockdir = $self->{'lockdir'};
	for my $d (<$lockdir/*>) {
	    $d =~ m:$lockdir/([0-9]+)$:o or next;
	    if(not kill 0, $1) {
		::debug("Dead: $d");
		unlink $d;
	    } else {
		::debug("Alive: $d");
	    }
	}
	# try again
	$self->atomic_link_if_count_less_than() and last;
	sleep 1;
	# TODO if timeout: last
    }
    ::debug("acquired $self->{'pid'}\n");
}

sub release {
    my $self = shift;
    unlink $self->{'pidfile'};
    if($self->nlinks() == 1) {
	# This is the last link, so atomic cleanup
	$self->lock();
	if($self->nlinks() == 1) {
	    unlink $self->{'idfile'};
	    rmdir $self->{'lockdir'};
	}
	$self->unlock();
    }
    ::debug("released $self->{'pid'}\n");
}


sub atomic_link_if_count_less_than {
    # Link $file1 to $file2 if nlinks to $file1 < $count
    my $self = shift;
    my $retval = 0;
    $self->lock();
    ::debug($self->nlinks()."<".$self->{'count'});
    if($self->nlinks() < $self->{'count'}) {
	-d $self->{'lockdir'} || mkdir $self->{'lockdir'};
	if(not -e $self->{'idfile'}) {
	    open (A, ">", $self->{'idfile'}) or die ">$self->{'idfile'}";
	    close A;
	}
	$retval = link $self->{'idfile'}, $self->{'pidfile'};
    }
    $self->unlock();
    ::debug("atomic $retval");
    return $retval;
}

sub nlinks {
    my $self = shift;
    if(-e $self->{'idfile'}) {
	::debug("nlinks".((stat(_))[3])."\n");
	return (stat(_))[3];
    } else {
	return 0;
    }
}

sub lock {
    my $self = shift;
    open $self->{'lockfh'}, ">", $self->{'lockfile'}
	or die "Can't open semaphore file $self->{'lockfile'}: $!";
    chmod 0666, $self->{'lockfile'}; # assuming you want it a+rw
    while(not flock $self->{'lockfh'}, LOCK_EX()|LOCK_NB()) {
	::debug("Cannot lock $self->{'lockfile'}");
	# TODO if timeout: last
	sleep 1;
    }
    ::debug("locked $self->{'lockfile'}");
}

sub unlock {
    my $self = shift;
    unlink $self->{'lockfile'};
    close $self->{'lockfh'};
    ::debug("unlocked\n");
}

# Keep perl -w happy

$::opt_x = $::opt_workdir = $Semaphore::timeout = $Semaphore::wait =
$::opt_skip_first_line = $::opt_shebang = 0 ;

