Released as 20240522 ('Tbilisi')

[parallel.git] / src / parallel

#!/usr/bin/env perl

# Copyright (C) 2007-2024 Ole Tange, http://ole.tange.dk and Free
# Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, see <https://www.gnu.org/licenses/>
# or write to the Free Software Foundation, Inc., 51 Franklin St,
# Fifth Floor, Boston, MA 02110-1301 USA
#
# SPDX-FileCopyrightText: 2007-2024 Ole Tange, http://ole.tange.dk and Free Software and Foundation, Inc.
# SPDX-License-Identifier: GPL-3.0-or-later

# open3 used in Job::start
use IPC::Open3;
use POSIX;
# gensym used in Job::start
use Symbol qw(gensym);
# tempfile used in Job::start
use File::Temp qw(tempfile tempdir);
# mkpath used in openresultsfile
use File::Path;
# GetOptions used in get_options_from_array
use Getopt::Long;
# Used to ensure code quality
use strict;
use File::Basename;

sub set_input_source_header($$) {
    my ($command_ref,$input_source_fh_ref) = @_;
    if(defined $opt::header and not $opt::pipe) {
        # split with colsep or \t
        # $header force $colsep = \t if undef?
        my $delimiter = defined $opt::colsep ? $opt::colsep : "\t";
        # regexp for {=
        my $left = "\Q$Global::parensleft\E";
        my $l = $Global::parensleft;
        # regexp for =}
        my $right = "\Q$Global::parensright\E";
        my $r = $Global::parensright;
        if($opt::header ne "0") {
            my $id = 1;
            for my $fh (@$input_source_fh_ref) {
                my $line = <$fh>;
                chomp($line);
                $line =~ s/\r$//;
                ::debug("init", "Delimiter: '$delimiter'");
                for my $s (split /$delimiter/o, $line) {
                    ::debug("init", "Colname: '$s'");
                    # Replace {colname} with {2}
                    for(@$command_ref, @Global::ret_files,
                        @Global::transfer_files, $opt::tagstring,
                        $opt::workdir, $opt::results, $opt::retries,
                        @Global::template_contents, @Global::template_names,
                        @opt::filter) {
                        # Skip if undefined
                        $_ or next;
                      s:\{$s(|/|//|\.|/\.)\}:\{$id$1\}:g;
                        # {=header1 ... =}  =>  {=1 ... =}
                      s:$left $s (.*?) $right:$l$id$1$r:gx;
                    }
                    $Global::input_source_header{$id} = $s;
                    $id++;
                }
            }
        }
        # Make it possible to do:
        # parallel --header 0 echo {file2} {file1} :::: file1 file2
        my $id = 1;
        for my $s (@opt::a) {
            # ::: are put into files and given a filehandle
            # ignore these and only keep the filenames.
            fileno $s and next;
            for(@$command_ref, @Global::ret_files,
                @Global::transfer_files, $opt::tagstring,
                $opt::workdir, $opt::results, $opt::retries,
                @Global::template_contents, @Global::template_names,
                @opt::filter) {
                # Skip if undefined
                $_ or next;
              s:\{\Q$s\E(|/|//|\.|/\.)\}:\{$id$1\}:g;
                # {=header1 ... =}  =>  {=1 ... =}
              s:$left \Q$s\E (.*?) $right:$l$id$1$r:gx;
            }
            $Global::input_source_header{$id} = $s;
            $id++;
        }
    } else {
        my $id = 1;
        for my $fh (@$input_source_fh_ref) {
            $Global::input_source_header{$id} = $id;
            $id++;
        }
    }
}

sub max_jobs_running() {
    # Compute $Global::max_jobs_running as the max number of jobs
    # running on each sshlogin.
    # Returns:
    #   $Global::max_jobs_running
    if(not $Global::max_jobs_running) {
        for my $sshlogin (values %Global::host) {
            $sshlogin->max_jobs_running();
        }
    }
    if(not $Global::max_jobs_running) {
        ::error("Cannot run any jobs.");
        wait_and_exit(255);
    }
    return $Global::max_jobs_running;
}

sub halt() {
    # Compute exit value,
    # wait for children to complete
    # and exit
    if($opt::halt and $Global::halt_when ne "never") {
        if(not defined $Global::halt_exitstatus) {
            if($Global::halt_pct) {
                $Global::halt_exitstatus =
                    ::ceil($Global::total_failed /
                           ($Global::total_started || 1) * 100);
            } elsif($Global::halt_count) {
                $Global::halt_exitstatus =
                    ::min(undef_as_zero($Global::total_failed),101);
            }
        }
        wait_and_exit($Global::halt_exitstatus);
    } else {
        if($Global::semaphore) {
            # --semaphore runs a single job:
            # Use exit value of that
            wait_and_exit($Global::halt_exitstatus);
        } else {
            # 0 = all jobs succeeded
            # 1-100 = n jobs failed
            # 101 = >100 jobs failed
            wait_and_exit(min(undef_as_zero($Global::exitstatus),101));
        }
    }
}


sub __PIPE_MODE__() {}


sub pipepart_setup() {
    # Compute the blocksize
    # Generate the commands to extract the blocks
    # Push the commands on queue
    # Changes:
    #   @Global::cat_prepends
    #   $Global::JobQueue
    if($opt::tee) {
        # Prepend each command with
        #   < file
        my $cat_string = "< ".Q($opt::a[0]);
        for(1..$Global::JobQueue->total_jobs()) {
            push @Global::cat_appends, $cat_string;
            push @Global::cat_prepends, "";
        }
    } else {
        if(not $opt::blocksize) {
            # --blocksize with 10 jobs per jobslot
            $opt::blocksize = -10;
        }
        if($opt::roundrobin) {
            # --blocksize with 1 job per jobslot
            $opt::blocksize = -1;
        }
        if($opt::blocksize < 0) {
            my $size = 0;
            # Compute size of -a
            for(@opt::a) {
                if(-f $_) {
                    $size += -s $_;
                } elsif(-b $_) {
                    $size += size_of_block_dev($_);
                } elsif(-e $_) {
                    ::error("$_ is neither a file nor a block device");
                    wait_and_exit(255);
                } else {
                    ::error("File not found: $_");
                    wait_and_exit(255);
                }
            }
            # Run in total $job_slots*(- $blocksize) jobs
            # Set --blocksize = size / no of proc / (- $blocksize)
            $Global::dummy_jobs = 1;
            $Global::blocksize = 1 +
                int($size / max_jobs_running() /
                    -multiply_binary_prefix($opt::blocksize));
        }
        @Global::cat_prepends = (map { pipe_part_files($_) }
                                 # ::: are put into files and given a filehandle
                                 # ignore these and only keep the filenames.
                                 grep { ! fileno $_ } @opt::a);
        # Unget the empty arg as many times as there are parts
        $Global::JobQueue->{'commandlinequeue'}{'arg_queue'}->unget(
            map { [Arg->new("\0noarg")] } @Global::cat_prepends
            );
    }
}

sub pipe_tee_setup() {
    # Create temporary fifos
    # Run 'tee fifo1 fifo2 fifo3 ... fifoN' in the background
    # This will spread the input to fifos
    # Generate commands that reads from fifo1..N:
    #   cat fifo | user_command
    # Changes:
    #   @Global::cat_prepends
    my @fifos;
    for(1..$Global::JobQueue->total_jobs()) {
        push @fifos, tmpfifo();
    }
    # cat foo | tee fifo1 fifo2 fifo3 fifo4 fifo5 > /dev/null
    if(not fork()){
        # Test if tee supports --output-error=warn-nopipe
        `echo | tee --output-error=warn-nopipe /dev/null >/dev/null 2>/dev/null`;
        my $opt = $? ? "" : "--output-error=warn-nopipe";
        ::debug("init","tee $opt");
        if($opt::dryrun) {
            # This is not exactly what is run, but it gives the basic idea
            print "mkfifo @fifos\n";
            print "tee $opt @fifos >/dev/null &\n";
        } else {
            # Let tee inherit our stdin
            # and redirect stdout to null
            open STDOUT, ">","/dev/null";
            if($opt) {
                exec "tee", $opt, @fifos;
            } else {
                exec "tee", @fifos;
            }
        }
        exit(0);
    }
    # For each fifo
    #   (rm fifo1; grep 1) < fifo1
    #   (rm fifo2; grep 2) < fifo2
    #   (rm fifo3; grep 3) < fifo3
    # Remove the tmpfifo as soon as it is open
    @Global::cat_prepends = map { "(rm $_;" } shell_quote(@fifos);
    @Global::cat_appends = map { ") < $_" } shell_quote(@fifos);
}


sub parcat_script() {
    # TODO if script fails: Use parallel -j0 --plain --lb cat ::: fifos
    my $script = q'{
        use POSIX qw(:errno_h);
        use IO::Select;
        use strict;
        use threads;
        use Thread::Queue;
        use Fcntl qw(:DEFAULT :flock);

        my $opened :shared;
        my $q = Thread::Queue->new();
        my $okq = Thread::Queue->new();
        my @producers;

        if(not @ARGV) {
            if(-t *STDIN) {
                print "Usage:\n";
                print "  parcat file(s)\n";
                print "  cat argfile | parcat\n";
            } else {
                # Read arguments from stdin
                chomp(@ARGV = <STDIN>);
            }
        }
        my $files_to_open = 0;
        # Default: fd = stdout
        my $fd = 1;
        for (@ARGV) {
            # --rm = remove file when opened
            /^--rm$/ and do { $opt::rm = 1; next; };
            # -1 = output to fd 1, -2 = output to fd 2
            /^-(\d+)$/ and do { $fd = $1; next; };
            push @producers, threads->create("producer", $_, $fd);
            $files_to_open++;
        }

        sub producer {
            # Open a file/fifo, set non blocking, enqueue fileno of the file handle
            my $file = shift;
            my $output_fd = shift;
            open(my $fh, "<", $file) || do {
                print STDERR "parcat: Cannot open $file: $!\n";
                exit(1);
            };
            # Remove file when it has been opened
            if($opt::rm) {
                unlink $file;
            }
            set_fh_non_blocking($fh);
            $opened++;
            # Pass the fileno to parent
            $q->enqueue(fileno($fh),$output_fd);
            # Get an OK that the $fh is opened and we can release the $fh
            while(1) {
                my $ok = $okq->dequeue();
                if($ok == fileno($fh)) { last; }
                # Not ours - very unlikely to happen
                $okq->enqueue($ok);
            }
            return;
        }

        my $s = IO::Select->new();
        my %buffer;

        sub add_file {
            my $infd = shift;
            my $outfd = shift;
            open(my $infh, "<&=", $infd) || die;
            open(my $outfh, ">&=", $outfd) || die;
            $s->add($infh);
            # Tell the producer now opened here and can be released
            $okq->enqueue($infd);
            # Initialize the buffer
            @{$buffer{$infh}{$outfd}} = ();
            $Global::fh{$outfd} = $outfh;
        }

        sub add_files {
            # Non-blocking dequeue
            my ($infd,$outfd);
            do {
                ($infd,$outfd) = $q->dequeue_nb(2);
                if(defined($outfd)) {
                    add_file($infd,$outfd);
                }
            } while(defined($outfd));
        }

        sub add_files_block {
            # Blocking dequeue
            my ($infd,$outfd) = $q->dequeue(2);
            add_file($infd,$outfd);
        }


        my $fd;
        my (@ready,$infh,$rv,$buf);
        do {
            # Wait until at least one file is opened
            add_files_block();
            while($q->pending or keys %buffer) {
                add_files();
                while(keys %buffer) {
                    @ready = $s->can_read(0.01);
                    if(not @ready) {
                        add_files();
                    }
                    for $infh (@ready) {
                        # There is only one key, namely the output file descriptor
                        for my $outfd (keys %{$buffer{$infh}}) {
                            # TODO test if 60800 is optimal (2^17 is used elsewhere)
                            $rv = sysread($infh, $buf, 60800);
                            if (!$rv) {
                                if($! == EAGAIN) {
                                    # Would block: Nothing read
                                    next;
                                } else {
                                    # Nothing read, but would not block:
                                    # This file is done
                                    $s->remove($infh);
                                    for(@{$buffer{$infh}{$outfd}}) {
                                        syswrite($Global::fh{$outfd},$_);
                                    }
                                    delete $buffer{$infh};
                                    # Closing the $infh causes it to block
                                    # close $infh;
                                    add_files();
                                    next;
                                }
                            }
                            # Something read.
                            # Find \n or \r for full line
                            my $i = (rindex($buf,"\n")+1);
                            if($i) {
                                # Print full line
                                for(@{$buffer{$infh}{$outfd}}, substr($buf,0,$i)) {
                                    syswrite($Global::fh{$outfd},$_);
                                }
                                # @buffer = remaining half line
                                $buffer{$infh}{$outfd} = [substr($buf,$i,$rv-$i)];
                            } else {
                                # Something read, but not a full line
                                push @{$buffer{$infh}{$outfd}}, $buf;
                            }
                            redo;
                        }
                    }
                }
            }
        } while($opened < $files_to_open);

        for (@producers) {
            $_->join();
        }

        sub set_fh_non_blocking {
            # Set filehandle as non-blocking
            # Inputs:
            #   $fh = filehandle to be blocking
            # Returns:
            #   N/A
            my $fh = shift;
            my $flags;
            fcntl($fh, &F_GETFL, $flags) || die $!; # Get the current flags on the filehandle
            $flags |= &O_NONBLOCK; # Add non-blocking to the flags
            fcntl($fh, &F_SETFL, $flags) || die $!; # Set the flags on the filehandle
        }
    }';
    return ::spacefree(3, $script);
}

sub sharder_script() {
    my $script = q{
        use B;
        # Column separator
        my $sep = shift;
        # Which columns to shard on (count from 1)
        my $col = shift;
        # Which columns to shard on (count from 0)
        my $col0 = $col - 1;
        # Perl expression
        my $perlexpr = shift;
        my $bins = @ARGV;
        # Open fifos for writing, fh{0..$bins}
        my $t = 0;
        my %fh;
        for(@ARGV) {
            open $fh{$t++}, ">", $_;
            # open blocks until it is opened by reader
            # so unlink only happens when it is ready
            unlink $_;
        }
        if($perlexpr) {
            my $subref = eval("sub { no strict; no warnings; $perlexpr }");
            while(<STDIN>) {
                # Split into $col columns (no need to split into more)
                @F = split $sep, $_, $col+1;
                {
                    local $_ = $F[$col0];
                    &$subref();
                    $fh = $fh{ hex(B::hash($_))%$bins };
                }
                print $fh $_;
            }
        } else {
            while(<STDIN>) {
                # Split into $col columns (no need to split into more)
                @F = split $sep, $_, $col+1;
                $fh = $fh{ hex(B::hash($F[$col0]))%$bins };
                print $fh $_;
            }
        }
        # Close all open fifos
        close values %fh;
    };
    return ::spacefree(1, $script);
}

sub binner_script() {
    my $script = q{
        use B;
        # Column separator
        my $sep = shift;
        # Which columns to shard on (count from 1)
        my $col = shift;
        # Which columns to shard on (count from 0)
        my $col0 = $col - 1;
        # Perl expression
        my $perlexpr = shift;
        my $bins = @ARGV;
        # Open fifos for writing, fh{0..$bins}
        my $t = 0;
        my %fh;
        # Let the last output fifo be the 0'th
        open $fh{$t++}, ">", pop @ARGV;
        for(@ARGV) {
            open $fh{$t++}, ">", $_;
            # open blocks until it is opened by reader
            # so unlink only happens when it is ready
            unlink $_;
        }
        if($perlexpr) {
            my $subref = eval("sub { no strict; no warnings; $perlexpr }");
            while(<STDIN>) {
                # Split into $col columns (no need to split into more)
                @F = split $sep, $_, $col+1;
                {
                    local $_ = $F[$col0];
                    &$subref();
                    $fh = $fh{ $_%$bins };
                }
                print $fh $_;
            }
        } else {
            while(<STDIN>) {
                # Split into $col columns (no need to split into more)
                @F = split $sep, $_, $col+1;
                $fh = $fh{ $F[$col0]%$bins };
                print $fh $_;
            }
        }
        # Close all open fifos
        close values %fh;
    };
    return ::spacefree(1, $script);
}

sub pipe_shard_setup() {
    # Create temporary fifos
    # Run 'shard.pl sep col fifo1 fifo2 fifo3 ... fifoN' in the background
    # This will spread the input to fifos
    # Generate commands that reads from fifo1..N:
    #   cat fifo | user_command
    # Changes:
    #   @Global::cat_prepends
    my @shardfifos;
    my @parcatfifos;
    # TODO $opt::jobs should be evaluated (100%)
    # TODO $opt::jobs should be number of total_jobs if there are arguments
    max_jobs_running();
    my $njobs = $Global::max_jobs_running;
    for my $m (0..$njobs-1) {
        for my $n (0..$njobs-1) {
            # sharding to A B C D
            # parcatting all As together
            $parcatfifos[$n][$m] = $shardfifos[$m][$n] = tmpfifo();
        }
    }
    my $shardbin = ($opt::shard || $opt::bin);
    my $script;
    if($opt::bin) {
        $script = binner_script();
    } else {
        $script = sharder_script();
    }

    # cat foo | sharder sep col fifo1 fifo2 fifo3 ... fifoN

    if($shardbin =~ /^[a-z_][a-z_0-9]*(\s|$)/i) {
        # Group by column name
        # (Yes, this will also wrongly match a perlexpr like: chop)
        my($read,$char,@line);
        # A full line, but nothing more (the rest must be read by the child)
        # $Global::header used to prepend block to each job
        do {
            $read = sysread(STDIN,$char,1);
            push @line, $char;
        } while($read and $char ne "\n");
        $Global::header = join "", @line;
    }
    my ($col, $perlexpr, $subref) =
        column_perlexpr($shardbin, $Global::header, $opt::colsep);
    if(not fork()) {
        # Let the sharder inherit our stdin
        # and redirect stdout to null
        open STDOUT, ">","/dev/null";
        # The PERL_HASH_SEED must be the same for all sharders
        # so B::hash will return the same value for any given input
        $ENV{'PERL_HASH_SEED'} = $$;
        exec qw(parallel -0 --block 100k -q --pipe -j), $njobs,
            qw(--roundrobin -u perl -e), $script, ($opt::colsep || ","),
            $col, $perlexpr, '{}', (map { (':::+', @{$_}) } @parcatfifos);
    }
    # For each fifo
    #   (rm fifo1; grep 1) < fifo1
    #   (rm fifo2; grep 2) < fifo2
    #   (rm fifo3; grep 3) < fifo3
    my $parcat = Q(parcat_script());
    if(not $parcat) {
        ::error("'parcat' must be in path.");
        ::wait_and_exit(255);
    }
    @Global::cat_prepends =
        map { "perl -e $parcat ".
                  join(" ",shell_quote(@$_))." | "} @parcatfifos;
}

sub pipe_part_files(@) {
    # Given the bigfile:
    # - find header and split positions
    # - make commands that 'cat's the partial file
    # Input:
    #   $file = the file to read
    # Returns:
    #   @commands that will cat_partial each part
    my ($file) = @_;
    my $buf = "";
    if(not -f $file and not -b $file) {
        ::error("--pipepart only works on seekable files, not streams/pipes.",
                "$file is not a seekable file.");
        ::wait_and_exit(255);
    }

    my $fh = open_or_exit("<",$file);
    my $firstlinelen = 0;
    if($opt::skip_first_line) {
        my $newline;
        # Read a full line one byte at a time
        while($firstlinelen += sysread($fh,$newline,1,0)) {
            $newline eq "\n" and last;
        }
    }
    my $header = find_header(\$buf,$fh);
    # find positions
    my @pos = find_split_positions($file,int($Global::blocksize),
                                   $header,$firstlinelen);
    # Make @cat_prepends
    my @cat_prepends = ();
    for(my $i=0; $i<$#pos; $i++) {
        push(@cat_prepends,
             cat_partial($file, $firstlinelen, $firstlinelen+length($header),
                         $pos[$i], $pos[$i+1]));
    }
    return @cat_prepends;
}

sub find_header($$) {
    # Compute the header based on $opt::header
    # Input:
    #   $buf_ref = reference to read-in buffer
    #   $fh = filehandle to read from
    # Uses:
    #   $opt::header
    #   $Global::blocksize
    #   $Global::header
    # Returns:
    #   $header string
    my ($buf_ref, $fh) = @_;
    my $header = "";
    # $Global::header may be set in group_by_loop()
    if($Global::header) { return $Global::header }
    if($opt::header) {
        if($opt::header eq ":") { $opt::header = "(.*\n)"; }
        # Number = number of lines
        $opt::header =~ s/^(\d+)$/"(.*\n)"x$1/e;
        while(sysread($fh,$$buf_ref,int($Global::blocksize),length $$buf_ref)) {
            if($$buf_ref =~ s/^($opt::header)//) {
                $header = $1;
                last;
            }
        }
    }
    return $header;
}

sub find_split_positions($$$) {
    # Find positions in bigfile where recend is followed by recstart
    # Input:
    #   $file = the file to read
    #   $block = (minimal) --block-size of each chunk
    #   $header = header to be skipped
    # Uses:
    #   $opt::recstart
    #   $opt::recend
    # Returns:
    #   @positions of block start/end
    my($file, $block, $header, $firstlinelen) = @_;
    my $skiplen = $firstlinelen + length $header;
    my $size = -s $file;
    if(-b $file) {
        # $file is a blockdevice
        $size = size_of_block_dev($file);
    }
    $block = int $block;
    if($opt::groupby) {
        return split_positions_for_group_by($file,$size,$block,
                                            $header,$firstlinelen);
    }
    # The optimal dd blocksize for mint, redhat, solaris, openbsd = 2^17..2^20
    # The optimal dd blocksize for freebsd = 2^15..2^17
    # The optimal dd blocksize for ubuntu (AMD6376) = 2^16
    my $dd_block_size = 131072; # 2^17
    my @pos;
    my ($recstart,$recend) = recstartrecend();
    my $recendrecstart = $recend.$recstart;
    my $fh = ::open_or_exit("<",$file);
    push(@pos,$skiplen);
    for(my $pos = $block+$skiplen; $pos < $size; $pos += $block) {
        my $buf;
        if($recendrecstart eq "") {
            # records ends anywhere
            push(@pos,$pos);
        } else {
            # Seek the the block start
            if(not sysseek($fh, $pos, 0)) {
                ::error("Cannot seek to $pos in $file");
                edit(255);
            }
            while(sysread($fh,$buf,$dd_block_size,length $buf)) {
                if($opt::regexp) {
                    # If match /$recend$recstart/ => Record position
                    if($buf =~ m:^(.*$recend)$recstart:os) {
                        # Start looking for next record _after_ this match
                        $pos += length($1);
                        push(@pos,$pos);
                        last;
                    }
                } else {
                    # If match $recend$recstart => Record position
                    # TODO optimize to only look at the appended
                    #   $dd_block_size + len $recendrecstart
                    # TODO increase $dd_block_size to optimize for longer records
                    my $i = index64(\$buf,$recendrecstart);
                    if($i != -1) {
                        # Start looking for next record _after_ this match
                        $pos += $i + length($recend);
                        push(@pos,$pos);
                        last;
                    }
                }
            }
        }
    }
    if($pos[$#pos] != $size) {
        # Last splitpoint was not at end of the file: add $size as the last
        push @pos, $size;
    }
    close $fh;
    return @pos;
}

sub split_positions_for_group_by($$$$) {
    my($fh);
    my %value;
    sub value_at($) {
        my $pos = shift;
        if(not defined $value{$pos}) {
            if($pos != 0) {
                seek($fh, $pos-1, 0) || die;
                # Read half line
                <$fh>;
            }
            # Read full line
            my $linepos = tell($fh);
            if(not defined $value{$linepos}) {
                $_ = <$fh>;
                if(defined $_) {
                    # Not end of file
                    my @F;
                    if(defined $group_by::col) {
                        $opt::colsep ||= "\t";
                        @F = split /$opt::colsep/, $_;
                        $_ = $F[$group_by::col];
                    }
                    eval $group_by::perlexpr;
                }
                $value{$linepos} = [$_,$linepos];
            }
            $value{$pos} = $value{$linepos};
        }
        return (@{$value{$pos}});
    }

    sub binary_search_end($$$) {
        my ($s,$spos,$epos) = @_;
        # value_at($spos) == $s
        # value_at($epos) != $s
        my $posdif = $epos - $spos;
        my ($v,$vpos);
        while($posdif) {
            ($v,$vpos) = value_at($spos+$posdif);
            if($v eq $s) {
                $spos = $vpos;
                $posdif = $epos - $spos;
            } else {
                $epos = $vpos;
            }
            $posdif = int($posdif/2);
        }
        return($v,$vpos);
    }

    sub binary_search_start($$$) {
        my ($s,$spos,$epos) = @_;
        # value_at($spos) != $s
        # value_at($epos) == $s
        my $posdif = $epos - $spos;
        my ($v,$vpos);
        while($posdif) {
            ($v,$vpos) = value_at($spos+$posdif);
            if($v eq $s) {
                $epos = $vpos;
            } else {
                $spos = $vpos;
                $posdif = $epos - $spos;
            }
            $posdif = int($posdif/2);
        }
        return($v,$vpos);
    }

    my ($file,$size,$block,$header,$firstlinelen) = @_;
    my @pos;
    $fh = open_or_exit("<",$file);
    # Set $Global::group_by_column $Global::group_by_perlexpr
    group_by_loop($fh,$opt::recsep);
    if($opt::max_args) {
        # Split after n values
        my ($a,$apos);
        # $xpos = linestart, $x = value at $xpos
        $apos = $firstlinelen + length $header;
        for(($a,$apos) = value_at($apos); $apos < $size;) {
            push @pos, $apos;
            ($a,$apos) = binary_search_end($a,$apos,$size);
            if(eof($fh)) {
                push @pos, $size; last;
            }
        }
        # @pos = start of every value
        # Merge n values
        # -nX = keep every X'th position
        my $i = 0;
        @pos = grep { not ($i++ % $opt::max_args) } @pos;
    } else {
        # Split after any value group
        # Preferable < $blocksize
        my ($a,$b,$c,$apos,$bpos,$cpos);
        # $xpos = linestart, $x = value at $xpos, $apos < $bpos < $cpos
        $apos = $firstlinelen + length $header;
        for(($a,$apos) = value_at($apos); $apos < $size;) {
            push @pos, $apos;
            $bpos = $apos + $block;
            ($b,$bpos) = value_at($bpos);
            if(eof($fh)) {
                # EOF is less than 1 block away
                push @pos, $size; last;
            }
            $cpos = $bpos + $block;
            ($c,$cpos) = value_at($cpos);
            if($a eq $b) {
                while($b eq $c) {
                    # Move bpos, cpos a block forward until $a == $b != $c
                    $bpos = $cpos;
                    $cpos += $block;
                    ($c,$cpos) = value_at($cpos);
                    if($cpos >= $size) {
                        $cpos = $size;
                        last;
                    }
                }
                # $a == $b != $c
                # Binary search for $b ending between ($bpos,$cpos)
                ($b,$bpos) = binary_search_end($b,$bpos,$cpos);
            } else {
                if($b eq $c) {
                    # $a != $b == $c
                    # Binary search for $b starting between ($apos,$bpos)
                    ($b,$bpos) = binary_search_start($b,$apos,$bpos);
                } else {
                    # $a != $b != $c
                    # Binary search for $b ending between ($bpos,$cpos)
                    ($b,$bpos) = binary_search_end($b,$bpos,$cpos);
                }
            }
            ($a,$apos) = ($b,$bpos);
        }
    }
    if($pos[$#pos] != $size) {
        # Last splitpoint was not at end of the file: add it
        push @pos, $size;
    }
    return @pos;
}

sub cat_partial($@) {
    # Efficient command to copy from byte X to byte Y
    # Input:
    #   $file = the file to read
    #   ($start, $end, [$start2, $end2, ...]) = start byte, end byte
    # Returns:
    #   Efficient command to copy $start..$end, $start2..$end2, ... to stdout
    my($file, @start_end) = @_;
    my($start, $i);
    # Convert (start,end) to (start,len)
    my @start_len = map {
        if(++$i % 2) { $start = $_; } else { $_-$start }
    } @start_end;
    # The optimal block size differs
    # It has been measured on:
    # AMD 6376: n*4k-1; small n
    # AMD Neo N36L: 44k-200k
    # Intel i7-3632QM: 55k-
    # ARM Cortex A53: 4k-28k
    # Intel i5-2410M: 36k-46k
    #
    # I choose 2^15-1 = 32767
    # q{
    #   expseq() {
    #       perl -E '
    #           $last = pop @ARGV;
    #       $first = shift || 1;
    #       $inc = shift || 1.03;
    #       for($i=$first; $i<=$last;$i*=$inc) { say int $i }
    #       ' "$@"
    #   }
    #
    #   seq 111111111 > big;
    #   f() { ppar --test $1 -a big --pipepart --block -1 'md5sum > /dev/null'; }
    #   export -f f;
    #   expseq 1000 1.001 300000 | shuf | parallel -j1 --jl jl-md5sum f;
    # };
    my $script = spacefree
        (0,
         q{
             while(@ARGV) {
                 sysseek(STDIN,shift,0) || die;
                 $left = shift;
                 while($read =
                       sysread(STDIN,$buf, $left > 32767 ? 32767 : $left)){
                     $left -= $read;
                     syswrite(STDOUT,$buf);
                 }
             }
         });
    return "<". Q($file) .
        " perl -e '$script' @start_len |";
}

sub column_perlexpr($$$) {
    # Compute the column number (if any), perlexpression from combined
    # string (such as --shard key, --groupby key, {=n perlexpr=}
    # Input:
    #   $column_perlexpr = string with column and perl expression
    #   $header = header from input file (if column is column name)
    #   $colsep = column separator regexp
    # Returns:
    #   $col = column number
    #   $perlexpr = perl expression
    #   $subref = compiled perl expression as sub reference
    my ($column_perlexpr, $header, $colsep) = @_;
    my ($col, $perlexpr, $subref);
    if($column_perlexpr =~ /^[-a-z0-9_]+(\s|$)/i) {
        # Column name/number (possibly prefix)
        if($column_perlexpr =~ s/^(-?\d+)(\s|$)//) {
            # Column number (possibly prefix)
            $col = $1;
        } elsif($column_perlexpr =~ s/^([a-z0-9_]+)(\s+|$)//i) {
            # Column name (possibly prefix)
            my $colname = $1;
            # Split on --copsep pattern
            my @headers = split /$colsep/, $header;
            my %headers;
            @headers{@headers} = (1..($#headers+1));
            $col = $headers{$colname};
            if(not defined $col) {
                ::error("Column '$colname' $colsep not found in header",keys %headers);
                ::wait_and_exit(255);
            }
        }
    }
    # What is left of $column_perlexpr is $perlexpr (possibly empty)
    $perlexpr = $column_perlexpr;
    $subref = eval("sub { no strict; no warnings; $perlexpr }");
    return($col, $perlexpr, $subref);
}

sub group_by_loop($$) {
    # Generate perl code for group-by loop
    # Insert a $recsep when the column value changes
    # The column value can be computed with $perlexpr
    my($fh,$recsep) = @_;
    my $groupby = $opt::groupby;
    if($groupby =~ /^[a-z_][a-z_0-9]*(\s|$)/i) {
        # Group by column name
        # (Yes, this will also wrongly match a perlexpr like: chop)
        my($read,$char,@line);
        # Read a full line, but nothing more
        # (the rest must be read by the child)
        # $Global::header used to prepend block to each job
        do {
            $read = sysread($fh,$char,1);
            push @line, $char;
        } while($read and $char ne "\n");
        $Global::header = join "", @line;
    }
    $opt::colsep ||= "\t";
    ($group_by::col, $group_by::perlexpr, $group_by::subref) =
        column_perlexpr($groupby, $Global::header, $opt::colsep);
    # Numbered 0..n-1 due to being used by $F[n]
    if($group_by::col) { $group_by::col--; }

    my $loop = ::spacefree(0,q{
        BEGIN{ $last = "RECSEP"; }
        {
            local $_=COLVALUE;
            PERLEXPR;
            if(($last) ne $_) {
                print "RECSEP";
                $last = $_;
            }
        }
                           });
    if(defined $group_by::col) {
        $loop =~ s/COLVALUE/\$F[$group_by::col]/g;
    } else {
        $loop =~ s/COLVALUE/\$_/g;
    }
    $loop =~ s/PERLEXPR/$group_by::perlexpr/g;
    $loop =~ s/RECSEP/$recsep/g;
    return $loop;
}

sub pipe_group_by_setup() {
    # Record separator with 119 bit random value
    $opt::recend = '';
    $opt::recstart =
        join "", map { (0..9,"a".."z","A".."Z")[rand(62)] } (1..20);
    $opt::remove_rec_sep = 1;
    my @filter;
    push @filter, "perl";
    if($opt::groupby =~ /^[a-z0-9_]+(\s|$)/i) {
        # This is column number/name
        # Use -a (auto-split)
        push @filter, "-a";
        $opt::colsep ||= "\t";
        my $sep = $opt::colsep;
        $sep =~ s/\t/\\t/g;
        $sep =~ s/\"/\\"/g;
        # man perlrun: -Fpattern [...] You can't use literal whitespace
        $sep =~ s/ /\\040/g;
        push @filter, "-F$sep";
    }
    push @filter, "-pe";
    push @filter, group_by_loop(*STDIN,$opt::recstart);
    ::debug("init", "@filter\n");
    open(STDIN, '-|', @filter) || die ("Cannot start @filter");
    if(which("mbuffer")) {
        # You get a speed up of 30% by going through mbuffer
        open(STDIN, '-|', "mbuffer", "-q","-m6M","-b5") ||
            die ("Cannot start mbuffer");
    }
}

sub spreadstdin() {
    # read a record
    # Spawn a job and print the record to it.
    # Uses:
    #   $Global::blocksize
    #   STDIN
    #   $opt::r
    #   $Global::max_lines
    #   $Global::max_number_of_args
    #   $opt::regexp
    #   $Global::start_no_new_jobs
    #   $opt::roundrobin
    #   %Global::running
    # Returns: N/A

    my $buf = "";
    my ($recstart,$recend) = recstartrecend();
    my $recendrecstart = $recend.$recstart;
    my $chunk_number = 1;
    my $one_time_through;
    my $two_gb = 2**31-1;
    my $blocksize = int($Global::blocksize);
    my $in = *STDIN;
    my $timeout = $Global::blocktimeout;

    if($opt::skip_first_line) {
        my $newline;
        # Read a full line one byte at a time
        while(sysread($in,$newline,1,0)) {
            $newline eq "\n" and last;
        }
    }
    my $header = find_header(\$buf,$in);
    my $anything_written;
    my $eof;
    my $garbage_read;

    sub read_block() {
        # Read a --blocksize from STDIN
        # possibly interrupted by --blocktimeout
        # Add up to the next full block
        my $readsize = $blocksize - (length $buf) % $blocksize;
        my ($nread,$alarm);
        eval {
            local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
            # --blocktimeout (or 0 if not set)
            alarm $timeout;
            if($] >= 5.026) {
                do {
                    $nread = sysread $in, $buf, $readsize, length $buf;
                    $readsize -= $nread;
                } while($readsize and $nread);
            } else {
                # Less efficient reading, but 32-bit sysread compatible
                do {
                    $nread = sysread($in,substr($buf,length $buf,0),$readsize,0);
                    $readsize -= $nread;
                } while($readsize and $nread);
            }
            alarm 0;
        };
        if ($@) {
            die unless $@ eq "alarm\n";   # propagate unexpected errors
            $alarm = 1;
        } else {
            $alarm = 0;
        }
        $eof = not ($nread or $alarm);
    }

    sub pass_n_line_records() {
        # Pass records of N lines
        my $n_lines = $buf =~ tr/\n/\n/;
        my $last_newline_pos = rindex64(\$buf,"\n");
        # Go backwards until there are full n-line records
        while($n_lines % $Global::max_lines) {
            $n_lines--;
            $last_newline_pos = rindex64(\$buf,"\n",$last_newline_pos-1);
        }
        # Chop at $last_newline_pos as that is where n-line record ends
        $anything_written +=
            write_record_to_pipe($chunk_number++,\$header,\$buf,
                                 $recstart,$recend,$last_newline_pos+1);
        shorten(\$buf,$last_newline_pos+1);
    }

    sub pass_n_regexps() {
        # Pass records of N regexps
        # -N => (start..*?end){n}
        # -L -N => (start..*?end){n*l}
        if(not $garbage_read) {
            $garbage_read = 1;
            if($buf !~ /^$recstart/o) {
                # Buf does not start with $recstart => There is garbage.
                # Make a single record of the garbage
                if($buf =~
                   /(?s:^)(
                   (?:(?:(?!$recend$recstart)(?s:.))*?$recend)
                   )
                   # Followed by recstart
                   (?=$recstart)/mox and length $1 > 0) {
                    $anything_written +=
                        write_record_to_pipe($chunk_number++,\$header,\$buf,
                                             $recstart,$recend,length $1);
                    shorten(\$buf,length $1);
                }
            }
        }

        my $n_records =
            $Global::max_number_of_args * ($Global::max_lines || 1);
        # (?!negative lookahead) is needed to avoid backtracking
        # See: https://unix.stackexchange.com/questions/439356/
        # (?s:.) = (.|[\n]) but faster
        while($buf =~
              /(?s:^)(
              # n more times recstart.*recend
              (?:$recstart(?:(?!$recend$recstart)(?s:.))*?$recend){$n_records}
              )
              # Followed by recstart
              (?=$recstart)/mox and length $1 > 0) {
            $anything_written +=
                write_record_to_pipe($chunk_number++,\$header,\$buf,
                                     $recstart,$recend,length $1);
            shorten(\$buf,length $1);
        }
    }

    sub pass_regexp() {
        # Find the last recend-recstart in $buf
        $eof and return;
        # (?s:.) = (.|[\n]) but faster
        if($buf =~ /^((?s:.)*$recend)$recstart(?s:.)*?$/mox) {
            $anything_written +=
                write_record_to_pipe($chunk_number++,\$header,\$buf,
                                     $recstart,$recend,length $1);
            shorten(\$buf,length $1);
        }
    }

    sub pass_csv_record() {
        # Pass CVS record
        # We define a CSV record as an even number of " + end of line
        # This works if you use " as quoting character
        my $last_newline_pos = length $buf;
        # Go backwards from the last \n and search for a position
        # where there is an even number of "
        do {
            # find last EOL
            $last_newline_pos = rindex64(\$buf,"\n",$last_newline_pos-1);
            # While uneven "
        } while((substr($buf,0,$last_newline_pos) =~ y/"/"/)%2
                and $last_newline_pos >= 0);
        # Chop at $last_newline_pos as that is where CSV record ends
        $anything_written +=
            write_record_to_pipe($chunk_number++,\$header,\$buf,
                                 $recstart,$recend,$last_newline_pos+1);
        shorten(\$buf,$last_newline_pos+1);
    }

    sub pass_n() {
        # Pass n records of --recend/--recstart
        # -N => (start..*?end){n}
        my $i = 0;
        my $read_n_lines =
            $Global::max_number_of_args * ($Global::max_lines || 1);
            while(($i = nindex(\$buf,$recendrecstart,$read_n_lines)) != -1
                  and
                  length $buf) {
                $i += length $recend; # find the actual splitting location
                $anything_written +=
                    write_record_to_pipe($chunk_number++,\$header,\$buf,
                                         $recstart,$recend,$i);
                shorten(\$buf,$i);
            }
    }

    sub pass() {
        # Pass records of --recend/--recstart
        # Split record at fixed string
        # Find the last recend+recstart in $buf
        $eof and return;
        my $i = rindex64(\$buf,$recendrecstart);
        if($i != -1) {
            $i += length $recend; # find the actual splitting location
            $anything_written +=
                write_record_to_pipe($chunk_number++,\$header,\$buf,
                                     $recstart,$recend,$i);
            shorten(\$buf,$i);
        }
    }

    sub increase_blocksize_maybe() {
        if(not $anything_written
           and not $opt::blocktimeout
           and not $Global::no_autoexpand_block) {
            # Nothing was written - maybe the block size < record size?
            # Increase blocksize exponentially up to 2GB-1 (2GB causes problems)
            if($blocksize < $two_gb) {
                my $old_blocksize = $blocksize;
                $blocksize = ::min(ceil($blocksize * 1.3 + 1), $two_gb);
                ::warning("A record was longer than $old_blocksize. " .
                          "Increasing to --blocksize $blocksize.");
            }
        }
    }

    while(1) {
        $anything_written = 0;
        read_block();
        if($opt::r) {
            # Remove empty lines
            $buf =~ s/^\s*\n//gm;
            if(length $buf == 0) {
                if($eof) {
                    last;
                } else {
                    next;
                }
            }
        }
        if($Global::max_lines and not $Global::max_number_of_args) {
            # Pass n-line records
            pass_n_line_records();
        } elsif($opt::csv) {
            # Pass a full CSV record
            pass_csv_record();
        } elsif($opt::regexp) {
            # Split record at regexp
            if($Global::max_number_of_args) {
                pass_n_regexps();
            } else {
                pass_regexp();
            }
        } else {
            # Pass normal --recend/--recstart record
            if($Global::max_number_of_args) {
                pass_n();
            } else {
                pass();
            }
        }
        $eof and last;
        increase_blocksize_maybe();
        ::debug("init", "Round\n");
    }
    ::debug("init", "Done reading input\n");

    # If there is anything left in the buffer write it
    write_record_to_pipe($chunk_number++, \$header, \$buf, $recstart,
                         $recend, length $buf);

    if($opt::retries) {
        $Global::no_more_input = 1;
        # We need to start no more jobs: At most we need to retry some
        # of the already running.
        my @running = values %Global::running;
        # Stop any virgins.
        for my $job (@running) {
            if(defined $job and $job->virgin()) {
                close $job->fh(0,"w");
            }
        }
        # Wait for running jobs to be done
        my $sleep = 1;
        while($Global::total_running > 0) {
            $sleep = ::reap_usleep($sleep);
            start_more_jobs();
        }
    }
    $Global::start_no_new_jobs ||= 1;
    if($opt::roundrobin) {
        # Flush blocks to roundrobin procs
        my $sleep = 1;
        while(%Global::running) {
            my $something_written = 0;
            for my $job (values %Global::running) {
                if($job->block_length()) {
                    $something_written += $job->non_blocking_write();
                } else {
                    close $job->fh(0,"w");
                }
            }
            if($something_written) {
                $sleep = $sleep/2+0.001;
            }
            $sleep = ::reap_usleep($sleep);
        }
    }
}

sub recstartrecend() {
    # Uses:
    #   $opt::recstart
    #   $opt::recend
    # Returns:
    #   $recstart,$recend with default values and regexp conversion
    my($recstart,$recend);
    if(defined($opt::recstart) and defined($opt::recend)) {
        # If both --recstart and --recend is given then both must match
        $recstart = $opt::recstart;
        $recend = $opt::recend;
    } elsif(defined($opt::recstart)) {
        # If --recstart is given it must match start of record
        $recstart = $opt::recstart;
        $recend = "";
    } elsif(defined($opt::recend)) {
        # If --recend is given then it must match end of record
        $recstart = "";
        $recend = $opt::recend;
        if($opt::regexp and $recend eq '') {
            # --regexp --recend ''
            $recend = '(?s:.)';
        }
    }

    if($opt::regexp) {
        # Do not allow /x comments - to avoid having to quote space
        $recstart = "(?-x:".$recstart.")";
        $recend = "(?-x:".$recend.")";
        # If $recstart/$recend contains '|'
        # the | should only apply to the regexp
        $recstart = "(?:".$recstart.")";
        $recend = "(?:".$recend.")";
    } else {
        # $recstart/$recend = printf strings (\n)
        $recstart =~ s/\\([0rnt\'\"\\])/"qq|\\$1|"/gee;
        $recend =~ s/\\([0rnt\'\"\\])/"qq|\\$1|"/gee;
    }
    return ($recstart,$recend);
}

sub nindex($$) {
    # See if string is in buffer N times
    # Returns:
    #   the position where the Nth copy is found
    my ($buf_ref, $str, $n) = @_;
    my $i = 0;
    for(1..$n) {
        $i = index64($buf_ref,$str,$i+1);
        if($i == -1) { last }
    }
    return $i;
}

{
    my @robin_queue;
    my $sleep = 1;

    sub round_robin_write($$$$$) {
        # Input:
        #   $header_ref = ref to $header string
        #   $block_ref = ref to $block to be written
        #   $recstart = record start string
        #   $recend = record end string
        #   $endpos = end position of $block
        # Uses:
        #   %Global::running
        # Returns:
        #   $something_written = amount of bytes written
        my ($header_ref,$buffer_ref,$recstart,$recend,$endpos) = @_;
        my $written = 0;
        my $block_passed = 0;
        while(not $block_passed) {
            # Continue flushing existing buffers
            # until one is empty and a new block is passed
            if(@robin_queue) {
                # Rotate queue once so new blocks get a fair chance
                # to be given to another slot
                push @robin_queue, shift @robin_queue;
            } else {
                # Make a queue to spread the blocks evenly
                push @robin_queue, (sort { $a->seq() <=> $b->seq() }
                                    values %Global::running);
            }
            do {
                $written = 0;
                for my $job (@robin_queue) {
                    if($job->block_length() > 0) {
                        $written += $job->non_blocking_write();
                    } else {
                        $job->set_block($header_ref, $buffer_ref,
                                        $endpos, $recstart, $recend);
                        $block_passed = 1;
                        $written += $job->non_blocking_write();
                        last;
                    }
                }
                if($written) {
                    $sleep = $sleep/1.5+0.001;
                }
                # Don't sleep if something is written
            } while($written and not $block_passed);
            $sleep = ::reap_usleep($sleep);
        }
        return $written;
    }
}

sub index64($$$) {
    # Do index on strings > 2GB.
    # index in Perl < v5.22 does not work for > 2GB
    # Input:
    #   as index except STR which must be passed as a reference
    # Output:
    #   as index
    my $ref = shift;
    my $match = shift;
    my $pos = shift || 0;
    my $max2gb = 2**31-1;
    my $strlen = length($$ref);
    # No point in doing extra work if we don't need to.
    if($strlen < $max2gb or $] > 5.022) {
        return index($$ref, $match, $pos);
    }

    my $matchlen = length($match);
    my $ret;
    my $offset = $pos;
    while($offset < $strlen) {
        $ret = index(
            substr($$ref, $offset, $max2gb),
            $match, $pos-$offset);
        if($ret != -1) {
            return $ret + $offset;
        }
        $offset += ($max2gb - $matchlen - 1);
    }
    return -1;
}

sub rindex64($@) {
    # Do rindex on strings > 2GB.
    # rindex in Perl < v5.22 does not work for > 2GB
    # Input:
    #   as rindex except STR which must be passed as a reference
    # Output:
    #   as rindex
    my $ref = shift;
    my $match = shift;
    my $pos = shift;
    my $block_size = 2**31-1;
    my $strlen = length($$ref);
    # Default: search from end
    $pos = defined $pos ? $pos : $strlen;
    # No point in doing extra work if we don't need to.
    if($strlen < $block_size or $] > 5.022) {
        return rindex($$ref, $match, $pos);
    }

    my $matchlen = length($match);
    my $ret;
    my $offset = $pos - $block_size + $matchlen;
    if($offset < 0) {
        # The offset is less than a $block_size
        # Set the $offset to 0 and
        # Adjust block_size accordingly
        $block_size = $block_size + $offset;
        $offset = 0;
    }
    while($offset >= 0) {
        $ret = rindex(
            substr($$ref, $offset, $block_size),
            $match);
        if($ret != -1) {
            return $ret + $offset;
        }
        $offset -= ($block_size - $matchlen - 1);
    }
    return -1;
}

sub shorten($$) {
    # Do: substr($buf,0,$i) = "";
    # Some Perl versions do not support $i > 2GB, so do this in 2GB chunks
    # Input:
    #   $buf_ref = \$buf
    #   $i = position to shorten to
    # Returns: N/A
    my ($buf_ref, $i) = @_;
    my $two_gb = 2**31-1;
    while($i > $two_gb) {
        substr($$buf_ref,0,$two_gb) = "";
        $i -= $two_gb;
    }
    substr($$buf_ref,0,$i) = "";
}

sub write_record_to_pipe($$$$$$) {
    # Fork then
    # Write record from pos 0 .. $endpos to pipe
    # Input:
    #   $chunk_number = sequence number - to see if already run
    #   $header_ref = reference to header string to prepend
    #   $buffer_ref = reference to record to write
    #   $recstart = start string of record
    #   $recend = end string of record
    #   $endpos = position in $buffer_ref where record ends
    # Uses:
    #   $Global::job_already_run
    #   $opt::roundrobin
    #   @Global::virgin_jobs
    # Returns:
    #   Number of chunks written (0 or 1)
    my ($chunk_number, $header_ref, $buffer_ref,
        $recstart, $recend, $endpos) = @_;
    if($endpos == 0) { return 0; }
    if(vec($Global::job_already_run,$chunk_number,1)) { return 1; }
    if($opt::roundrobin) {
        # Write the block to one of the already running jobs
        return round_robin_write($header_ref, $buffer_ref,
                                 $recstart, $recend, $endpos);
    }
    # If no virgin found, backoff
    my $sleep = 0.0001; # 0.01 ms - better performance on highend
    while(not @Global::virgin_jobs) {
        ::debug("pipe", "No virgin jobs");
        $sleep = ::reap_usleep($sleep);
        # Jobs may not be started because of loadavg
        # or too little time between each ssh login
        # or retrying failed jobs.
        start_more_jobs();
    }
    my $job = shift @Global::virgin_jobs;
    $job->set_block($header_ref, $buffer_ref, $endpos, $recstart, $recend);
    $job->write_block();
    return 1;
}


sub __SEM_MODE__() {}


sub acquire_semaphore() {
    # Acquires semaphore. If needed: spawns to the background
    # Uses:
    #   @Global::host
    # 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();
    if($Semaphore::fg) {
        # skip
    } else {
        if(fork()) {
            exit(0);
        } else {
            # If run in the background, the PID will change
            $sem->pid_change();
        }
    }
    return $sem;
}


sub __PARSE_OPTIONS__() {}

sub shell_completion() {
    if($opt::shellcompletion eq "zsh") {
        # if shell == zsh
        zsh_competion();
    } elsif($opt::shellcompletion eq "bash") {
        # if shell == bash
        bash_competion();
    } elsif($opt::shellcompletion eq "auto") {
        if($Global::shell =~ m:/zsh$|^zsh$:) {
            # if shell == zsh
            zsh_competion();
        } elsif($Global::shell =~ m:/bash$|^bash$:) {
            # if shell == bash
            bash_competion();
        } else {
            ::error("--shellcompletion is not implemented for ".
                    "'$Global::shell'.");
            wait_and_exit(255);
        }
    } else {
        ::error("--shellcompletion is not implemented for ".
                "'$opt::shellcompletion'.");
        wait_and_exit(255);
    }
}

sub bash_competion() {
    # Print:
    #   complete -F _comp_parallel parallel;
    #   _comp_parallel() {
    #     COMPREPLY=($(compgen -W "--options" --
    #                    "${COMP_WORDS[$COMP_CWORD]}"));
    #   };
    my @bash_completion =
        ("complete -F _comp_parallel parallel;",
         '_comp_parallel() { COMPREPLY=($(compgen -W "');
    my @och = options_completion_hash();
    while(@och) {
        $_ = shift @och;
        # Split input like:
        # "joblog|jl=s[Logfile for executed jobs]:logfile:_files"
        if(/^(.*?)(\[.*?])?(:[^:]*)?(:.*)?$/) {
            my $opt = $1;
            my $desc = $2;
            my $argdesc = $3;
            my $func = $4;
            # opt=s => opt
            $opt =~ s/[:=].$//;
            if($opt =~ /^_/) {
                # internal options start with --_
                # skip
            } else {
                push @bash_completion,
                    (map { (length $_ == 1) ? "-$_ " : "--$_ " }
                     split /\|/, $opt);
            }
        }
        shift @och;
    }
    push @bash_completion,'" -- "${COMP_WORDS[$COMP_CWORD]}")); };'."\n";
    print @bash_completion;
}

sub zsh_competion() {
    # Print code used for completion in zsh
    my @zsh_completion =
        ("compdef _comp_parallel parallel; ",
         "setopt localoptions extended_glob; ",
         "_comp_parallel() { ",
         "_arguments ");
    my @och = options_completion_hash();
    while(@och) {
        $_ = shift @och;
        # Split input like:
        # "joblog|jl=s[Logfile for executed jobs]:logfile:_files"
        if(/^(.*?)(\[.*?])?(:[^:]*)?(:.*)?$/) {
            my $opt = $1;
            my $desc = $2;
            my $argdesc = $3;
            my $func = $4;
            # opt=s => opt
            $opt =~ s/[:=].$//;
            if($opt =~ /^_/) {
                # internal options start with --_
                # skip
            } else {
                # {-o,--option}
                my $zsh_opt = join(",",
                                   (map { (length $_ == 1) ? "-$_" : "--$_" }
                                    split /\|/, $opt));
                if($zsh_opt =~ /,/) { $zsh_opt = "{$zsh_opt}"; }
                $desc =~ s/'/'"'"'/g;
                $argdesc =~ s/'/'"'"'/g;
                $func =~ s/'/'"'"'/g;
                push @zsh_completion, $zsh_opt."'".$desc.$argdesc.$func."' ";
            }
        }
        shift @och;
    }
    push @zsh_completion,
        q{'(-)1:command:{_command_names -e}' },
        q{'*::arguments:_normal'},
        "};\n";
    print @zsh_completion;
}

sub options_hash() {
    # Returns:
    #   %hash = for GetOptions
    my %och = options_completion_hash();
    my %oh;
    my ($k,$v);
    while(($k,$v) = each %och) {
        # Remove description
        $k =~ s/\[.*//;
        $oh{$k} = $v;
    }
    return %oh;
}

sub options_completion_hash() {
    # Returns:
    #   %hash = for GetOptions and shell completion
    return
        ("debug|D=s" => \$opt::D,
         "xargs[Insert as many arguments as the command line length permits]"
         => \$opt::xargs,
         "m[Multiple arguments]" => \$opt::m,
         ("X[Insert as many arguments with context as the command line ".
         "length permits]"
         => \$opt::X),
         "v[Verbose]" => \@opt::v,
         "sql=s[Use --sql-master instead (obsolete)]:DBURL" => \$opt::retired,
         ("sql-master|sqlmaster=s".
          "[Submit jobs via SQL server. DBURL must point to a table, which ".
          "will contain --joblog, the values, and output]:DBURL"
          => \$opt::sqlmaster),
         ("sql-worker|sqlworker=s".
          "[Execute jobs via SQL server. Read the input sources variables ".
          "from the table pointed to by DBURL.]:DBURL"
          => \$opt::sqlworker),
         ("sql-and-worker|sqlandworker=s".
          "[--sql-master DBURL --sql-worker DBURL]:DBURL"
          => \$opt::sqlandworker),
         ("joblog|jl=s[Logfile for executed jobs]:logfile:_files"
          => \$opt::joblog),
         ("results|result|res=s[Save the output into files]:name:_files"
          => \$opt::results),
         "resume[Resumes from the last unfinished job]" => \$opt::resume,
         ("resume-failed|resumefailed".
          "[Retry all failed and resume from the last unfinished job]"
          => \$opt::resume_failed),
         ("retry-failed|retryfailed[Retry all failed jobs in joblog]"
          => \$opt::retry_failed),
         "silent[Silent]" => \$opt::silent,
         ("keep-order|keeporder|k".
          "[Keep sequence of output same as the order of input]"
          => \$opt::keeporder),
         ("no-keep-order|nokeeporder|nok|no-k".
          "[Overrides an earlier --keep-order (e.g. if set in ".
          "~/.parallel/config)]"
          => \$opt::nokeeporder),
         "group[Group output]" => \$opt::group,
         "g" => \$opt::retired,
         ("ungroup|u".
          "[Output is printed as soon as possible and bypasses GNU parallel ".
          "internal processing]"
          => \$opt::ungroup),
         ("latest-line|latestline|ll".
          "[Print latest line of each job]"
          => \$opt::latestline),
         ("line-buffer|line-buffered|linebuffer|linebuffered|lb".
          "[Buffer output on line basis]"
          => \$opt::linebuffer),
         ("tmux".
          "[Use tmux for output. Start a tmux session and run each job in a ".
          "window in that session. No other output will be produced]"
          => \$opt::tmux),
         ("tmux-pane|tmuxpane".
          "[Use tmux for output but put output into panes in the first ".
          "window.  Useful if you want to monitor the progress of less than ".
          "100 concurrent jobs]"
          => \$opt::tmuxpane),
         "null|0[Use NUL as delimiter]" => \$opt::null,
         "quote|q[Quote command]" => \$opt::quote,
         # Replacement strings
         ("parens=s[Use parensstring instead of {==}]:parensstring"
          => \$opt::parens),
         ('rpl=s[Define replacement string]:"tag perl expression"'
          => \@opt::rpl),
         "plus[Add more replacement strings]" => \$opt::plus,
         ("I=s".
          "[Use the replacement string replace-str instead of {}]:replace-str"
          => \$opt::I),
         ("extensionreplace|er=s".
          "[Use the replacement string replace-str instead of {.} for input ".
          "line without extension]:replace-str"
          => \$opt::U),
         "U=s" => \$opt::retired,
         ("basenamereplace|bnr=s".
          "[Use the replacement string replace-str instead of {/} for ".
          "basename of input line]:replace-str"
          => \$opt::basenamereplace),
         ("dirnamereplace|dnr=s".
          "[Use the replacement string replace-str instead of {//} for ".
          "dirname of input line]:replace-str"
          => \$opt::dirnamereplace),
         ("basenameextensionreplace|bner=s".
          "[Use the replacement string replace-str instead of {/.} for ".
          "basename of input line without extension]:replace-str"
          => \$opt::basenameextensionreplace),
         ("seqreplace=s".
          "[Use the replacement string replace-str instead of {#} for job ".
          "sequence number]:replace-str"
          => \$opt::seqreplace),
         ("slotreplace=s".
          "[Use the replacement string replace-str instead of {%} for job ".
          "slot number]:replace-str"
          => \$opt::slotreplace),
         ("delay=s".
          "[Delay starting next job by duration]:duration" => \$opt::delay),
         ("ssh-delay|sshdelay=f".
          "[Delay starting next ssh by duration]:duration"
          => \$opt::sshdelay),
         ("load=s".
          "[Only start jobs if load is less than max-load]:max-load"
          => \$opt::load),
         "noswap[Do not start job is computer is swapping]" => \$opt::noswap,
         ("max-line-length-allowed|maxlinelengthallowed".
          "[Print maximal command line length]"
          => \$opt::max_line_length_allowed),
         ("number-of-cpus|numberofcpus".
          "[Print the number of physical CPU cores and exit (obsolete)]"
          => \$opt::number_of_cpus),
         ("number-of-sockets|numberofsockets".
          "[Print the number of CPU sockets and exit]"
          => \$opt::number_of_sockets),
         ("number-of-cores|numberofcores".
          "[Print the number of physical CPU cores and exit]"
          => \$opt::number_of_cores),
         ("number-of-threads|numberofthreads".
          "[Print the number of hyperthreaded CPU cores and exit]"
          => \$opt::number_of_threads),
         ("use-sockets-instead-of-threads|usesocketsinsteadofthreads".
          "[Determine how GNU Parallel counts the number of CPUs]"
          => \$opt::use_sockets_instead_of_threads),
         ("use-cores-instead-of-threads|usecoresinsteadofthreads".
          "[Determine how GNU Parallel counts the number of CPUs]"
          => \$opt::use_cores_instead_of_threads),
         ("use-cpus-instead-of-cores|usecpusinsteadofcores".
          "[Determine how GNU Parallel counts the number of CPUs]"
          => \$opt::use_cpus_instead_of_cores),
         ("shell-quote|shellquote|shell_quote".
          "[Does not run the command but quotes it. Useful for making ".
          "quoted composed commands for GNU parallel]"
          => \@opt::shellquote),
         ('nice=i[Run the command at this niceness]:niceness:($(seq -20 19))'
          => \$opt::nice),
         "tag[Tag lines with arguments]" => \$opt::tag,
         ("tag-string|tagstring=s".
          "[Tag lines with a string]:str" => \$opt::tagstring),
         "ctag[Color tag]:str" => \$opt::ctag,
         "ctag-string|ctagstring=s[Colour tagstring]:str" => \$opt::ctagstring,
         "color|colour[Colourize output]" => \$opt::color,
         ("color-failed|colour-failed|colorfailed|colourfailed|".
          "color-fail|colour-fail|colorfail|colourfail|cf".
          "[Colour failed jobs red]"
          => \$opt::colorfailed),
         ("onall[Run all the jobs on all computers given with --sshlogin]"
          => \$opt::onall),
         "nonall[--onall with no arguments]" => \$opt::nonall,
         ("filter-hosts|filterhosts|filter-host[Remove down hosts]"
          => \$opt::filter_hosts),
         ('sshlogin|S=s'.
          '[Distribute jobs to remote computers]'.
          ':[@hostgroups/][ncpus/]sshlogin'.
          '[,[@hostgroups/][ncpus/]sshlogin[,...]] or @hostgroup'.
          ':_users') => \@opt::sshlogin,
         ("sshloginfile|slf=s".
          "[File with sshlogins on separate lines. Lines starting with '#' ".
          "are ignored.]:filename:_files"
          => \@opt::sshloginfile),
         ("controlmaster|M".
          "[Use ssh's ControlMaster to make ssh connections faster]"
          => \$opt::controlmaster),
         ("ssh=s".
          "[Use this command instead of ssh for remote access]:sshcommand"
          => \$opt::ssh),
         ("transfer-file|transferfile|transfer-files|transferfiles|tf=s".
          "[Transfer filename to remote computers]:filename:_files"
          => \@opt::transfer_files),
         ("return=s[Transfer files from remote computers]:filename:_files"
          => \@opt::return),
         ("trc=s[--transfer --return filename --cleanup]:filename:_files"
          => \@opt::trc),
         "transfer[Transfer files to remote computers]" => \$opt::transfer,
         "cleanup[Remove transferred files]" => \$opt::cleanup,
         ("basefile|bf=s".
          "[Transfer file to each sshlogin before first job is started]".
          ":file:_files"
          => \@opt::basefile),
         ("template|tmpl=s".
          "[Replace replacement strings in file and save it in repl]".
          ":file=repl:_files"
          => \%opt::template),
         "B=s" => \$opt::retired,
         "ctrl-c|ctrlc" => \$opt::retired,
         "no-ctrl-c|no-ctrlc|noctrlc" => \$opt::retired,
         ("work-dir|workdir|wd=s".
          "[Jobs will be run in the dir mydir. (default: the current dir ".
          "for the local machine, the login dir for remote computers)]".
          ":mydir:_cd"
          => \$opt::workdir),
         "W=s" => \$opt::retired,
         ("rsync-opts|rsyncopts=s[Options to pass on to rsync]:options"
          => \$opt::rsync_opts),
         ("tmpdir|tempdir=s[Directory for temporary files]:dirname:_cd"
          => \$opt::tmpdir),
         ("use-compress-program|compress-program|".
          "usecompressprogram|compressprogram=s".
          "[Use prg for compressing temporary files]:prg:_commands"
          => \$opt::compress_program),
         ("use-decompress-program|decompress-program|".
          "usedecompressprogram|decompressprogram=s".
          "[Use prg for decompressing temporary files]:prg:_commands"
          => \$opt::decompress_program),
         "compress[Compress temporary files]" => \$opt::compress,
         "open-tty|o[Open terminal tty]" => \$opt::open_tty,
         "tty[Open terminal tty]" => \$opt::tty,
         "T" => \$opt::retired,
         "H=i" => \$opt::retired,
         ("dry-run|dryrun|dr".
          "[Print the job to run on stdout (standard output), but do not ".
          "run the job]"
          => \$opt::dryrun),
         "progress[Show progress of computations]" => \$opt::progress,
         ("eta[Show the estimated number of seconds before finishing]"
          => \$opt::eta),
         "bar[Show progress as a progress bar]" => \$opt::bar,
         ("total-jobs|totaljobs|total=s".
          "[Set total number of jobs]" => \$opt::totaljobs),
         "shuf[Shuffle jobs]" => \$opt::shuf,
         ("arg-sep|argsep=s".
          "[Use sep-str instead of ::: as separator string]:sep-str"
          => \$opt::arg_sep),
         ("arg-file-sep|argfilesep=s".
          "[Use sep-str instead of :::: as separator string ".
          "between command and argument files]:sep-str"
          => \$opt::arg_file_sep),
         ('trim=s[Trim white space in input]:trim_method:'.
          '((n\:"No trim" l\:"Left\ trim" r\:"Right trim" '.
          'lr\:"Both trim" rl\:"Both trim"))'
          => \$opt::trim),
         "env=s[Copy environment variable var]:var:_vars" => \@opt::env,
         "recordenv|record-env[Record environment]" => \$opt::record_env,
         ('session'.
          '[Record names in current environment in $PARALLEL_IGNORED_NAMES '.
          'and exit. Only used with env_parallel. '.
          'Aliases, functions, and variables with names i]'
          => \$opt::session),
         ('plain[Ignore --profile, $PARALLEL, and ~/.parallel/config]'
          => \$opt::plain),
         ("profile|J=s".
          "[Use profile profilename for options]:profilename:_files"
          => \@opt::profile),
         "tollef" => \$opt::tollef,
         "gnu[Behave like GNU parallel]" => \$opt::gnu,
         "link|xapply[Link input sources]" => \$opt::link,
         "linkinputsource|xapplyinputsource=i" => \@opt::linkinputsource,
         # Before changing these lines, please read
         # https://www.gnu.org/software/parallel/parallel_design.html#citation-notice
         # https://git.savannah.gnu.org/cgit/parallel.git/tree/doc/citation-notice-faq.txt
         # You accept to be put in a public hall-of-shame by removing
         # these lines
         ("bibtex|citation".
          "[Print the citation notice and BibTeX entry for GNU parallel, ".
          "silence citation notice for all future runs, and exit. ".
          "It will not run any commands]"
          => \$opt::citation),
         "will-cite|willcite|nn|nonotice|no-notice" => \$opt::willcite,
         # Termination and retries
         ('halt-on-error|haltonerror|halt=s'.
          '[When should GNU parallel terminate]'.
          ':when:((now\:"kill all running jobs and halt immediately" '.
          'soon\:"wait for all running jobs to complete, start no new jobs"))'
          => \$opt::halt),
         'limit=s[Dynamic job limit]:"command args"' => \$opt::limit,
         ("memfree=s".
          "[Minimum memory free when starting another job]:size"
          => \$opt::memfree),
         ("memsuspend=s".
          "[Suspend jobs when there is less memory available]:size"
          => \$opt::memsuspend),
         "retries=s[Try failing jobs n times]:n" => \$opt::retries,
         ("timeout=s".
          "[Time out for command. If the command runs for longer than ".
          "duration seconds it will get killed as per --term-seq]:duration"
          => \$opt::timeout),
         ("term-seq|termseq=s".
          "[Termination sequence]:sequence" => \$opt::termseq),
         # xargs-compatibility - implemented, man, testsuite
         ("max-procs|maxprocs|P|jobs|j=s".
          "[Add N to/Subtract N from/Multiply N% with/ the number of CPU ".
          "threads or read parameter from file]:+N/-N/N%/N/procfile:_files"
          => \$opt::jobs),
         ("delimiter|d=s[Input items are terminated by delim]:delim"
          => \$opt::d),
         ("max-chars|maxchars|s=s[Limit length of command]:max-chars"
          => \$opt::max_chars),
         ("arg-file|argfile|a=s".
          "[Use input-file as input source]:input-file:_files" => \@opt::a),
         "no-run-if-empty|norunifempty|r[Do not run empty input]" => \$opt::r,
         ("replace|i:s".
          "[This option is deprecated; use -I instead]:replace-str"
          => \$opt::i),
         "E=s" => \$opt::eof,
         ("eof|e:s[Set the end of file string to eof-str]:eof-str"
          => \$opt::eof),
         ("process-slot-var|processslotvar=s".
          "[Set this variable to job slot number]:varname"
          => \$opt::process_slot_var),
         ("max-args|maxargs|n=s".
          "[Use at most max-args arguments per command line]:max-args"
          => \$opt::max_args),
         ("max-replace-args|maxreplaceargs|N=s".
          "[Use at most max-args arguments per command line]:max-args"
          => \$opt::max_replace_args),
         "col-sep|colsep|C=s[Column separator]:regexp" => \$opt::colsep,
         "csv[Treat input as CSV-format]"=> \$opt::csv,
         ("help|h[Print a summary of the options to GNU parallel and exit]"
          => \$opt::help),
         ("L=s[When used with --pipe: Read records of recsize]:recsize"
          => \$opt::L),
         ("max-lines|maxlines|l:f".
          "[When used with --pipe: Read records of recsize lines]:recsize"
          => \$opt::max_lines),
         "interactive|p[Ask user before running a job]" => \$opt::interactive,
         ("verbose|t[Print the job to be run on stderr (standard error)]"
          => \$opt::verbose),
         ("version|V[Print the version GNU parallel and exit]"
          => \$opt::version),
         ('min-version|minversion=i'.
          '[Print the version GNU parallel and exit]'.
          ':version:($(parallel --minversion 0))'
          => \$opt::minversion),
         ("show-limits|showlimits".
          "[Display limits given by the operating system]"
          => \$opt::show_limits),
         ("exit|x[Exit if the size (see the -s option) is exceeded]"
          => \$opt::x),
         # Semaphore
         "semaphore[Work as a counting semaphore]" => \$opt::semaphore,
         ("semaphore-timeout|semaphoretimeout|st=s".
          "[If secs > 0: If the semaphore is not released within secs ".
          "seconds, take it anyway]:secs"
          => \$opt::semaphoretimeout),
         ("semaphore-name|semaphorename|id=s".
          "[Use name as the name of the semaphore]:name"
          => \$opt::semaphorename),
         "fg[Run command in foreground]" => \$opt::fg,
         "bg[Run command in background]" => \$opt::bg,
         "wait[Wait for all commands to complete]" => \$opt::wait,
         # Shebang #!/usr/bin/parallel --shebang
         ("shebang|hashbang".
          "[GNU parallel can be called as a shebang (#!) command as the ".
          "first line of a script. The content of the file will be treated ".
          "as inputsource]"
          => \$opt::shebang),
         ("_pipe-means-argfiles[internal]"
          => \$opt::_pipe_means_argfiles),
         "Y" => \$opt::retired,
         ("skip-first-line|skipfirstline".
          "[Do not use the first line of input]"
          => \$opt::skip_first_line),
         "_bug" => \$opt::_bug,
         "_unsafe" => \$opt::_unsafe,
         # --pipe
         ("pipe|spreadstdin".
          "[Spread input to jobs on stdin (standard input)]" => \$opt::pipe),
         ("round-robin|roundrobin|round".
          "[Distribute chunks of standard input in a round robin fashion]"
          => \$opt::roundrobin),
         "recstart=s" => \$opt::recstart,
         ("recend=s".
          "[Split record between endstring and startstring]:endstring"
          => \$opt::recend),
         ("regexp|regex".
          "[Interpret --recstart and --recend as regular expressions]"
          => \$opt::regexp),
         ("remove-rec-sep|removerecsep|rrs".
          "[Remove record separator]" => \$opt::remove_rec_sep),
         ("output-as-files|outputasfiles|files[Save output to files]"
          => \$opt::files),
         ("output-as-files0|outputasfiles0|files0".
          "[Save output to files separated by NUL]"
          => \$opt::files0),
         ("block-size|blocksize|block=s".
          "[Size of block in bytes to read at a time]:size"
          => \$opt::blocksize),
         ("block-timeout|blocktimeout|bt=s".
          "[Timeout for reading block when using --pipe]:duration"
          => \$opt::blocktimeout),
         "header=s[Use regexp as header]:regexp" => \$opt::header,
         "cat[Create a temporary file with content]" => \$opt::cat,
         "fifo[Create a temporary fifo with content]" => \$opt::fifo,
         ("pipe-part|pipepart[Pipe parts of a physical file]"
          => \$opt::pipepart),
         "tee[Pipe all data to all jobs]" => \$opt::tee,
         ("shard=s".
          "[Use shardexpr as shard key and shard input to the jobs]:shardexpr"
          => \$opt::shard),
         ("bin=s".
          "[Use binexpr as binning key and bin input to the jobs]:binexpr"
          => \$opt::bin),
         "group-by|groupby=s[Group input by value]:val" => \$opt::groupby,
         #
         ("hgrp|hostgrp|hostgroup|hostgroups[Enable hostgroups on arguments]"
          => \$opt::hostgroups),
         "embed[Embed GNU parallel in a shell script]" => \$opt::embed,
         ("filter=s[Only run jobs where filter is true]:filter"
          => \@opt::filter),
         "combineexec|combine-exec|combineexecutable|combine-executable=s".
         "[Embed GNU parallel in a shell script]" => \$opt::combineexec,
         ("filter=s[Only run jobs where filter is true]:filter"
          => \@opt::filter),
         "_parset=s[Generate shell code for parset]" => \$opt::_parset,
         ("shell-completion|shellcompletion=s".
          "[Generate shell code for shell completion]:shell:(bash zsh)"
          => \$opt::shellcompletion),
         # Parameter for testing optimal values
         "_test=s" => \$opt::_test,
        );
}

sub get_options_from_array($@) {
    # Run GetOptions on @array
    # Input:
    #   $array_ref = ref to @ARGV to parse
    #   @keep_only = Keep only these options (e.g. --profile)
    # Uses:
    #   @ARGV
    # Returns:
    #   true if parsing worked
    #   false if parsing failed
    #   @$array_ref is changed
    my ($array_ref, @keep_only) = @_;
    if(not @$array_ref) {
        # Empty array: No need to look more at that
        return 1;
    }
    # 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};
    }
    # If @keep_only set: Ignore all values except @keep_only
    my %options = options_hash();
    if(@keep_only) {
        my (%keep,@dummy);
        @keep{@keep_only} = @keep_only;
        for my $k (grep { not $keep{$_} } keys %options) {
            # Store the value of the option in @dummy
            $options{$k} = \@dummy;
        }
    }
    my $retval = GetOptions(%options);
    if(not $this_is_ARGV) {
        @{$array_ref} = @::ARGV;
        @::ARGV = @save_argv;
    }
    return $retval;
}

sub parse_parset() {
    $Global::progname = "parset";
    @Global::parset_vars = split /[ ,]/, $opt::_parset;
    my $var_or_assoc = shift @Global::parset_vars;
    # Legal names: var _v2ar arrayentry[2]
    my @illegal = (grep { not /^[a-zA-Z_][a-zA-Z_0-9]*(\[\d+\])?$/ }
                   @Global::parset_vars);
    if(@illegal) {
        ::error
            ("@illegal is an invalid variable name.",
             "Variable names must be letter followed by letters or digits.",
             "Usage:",
             "  parset varname GNU Parallel options and command");
        wait_and_exit(255);
    }
    if($var_or_assoc eq "assoc") {
        my $var = shift @Global::parset_vars;
        print "$var=(";
        $Global::parset = "assoc";
        $Global::parset_endstring=")\n";
    } elsif($var_or_assoc eq "var") {
        if($#Global::parset_vars > 0) {
            $Global::parset = "var";
        } else {
            my $var = shift @Global::parset_vars;
            print "$var=(";
            $Global::parset = "array";
            $Global::parset_endstring=")\n";
        }
    } else {
        ::die_bug("parset: unknown '$opt::_parset'");
    }
}

sub parse_options(@) {
    # Returns: N/A
    init_globals();
    my @argv_before = @ARGV;
    @ARGV = read_options();
    # Before changing these line, please read
    # https://www.gnu.org/software/parallel/parallel_design.html#citation-notice
    # https://git.savannah.gnu.org/cgit/parallel.git/tree/doc/citation-notice-faq.txt
    # You accept to be added to a public hall-of-shame by removing the lines
    if(defined $opt::citation) {
        citation(\@argv_before,\@ARGV);
        wait_and_exit(0);
    }
    # no-* overrides *
    if($opt::nokeeporder) { $opt::keeporder = undef; }

    if(@opt::v) { $Global::verbose = $#opt::v+1; } # Convert -v -v to v=2
    if($opt::_bug) { ::die_bug("test-bug"); }
    $Global::debug = $opt::D;
    #
    ## Shell
    #
    $Global::shell = $ENV{'PARALLEL_SHELL'} || parent_shell($$)
        || $ENV{'SHELL'} || "/bin/sh";
    if(not -x $Global::shell and not which($Global::shell)) {
        ::error("Shell '$Global::shell' not found.");
        wait_and_exit(255);
    }
    ::debug("init","Global::shell $Global::shell\n");
    $Global::cshell = $Global::shell =~ m:(/[-a-z]*)?csh:;
    $Global::fish = $Global::shell =~ m:(/[-a-z]*)?fish:;
    if(defined $opt::_parset) { parse_parset(); }
    if(defined $opt::X) { $Global::ContextReplace = 1; }
    if(defined $opt::silent) { $Global::verbose = 0; }
    if(defined $opt::null) { $/ = "\0"; }
    if(defined $opt::files) { $Global::files = 1; $Global::files_sep = "\n"; }
    if(defined $opt::files0) { $Global::files = 1; $Global::files_sep = "\0"; }
    if(defined $opt::d) { $/ = unquote_printf($opt::d) }
    parse_replacement_string_options();
    $opt::tag ||= $opt::ctag;
    $opt::tagstring ||= $opt::ctagstring;
    if(defined $opt::ctag or defined $opt::ctagstring
        or defined $opt::color) {
        $Global::color = 1;
    }
    if($opt::linebuffer or $opt::latestline) {
        $Global::linebuffer = 1;
        Job::latestline_init();
    }
    if(defined $opt::tag and not defined $opt::tagstring) {
        # Default = {}
        $opt::tagstring = $Global::parensleft.$Global::parensright;
    }
    if(defined $opt::tagstring) {
        $opt::tagstring = unquote_printf($opt::tagstring);
        if($opt::tagstring =~
           /\Q$Global::parensleft\E.*\S+.*\Q$Global::parensright\E/
           and
           $Global::linebuffer) {
            # --tagstring contains {= ... =} and --linebuffer =>
            #   recompute replacement string for each use (do not cache)
            $Global::cache_replacement_eval = 0;
        }
    }
    if(defined $opt::interactive) { $Global::interactive = $opt::interactive; }
    if(defined $opt::quote) { $Global::quoting = 1; }
    if(defined $opt::r) { $Global::ignore_empty = 1; }
    if(defined $opt::verbose) { $Global::stderr_verbose = 1; }
    if(defined $opt::eof) { $Global::end_of_file_string = $opt::eof; }
    if(defined $opt::max_args) {
        $opt::max_args = multiply_binary_prefix($opt::max_args);
        $Global::max_number_of_args = $opt::max_args;
        if($opt::pipepart and $opt::groupby) { $Global::max_number_of_args = 1; }
    }
    if(defined $opt::blocktimeout) {
        $Global::blocktimeout = int(multiply_time_units($opt::blocktimeout));
        if($Global::blocktimeout < 1) {
            ::error("--block-timeout must be at least 1");
            wait_and_exit(255);
        }
    }
    if(defined $opt::timeout) {
        $Global::timeoutq = TimeoutQueue->new($opt::timeout);
    }
    if(defined $opt::tmpdir) { $ENV{'TMPDIR'} = $opt::tmpdir; }
    $ENV{'PARALLEL_RSYNC_OPTS'} = $opt::rsync_opts ||
        $ENV{'PARALLEL_RSYNC_OPTS'} || '-rlDzR';
    # Default: Same nice level as GNU  Parallel is started at
    $opt::nice ||= eval { getpriority(0,0) } || 0;
    if(defined $opt::help) { usage(); exit(0); }
    if(defined $opt::shellcompletion) { shell_completion(); exit(0); }
    if(defined $opt::embed) { embed(); exit(0); }
    if(defined $opt::sqlandworker) {
        $opt::sqlmaster = $opt::sqlworker = $opt::sqlandworker;
    }
    if(defined $opt::tmuxpane) { $opt::tmux = $opt::tmuxpane; }
    if(defined $opt::colsep) { $Global::trim = 'lr'; }
    if(defined $opt::csv) {
        if(not $Global::use{"Text::CSV"} ||= eval "use Text::CSV; 1;") {
            ::error("The perl module Text::CSV is not installed.");
            ::error("Try installing libtext-csv-perl or perl-Text-CSV.");
            wait_and_exit(255);
        }
        $opt::colsep = defined $opt::colsep ? $opt::colsep : ",";
        my $csv_setting = { binary => 1, sep_char => $opt::colsep };
        my $sep = $csv_setting->{sep_char};
        $Global::csv = Text::CSV->new($csv_setting)
            or die "Cannot use CSV: ".Text::CSV->error_diag ();
    }
    if(defined $opt::header) {
        $opt::colsep = defined $opt::colsep ? $opt::colsep : "\t";
    }
    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(not defined $opt::process_slot_var) {
        $opt::process_slot_var = 'PARALLEL_JOBSLOT0';
    }
    if(defined $opt::number_of_sockets) {
        print SSHLogin::no_of_sockets(),"\n"; wait_and_exit(0);
    }
    if(defined $opt::number_of_cpus) {
        print SSHLogin::no_of_cores(),"\n"; wait_and_exit(0);
    }
    if(defined $opt::number_of_cores) {
        print SSHLogin::no_of_cores(),"\n"; wait_and_exit(0);
    }
    if(defined $opt::number_of_threads) {
        print SSHLogin::no_of_threads(),"\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::max_chars) {
        $opt::max_chars = multiply_binary_prefix($opt::max_chars);
    }
    if(defined $opt::version) { version(); wait_and_exit(0); }
    if(defined $opt::record_env) { record_env(); wait_and_exit(0); }
    if(@opt::sshlogin) { @Global::sshlogin = @opt::sshlogin; }
    if(@opt::sshloginfile) { read_sshloginfiles(@opt::sshloginfile); }
    if(@opt::return) { push @Global::ret_files, @opt::return; }
    if($opt::transfer) {
        push @Global::transfer_files, $opt::i || $opt::I || "{}";
    }
    push @Global::transfer_files, @opt::transfer_files;
    if(%opt::template) {
        while (my ($source, $template_name) = each %opt::template) {
            push @Global::template_names, $template_name;
            push @Global::template_contents, slurp_or_exit($source);
        }
    }
    if(not defined $opt::recstart and
       not defined $opt::recend) { $opt::recend = "\n"; }
    $Global::blocksize = multiply_binary_prefix($opt::blocksize || "1M");
    if($Global::blocksize > 2**31-1 and not $opt::pipepart) {
        warning("--blocksize >= 2G causes problems. Using 2G-1.");
        $Global::blocksize = 2**31-1;
    }
    if($^O eq "cygwin" and
       ($opt::pipe or $opt::pipepart or $opt::roundrobin)
       and $Global::blocksize > 65535) {
        warning("--blocksize >= 64K causes problems on Cygwin.");
    }
    $opt::memfree = multiply_binary_prefix($opt::memfree);
    $opt::memsuspend = multiply_binary_prefix($opt::memsuspend);
    $Global::memlimit = $opt::memsuspend + $opt::memfree;
    check_invalid_option_combinations();
    if((defined $opt::fifo or defined $opt::cat) and not $opt::pipepart) {
        $opt::pipe = 1;
    }
    if(defined $opt::minversion) {
        print $Global::version,"\n";
        if($Global::version < $opt::minversion) {
            wait_and_exit(255);
        } else {
            wait_and_exit(0);
        }
    }
    if(not defined $opt::delay) {
        # Set --delay to --sshdelay if not set
        $opt::delay = $opt::sshdelay;
    }
    $Global::sshdelayauto = $opt::sshdelay =~ s/auto$//;
    $opt::sshdelay = multiply_time_units($opt::sshdelay);
    $Global::delayauto = $opt::delay =~ s/auto$//;
    $opt::delay = multiply_time_units($opt::delay);
    if($opt::compress_program) {
        $opt::compress = 1;
        $opt::decompress_program ||= $opt::compress_program." -dc";
    }

    if(defined $opt::results) {
        # Is the output a dir or CSV-file?
        if($opt::results =~ /\.csv$/i) {
            # CSV with , as separator
            $Global::csvsep = ",";
            $Global::membuffer ||= 1;
        } elsif($opt::results =~ /\.tsv$/i) {
            # CSV with TAB as separator
            $Global::csvsep = "\t";
            $Global::membuffer ||= 1;
        } elsif($opt::results =~ /\.json$/i) {
            # JSON output
            $Global::jsonout ||= 1;
            $Global::membuffer ||= 1;
        }
    }
    if($opt::compress) {
        my ($compress, $decompress) = find_compression_program();
        $opt::compress_program ||= $compress;
        $opt::decompress_program ||= $decompress;
        if(($opt::results and not $Global::csvsep) or $Global::files) {
            # No need for decompressing
            $opt::decompress_program = "cat >/dev/null";
        }
    }
    if(defined $opt::dryrun) {
        # Force grouping due to bug #51039: --dry-run --timeout 3600 -u breaks
        $opt::ungroup = 0;
        $opt::group = 1;
    }
    if(defined $opt::nonall) {
        # Append a dummy empty argument if there are no arguments
        # on the command line to avoid reading from STDIN.
        # arg_sep = random 50 char
        # \0noarg => nothing (not the empty string)
        $Global::arg_sep = join "",
        map { (0..9,"a".."z","A".."Z")[rand(62)] } (1..50);
        push @ARGV, $Global::arg_sep, "\0noarg";
    }
    if(defined $opt::tee) {
        if(not defined $opt::jobs) {
            $opt::jobs = 0;
        }
    }
    if(defined $opt::tty) {
        # Defaults for --tty: -j1 -u
        # Can be overridden with -jXXX -g
        if(not defined $opt::jobs) {
            $opt::jobs = 1;
        }
        if(not defined $opt::group) {
            $opt::ungroup = 1;
        }
    }
    if(@opt::trc) {
        push @Global::ret_files, @opt::trc;
        if(not @Global::transfer_files) {
            # Defaults to --transferfile {}
            push @Global::transfer_files, $opt::i || $opt::I || "{}";
        }
        $opt::cleanup = 1;
    }
    if(defined $opt::max_lines) {
        if($opt::max_lines eq "-0") {
            # -l -0 (swallowed -0)
            $opt::max_lines = 1;
            $opt::null = 1;
            $/ = "\0";
        } else {
            $opt::max_lines = multiply_binary_prefix($opt::max_lines);
            if ($opt::max_lines == 0) {
                # If not given (or if 0 is given) => 1
                $opt::max_lines = 1;
            }
        }

        $Global::max_lines = $opt::max_lines;
        if(not $opt::pipe) {
            # --pipe -L means length of record - not max_number_of_args
            $Global::max_number_of_args ||= $Global::max_lines;
        }
    }

    # Read more than one arg at a time (-L, -N)
    if(defined $opt::L) {
        $opt::L = multiply_binary_prefix($opt::L);
        $Global::max_lines = $opt::L;
        if(not $opt::pipe) {
            # --pipe -L means length of record - not max_number_of_args
            $Global::max_number_of_args ||= $Global::max_lines;
        }
    }
    if(defined $opt::max_replace_args) {
        $opt::max_replace_args =
            multiply_binary_prefix($opt::max_replace_args);
        $Global::max_number_of_args = $opt::max_replace_args;
        $Global::ContextReplace = 1;
    }
    if((defined $opt::L or defined $opt::max_replace_args)
       and
       not ($opt::xargs or $opt::m)) {
        $Global::ContextReplace = 1;
    }
    # Deal with ::: :::+ :::: ::::+ and -a +file
    my @ARGV_with_argsep = @ARGV;
    @ARGV = read_args_from_command_line();
    if(defined $opt::combineexec) {
        pack_combined_executable(\@argv_before,\@ARGV_with_argsep,\@ARGV);
        exit(0);
    }
    parse_semaphore();

    if(defined $opt::eta) { $opt::progress = $opt::eta; }
    if(defined $opt::bar) { $opt::progress = $opt::bar; }
    if(defined $opt::bar or defined $opt::latestline) {
        my $fh = $Global::status_fd || *STDERR;
        # Activate decode_utf8
        eval q{
            # Enable utf8 if possible
            use utf8;
            binmode $fh, "encoding(utf8)";
            *decode_utf8 = \&Encode::decode_utf8;
        };
        if(eval { decode_utf8("x") }) {
            # Great: decode works
        } else {
            # UTF8-decode not supported: Dummy decode
            eval q{sub decode_utf8($;$) { $_[0]; }};
        }
        # Activate decode_utf8
        eval q{
            # Enable utf8 if possible
            use utf8;
            use Encode             qw( encode_utf8 );
            use Text::CharWidth    qw( mbswidth );
            use Unicode::Normalize qw( NFC NFD );
        };
        if(eval { mbswidth("ヌー平行") }) {
            # Great: mbswidth works
        } else {
            # mbswidth not supported: Dummy mbswidth
            eval q{ sub mbswidth { return length @_; } };
        }
    }

    # If you want GNU Parallel to be maintained in the future you
    # should keep this.
    # *YOU* will be harming free software by removing the notice.
    #
    # Funding a free software project is hard. GNU Parallel is no
    # exception. On top of that it seems the less visible a project
    # is, the harder it is to get funding. And the nature of GNU
    # Parallel is that it will never be seen by "the guy with the
    # checkbook", but only by the people doing the actual work.
    #
    # This problem has been covered by others - though no solution has
    # been found:
    # https://www.slideshare.net/NadiaEghbal/consider-the-maintainer
    # https://www.numfocus.org/blog/why-is-numpy-only-now-getting-funded/
    #
    # The FAQ tells you why the citation notice exists:
    # https://git.savannah.gnu.org/cgit/parallel.git/tree/doc/citation-notice-faq.txt
    #
    # If you want GNU Parallel to be maintained in the future, and not
    # just wither away like so many other free software tools, you
    # need to help finance the development.
    #
    # The citation notice is a simple way of doing so, as citations
    # makes it possible to me to get a job where I can maintain GNU
    # Parallel as part of the job.
    #
    # This means you can help financing development
    #
    #   WITHOUT PAYING A SINGLE CENT!
    #
    # Before implementing the citation notice it was discussed with
    # the users:
    # https://lists.gnu.org/archive/html/parallel/2013-11/msg00006.html
    #
    # Having to spend 10 seconds on running 'parallel --citation' once
    # is no doubt not an ideal solution, but no one has so far come up
    # with an ideal solution - neither for funding GNU Parallel nor
    # other free software.
    #
    # If you believe you have the perfect solution, you should try it
    # out, and if it works, you should post it on the email
    # list. Ideas that will cost work and which have not been tested
    # are, however, unlikely to be prioritized.
    #
    # Please note that GPL version 3 gives you the right to fork GNU
    # Parallel under a new name, but it does not give you the right to
    # distribute modified copies with the citation notice disabled in
    # a way where the software can be confused with GNU Parallel. To
    # do that you need to be the owner of the GNU Parallel
    # trademark. The xt:Commerce case shows this.
    #
    # Description of the xt:Commerce case in OLG Duesseldorf
    # https://web.archive.org/web/20180715073746/http://www.inta.org/INTABulletin/Pages/GERMANYGeneralPublicLicenseDoesNotPermitUseofThird-PartyTrademarksforAdvertisingModifiedVersionsofOpen-SourceSoftware.aspx
    #
    # The verdict in German
    # https://www.admody.com/urteilsdatenbank/cafe6fdaeed3/OLG-Duesseldorf_Urteil_vom_28-September-2010_Az_I-20-U-41-09
    # https://web.archive.org/web/20180715073717/https://www.admody.com/urteilsdatenbank/cafe6fdaeed3/OLG-Duesseldorf_Urteil_vom_28-September-2010_Az_I-20-U-41-09
    #
    # Other free software limiting derivates by the same name:
    # https://en.wikipedia.org/wiki/Red_Hat_Enterprise_Linux_derivatives#Legal_aspects
    # https://tm.joomla.org/trademark-faq.html
    # https://www.mozilla.org/en-US/foundation/trademarks/faq/
    #
    # Running 'parallel --citation' one single time takes less than 10
    # seconds, and will silence the citation notice for future
    # runs. If that is too much trouble for you, why not use one of
    # the alternatives instead?
    # See a list in: 'man parallel_alternatives'
    #
    # If you want GNU Parallel to be maintained in the future, you
    # should keep this line:
    citation_notice();
    # This is because _YOU_ actively make it harder to justify
    # spending time developing GNU Parallel by removing it.

    # If you disagree, please read (especially 77-):
    # https://www.fordfoundation.org/media/2976/roads-and-bridges-the-unseen-labor-behind-our-digital-infrastructure.pdf

    # *YOU* will be harming free software by removing the notice.  You
    # accept to be added to a public hall of shame by removing the
    # line.  That includes you, George and Andreas.

    parse_halt();

    if($ENV{'PARALLEL_ENV'}) {
        # Read environment and set $Global::parallel_env
        # Must be done before is_acceptable_command_line_length()
        my $penv = $ENV{'PARALLEL_ENV'};
        # unset $PARALLEL_ENV: It should not be given to children
        # because it takes up a lot of env space
        delete $ENV{'PARALLEL_ENV'};
        if(-e $penv) {
            # This is a file/fifo: Replace envvar with content of file
            $penv = slurp_or_exit($penv);
        }
        # Map \001 to \n to make it easer to quote \n in $PARALLEL_ENV
        $penv =~ s/\001/\n/g;
        if($penv =~ /\0/) {
            ::warning('\0 (NUL) in environment is not supported');
        }
        $Global::parallel_env = $penv;
    }

    parse_sshlogin();
    if(defined $opt::show_limits) { show_limits(); }

    if(remote_hosts() and
       (defined $opt::X or defined $opt::m or defined $opt::xargs)) {
        # As we do not know the max line length on the remote machine
        # long commands generated by xargs may fail
        # If $opt::max_replace_args is set, it is probably safe
        ::warning("Using -X or -m with --sshlogin may fail.");
    }

    if(not defined $opt::jobs) { $opt::jobs = "100%"; }
    open_joblog();
    open_json_csv();
    if(defined $opt::sqlmaster or defined $opt::sqlworker) {
        $Global::sql = SQL->new($opt::sqlmaster || $opt::sqlworker);
    }
    if(defined $opt::sqlworker) { $Global::membuffer ||= 1; }
    # The sqlmaster groups the arguments, so the should just read one
    if(defined $opt::sqlworker and not defined $opt::sqlmaster) {
        $Global::max_number_of_args = 1;
    }
    if(defined $Global::color or defined $opt::colorfailed) {
        Job::init_color();
    }
}

sub check_invalid_option_combinations() {
    if(defined $opt::timeout and
       $opt::timeout !~ /^\d+(\.\d+)?%?$|^(\d+(\.\d+)?[dhms])+$/i) {
        ::error("--timeout must be seconds or percentage.");
        wait_and_exit(255);
    }
    if(defined $opt::fifo and defined $opt::cat) {
        ::error("--fifo cannot be combined with --cat.");
        ::wait_and_exit(255);
    }
    if(defined $opt::retries and defined $opt::roundrobin) {
        ::error("--retries cannot be combined with --roundrobin.");
        ::wait_and_exit(255);
    }
    if(defined $opt::pipepart and
       (defined $opt::L or defined $opt::max_lines
        or defined $opt::max_replace_args)) {
        ::error("--pipepart is incompatible with --max-replace-args, ".
                "--max-lines, and -L.");
        wait_and_exit(255);
    }
    if(defined $opt::group and defined $opt::ungroup) {
        ::error("--group cannot be combined with --ungroup.");
        ::wait_and_exit(255);
    }
    if(defined $opt::group and defined $opt::linebuffer) {
        ::error("--group cannot be combined with --line-buffer.");
        ::wait_and_exit(255);
    }
    if(defined $opt::ungroup and defined $opt::linebuffer) {
        ::error("--ungroup cannot be combined with --line-buffer.");
        ::wait_and_exit(255);
    }
    if(defined $opt::tollef and not defined $opt::gnu) {
       ::error("--tollef has been retired.",
               "Remove --tollef or use --gnu to override --tollef.");
       ::wait_and_exit(255);
    }
    if(defined $opt::retired) {
            ::error("-g has been retired. Use --group.",
                    "-B has been retired. Use --bf.",
                    "-T has been retired. Use --tty.",
                    "-U has been retired. Use --er.",
                    "-W has been retired. Use --wd.",
                    "-Y has been retired. Use --shebang.",
                    "-H has been retired. Use --halt.",
                    "--sql has been retired. Use --sqlmaster.",
                    "--ctrlc has been retired.",
                    "--noctrlc has been retired.");
            ::wait_and_exit(255);
    }
    if(defined $opt::groupby) {
        if(not defined $opt::pipe and not defined $opt::pipepart) {
            $opt::pipe = 1;
        }
        if(defined $opt::remove_rec_sep) {
            ::error("--remove-rec-sep is not compatible with --groupby");
            ::wait_and_exit(255);
        }
        if(defined $opt::recstart) {
            ::error("--recstart is not compatible with --groupby");
            ::wait_and_exit(255);
        }
        if($opt::recend ne "\n") {
            ::error("--recend is not compatible with --groupby");
            ::wait_and_exit(255);
        }
    }
    sub unsafe_warn {
        # use --_unsafe to only generate a warning
        if($opt::_unsafe) { ::warning(@_); } else { ::error(@_); exit(255); }
    }
    if(defined $opt::results) {
        if($opt::nonall or $opt::onall) {
            unsafe_warn("--(n)onall + --results not supported (yet).");
        }
    }
    sub test_safe_chars {
        my $var = shift;
        if($ENV{$var} =~ m{^[-a-z0-9_+,.%:/= ]*$}i) {
            # OK
        } else {
            unsafe_warn("\$$var can only contain [-a-z0-9_+,.%:/= ].");
        }
    }
    if($ENV{'TMPDIR'} =~ /\n/) {
        if(defined $opt::files) {
            ::warning("Use --files0 when \$TMPDIR contains newline.");
        } elsif($Global::cshell
                and
                (defined $opt::cat or defined $opt::fifo)) {
            ::warning("--cat/--fifo fails under csh ".
                      "if \$TMPDIR contains newline.");
        }
    } elsif($ENV{'TMPDIR'} =~ /\257/) {
        unsafe_warn("\$TMPDIR with \\257 (\257) is not supported.");
    } else{
        test_safe_chars('TMPDIR');
    }
    map { test_safe_chars($_); } qw(PARALLEL_HOME XDG_CONFIG_DIRS
                                    PARALLEL_REMOTE_TMPDIR XDG_CACHE_HOME);
}

sub init_globals() {
    # Defaults:
    $Global::version = 20240522;
    $Global::progname = 'parallel';
    $::name = "GNU Parallel";
    $Global::infinity = 2**31;
    $Global::debug = 0;
    $Global::verbose = 0;
    # Don't quote every part of the command line
    $Global::quoting = 0;
    # Quote replacement strings
    $Global::quote_replace = 1;
    $Global::total_completed = 0;
    $Global::cache_replacement_eval = 1;
    # Read only table with default --rpl values
    %Global::replace =
        (
         '{}'   => '',
         '{#}'  => '1 $_=$job->seq()',
         '{%}'  => '1 $_=$job->slot()',
         '{/}'  => 's:.*/::',
         '{//}' =>
         ('$Global::use{"File::Basename"} ||= eval "use File::Basename; 1;"; '.
          '$_ = dirname($_);'),
         '{/.}' => 's:.*/::; s:\.[^/.]*$::;',
         '{.}'  => 's:\.[^/.]*$::',
        );
    %Global::plus =
        (
         # {} = {+/}/{/}
         #    = {.}.{+.}     = {+/}/{/.}.{+.}
         #    = {..}.{+..}   = {+/}/{/..}.{+..}
         #    = {...}.{+...} = {+/}/{/...}.{+...}
         '{+/}' => 's:/[^/]*$:: || s:.*$::',
         # a.b => b; a => ''
         '{+.}' => 's:.*\.:: || s:.*$::',
         # a.b.c => b.c; a.b => ''; a => ''
         '{+..}' => 's:.*\.([^/.]*\.[^/.]*)$:$1: || s:.*$::',
         '{+...}' => 's:.*\.([^/.]*\.[^/.]*\.[^/.]*)$:$1: || s:.*$::',
         '{..}' => 's:\.[^/.]*\.[^/.]*$::',
         '{...}' => 's:\.[^/.]*\.[^/.]*\.[^/.]*$::',
         '{/..}' => 's:.*/::; s:\.[^/.]*\.[^/.]*$::',
         '{/...}' => 's:.*/::; s:\.[^/.]*\.[^/.]*\.[^/.]*$::',
         # n choose k = Binomial coefficient
         '{choose_k}' => ('for $t (2..$#arg)'.
                          '{ if($arg[$t-1] ge $arg[$t]) { skip() } }'),
         # unique values: Skip job if any args are the same
         '{uniq}' => 'if(::uniq(@arg) != @arg) { skip(); }',
         # {##} = number of jobs
         '{##}' => '1 $_=total_jobs()',
         # {0#} = 0-padded seq
         '{0#}' => ('1 $f=1+int((log(total_jobs())/log(10)));'.
                    '$_=sprintf("%0${f}d",seq())'),
         # {0%} = 0-padded jobslot
         '{0%}' => ('1 $f=1+int((log($Global::max_jobs_running||1)/log(10)));'.
                    '$_=sprintf("%0${f}d",slot())'),
         # {seq-1} = seq-1 = counting from 0
         '{seq(.*?)}' => '$_=eval q{$job->seq()}.qq{$$1}',
         # {seq-1} = jobslot-1 = counting from 0
         '{slot(.*?)}' => '$_=eval q{$job->slot()}.qq{$$1}',

         ## Bash inspired replacement strings
         # Bash ${a:-myval}
         '{:-([^}]+?)}' => '$_ ||= $$1',
         # Bash ${a:2}
         '{:(\d+?)}' => 'substr($_,0,$$1) = ""',
         # Bash ${a:2:3}
         '{:(\d+?):(\d+?)}' => '$_ = substr($_,$$1,$$2);',
         # echo {#z.*z.} ::: z.z.z.foo => z.foo
         # echo {##z.*z.} ::: z.z.z.foo => foo
         # Bash ${a#bc}
         '{#([^#}][^}]*?)}' =>
         '$nongreedy=::make_regexp_ungreedy($$1);s/^$nongreedy(.*)/$1/;',
         # Bash ${a##bc}
         '{##([^#}][^}]*?)}' => 's/^$$1//;',
         # echo {%.z.*z} ::: foo.z.z.z => foo.z
         # echo {%%.z.*z} ::: foo.z.z.z => foo
         # Bash ${a%def}
         '{%([^}]+?)}' =>
         '$nongreedy=::make_regexp_ungreedy($$1);s/(.*)$nongreedy$/$1/;',
         # Bash ${a%%def}
         '{%%([^}]+?)}' => 's/$$1$//;',
         # Bash ${a/def/ghi} ${a/def/}
         '{/([^#%}/]+?)/([^}]*?)}' => 's/$$1/$$2/;',
         # Bash ${a/#def/ghi} ${a/#def/}
         '{/#([^}]+?)/([^}]*?)}' => 's/^$$1/$$2/g;',
         # Bash ${a/%def/ghi} ${a/%def/}
         '{/%([^}]+?)/([^}]*?)}' => 's/$$1$/$$2/g;',
         # Bash ${a//def/ghi} ${a//def/}
         '{//([^}]+?)/([^}]*?)}' => 's/$$1/$$2/g;',
         # Bash ${a^a}
         '{^([^}]+?)}' => 's/^($$1)/uc($1)/e;',
         # Bash ${a^^a}
         '{^^([^}]+?)}' => 's/($$1)/uc($1)/eg;',
         # Bash ${a,A}
         '{,([^}]+?)}' => 's/^($$1)/lc($1)/e;',
         # Bash ${a,,A}
         '{,,([^}]+?)}' => 's/($$1)/lc($1)/eg;',

         # {slot} = $PARALLEL_JOBSLOT
         '{slot}' => '1 $_="\${PARALLEL_JOBSLOT}";uq()',
         # {host} = ssh host
         '{host}' => '1 $_="\${PARALLEL_SSHHOST}";uq()',
         # {sshlogin} = sshlogin
         '{sshlogin}' => '1 $_="\${PARALLEL_SSHLOGIN}";uq()',
         # {hgrp} = hostgroups of the host
         '{hgrp}' => '1 $_="\${PARALLEL_HOSTGROUPS}";uq()',
         # {agrp} = hostgroups of the argument
         '{agrp}' => '1 $_="\${PARALLEL_ARGHOSTGROUPS}";uq()',
        );
    # Modifiable copy of %Global::replace
    %Global::rpl = %Global::replace;
    $/ = "\n";
    $Global::ignore_empty = 0;
    $Global::interactive = 0;
    $Global::stderr_verbose = 0;
    $Global::default_simultaneous_sshlogins = 9;
    $Global::exitstatus = 0;
    $Global::arg_sep = ":::";
    $Global::arg_file_sep = "::::";
    $Global::trim = 'n';
    $Global::max_jobs_running = 0;
    $Global::job_already_run = '';
    $ENV{'TMPDIR'} ||= "/tmp";
    $ENV{'PARALLEL_REMOTE_TMPDIR'} ||= "/tmp";
    # bug #55398: set $OLDPWD when using --wd
    $ENV{'OLDPWD'} = $ENV{'PWD'};
    if(not $ENV{HOME}) {
        # $ENV{HOME} is sometimes not set if called from PHP
        ::warning("\$HOME not set. Using /tmp.");
        $ENV{HOME} = "/tmp";
    }
    # no warnings to allow for undefined $XDG_*
    no warnings 'uninitialized';
    # If $PARALLEL_HOME is set, but does not exist, try making it.
    if(defined $ENV{'PARALLEL_HOME'}) {
        eval { File::Path::mkpath($ENV{'PARALLEL_HOME'}); };
    }
    # $xdg_config_home is needed to make env_parallel.fish stop complaining
    my $xdg_config_home = $ENV{'XDG_CONFIG_HOME'};
    # Use the first config dir that exists from:
    #   $PARALLEL_HOME
    #   $XDG_CONFIG_HOME/parallel
    #   $(each XDG_CONFIG_DIRS)/parallel
    #   $HOME/.parallel
    #
    # Keep only dirs that exist
    @Global::config_dirs =
        (grep { -d $_ }
         $ENV{'PARALLEL_HOME'},
         (map { "$_/parallel" }
          $xdg_config_home,
          split /:/, $ENV{'XDG_CONFIG_DIRS'}),
         $ENV{'HOME'} . "/.parallel");
    # Use first dir as config dir
    $Global::config_dir = $Global::config_dirs[0] ||
        $ENV{'HOME'} . "/.parallel";
    if($ENV{'PARALLEL_HOME'} =~ /./ and not -d $ENV{'PARALLEL_HOME'}) {
        ::warning("\$PARALLEL_HOME ($ENV{'PARALLEL_HOME'}) does not exist.");
        ::warning("Using $Global::config_dir");
    }
    # Use the first cache dir that exists from:
    #   $PARALLEL_HOME
    #   $XDG_CACHE_HOME/parallel
    # Keep only dirs that exist
    @Global::cache_dirs = (grep { -d $_ }
                           $ENV{'PARALLEL_HOME'},
                           $ENV{'XDG_CACHE_HOME'}."/parallel");
    $Global::cache_dir = $Global::cache_dirs[0] ||
        $ENV{'HOME'} . "/.parallel";
    Job::init_color();
}

sub parse_halt() {
    # $opt::halt flavours
    # Uses:
    #   $opt::halt
    #   $Global::halt_when
    #   $Global::halt_fail
    #   $Global::halt_success
    #   $Global::halt_pct
    #   $Global::halt_count
    if(defined $opt::halt) {
        my %halt_expansion = (
            "0" => "never",
            "1" => "soon,fail=1",
            "2" => "now,fail=1",
            "-1" => "soon,success=1",
            "-2" => "now,success=1",
        );
        # Expand -2,-1,0,1,2 into long form
        $opt::halt = $halt_expansion{$opt::halt} || $opt::halt;
        # --halt 5% == --halt soon,fail=5%
        $opt::halt =~ s/^(\d+)%$/soon,fail=$1%/;
        # Split: soon,fail=5%
        my ($when,$fail_success,$pct_count) = split /[,=]/, $opt::halt;
        if(not grep { $when eq $_ } qw(never soon now)) {
            ::error("--halt must have 'never', 'soon', or 'now'.");
            ::wait_and_exit(255);
        }
        $Global::halt_when = $when;
        if($when ne "never") {
            if($fail_success eq "fail") {
                $Global::halt_fail = 1;
            } elsif($fail_success eq "success") {
                $Global::halt_success = 1;
            } elsif($fail_success eq "done") {
                $Global::halt_done = 1;
            } else {
                ::error("--halt $when must be followed by ,success or ,fail.");
                ::wait_and_exit(255);
            }
            if($pct_count =~ /^(\d+)%$/) {
                $Global::halt_pct = $1/100;
            } elsif($pct_count =~ /^(\d+)$/) {
                $Global::halt_count = $1;
            } else {
                ::error("--halt $when,$fail_success ".
                        "must be followed by ,number or ,percent%.");
                ::wait_and_exit(255);
            }
        }
    }
}

sub parse_replacement_string_options() {
    # Deal with --rpl
    # Uses:
    #   %Global::rpl
    #   $Global::parensleft
    #   $Global::parensright
    #   $opt::parens
    #   $Global::parensleft
    #   $Global::parensright
    #   $opt::plus
    #   %Global::plus
    #   $opt::I
    #   $opt::U
    #   $opt::i
    #   $opt::basenamereplace
    #   $opt::dirnamereplace
    #   $opt::seqreplace
    #   $opt::slotreplace
    #   $opt::basenameextensionreplace

    sub rpl($$) {
        # Modify %Global::rpl
        # Replace $old with $new
        my ($old,$new) =  @_;
        if($old ne $new) {
            $Global::rpl{$new} = $Global::rpl{$old};
            delete $Global::rpl{$old};
        }
    }
    my $parens = "{==}";
    if(defined $opt::parens) { $parens = $opt::parens; }
    my $parenslen = 0.5*length $parens;
    $Global::parensleft = substr($parens,0,$parenslen);
    $Global::parensright = substr($parens,$parenslen);
    if(defined $opt::plus) { %Global::rpl = (%Global::plus,%Global::rpl); }
    if(defined $opt::I) { rpl('{}',$opt::I); }
    if(defined $opt::i and $opt::i) { rpl('{}',$opt::i); }
    if(defined $opt::U) { rpl('{.}',$opt::U); }
    if(defined $opt::basenamereplace) { rpl('{/}',$opt::basenamereplace); }
    if(defined $opt::dirnamereplace) { rpl('{//}',$opt::dirnamereplace); }
    if(defined $opt::seqreplace) { rpl('{#}',$opt::seqreplace); }
    if(defined $opt::slotreplace) { rpl('{%}',$opt::slotreplace); }
    if(defined $opt::basenameextensionreplace) {
       rpl('{/.}',$opt::basenameextensionreplace);
    }
    for(@opt::rpl) {
        # Create $Global::rpl entries for --rpl options
        # E.g: "{..} s:\.[^.]+$:;s:\.[^.]+$:;"
        my ($shorthand,$long) = split/\s/,$_,2;
        $Global::rpl{$shorthand} = $long;
    }
}

sub parse_semaphore() {
    # 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
    # Uses:
    #   $opt::semaphore
    #   $Global::semaphore
    #   $opt::semaphoretimeout
    #   $Semaphore::timeout
    #   $opt::semaphorename
    #   $Semaphore::name
    #   $opt::fg
    #   $Semaphore::fg
    #   $opt::wait
    #   $Semaphore::wait
    #   $opt::bg
    #   @opt::a
    #   @Global::unget_argv
    #   $Global::default_simultaneous_sshlogins
    #   $opt::jobs
    #   $Global::interactive
    $Global::semaphore ||= ($0 =~ m:(^|/)sem$:); # called as 'sem'
    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 and not $opt::tmux and not $opt::tmuxpane) {
        $Global::semaphore = 1;
    }
    if(defined $opt::bg) { $Global::semaphore = 1; }
    if(defined $opt::wait and not $opt::sqlmaster) {
        $Global::semaphore = 1; @ARGV = "true";
    }
    if($Global::semaphore) {
        if(@opt::a) {
            # Assign the first -a to STDIN
            open(STDIN,"<",shift @opt::a);
            if(@opt::a) {
                # We currently have no way of dealing with more -a
                ::error("A semaphore cannot take input from more files\n");
                ::wait_and_exit(255);
            }
        }
        @opt::a = ("/dev/null");
        # Append a dummy empty argument
        # \0 => nothing (not the empty string)
        push(@Global::unget_argv, [Arg->new("\0noarg")]);
        $Semaphore::timeout = int(multiply_time_units($opt::semaphoretimeout))
            || 0;
        if(defined $opt::semaphorename) {
            $Semaphore::name = $opt::semaphorename;
        } else {
            local $/ = "\n";
            $Semaphore::name = `tty`;
            chomp $Semaphore::name;
        }
        $Semaphore::fg = $opt::fg;
        $Semaphore::wait = $opt::wait;
        $Global::default_simultaneous_sshlogins = 1;
        if(not defined $opt::jobs) {
            $opt::jobs = 1;
        }
        if($Global::interactive and $opt::bg) {
            ::error("Jobs running in the ".
                    "background cannot be interactive.");
            ::wait_and_exit(255);
        }
    }
}

sub record_env() {
    # Record current %ENV-keys in $PARALLEL_HOME/ignored_vars
    # Returns: N/A
    my $ignore_filename = $Global::config_dir . "/ignored_vars";
    write_or_exit($ignore_filename,map { $_,"\n" } keys %ENV);
}

sub open_joblog() {
    # Open joblog as specified by --joblog
    # Uses:
    #   $opt::resume
    #   $opt::resume_failed
    #   $opt::joblog
    #   $opt::results
    #   $Global::job_already_run
    #   %Global::fh
    my $append = 0;
    if(($opt::resume or $opt::resume_failed)
       and
       not ($opt::joblog or $opt::results)) {
        ::error("--resume and --resume-failed require --joblog or --results.");
        ::wait_and_exit(255);
    }
    if(defined $opt::joblog and $opt::joblog =~ s/^\+//) {
        # --joblog +filename = append to filename
        $append = 1;
    }
    if($opt::joblog
       and
       ($opt::sqlmaster
        or
        not $opt::sqlworker)) {
        # Do not log if --sqlworker
        if($opt::resume || $opt::resume_failed || $opt::retry_failed) {
            if(open(my $joblog_fh, "<", $opt::joblog)) {
                # Enable utf8 if possible
                eval q{ binmode $joblog_fh, "encoding(utf8)"; };
                # Read the joblog
                # Override $/ with \n because -d might be set
                local $/ = "\n";
                # If there is a header: Open as append later
                $append = <$joblog_fh>;
                my $joblog_regexp;
                if($opt::retry_failed) {
                    # Make a regexp that matches commands with exit+signal=0
                    # 4 host 1360490623.067 3.445 1023 1222 0 0 command
                    $joblog_regexp='^(\d+)(?:\t[^\t]+){5}\t0\t0\t';
                    my @group;
                    while(<$joblog_fh>) {
                        if(/$joblog_regexp/o) {
                            # This is 30% faster than set_job_already_run($1);
                            vec($Global::job_already_run,($1||0),1) = 1;
                            $Global::total_completed++;
                            $group[$1-1] = "true";
                        } elsif(/(\d+)\s+\S+(\s+[-0-9.]+){6}\s+(.*)$/) {
                            # Grab out the command
                            $group[$1-1] = $3;
                        } else {
                            chomp;
                            ::error("Format of '$opt::joblog' is wrong: $_");
                            ::wait_and_exit(255);
                        }
                    }
                    if(@group) {
                        my ($outfh,$name) = ::tmpfile(SUFFIX => ".arg");
                        unlink($name);
                        # Put args into argfile
                        if(grep /\0/, @group) {
                            # force --null to deal with \n in commandlines
                            ::warning("Command lines contain newline. ".
                                      "Forcing --null.");
                            $opt::null = 1;
                            $/ = "\0";
                        }
                        # Replace \0 with '\n' as used in print_joblog()
                        print $outfh (map { s/\0/\n/g; $_,$/ }
                                      map { $_ } @group);
                        seek $outfh, 0, 0;
                        exit_if_disk_full();
                        # Set filehandle to -a
                        @opt::a = ($outfh);
                    }
                    # Remove $command (so -a is run)
                    @ARGV = ();
                }
                if($opt::resume || $opt::resume_failed) {
                    if($opt::resume_failed) {
                        # Make a regexp that matches commands with exit+signal=0
                        # 4 host 1360490623.067 3.445 1023 1222 0 0 command
                        $joblog_regexp='^(\d+)(?:\t[^\t]+){5}\t0\t0\t';
                    } else {
                        # Just match the job number
                        $joblog_regexp='^(\d+)';
                    }
                    while(<$joblog_fh>) {
                        if(/$joblog_regexp/o) {
                            # This is 30% faster than set_job_already_run($1);
                            vec($Global::job_already_run,($1||0),1) = 1;
                            $Global::total_completed++;
                        } elsif(not /\d+\s+[^\s]+\s+([-0-9.]+\s+){6}/) {
                            ::error("Format of '$opt::joblog' is wrong: $_");
                            ::wait_and_exit(255);
                        }
                    }
                }
                close $joblog_fh;
            }
            # $opt::null may be set if the commands contain \n
            if($opt::null) { $/ = "\0"; }
        }
        if($opt::dryrun) {
            # Do not write to joblog in a dry-run

        } elsif($append) {
            # Append to joblog
            $Global::joblog = open_or_exit(">>", $opt::joblog);
        } else {
            if($opt::joblog eq "-") {
                # Use STDOUT as joblog
                $Global::joblog = $Global::fh{1};
            } else {
                # Overwrite the joblog
                $Global::joblog = open_or_exit(">", $opt::joblog);
            }
            print $Global::joblog
                join("\t", "Seq", "Host", "Starttime", "JobRuntime",
                     "Send", "Receive", "Exitval", "Signal", "Command"
                ). "\n";
        }
    }
}

sub open_json_csv() {
    if($opt::results) {
        # Output as JSON/CSV/TSV
        if($opt::results eq "-.csv"
           or
           $opt::results eq "-.tsv"
           or
           $opt::results eq "-.json") {
            # Output as JSON/CSV/TSV on stdout
            open $Global::csv_fh, ">&", "STDOUT" or
                ::die_bug("Can't dup STDOUT in csv: $!");
            # Do not print any other output to STDOUT
            # by forcing all other output to /dev/null
            open my $fd, ">", "/dev/null" or
                ::die_bug("Can't >/dev/null in csv: $!");
            $Global::fh{1} = $fd;
            $Global::fh{2} = $fd;
        } elsif($Global::csvsep or $Global::jsonout) {
            $Global::csv_fh = open_or_exit(">",$opt::results);
        }
    }
}

sub find_compression_program() {
    # Find a fast compression program
    # Returns:
    #   $compress_program = compress program with options
    #   $decompress_program = decompress program with options

    # Search for these. Sorted by speed on 128 core

    # seq 120000000|shuf > 1gb &
    # apt-get update
    # apt install make g++ htop
    # wget -O - pi.dk/3 | bash
    # apt install zstd clzip liblz4-tool lzop pigz pxz gzip plzip pbzip2 lzma xz-utils lzip bzip2 lbzip2 lrzip pixz
    # git clone https://github.com/facebook/zstd.git
    # (cd zstd/contrib/pzstd; make -j; cp pzstd /usr/local/bin)
    # echo 'lrzip -L $((-$1))'  >/usr/local/bin/lrz
    # chmod +x /usr/local/bin/lrz
    # wait
    # onethread="zstd clzip lz4 lzop gzip lzma xz bzip2"
    # multithread="pzstd pigz pxz plzip pbzip2 lzip lbzip2 lrz pixz"
    # parallel --shuf -j1  --joblog jl-m --arg-sep ,  parallel --compress-program \'{3}" "-{2}\' cat ::: 1gb '>'/dev/null , 1 2 3 ,  {1..3} , $multithread
    # parallel --shuf -j50% --delay 1  --joblog jl-s --arg-sep ,  parallel --compress-program \'{3}" "-{2}\' cat ::: 1gb '>'/dev/null , 1 2 3 ,  {1..3} , $onethread
    # sort -nk4 jl-?

    # 1-core:
    # 2-cores: pzstd zstd lz4 lzop pigz gzip lbzip2 pbzip2 lrz bzip2 lzma pxz plzip xz lzip clzip
    # 4-cores:
    # 8-cores: pzstd lz4 zstd pigz lzop lbzip2 pbzip2 gzip lzip lrz plzip pxz bzip2 lzma xz clzip
    # 16-cores: pzstd lz4 pigz lzop lbzip2 pbzip2 plzip lzip lrz pxz gzip lzma xz bzip2
    # 32-cores: pzstd lbzip2 pbzip2 zstd pigz lz4 lzop plzip lzip lrz gzip pxz lzma bzip2 xz clzip
    # 64-cores: pzstd lbzip2 pbzip2 pigz zstd pixz lz4 plzip lzop lzip lrz gzip pxz lzma bzip2 xz clzip
    # 128-core: pzstd lbzip2 pbzip2 zstd pixz lz4 pigz lzop plzip lzip gzip lrz pxz bzip2 lzma xz clzip

    my @prg = qw(pzstd lbzip2 pbzip2 zstd pixz lz4 pigz lzop plzip lzip gzip
                 lrz pxz bzip2 lzma xz clzip);
    for my $p (@prg) {
        if(which($p)) {
            return ("$p -c -1","$p -dc");
        }
    }
    # Fall back to cat
    return ("cat","cat");
}

sub read_options() {
    # Read options from command line, profile and $PARALLEL
    # Uses:
    #   $opt::shebang_wrap
    #   $opt::shebang
    #   @ARGV
    #   $opt::plain
    #   @opt::profile
    #   $ENV{'HOME'}
    #   $ENV{'PARALLEL'}
    # Returns:
    #   @ARGV_no_opt = @ARGV without --options

    # This must be done first as this may exec myself
    if(defined $ARGV[0] and ($ARGV[0] =~ /^--shebang/ or
                             $ARGV[0] =~ /^--shebang-?wrap/ or
                             $ARGV[0] =~ /^--hashbang/)) {
        # Program is called from #! line in script
        # remove --shebang-wrap if it is set
        $opt::shebang_wrap = ($ARGV[0] =~ s/^--shebang-?wrap *//);
        # remove --shebang if it is set
        $opt::shebang = ($ARGV[0] =~ s/^--shebang *//);
        # remove --hashbang if it is set
        $opt::shebang .= ($ARGV[0] =~ s/^--hashbang *//);
        if($opt::shebang) {
            my $argfile = Q(pop @ARGV);
            # exec myself to split $ARGV[0] into separate fields
            exec "$0 --skip-first-line -a $argfile @ARGV";
        }
        if($opt::shebang_wrap) {
            my @options;
            my @parser;
            if ($^O eq 'freebsd') {
                # FreeBSD's #! puts different values in @ARGV than Linux' does
                my @nooptions = @ARGV;
                get_options_from_array(\@nooptions);
                while($#ARGV > $#nooptions) {
                    push @options, shift @ARGV;
                }
                while(@ARGV and $ARGV[0] ne ":::") {
                    push @parser, shift @ARGV;
                }
                if(@ARGV and $ARGV[0] eq ":::") {
                    shift @ARGV;
                }
            } else {
                @options = shift @ARGV;
            }
            my $script = Q(Q(shift @ARGV)); # TODO - test if script = " "
            my @args = map{ Q($_) } @ARGV;
            # exec myself to split $ARGV[0] into separate fields
            exec "$0 --_pipe-means-argfiles @options @parser $script ".
                "::: @args";
        }
    }
    if($ARGV[0] =~ / --shebang(-?wrap)? /) {
        ::warning("--shebang and --shebang-wrap must be the first ".
                  "argument.\n");
    }

    Getopt::Long::Configure("bundling","require_order");
    my @ARGV_copy = @ARGV;
    my @ARGV_orig = @ARGV;
    # Check if there is a --profile to set @opt::profile
    get_options_from_array(\@ARGV_copy,"profile|J=s","plain") || die_usage();
    my @ARGV_profile = ();
    my @ARGV_env = ();
    if(not $opt::plain) {
        # Add options from $PARALLEL_HOME/config and other profiles
        my @config_profiles = (
            "/etc/parallel/config",
            (map { "$_/config" } @Global::config_dirs),
            $ENV{'HOME'}."/.parallelrc");
        my @profiles = @config_profiles;
        if(@opt::profile) {
            # --profile overrides default profiles
            @profiles = ();
            for my $profile (@opt::profile) {
                if($profile =~ m:^\./|^/:) {
                    # Look for ./profile in .
                    # Look for /profile in /
                    push @profiles, grep { -r $_ } $profile;
                } else {
                    # Look for the $profile in @Global::config_dirs
                    push @profiles, grep { -r $_ }
                    map { "$_/$profile" } @Global::config_dirs;
                }
            }
        }
        for my $profile (@profiles) {
            if(-r $profile) {
                ::debug("init","Read $profile\n");
                local $/ = "\n";
                open (my $in_fh, "<", $profile) ||
                    ::die_bug("read-profile: $profile");
                while(<$in_fh>) {
                    /^\s*\#/ and next;
                    chomp;
                    push @ARGV_profile, shell_words($_);
                }
                close $in_fh;
            } else {
                if(grep /^\Q$profile\E$/, @config_profiles) {
                    # config file is not required to exist
                } else {
                    ::error("$profile not readable.");
                    wait_and_exit(255);
                }
            }
        }
        # Add options from shell variable $PARALLEL
        if($ENV{'PARALLEL'}) {
            push @ARGV_env, shell_words($ENV{'PARALLEL'});
        }
        # Add options from env_parallel.csh via $PARALLEL_CSH
        if($ENV{'PARALLEL_CSH'}) {
            push @ARGV_env, shell_words($ENV{'PARALLEL_CSH'});
        }
    }
    Getopt::Long::Configure("bundling","require_order");
    get_options_from_array(\@ARGV_profile) || die_usage();
    get_options_from_array(\@ARGV_env) || die_usage();
    get_options_from_array(\@ARGV) || die_usage();
    # What were the options given on the command line?
    # Used to start --sqlworker
    my $ai = arrayindex(\@ARGV_orig, \@ARGV);
    @Global::options_in_argv = @ARGV_orig[0..$ai-1];
    # Prepend non-options to @ARGV (such as commands like 'nice')
    unshift @ARGV, @ARGV_profile, @ARGV_env;
    return @ARGV;
}

sub arrayindex($$) {
    # Similar to Perl's index function, but for arrays
    # Input:
    #   $arr_ref1 = ref to @array1 to search in
    #   $arr_ref2 = ref to @array2 to search for
    # Returns:
    #   $pos = position of @array1 in @array2, -1 if not found
    my ($arr_ref1,$arr_ref2) = @_;
    my $array1_as_string = join "", map { "\0".$_ } @$arr_ref1;
    my $array2_as_string = join "", map { "\0".$_ } @$arr_ref2;
    my $i = index($array1_as_string,$array2_as_string,0);
    if($i == -1) { return -1 }
    my @before = split /\0/, substr($array1_as_string,0,$i);
    return $#before;
}

sub read_args_from_command_line() {
    # Arguments given on the command line after:
    #   ::: ($Global::arg_sep)
    #   :::: ($Global::arg_file_sep)
    #   :::+ ($Global::arg_sep with --link)
    #   ::::+ ($Global::arg_file_sep with --link)
    # Removes the arguments from @ARGV and:
    # - puts filenames into -a
    # - puts arguments into files and add the files to -a
    # - adds --linkinputsource with 0/1 for each -a depending on :::+/::::+
    # Input:
    #   @::ARGV = command option ::: arg arg arg :::: argfiles
    # Uses:
    #   $Global::arg_sep
    #   $Global::arg_file_sep
    #   $opt::_pipe_means_argfiles
    #   $opt::pipe
    #   @opt::a
    # Returns:
    #   @argv_no_argsep = @::ARGV without ::: and :::: and following args
    my %group_sep = ($Global::arg_sep => ":::",
                     $Global::arg_sep."+" => ":::+",
                     $Global::arg_file_sep => "::::",
                     $Global::arg_file_sep."+" => "::::+");
    sub is_linked($) {
        # file is linked if file starts with +
        local $_ = shift;
        if(/^\+(.*)/) {
            my $noplus = $1;
            if(-e $_ and -e $noplus) {
                ::error("It is unclear whether you mean +./$noplus or ./+$noplus");
                wait_and_exit(255);
            } elsif(-e $_ and not -e $noplus) {
                # This is ./+file = this is not linked
                return 0;
            } elsif(not -e $_ and -e $noplus) {
                # This is +./file = this is linked
                return 1;
            } elsif(not -e $_ and not -e $noplus) {
                # File does not exist, maybe it is stdin?
                if($_ eq "-") {
                    # This is - = this is not linked
                    return 0;
                } elsif($_ eq "+-") {
                    # This is +- = this is linked
                    return 1;
                } else {
                    ::error("File not found: $_");
                    wait_and_exit(255);
                }
            } else {
                ::die_bug("noplus: $noplus $_");
            }
        }
        # not linked
        return 0;
    }
    sub cmd_template() {
        # remove command template from @ARGV
        # keep ::: / :::: in @ARGV if any
        my @cmd_template;
        while(@ARGV) {
            my $arg = shift @ARGV;
            if($group_sep{$arg}) {
                # Found separator: push it back and exit loop
                unshift @ARGV, $arg;
                last;
            }
            push @cmd_template, $arg;
        }
        return @cmd_template;
    }
    sub divide_into_groups() {
        # Split arguments from @ARGV into groups:
        #   ::: 1 2 3 :::: a b c ::::+ d e f
        # =>
        #   [ ::: 1 2 3 ], [ :::: a b c ], [ ::::+ d e f ]
        my @g;
        my @grp;
        while(@ARGV) {
            my $arg = shift @ARGV;
            if($group_sep{$arg}) {
                # start a new group
                push @grp, [@g];
                @g = ($group_sep{$arg});
            } else {
                push @g, $arg;
            }
        }
        push @grp, [@g];
        shift @grp; # The first will always be empty
        return @grp;
    }
    sub save_to_file(@) {
        # Put args into a file, return open file handle of file
        # Create argfile
        my ($fh,$name) = ::tmpfile(SUFFIX => ".arg");
        unlink($name);
        # Put args into argfile
        print $fh map { $_,$/ } @_;
        seek $fh, 0, 0;
        exit_if_disk_full();
        return $fh;
    }
    my @cmd = cmd_template();
    # The rest of @ARGV is ::: / :::: args
    # If there are any -a: Rewrite them to use ::::
    if(@opt::a) { unshift @ARGV, $Global::arg_file_sep, @opt::a; }
    @opt::a = ();
    # Convert ::: and :::: into (linked) files and put those into @opt::a
    for my $g_ref (divide_into_groups()) {
        my $group_sep = shift @$g_ref;
        if($group_sep eq ":::" or $group_sep eq ":::+") {
            # Group starts with ::: / :::+
            if($opt::_pipe_means_argfiles and $#$g_ref < 0) {
                # TODO
                # Deal with --shebang-wrap and ::: on the shebang line
            } else {
                push @opt::a, save_to_file(@$g_ref);
                # if $group_sep == ":::+": it is linked
                push @opt::linkinputsource, ($group_sep eq ":::+");
            }
        } elsif($group_sep eq "::::" or $group_sep eq "::::+") {
            # Group starts with :::: / ::::+
            for my $f (@$g_ref) {
                if($group_sep eq "::::+") {
                    # Linking forced
                    push @opt::a, $f;
                    push @opt::linkinputsource, 1;
                } elsif($group_sep eq "::::") {
                    # Auto detect linking
                    if(is_linked($f)) {
                        # +file
                        push @opt::linkinputsource, 1;
                        $f =~ s/^\+//;
                    } else {
                        # file (no plus)
                        push @opt::linkinputsource, 0;
                    }
                    push @opt::a, $f;
                } else {
                    ::die_bug("arg link error");
                }
            }
        } else {
            ::die_bug("arg link error");
        }
    }
    # Output: command to run with options
    return @cmd;
}

sub cleanup() {
    # Returns: N/A
    unlink keys %Global::unlink;
    map { rmdir $_ } keys %Global::unlink;
    if(@opt::basefile and $opt::cleanup) { cleanup_basefile(); }
    for(keys %Global::sshmaster) {
        # If 'ssh -M's are running: kill them
        kill "TERM", $_;
    }
}


sub __QUOTING_ARGUMENTS_FOR_SHELL__() {}

sub shell_quote(@) {
    # Input:
    #   @strings = strings to be quoted
    # Returns:
    #   @shell_quoted_strings = string quoted as needed by the shell
    return wantarray ? (map { Q($_) } @_) : (join" ",map { Q($_) } @_);
}

sub shell_quote_scalar_rc($) {
    # Quote for the rc-shell
    my $a = $_[0];
    if(defined $a) {
        if(($a =~ s/'/''/g)
           +
           ($a =~ s/[\n\002-\011\013-\032\\\#\?\`\(\)\{\}\[\]\^\*\<\=\>\~\|\; \"\!\$\&\'\202-\377]+/'$&'/go)) {
            # A string was replaced
            # No need to test for "" or \0
        } elsif($a eq "") {
            $a = "''";
        } elsif($a eq "\0") {
            $a = "";
        }
    }
    return $a;
}

sub shell_quote_scalar_csh($) {
    # Quote for (t)csh
    my $a = $_[0];
    if(defined $a) {
        # $a =~ s/([\002-\011\013-\032\\\#\?\`\(\)\{\}\[\]\^\*\>\<\~\|\; \"\!\$\&\'\202-\377])/\\$1/g;
        # This is 1% faster than the above
        if(($a =~ s/[\002-\011\013-\032\\\#\?\`\(\)\{\}\[\]\^\*\<\=\>\~\|\; \"\!\$\&\'\202-\377]/\\$&/go)
           +
           # quote newline in csh as \\\n
           ($a =~ s/[\n]/"\\\n"/go)) {
            # A string was replaced
            # No need to test for "" or \0
        } elsif($a eq "") {
            $a = "''";
        } elsif($a eq "\0") {
            $a = "";
        }
    }
    return $a;
}

sub shell_quote_scalar_default($) {
    # Quote for other shells (Bourne compatibles)
    # Inputs:
    #   $string = string to be quoted
    # Returns:
    #   $shell_quoted = string quoted as needed by the shell
    local $_ = $_[0];
    if(/[^-_.+a-z0-9\/]/i) {
        s/'+/'"$&"'/g;  # "-quote '-quotes: ''' => "'''"
        $_ = "'$_'";    # '-quote entire string
        s/^''//;        # Remove unneeded '' at ends
        s/''$//;        # (faster than s/^''|''$//g)
        return $_;
    } elsif ($_ eq "") {
        return "''";
    } else {
        # No quoting needed
        return $_;
    }
}

sub shell_quote_scalar($) {
    # Quote the string so the shell will not expand any special chars
    # Inputs:
    #   $string = string to be quoted
    # Returns:
    #   $shell_quoted = string quoted as needed by the shell

    # Speed optimization: Choose the correct shell_quote_scalar_*
    # and call that directly from now on
    no warnings 'redefine';
    if($Global::cshell) {
        # (t)csh
        *shell_quote_scalar = \&shell_quote_scalar_csh;
    } elsif($Global::shell =~ m:(^|/)rc$:) {
        # rc-shell
        *shell_quote_scalar = \&shell_quote_scalar_rc;
    } else {
        # other shells
        *shell_quote_scalar = \&shell_quote_scalar_default;
    }
    # The sub is now redefined. Call it
    return shell_quote_scalar($_[0]);
}

sub Q($) {
    # Q alias for ::shell_quote_scalar
    my $ret = shell_quote_scalar($_[0]);
    no warnings 'redefine';
    *Q = \&::shell_quote_scalar;
    return $ret;
}

sub shell_quote_file($) {
    # Quote the string so shell will not expand any special chars
    # and prepend ./ if needed
    # Input:
    #   $filename = filename to be shell quoted
    # Returns:
    #   $quoted_filename = filename quoted with \ and ./ if needed
    my $a = shift;
    if(defined $a) {
        if($a =~ m:^/: or $a =~ m:^\./:) {
            # /abs/path or ./rel/path => skip
        } else {
            # rel/path => ./rel/path
            $a = "./".$a;
        }
    }
    return Q($a);
}

sub shell_words(@) {
    # Input:
    #   $string = shell line
    # Returns:
    #   @shell_words = $string split into words as shell would do
    $Global::use{"Text::ParseWords"} ||= eval "use Text::ParseWords; 1;";
    return Text::ParseWords::shellwords(@_);
}

sub perl_quote_scalar($) {
    # Quote the string so perl's eval will not expand any special chars
    # Inputs:
    #   $string = string to be quoted
    # Returns:
    #   $perl_quoted = string quoted with \ as needed by perl's eval
    my $a = $_[0];
    if(defined $a) {
        $a =~ s/[\\\"\$\@]/\\$&/go;
    }
    return $a;
}

# -w complains about prototype
sub pQ($) {
    # pQ alias for ::perl_quote_scalar
    my $ret = perl_quote_scalar($_[0]);
    *pQ = \&::perl_quote_scalar;
    return $ret;
}

sub unquote_printf() {
    # Convert \t \n \r \000 \0
    # Inputs:
    #   $string = string with \t \n \r \num \0
    # Returns:
    #   $replaced = string with TAB NEWLINE CR <ascii-num> NUL
    $_ = shift;
    s/\\t/\t/g;
    s/\\n/\n/g;
    s/\\r/\r/g;
    s/\\(\d\d\d)/eval 'sprintf "\\'.$1.'"'/ge;
    s/\\(\d)/eval 'sprintf "\\'.$1.'"'/ge;
    return $_;
}


sub __FILEHANDLES__() {}


sub save_stdin_stdout_stderr() {
    # Remember the original STDIN, STDOUT and STDERR
    # and file descriptors opened by the shell (e.g. 3>/tmp/foo)
    # Uses:
    #   %Global::fh
    #   $Global::original_stderr
    #   $Global::original_stdin
    # Returns: N/A

    # TODO Disabled until we have an open3 that will take n filehandles
    # for my $fdno (1..61) {
    # # /dev/fd/62 and above are used by bash for <(cmd)
    # # Find file descriptors that are already opened (by the shell)
    # Only focus on stdout+stderr for now
    for my $fdno (1..2) {
        my $fh;
        # 2-argument-open is used to be compatible with old perl 5.8.0
        # bug #43570: Perl 5.8.0 creates 61 files
        if(open($fh,">&=$fdno")) {
            $Global::fh{$fdno}=$fh;
        }
    }
    open $Global::original_stderr, ">&", "STDERR" or
        ::die_bug("Can't dup STDERR: $!");
    open $Global::status_fd, ">&", "STDERR" or
        ::die_bug("Can't dup STDERR: $!");
    open $Global::original_stdin, "<&", "STDIN" or
        ::die_bug("Can't dup STDIN: $!");
}

sub enough_file_handles() {
    # Check that we have enough filehandles available for starting
    # another job
    # Uses:
    #   $opt::ungroup
    #   %Global::fh
    # Returns:
    #   1 if ungrouped (thus not needing extra filehandles)
    #   0 if too few filehandles
    #   1 if enough filehandles
    if(not $opt::ungroup) {
        my %fh;
        my $enough_filehandles = 1;
        # perl uses 7 filehandles for something?
        # open3 uses 2 extra filehandles temporarily
        # We need a filehandle for each redirected file descriptor
        # (normally just STDOUT and STDERR)
        for my $i (1..(7+2+keys %Global::fh)) {
            $enough_filehandles &&= open($fh{$i}, "<", "/dev/null");
        }
        for (values %fh) { close $_; }
        return $enough_filehandles;
    } else {
        # Ungrouped does not need extra file handles
        return 1;
    }
}

sub open_or_exit($$) {
    # Open a file name or exit if the file cannot be opened
    # Inputs:
    #   $mode = read:"<" write:">"
    #   $file = filehandle or filename to open
    # Uses:
    #   $Global::original_stdin
    # Returns:
    #   $fh = file handle to opened file
    my $mode = shift;
    my $file = shift;
    if($file eq "-") {
        if($mode eq "<") {
            return ($Global::original_stdin || *STDIN);
        } else {
            return ($Global::original_stderr || *STDERR);
        }
    }
    if(ref $file eq "GLOB") {
        # This is an open filehandle
        return $file;
    }
    my $fh = gensym;
    if(not open($fh, $mode, $file)) {
        ::error("Cannot open `$file': $!");
        wait_and_exit(255);
    }
    return $fh;
}

sub slurp_or_exit($) {
    # Read content of a file or exit if the file cannot be opened
    # Inputs:
    #   $file = filehandle or filename to open
    # Returns:
    #   $content = content as scalar
    my $fh = open_or_exit("<",shift);
    # $/ = undef => slurp whole file
    local $/;
    my $content = <$fh>;
    close $fh;
    return $content;
}

sub write_or_exit(@) {
    # Write content to a file or exit if the file cannot be opened
    # Inputs:
    #   $file = filehandle or filename to open
    #   @content = content to be written
    # Returns:
    #   N/A
    my $file = shift;
    sub failed {
        error("Cannot write to `$file': $!");
        wait_and_exit(255);
    }
    my $fh = open_or_exit(">",$file);
    print($fh @_) or failed();
    close($fh) or failed();
}

sub set_fh_blocking($) {
    # Set filehandle as blocking
    # Inputs:
    #   $fh = filehandle to be blocking
    # Returns:
    #   N/A
    my $fh = shift;
    $Global::use{"Fcntl"} ||= eval "use Fcntl qw(:DEFAULT :flock); 1;";
    my $flags;
    # Get the current flags on the filehandle
    fcntl($fh, &F_GETFL, $flags) || die $!;
    # Remove non-blocking from the flags
    $flags &= ~&O_NONBLOCK;
    # Set the flags on the filehandle
    fcntl($fh, &F_SETFL, $flags) || die $!;
}

sub set_fh_non_blocking($) {
    # Set filehandle as non-blocking
    # Inputs:
    #   $fh = filehandle to be blocking
    # Returns:
    #   N/A
    my $fh = shift;
    $Global::use{"Fcntl"} ||= eval "use Fcntl qw(:DEFAULT :flock); 1;";
    my $flags;
    # Get the current flags on the filehandle
    fcntl($fh, &F_GETFL, $flags) || die $!;
    # Add non-blocking to the flags
    $flags |= &O_NONBLOCK;
    # Set the flags on the filehandle
    fcntl($fh, &F_SETFL, $flags) || die $!;
}


sub __RUNNING_THE_JOBS_AND_PRINTING_PROGRESS__() {}


# Variable structure:
#
#    $Global::running{$pid} = Pointer to Job-object
#    @Global::virgin_jobs = Pointer to Job-object that have received no input
#    $Global::host{$sshlogin} = Pointer to SSHLogin-object
#    $Global::total_running = total number of running jobs
#    $Global::total_started = total jobs started
#    $Global::max_procs_file = filename if --jobs is given a filename
#    $Global::JobQueue = JobQueue object for the queue of jobs
#    $Global::timeoutq = queue of times where jobs timeout
#    $Global::newest_job = Job object of the most recent job started
#    $Global::newest_starttime = timestamp of $Global::newest_job
#    @Global::sshlogin
#    $Global::minimal_command_line_length = min len supported by all sshlogins
#    $Global::start_no_new_jobs = should more jobs be started?
#    $Global::original_stderr = file handle for STDERR when the program started
#    $Global::total_started = total number of jobs started
#    $Global::joblog = filehandle of joblog
#    $Global::debug = Is debugging on?
#    $Global::exitstatus = status code of GNU Parallel
#    $Global::quoting = quote the command to run

sub init_run_jobs() {
    # Set Global variables and progress signal handlers
    # Do the copying of basefiles
    # Returns: N/A
    $Global::total_running = 0;
    $Global::total_started = 0;
    $SIG{USR1} = \&list_running_jobs;
    $SIG{USR2} = \&toggle_progress;
    if(@opt::basefile) { setup_basefile(); }
}

{
    my $last_time;
    my %last_mtime;
    my $max_procs_file_last_mod;

    sub changed_procs_file {
        # If --jobs is a file and it is modfied:
        # Force recomputing of max_jobs_running for each $sshlogin
        # Uses:
        #   $Global::max_procs_file
        #   %Global::host
        # Returns: N/A
        if($Global::max_procs_file) {
            # --jobs filename
            my $mtime = (stat($Global::max_procs_file))[9];
            $max_procs_file_last_mod ||= 0;
            if($mtime > $max_procs_file_last_mod) {
                # file changed: Force re-computing max_jobs_running
                $max_procs_file_last_mod = $mtime;
                for my $sshlogin (values %Global::host) {
                    $sshlogin->set_max_jobs_running(undef);
                }
            }
        }
    }

    sub changed_sshloginfile {
        # If --slf is changed:
        #   reload --slf
        #   filter_hosts
        #   setup_basefile
        # Uses:
        #   @opt::sshloginfile
        #   @Global::sshlogin
        #   %Global::host
        #   $opt::filter_hosts
        # Returns: N/A
        if(@opt::sshloginfile) {
            # Is --sshloginfile changed?
            for my $slf (@opt::sshloginfile) {
                my $actual_file = expand_slf_shorthand($slf);
                my $mtime = (stat($actual_file))[9];
                $last_mtime{$actual_file} ||= $mtime;
                if($mtime - $last_mtime{$actual_file} > 1) {
                    ::debug("run",
                            "--sshloginfile $actual_file changed. reload\n");
                    $last_mtime{$actual_file} = $mtime;
                    # Reload $slf
                    # Empty sshlogins
                    @Global::sshlogin = ();
                    for (values %Global::host) {
                        # Don't start new jobs on any host
                        # except the ones added back later
                        $_->set_max_jobs_running(0);
                    }
                    # This will set max_jobs_running on the SSHlogins
                    read_sshloginfile($actual_file);
                    parse_sshlogin();
                    $opt::filter_hosts and filter_hosts();
                    setup_basefile();
                }
            }
        }
    }

    sub start_more_jobs {
        # Run start_another_job() but only if:
        #   * not $Global::start_no_new_jobs set
        #   * not JobQueue is empty
        #   * not load on server is too high
        #   * not server swapping
        #   * not too short time since last remote login
        # Uses:
        #   %Global::host
        #   $Global::start_no_new_jobs
        #   $Global::JobQueue
        #   $opt::pipe
        #   $opt::load
        #   $opt::noswap
        #   $opt::delay
        #   $Global::newest_starttime
        # Returns:
        #   $jobs_started = number of jobs started
        my $jobs_started = 0;
        if($Global::start_no_new_jobs) {
            return $jobs_started;
        }
        if(time - ($last_time||0) > 1) {
            # At most do this every second
            $last_time = time;
            changed_procs_file();
            changed_sshloginfile();
        }
        # This will start 1 job on each --sshlogin (if possible)
        # thus distribute the jobs on the --sshlogins round robin
        for my $sshlogin (values %Global::host) {
            if($Global::JobQueue->empty() and not $opt::pipe) {
                # No more jobs in the queue
                last;
            }
            debug("run", "Running jobs before on ", $sshlogin->string(), ": ",
                  $sshlogin->jobs_running(), "\n");
            if ($sshlogin->jobs_running() < $sshlogin->max_jobs_running()) {
                if($opt::delay
                   and
                   $opt::delay-0.008 > ::now()-$Global::newest_starttime) {
                    # It has been too short since last start
                    next;
                }
                if($opt::load and $sshlogin->loadavg_too_high()) {
                    # The load is too high or unknown
                    next;
                }
                if($opt::noswap and $sshlogin->swapping()) {
                    # The server is swapping
                    next;
                }
                if($opt::limit and $sshlogin->limit()) {
                    # Over limit
                    next;
                }
                if(($opt::memfree or $opt::memsuspend)
                   and
                   $sshlogin->memfree() < $Global::memlimit) {
                    # The server has not enough mem free
                    ::debug("mem", "Not starting job: not enough mem\n");
                    next;
                }
                if($sshlogin->too_fast_remote_login()) {
                    # It has been too short since last login
                    next;
                }
                debug("run", $sshlogin->string(),
                      " has ", $sshlogin->jobs_running(),
                      " out of ", $sshlogin->max_jobs_running(),
                      " jobs running. Start another.\n");
                if(start_another_job($sshlogin) == 0) {
                    # No more jobs to start on this $sshlogin
                    debug("run","No jobs started on ",
                          $sshlogin->string(), "\n");
                    next;
                }
                $sshlogin->inc_jobs_running();
                $sshlogin->set_last_login_at(::now());
                $jobs_started++;
            }
            debug("run","Running jobs after on ", $sshlogin->string(), ": ",
                  $sshlogin->jobs_running(), " of ",
                  $sshlogin->max_jobs_running(), "\n");
        }

        return $jobs_started;
    }
}

{
    my $no_more_file_handles_warned;

    sub start_another_job() {
        # If there are enough filehandles
        #   and JobQueue not empty
        #   and not $job is in joblog
        # Then grab a job from Global::JobQueue,
        #   start it at sshlogin
        #   mark it as virgin_job
        # Inputs:
        #   $sshlogin = the SSHLogin to start the job on
        # Uses:
        #   $Global::JobQueue
        #   $opt::pipe
        #   $opt::results
        #   $opt::resume
        #   @Global::virgin_jobs
        # 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() and not $opt::pipe) {
                # No more commands to run
                debug("start", "Not starting: JobQueue empty\n");
                return 0;
            } else {
                my $job;
                # Skip jobs already in job log
                # Skip jobs already in results
                do {
                    $job = get_job_with_sshlogin($sshlogin);
                    if(not defined $job) {
                        # No command available for that sshlogin
                        debug("start", "Not starting: no jobs available for ",
                              $sshlogin->string(), "\n");
                        return 0;
                    }
                    if($job->is_already_in_joblog()) {
                        $job->free_slot();
                    }
                } while ($job->is_already_in_joblog()
                         or
                         ($opt::results and $opt::resume
                          and $job->is_already_in_results()));
                debug("start", "Command to run on '",
                      $job->sshlogin()->string(), "': '",
                      $job->replaced(),"'\n");
                if($job->start()) {
                    if($opt::pipe) {
                        if($job->virgin()) {
                            push(@Global::virgin_jobs,$job);
                        } else {
                            # Block already set: This is a retry
                            $job->write_block();
                        }
                    }
                    debug("start", "Started as seq ", $job->seq(),
                          " pid:", $job->pid(), "\n");
                    return 1;
                } else {
                    # Not enough processes to run the job.
                    # Put it back on the queue.
                    $Global::JobQueue->unget($job);
                    # Count down the number of jobs to run for this SSHLogin.
                    my $max = $sshlogin->max_jobs_running();
                    if($max > 1) { $max--; } else {
                        my @arg;
                        for my $record (@{$job->{'commandline'}{'arg_list'}}) {
                            push @arg, map { $_->orig() } @$record;
                        }
                        ::error("No more processes: cannot run a single job. ".
                                "Something is wrong at @arg.");
                        ::wait_and_exit(255);
                    }
                    $sshlogin->set_max_jobs_running($max);
                    # Sleep up to 300 ms to give other processes time to die
                    ::usleep(rand()*300);
                    ::warning("No more processes: ".
                              "Decreasing number of running jobs to $max.",
                              "Try increasing 'ulimit -u' (try: ulimit -u `ulimit -Hu`)",
                              "or increasing 'nproc' in /etc/security/limits.conf",
                              "or increasing /proc/sys/kernel/pid_max");
                    return 0;
                }
            }
        } else {
            # No more file handles
            $no_more_file_handles_warned++ or
                ::warning("No more file handles. ",
                          "Try running 'parallel -j0 -N 100 --pipe parallel -j0'",
                          "or increasing 'ulimit -n' (try: ulimit -n `ulimit -Hn`)",
                          "or increasing 'nofile' in /etc/security/limits.conf",
                          "or increasing /proc/sys/fs/file-max");
            debug("start", "No more file handles. ");
            return 0;
        }
    }
}

sub init_progress() {
    # Uses:
    #   $opt::bar
    # Returns:
    #   list of computers for progress output
    $|=1;
    if($opt::bar) {
        return("","");
    }
    my $progress = progress();
    my $cpu_units = $opt::use_sockets_instead_of_threads ? "CPU sockets" :
        ($opt::use_cores_instead_of_threads ? "CPU cores" : "CPU threads");
    return ("\nComputers / $cpu_units / Max jobs to run\n",
            $progress->{'workerlist'},"\n",$progress->{'header'});
}

sub drain_job_queue(@) {
    # Uses:
    #   $opt::progress
    #   $Global::total_running
    #   $Global::max_jobs_running
    #   %Global::running
    #   $Global::JobQueue
    #   %Global::host
    #   $Global::start_no_new_jobs
    # Returns: N/A
    my @command = @_;
    my $sleep = 0.2;
    my $sleepsum = 0;
    do {
        while($Global::total_running > 0) {
            debug("init",$Global::total_running, "==", scalar
                  keys %Global::running," slots: ", $Global::max_jobs_running);
            if($opt::pipe) {
                # When using --pipe sometimes file handles are not
                # closed properly
                for my $job (values %Global::running) {
                    close $job->fh(0,"w");
                }
            }
            if($opt::progress) {
                my $progress = progress();
                ::status_no_nl("\r",$progress->{'status'});
            }
            if($Global::total_running < $Global::max_jobs_running
               and not $Global::JobQueue->empty()) {
                # These jobs may not be started because of loadavg
                # or too little time between each ssh login.
                if(start_more_jobs() > 0) {
                    # Exponential back-on if jobs were started
                    $sleep = $sleep/2+0.001;
                }
            }
            # Exponential back-off sleeping
            $sleep = ::reap_usleep($sleep);
            $sleepsum += $sleep;
            if($sleepsum >= 1000) {
                # At most do this every second
                $sleepsum = 0;
                changed_procs_file();
                changed_sshloginfile();
                start_more_jobs();
            }
        }
        if(not $Global::JobQueue->empty()) {
            # These jobs may not be started:
            # * because there the --filter-hosts has removed all
            if(not %Global::host) {
                ::error("There are no hosts left to run on.");
                ::wait_and_exit(255);
            }
            # * because of loadavg
            # * because of too little time between each ssh login.
            $sleep = ::reap_usleep($sleep);
            start_more_jobs();
            if($Global::max_jobs_running == 0) {
                ::warning("There are no job slots available. Increase --jobs.");
            }
        }
        while($opt::sqlmaster and not $Global::sql->finished()) {
            # SQL master
            $sleep = ::reap_usleep($sleep);
            start_more_jobs();
            if($Global::start_sqlworker) {
                # Start an SQL worker as we are now sure there is work to do
                $Global::start_sqlworker = 0;
                if(my $pid = fork()) {
                    $Global::unkilled_sqlworker = $pid;
                } else {
                    # Replace --sql/--sqlandworker with --sqlworker
                    my @ARGV = (map { s/^--sql(andworker)?$/--sqlworker/; $_ }
                                @Global::options_in_argv);
                    # exec the --sqlworker
                    exec($0,@ARGV,@command);
                }
            }
        }
    } while ($Global::total_running > 0
             or
             not $Global::start_no_new_jobs and not $Global::JobQueue->empty()
             or
             $opt::sqlmaster and not $Global::sql->finished());
    $Global::all_jobs_done = 1;
    if($opt::progress) {
        my $progress = progress();
        ::status("\r".$progress->{'status'});
    }
}

sub toggle_progress() {
    # Turn on/off progress view
    # Uses:
    #   $opt::progress
    # Returns: N/A
    $opt::progress = not $opt::progress;
    if($opt::progress) {
        ::status_no_nl(init_progress());
    }
}

{
    my $last_header;
    my $eol;

    sub progress() {
        # Uses:
        #       $opt::bar
        #       $opt::eta
        #       %Global::host
        #       $Global::total_started
        # Returns:
        #       $workerlist = list of workers
        #       $header = that will fit on the screen
        #       $status = message that will fit on the screen
        if($opt::bar) {
            return {"workerlist" => "", "header" => "", "status" => bar()};
        }
        my $eta = "";
        my ($status,$header)=("","");
        if($opt::eta) {
            my($total, $completed, $left, $pctcomplete, $avgtime, $this_eta) =
                compute_eta();
            $eta = sprintf("ETA: %ds Left: %d AVG: %.2fs  ",
                           $this_eta, $left, $avgtime);
        }
        my $termcols = terminal_columns();
        my @workers = sort keys %Global::host;
        my $workerno = 1;
        my %wrk;
        for my $w (@workers) {
            my %i;
            $i{'sshlogin'} = $w eq ":" ? "local" : $w;
            $i{'no'} = $workerno++;
            $i{'ncpu'} = ($Global::host{$w}->ncpus() || "-");
            $i{'jobslots'} = $Global::host{$w}->max_jobs_running();
            $i{'completed'} = ($Global::host{$w}->jobs_completed() || 0);
            $i{'running'} = $Global::host{$w}->jobs_running();
            $i{'pct'} = $Global::total_started ?
                (($i{'running'}+$i{'completed'})*100 /
                 $Global::total_started) : 0;
            $i{'time'} = $i{'completed'} ? (time-$^T)/($i{'completed'}) : 0;
            $wrk{$w} = \%i;
        }

        my $workerlist = "";
        for my $w (@workers) {
            $workerlist .=
                $wrk{$w}{'no'}.":".$wrk{$w}{'sshlogin'} ." / ".
                $wrk{$w}{'ncpu'}." / ".
                $wrk{$w}{'jobslots'}."\n";
        }
        # Force $status to select one of the below formats
        $status = "c"x($termcols+1);
        # Select an output format that will fit on a single line
        if(length $status > $termcols) {
            # sshlogin1:XX/XX/XX%/XX.Xs s2:XX/XX/XX%/XX.Xs s3:XX/XX/XX%/XX.Xs
            $header = "Computer:jobs running/jobs completed/".
                "%of started jobs/Average seconds to complete";
            $status = $eta . join(" ",map {
                sprintf("%s:%d/%d/%d%%/%.1fs ",
                        @{$wrk{$_}}
                        {'sshlogin','running','completed','pct','time'}
                    ); } @workers);
        }
        if(length $status > $termcols) {
            # 1:XX/XX/XX%/X.Xs 2:XX/XX/XX%/X.Xs 3:XX/XX/XX%/X.Xs
            $header = "Computer:jobs running/jobs completed/%of started jobs";
            $status = $eta . join(" ",map {
                sprintf("%s:%d/%d/%d%%/%.1fs ",
                        @{$wrk{$_}}
                        {'no','running','completed','pct','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%%",
                        @{$wrk{$_}}
                        {'sshlogin','running','completed','pct'}
                    ); } @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%
            $header = "Computer:jobs running/jobs completed/%of started jobs";
            $status = $eta . join(" ",map {
                sprintf("%s:%d/%d/%d%%",
                        @{$wrk{$_}}
                        {'no','running','completed','pct'}
                    ); } @workers);
        }
        if(length $status > $termcols) {
            # sshlogin1:XX/XX sshlogin2:XX/XX sshlogin3:XX/XX
            $header = "Computer:jobs running/jobs completed";
            $status = $eta . join(" ", map {
                sprintf("%s:%d/%d",
                        @{$wrk{$_}}
                        {'sshlogin','running','completed'}
                    ); } @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",
                        @{$wrk{$_}}
                        {'no','running','completed'}
                    ); } @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",
                        @{$wrk{$_}}
                        {'sshlogin','completed'}
                    ); } @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",
                        @{$wrk{$_}}
                        {'no','completed'}
                    ); } @workers);
        }
        if($last_header ne $header) {
            $header .= "\n";
            $last_header = $header;
        } else {
            $header = "";
        }
        if(not $eol) {
            $eol = `sh -c "tput el </dev/tty" 2>/dev/null`;
            chomp($eol);
            if($eol eq "") { $eol = "\033[K"; }
        }

        return {"workerlist" => $workerlist, "header" => $header,
                    "status" => $status.$eol};
    }
}

{

    my ($first_completed, $smoothed_avg_time, $last_eta);

    sub compute_eta {
        # Calculate important numbers for ETA
        # Returns:
        #   $total = number of jobs in total
        #   $completed = number of jobs completed
        #   $left = number of jobs left
        #   $pctcomplete = percent of jobs completed
        #   $avgtime = averaged time
        #   $eta = smoothed eta
        my $completed = $Global::total_completed;
        # In rare cases with -X will $completed > total_jobs()
        my $total = ::max($Global::JobQueue->total_jobs(),$completed);
        my $left = $total - $completed;
        if(not $completed) {
            return($total, $completed, $left, 0, 0, 0);
        }
        my $pctcomplete = ::min($completed / $total,100);
        $first_completed ||= time;
        my $timepassed = (time - $first_completed);
        my $avgtime = $timepassed / $completed;
        $smoothed_avg_time ||= $avgtime;
        # Smooth the eta so it does not jump wildly
        $smoothed_avg_time = (1 - $pctcomplete) * $smoothed_avg_time +
            $pctcomplete * $avgtime;
        my $eta = int($left * $smoothed_avg_time);
        if($eta*0.90 < $last_eta and $last_eta < $eta) {
            # Eta jumped less that 10% up: Keep the last eta instead
            $eta = $last_eta;
        } else {
            $last_eta = $eta;
        }
        return($total, $completed, $left, $pctcomplete, $avgtime, $eta);
    }
}

{
    my ($rev,$reset);

    sub bar() {
        # Return:
        #   $status = bar with eta, completed jobs, arg and pct
        $rev ||= "\033[7m";
        $reset ||= "\033[0m";
        my($total, $completed, $left, $pctcomplete, $avgtime, $eta) =
            compute_eta();
        if($Global::all_jobs_done) { $eta = now()-$Global::start_time; }
        my $arg = $Global::newest_job ?
            $Global::newest_job->{'commandline'}->
            replace_placeholders(["\257<\257>"],0,0) : "";
        $arg = decode_utf8($arg);
        my $eta_dhms = ::seconds_to_time_units($eta);
        my $bar_text =
            sprintf("%d%% %d:%d=%s %s",
                    $pctcomplete*100, $completed, $left, $eta_dhms, $arg);
        my $terminal_width = terminal_columns();
        my $s = sprintf("%-${terminal_width}s",
                        substr($bar_text." "x$terminal_width,
                               0,$terminal_width));
        my $width = int($terminal_width * $pctcomplete);
        substr($s,$width,0) = $reset;
        my $zenity = sprintf("%-${terminal_width}s",
                             substr("#   $eta sec $arg",
                                    0,$terminal_width));
        # Prefix with zenity header
        $s = "\r" . $zenity . "\r" . $pctcomplete*100 .
            "\r" . $rev . $s . $reset;
        return $s;
    }
}

{
    my ($rows,$columns,$last_update_time);

    sub compute_terminal_size() {
        # && true is to force spawning a shell and not just exec'ing
        my @tput = qx{ tput lines cols </dev/tty 2>/dev/null && true };
        $rows = 0 + $tput[0];
        $columns = 0 + $tput[1];
        if(not ($rows && $columns)) {
            # && true is to force spawning a shell and not just exec'ing
            my $stty = qx{ stty -a </dev/tty 2>/dev/null && true };
            # FreeBSD/OpenBSD/NetBSD/Dragonfly/MirOS
            # MacOSX/IRIX/AIX/Tru64
            $stty =~ /(\d+) columns/ and do { $columns = $1; };
            $stty =~ /(\d+) rows/ and do { $rows = $1; };
            # GNU/Linux/Solaris
            $stty =~ /columns (\d+)/ and do { $columns = $1; };
            $stty =~ /rows (\d+)/ and do { $rows = $1; };
            # Solaris-x86/HPUX/SCOsysV/UnixWare/OpenIndiana
            $stty =~ /columns = (\d+)/ and do { $columns = $1; };
            $stty =~ /rows = (\d+)/ and do { $rows = $1; };
            # QNX
            $stty =~ /rows=(\d+),(\d+)/ and do { ($rows,$columns) = ($1,$2); };
        }
        if(not ($rows && $columns)) {
            # && true is to force spawning a shell and not just exec'ing
            my $resize = qx{ resize 2>/dev/null && true };
            $resize =~ /COLUMNS=(\d+);/ and do { $columns ||= $1; };
            $resize =~ /LINES=(\d+);/ and do { $rows ||= $1; };
        }
        $rows ||= 24;
        $columns ||= 80;
    }

    sub update_terminal_size() {
        # Only update once per second.
        if($last_update_time < time) {
            $last_update_time = time;
            compute_terminal_size();
            # Set signal WINdow CHange to force recompute
            $SIG{WINCH} = \&compute_terminal_size;
        }
    }

    sub terminal_rows() {
        # Get the number of rows of the terminal.
        # Returns:
        #   number of rows of the screen
        update_terminal_size();
        return $rows;
    }

    sub terminal_columns() {
        # Get the number of columns of the terminal.
        # Returns:
        #   number of columns of the screen
        update_terminal_size();
        return $columns;
    }
}

sub untabify($) {
    # Convert \t into spaces
    my @out;
    my ($src);
    # Deal with multi-byte characters
    for my $src (split("\t",$_[0])) {
        push @out, $src. " "x(8-mbswidth($src)%8);
    }
    return join "",@out;
}

# Prototype forwarding
sub get_job_with_sshlogin($);
sub get_job_with_sshlogin($) {
    # Input:
    #   $sshlogin = which host should the job be run on?
    # Uses:
    #   $opt::hostgroups
    #   $Global::JobQueue
    # Returns:
    #   $job = next job object for $sshlogin if any available
    my $sshlogin = shift;
    my $job;

    if ($opt::hostgroups) {
        my @other_hostgroup_jobs = ();

        while($job = $Global::JobQueue->get()) {
            if($sshlogin->in_hostgroups($job->hostgroups())) {
                # Found a job to be run on a hostgroup of this
                # $sshlogin
                last;
            } else {
                # This job was not in the hostgroups of $sshlogin
                push @other_hostgroup_jobs, $job;
            }
        }
        $Global::JobQueue->unget(@other_hostgroup_jobs);
        if(not defined $job) {
            # No more jobs
            return undef;
        }
    } else {
        $job = $Global::JobQueue->get();
        if(not defined $job) {
            # No more jobs
            ::debug("start", "No more jobs: JobQueue empty\n");
            return undef;
        }
    }
    if(not $job->suspended()) {
        $job->set_sshlogin($sshlogin);
    }
    if(defined $opt::retries and $job->failed_here()) {
        # This command with these args failed for this sshlogin
        my ($no_of_failed_sshlogins,$min_failures) = $job->min_failed();
        # Only look at the Global::host that have > 0 jobslots
        if($no_of_failed_sshlogins ==
           grep { $_->max_jobs_running() > 0 } values %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()) {
                # This can potentially recurse for all args
                no warnings 'recursion';
                $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_sshloginfiles(@) {
    # Read a list of --slf's
    # Input:
    #   @files = files or symbolic file names to read
    # Returns: N/A
    for my $s (@_) {
        read_sshloginfile(expand_slf_shorthand($s));
    }
}

sub expand_slf_shorthand($) {
    # Expand --slf shorthand into a read file name
    # Input:
    #   $file = file or symbolic file name to read
    # Returns:
    #   $file = actual file name to read
    my $file = shift;
    if($file eq "-") {
        # skip: It is stdin
    } elsif($file eq "..") {
        $file = $Global::config_dir."/sshloginfile";
    } elsif($file eq ".") {
        $file = "/etc/parallel/sshloginfile";
    } elsif(not -r $file) {
        for(@Global::config_dirs) {
            if(not -r $_."/".$file) {
                # Try prepending $PARALLEL_HOME
                ::error("Cannot open $file.");
                ::wait_and_exit(255);
            } else {
                $file = $_."/".$file;
                last;
            }
        }
    }
    return $file;
}

sub read_sshloginfile($) {
    # Read sshloginfile into @Global::sshlogin
    # Input:
    #   $file = file to read
    # Uses:
    #   @Global::sshlogin
    # Returns: N/A
    local $/ = "\n";
    my $file = shift;
    my $close = 1;
    my $in_fh;
    ::debug("init","--slf ",$file);
    if($file eq "-") {
        $in_fh = *STDIN;
        $close = 0;
    } else {
        $in_fh = open_or_exit("<", $file);
    }
    while(<$in_fh>) {
        chomp;
        /^\s*#/ and next;
        /^\s*$/ and next;
        push @Global::sshlogin, $_;
    }
    if($close) {
        close $in_fh;
    }
}

sub parse_sshlogin() {
    # Parse @Global::sshlogin into %Global::host.
    # Keep only hosts that are in one of the given ssh hostgroups.
    # Uses:
    #   @Global::sshlogin
    #   $Global::minimal_command_line_length
    #   %Global::host
    #   $opt::transfer
    #   @opt::return
    #   $opt::cleanup
    #   @opt::basefile
    #   @opt::trc
    # Returns: N/A
    sub expand_range($) {
        # Expand host[9-11,15]a[09-11]b
        # [9-11,15] => 9 10 11 15
        # [09-11] => 09 10 11
        my ($in) = @_;
        my ($prefix, $range, $suffix);
        if(($prefix, $range, $suffix) = $in =~ /^(.*?)\[([-0-9,]*)\](.*)$/) {
            my @res;
            while(length $range) {
                if($range =~ s/^,//) {
                    # skip
                } elsif($range =~ s/^(\d+)-(\d+)//) {
                    my ($start, $end) = ($1, $2);
                    push @res, map { $prefix . $_ . $suffix } $start..$end;
                } elsif($range =~ s/^(\d+)//) {
                    push @res, map { $prefix . $_ . $suffix } $1;
                } else {
                    die "Cannot parse $in (at $range)";
                }
            }
            return map { expand_range($_) } @res;
        } else {
            return $in;
        }
    }    
    my @login;
    if(not @Global::sshlogin) { @Global::sshlogin = (":"); }
    for my $sshlogin (@Global::sshlogin) {
        # Split up -S sshlogin,sshlogin
        # Parse ,, and \, as , but do not split on that
        #   -S "ssh -J jump1,,jump2 host1,host2" =>
        #     ssh -J jump1,jump2 host1
        #     host2
        # Protect \, and ,, as \0
        $sshlogin =~ s/\\,|,,/\0/g;
        # Protect , in ranges: [___,___] => [___\0___]
        while($sshlogin =~ s/(\[[-0-9\0]*),(.*\])/$1\0$2/g) {}
        for my $s (split /,|\n/, $sshlogin) {
            # Replace \0 => ,
            $s =~ s/\0/,/g;
            if ($s eq ".." or $s eq "-") {
                # This may add to @Global::sshlogin - possibly bug
                read_sshloginfile(expand_slf_shorthand($s));
            } else {
                $s =~ s/\s*$//;
                # Expand host[1-12,15]a[01-10]b
                push @login, expand_range($s);
            }
        }
    }
    $Global::minimal_command_line_length = 100_000_000;
    my @allowed_hostgroups;
    for my $ncpu_sshlogin_string (::uniq(@login)) {
        my $sshlogin = SSHLogin->new($ncpu_sshlogin_string);
        my $sshlogin_string = $sshlogin->string();
        if($sshlogin_string eq "") {
            # This is an ssh group: -S @webservers
            push @allowed_hostgroups, $sshlogin->hostgroups();
            next;
        }
        if($Global::host{$sshlogin_string}) {
            # This sshlogin has already been added:
            # It is probably a host that has come back
            # Set the max_jobs_running back to the original
            debug("run","Already seen $sshlogin_string\n");
            if($sshlogin->{'ncpus'}) {
                # If ncpus set by '#/' of the sshlogin, overwrite it:
                $Global::host{$sshlogin_string}->set_ncpus($sshlogin->ncpus());
            }
            $Global::host{$sshlogin_string}->set_max_jobs_running(undef);
            next;
        }
        $sshlogin->set_maxlength(Limits::Command::max_length());

        $Global::minimal_command_line_length =
            ::min($Global::minimal_command_line_length, $sshlogin->maxlength());
        $Global::host{$sshlogin_string} = $sshlogin;
    }
    $Global::usable_command_line_length =
        # Usable len = maxlen - 3000 for wrapping, div 2 for hexing
        int(($Global::minimal_command_line_length - 3000)/2);
    if($opt::max_chars) {
        if($opt::max_chars <= $Global::usable_command_line_length) {
            $Global::usable_command_line_length = $opt::max_chars;
        } else {
            ::warning("Value for option -s should be < ".
                      $Global::usable_command_line_length.".");
        }
    }
    if(@allowed_hostgroups) {
        # Remove hosts that are not in these groups
        while (my ($string, $sshlogin) = each %Global::host) {
            if(not $sshlogin->in_hostgroups(@allowed_hostgroups)) {
                delete $Global::host{$string};
            }
        }
    }

    # debug("start", "sshlogin: ", my_dump(%Global::host),"\n");
    if(@Global::transfer_files or @opt::return
       or $opt::cleanup or @opt::basefile) {
        if(not remote_hosts()) {
            # There are no remote hosts
            if(@opt::trc) {
                ::warning("--trc ignored as there are no remote --sshlogin.");
            } elsif (defined $opt::transfer) {
                ::warning("--transfer ignored as there are ".
                          "no remote --sshlogin.");
            } elsif (@opt::transfer_files) {
                ::warning("--transferfile ignored as there ".
                          "are no remote --sshlogin.");
            } elsif (@opt::return) {
                ::warning("--return ignored as there are no remote --sshlogin.");
            } elsif (defined $opt::cleanup and not %opt::template) {
                ::warning("--cleanup ignored as there ".
                          "are no remote --sshlogin.");
            } elsif (@opt::basefile) {
                ::warning("--basefile ignored as there ".
                          "are no remote --sshlogin.");
            }
        }
    }
}

sub remote_hosts() {
    # Return sshlogins that are not ':'
    # Uses:
    #   %Global::host
    # 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
    # Uses:
    #   %Global::host
    #   @opt::basefile
    # Returns: N/A
    my @cmd;
    my $rsync_destdir;
    my $workdir;
    for my $sshlogin (values %Global::host) {
      if($sshlogin->local()) { next }
      for my $file (@opt::basefile) {
        if($file !~ m:^/: and $opt::workdir eq "...") {
          ::error("Work dir '...' will not work with relative basefiles.");
          ::wait_and_exit(255);
        }
        if(not $workdir) {
            my $dummycmdline =
                CommandLine->new(1,["true"],{},0,0,[],[],[],[],{},{});
            my $dummyjob = Job->new($dummycmdline);
            $workdir = $dummyjob->workdir();
        }
        push @cmd, $sshlogin->rsync_transfer_cmd($file,$workdir);
      }
    }
    debug("init", "basesetup: @cmd\n");
    my ($exitstatus,$stdout_ref,$stderr_ref) =
        run_gnu_parallel((join "\n",@cmd),"-j0","--retries",5);
    if($exitstatus) {
        my @stdout = @$stdout_ref;
        my @stderr = @$stderr_ref;
        ::error("Copying of --basefile failed: @stdout@stderr");
        ::wait_and_exit(255);
    }
}

sub cleanup_basefile() {
    # Remove the basefiles transferred
    # Uses:
    #   %Global::host
    #   @opt::basefile
    # Returns: N/A
    my @cmd;
    my $workdir;
    if(not $workdir) {
        my $dummycmdline = CommandLine->new(1,["true"],{},0,0,[],[],[],[],{},{});
        my $dummyjob = Job->new($dummycmdline);
        $workdir = $dummyjob->workdir();
    }
    for my $sshlogin (values %Global::host) {
        if($sshlogin->local()) { next }
        for my $file (@opt::basefile) {
            push @cmd, $sshlogin->cleanup_cmd($file,$workdir);
        }
    }
    debug("init", "basecleanup: @cmd\n");
    my ($exitstatus,$stdout_ref,$stderr_ref) =
        run_gnu_parallel(join("\n",@cmd),"-j0","--retries",5);
    if($exitstatus) {
        my @stdout = @$stdout_ref;
        my @stderr = @$stderr_ref;
        ::error("Cleanup of --basefile failed: @stdout@stderr");
        ::wait_and_exit(255);
    }
}

sub run_gnu_parallel() {
    my ($stdin,@args) = @_;
    my $cmd = join "",map { " $_ & " } split /\n/, $stdin;
    print $Global::original_stderr ` $cmd wait` ;
    return 0
}

sub _run_gnu_parallel() {
    # Run GNU Parallel
    # This should ideally just fork an internal copy
    # and not start it through a shell
    # Input:
    #   $stdin = data to provide on stdin for GNU   Parallel
    #   @args = command line arguments
    # Returns:
    #   $exitstatus = exitcode of GNU Parallel run
    #   \@stdout = standard output
    #   \@stderr = standard error
    my ($stdin,@args) = @_;
    my ($exitstatus,@stdout,@stderr);
    my ($stdin_fh,$stdout_fh)=(gensym(),gensym());
    my ($stderr_fh, $stderrname) = ::tmpfile(SUFFIX => ".par");
    unlink $stderrname;

    my $pid = ::open3($stdin_fh,$stdout_fh,$stderr_fh,
                      $0,qw(--plain --shell /bin/sh --will-cite), @args);
    if(my $writerpid = fork()) {
        close $stdin_fh;
        @stdout = <$stdout_fh>;
        # Now stdout is closed:
        # These pids should be dead or die very soon
        while(kill 0, $writerpid) { ::usleep(1); }
        die;
#       reap $writerpid;
#       while(kill 0, $pid) { ::usleep(1); }
#       reap $writerpid;
        $exitstatus = $?;
        seek $stderr_fh, 0, 0;
        @stderr = <$stderr_fh>;
        close $stdout_fh;
        close $stderr_fh;
    } else {
        close $stdout_fh;
        close $stderr_fh;
        print $stdin_fh $stdin;
        close $stdin_fh;
        exit(0);
    }
    return ($exitstatus,\@stdout,\@stderr);
}

sub filter_hosts() {
    # Remove down --sshlogins from active duty.
    # Find ncpus, ncores, maxlen, time-to-login for each host.
    # Uses:
    #   %Global::host
    #   $Global::minimal_command_line_length
    #   $opt::use_sockets_instead_of_threads
    #   $opt::use_cores_instead_of_threads
    #   $opt::use_cpus_instead_of_cores
    # Returns: N/A

    my ($nsockets_ref,$ncores_ref, $nthreads_ref, $time_to_login_ref,
        $maxlen_ref, $echo_ref, $down_hosts_ref) =
        parse_host_filtering(parallelized_host_filtering());

    delete @Global::host{@$down_hosts_ref};
    @$down_hosts_ref and ::warning("Removed @$down_hosts_ref.");

    $Global::minimal_command_line_length = 100_000_000;
    while (my ($string, $sshlogin) = each %Global::host) {
        if($sshlogin->local()) { next }
        my ($nsockets,$ncores,$nthreads,$time_to_login,$maxlen) =
            ($nsockets_ref->{$string},$ncores_ref->{$string},
             $nthreads_ref->{$string},$time_to_login_ref->{$string},
             $maxlen_ref->{$string});
        defined $nsockets or ::die_bug("nsockets missing: $string");
        defined $ncores or ::die_bug("ncores missing: $string");
        defined $nthreads or ::die_bug("nthreads missing: $string");
        defined $time_to_login or ::die_bug("time_to_login missing: $string");
        defined $maxlen or ::die_bug("maxlen missing: $string");
        # ncpus may be set by 4/hostname or may be undefined yet
        my $ncpus = $sshlogin->{'ncpus'};
        # $nthreads may be 0 if GNU Parallel is not installed remotely
        $ncpus = $nthreads || $ncpus || $sshlogin->ncpus();
        if($opt::use_cpus_instead_of_cores) {
            $ncpus = $ncores || $ncpus;
        } elsif($opt::use_sockets_instead_of_threads) {
            $ncpus = $nsockets || $ncpus;
        } elsif($opt::use_cores_instead_of_threads) {
            $ncpus = $ncores || $ncpus;
        }
        $sshlogin->set_ncpus($ncpus);
        $sshlogin->set_time_to_login($time_to_login);
        $maxlen = $maxlen || Limits::Command::max_length();
        $sshlogin->set_maxlength($maxlen);
        ::debug("init", "Timing from -S:$string ",
                " ncpus:", $ncpus,
                " nsockets:",$nsockets,
                " ncores:", $ncores,
                " nthreads:",$nthreads,
                " time_to_login:", $time_to_login,
                " maxlen:", $maxlen,
                " min_max_len:", $Global::minimal_command_line_length,"\n");
    }
}

sub parse_host_filtering() {
    # Input:
    #   @lines = output from parallelized_host_filtering()
    # Returns:
    #   \%nsockets = number of sockets of {host}
    #   \%ncores = number of cores of {host}
    #   \%nthreads = number of hyperthreaded cores of {host}
    #   \%time_to_login = time_to_login on {host}
    #   \%maxlen = max command len on {host}
    #   \%echo = echo received from {host}
    #   \@down_hosts = list of hosts with no answer
    local $/ = "\n";
    my (%nsockets, %ncores, %nthreads, %time_to_login, %maxlen, %echo,
        @down_hosts);
    for (@_) {
        ::debug("init","Read: ",$_);
        chomp;
        my @col = split /\t/, $_;
        if($col[0] =~ /^parallel: Warning:/) {
            # Timed out job: Ignore it
            next;
        } elsif(defined $col[6]) {
            # This is a line from --joblog
            # seq host time spent sent received exit signal command
            # 2 : 1372607672.654 0.675 0 0 0 0 eval true\ m\;ssh\ m\ parallel\ --number-of-cores
            if($col[0] eq "Seq" and $col[1] eq "Host" and
                    $col[2] eq "Starttime") {
                # Header => skip
                next;
            }
            # Get server from: eval true server\;
            $col[8] =~ /eval .?true.?\s([^\;]+);/ or
                ::die_bug("col8 does not contain host: $col[8] in $_");
            my $host = $1;
            $host =~ tr/\\//d;
            $Global::host{$host} or next;
            if($col[6] eq "255" or $col[6] eq "-1" or $col[6] eq "1") {
                # exit == 255 or exit == timeout (-1): ssh failed/timedout
                # exit == 1: lsh failed
                # Remove sshlogin
                ::debug("init", "--filtered $host\n");
                push(@down_hosts, $host);
            } elsif($col[6] eq "127") {
                # signal == 127: parallel not installed remote
                # Set nsockets, ncores, nthreads = 1
                ::warning("Could not figure out ".
                          "number of cpus on $host. Using 1.");
                $nsockets{$host} = 1;
                $ncores{$host} = 1;
                $nthreads{$host} = 1;
                $maxlen{$host} = Limits::Command::max_length();
            } elsif($col[0] =~ /^\d+$/ and $Global::host{$host}) {
                # Remember how log it took to log in
                # 2 : 1372607672.654 0.675 0 0 0 0 eval true\ m\;ssh\ m\ echo
                $time_to_login{$host} = ::min($time_to_login{$host},$col[3]);
            } else {
                ::die_bug("host check unmatched long jobline: $_");
            }
        } elsif($Global::host{$col[0]}) {
            # This output from --number-of-cores, --number-of-cpus,
            # --max-line-length-allowed
            # ncores: server       8
            # ncpus:  server       2
            # maxlen: server       131071
            if(/parallel: Warning: Cannot figure out number of/) {
                next;
            }
            if(/\t(perl: warning:|LANGUAGE =|LC_ALL =|LANG =|are supported and installed|Disconnected from|Received disconnect from)/
               or
               /\tWarning: /
               or
               /\t(Host key fingerprint is|\+-.*-\+|\|.*\|)/
               or
               /\t\S+: Undefined variable./
                ) {
                # Skip these (from perl):
                #   perl: warning: Setting locale failed.
                #   perl: warning: Please check that your locale settings:
                #         LANGUAGE = (unset),
                #         LC_ALL = (unset),
                #         LANG = "en_US.UTF-8"
                #       are supported and installed on your system.
                #   perl: warning: Falling back to the standard locale ("C").
                #   Disconnected from 127.0.0.1 port 22
                #
                # Skip these (from ssh):
                #   Warning: Permanently added * to the list of known hosts.
                #   Warning: Identity file * not accessible: *
                #   (VisualHostKey=yes)
                #   Host key fingerprint is SHA256:...
                #   +--[ED25519 256]--+
                #   |               o |
                #   +----[SHA256]-----+
                #
                # Skip these (from csh):
                #   MANPATH: Undefined variable.
            } elsif(not defined $nsockets{$col[0]}) {
                $nsockets{$col[0]} = $col[1];
            } elsif(not defined $ncores{$col[0]}) {
                $ncores{$col[0]} = $col[1];
            } elsif(not defined $nthreads{$col[0]}) {
                $nthreads{$col[0]} = $col[1];
            } elsif(not defined $maxlen{$col[0]}) {
                $maxlen{$col[0]} = $col[1];
            } elsif(not defined $echo{$col[0]}) {
                $echo{$col[0]} = $col[1];
            } else {
                ::die_bug("host check too many col0: $_");
            }
        } else {
            ::die_bug("host check unmatched short jobline ($col[0]): $_");
        }
    }
    @down_hosts = uniq(@down_hosts);
    return(\%nsockets, \%ncores, \%nthreads, \%time_to_login,
           \%maxlen, \%echo, \@down_hosts);
}

sub parallelized_host_filtering() {
    # Uses:
    #   %Global::host
    # Returns:
    #   text entries with:
    #   * joblog line
    #   * hostname \t number of cores
    #   * hostname \t number of cpus
    #   * hostname \t max-line-length-allowed
    #   * hostname \t empty

    sub sshwrapped {
        # Wrap with ssh and --env
        # Return $default_value if command fails
        my $sshlogin = shift;
        my $command = shift;
        # wrapper that returns output "0\n" if the command fails
        # E.g. parallel not installed => "0\n"
        my $wcmd = q(perl -e '$a=`).$command.q(`; print $? ? "0".v010 : $a');
        my $commandline = CommandLine->new(1,[$wcmd],{},0,0,[],[],[],[],{},{});
        my $job = Job->new($commandline);
        $job->set_sshlogin($sshlogin);
        $job->wrapped();
        return($job->{'wrapped'});
    }

    my(@sockets, @cores, @threads, @maxline, @echo);
    while (my ($host, $sshlogin) = each %Global::host) {
        if($host eq ":") { next }
        # The 'true' is used to get the $host out later
        push(@sockets, $host."\t"."true $host; ".
             sshwrapped($sshlogin,"parallel --number-of-sockets")."\n\0");
        push(@cores, $host."\t"."true $host; ".
             sshwrapped($sshlogin,"parallel --number-of-cores")."\n\0");
        push(@threads, $host."\t"."true $host; ".
             sshwrapped($sshlogin,"parallel --number-of-threads")."\n\0");
        push(@maxline, $host."\t"."true $host; ".
             sshwrapped($sshlogin,
                        "parallel --max-line-length-allowed")."\n\0");
        # 'echo' is used to get the fastest possible ssh login time
        push(@echo, $host."\t"."true $host; ".
             $sshlogin->wrap("echo $host")."\n\0");
    }
    # --timeout 10: Setting up an SSH connection and running a simple
    #               command should never take > 10 sec.
    # --delay 0.1:  If multiple sshlogins use the same proxy the delay
    #               will make it less likely to overload the ssh daemon.
    # --retries 3:  If the ssh daemon is overloaded, try 3 times
    my $cmd =
        "$0 -j0 --timeout 10 --joblog - --plain --delay 0.1 --retries 3 ".
        "--tag --tagstring '{1}' -0 --colsep '\t' -k eval '{2}' && true ";
    $cmd = $Global::shell." -c ".Q($cmd);
    ::debug("init", $cmd, "\n");
    my @out;
    my $prepend = "";

    my ($host_fh,$in,$err);
    open3($in, $host_fh, $err, $cmd) || ::die_bug("parallel host check: $cmd");
    ::debug("init", map { $_,"\n" } @sockets, @cores, @threads, @maxline, @echo);

    if(not fork()) {
        # Give the commands to run to the $cmd
        close $host_fh;
        print $in @sockets, @cores, @threads, @maxline, @echo;
        close $in;
        exit();
    }
    close $in;
    # If -0: $/ must be \n
    local $/ = "\n";
    for(<$host_fh>) {
        # TODO incompatible with '-quoting. Needs to be fixed differently
        #if(/\'$/) {
        #    # if last char = ' then append next line
        #    # This may be due to quoting of \n in environment var
        #    $prepend .= $_;
        #    next;
        #}
        $_ = $prepend . $_;
        $prepend = "";
        push @out, $_;
    }
    close $host_fh;
    return @out;
}

sub onall($@) {
    # Runs @command on all hosts.
    # Uses parallel to run @command on each host.
    # --jobs = number of hosts to run on simultaneously.
    # For each host a parallel command with the args will be running.
    # Uses:
    #   $Global::debug
    #   $Global::exitstatus
    #   $Global::joblog
    #   $Global::quoting
    #   $opt::D
    #   $opt::arg_file_sep
    #   $opt::arg_sep
    #   $opt::colsep
    #   $opt::files
    #   $opt::files0
    #   $opt::group
    #   $opt::joblog
    #   $opt::jobs
    #   $opt::keeporder
    #   $opt::linebuffer
    #   $opt::max_chars
    #   $opt::plain
    #   $opt::retries
    #   $opt::tag
    #   $opt::tee
    #   $opt::timeout
    #   $opt::ungroup
    #   %Global::host
    #   @opt::basefile
    #   @opt::env
    #   @opt::v
    # Input:
    #   @command = command to run on all hosts
    # Returns: N/A
    sub tmp_joblog {
        # Input:
        #   $joblog = filename of joblog - undef if none
        # Returns:
        #   $tmpfile = temp file for joblog - undef if none
        my $joblog = shift;
        if(not defined $joblog) {
            return undef;
        }
        my ($fh, $tmpfile) = ::tmpfile(SUFFIX => ".log");
        close $fh;
        return $tmpfile;
    }
    my ($input_source_fh_ref,@command) = @_;
    if($Global::quoting) {
       @command = shell_quote(@command);
    }

    # Copy all @input_source_fh (-a and :::) into tempfiles
    my @argfiles = ();
    for my $fh (@$input_source_fh_ref) {
        my ($outfh, $name) = ::tmpfile(SUFFIX => ".all", UNLINK => not $opt::D);
        print $outfh (<$fh>);
        close $outfh;
        push @argfiles, $name;
    }
    if(@opt::basefile) { setup_basefile(); }
    # for each sshlogin do:
    # parallel -S $sshlogin $command :::: @argfiles
    #
    # Pass some of the options to the sub-parallels, not all of them as
    # -P should only go to the first, and -S should not be copied at all.
    my $options =
        join(" ",
             ((defined $opt::sshdelay) ? "--delay ".$opt::sshdelay : ""),
             ((defined $opt::memfree) ? "--memfree ".$opt::memfree : ""),
             ((defined $opt::memsuspend) ? "--memfree ".$opt::memsuspend : ""),
             ((defined $opt::D) ? "-D $opt::D" : ""),
             ((defined $opt::group) ? "--group" : ""),
             ((defined $opt::jobs) ? "-P $opt::jobs" : ""),
             ((defined $opt::keeporder) ? "--keeporder" : ""),
             ((defined $opt::linebuffer) ? "--linebuffer" : ""),
             ((defined $opt::max_chars) ? "--max-chars ".$opt::max_chars : ""),
             ((defined $opt::plain) ? "--plain" : ""),
             (($opt::ungroup == 1) ? "-u" : ""),
             ((defined $opt::tee) ? "--tee" : ""),
        );
    my $suboptions =
        join(" ",
             ((defined $opt::sshdelay) ? "--delay ".$opt::sshdelay : ""),
             ((defined $opt::D) ? "-D $opt::D" : ""),
             ((defined $opt::arg_file_sep) ? "--arg-file-sep ".$opt::arg_file_sep : ""),
             ((defined $opt::arg_sep) ? "--arg-sep ".$opt::arg_sep : ""),
             ((defined $opt::colsep) ? "--colsep ".shell_quote($opt::colsep) : ""),
             ((defined $opt::files) ? "--files" : ""),
             ((defined $opt::files0) ? "--files0" : ""),
             ((defined $opt::group) ? "--group" : ""),
             ((defined $opt::cleanup) ? "--cleanup" : ""),
             ((defined $opt::keeporder) ? "--keeporder" : ""),
             ((defined $opt::linebuffer) ? "--linebuffer" : ""),
             ((defined $opt::max_chars) ? "--max-chars ".$opt::max_chars : ""),
             ((defined $opt::plain) ? "--plain" : ""),
             ((defined $opt::plus) ? "--plus" : ""),
             ((defined $opt::retries) ? "--retries ".$opt::retries : ""),
             ((defined $opt::timeout) ? "--timeout ".$opt::timeout : ""),
             (($opt::ungroup == 1) ? "-u" : ""),
             ((defined $opt::ssh) ? "--ssh '".$opt::ssh."'" : ""),
             ((defined $opt::tee) ? "--tee" : ""),
             ((defined $opt::workdir) ? "--wd ".Q($opt::workdir) : ""),
             (@Global::transfer_files ? map { "--tf ".Q($_) }
              @Global::transfer_files : ""),
             (@Global::ret_files ? map { "--return ".Q($_) }
              @Global::ret_files : ""),
             (@opt::env ? map { "--env ".Q($_) } @opt::env : ""),
             (map { "-v" } @opt::v),
        );
    ::debug("init", "| $0 $options\n");
    open(my $parallel_fh, "|-", "$0 -0 --will-cite -j0 $options") ||
        ::die_bug("This does not run GNU Parallel: $0 $options");
    my @joblogs;
    for my $host (sort keys %Global::host) {
        my $sshlogin = $Global::host{$host};
        my $qsshlogin = Q($sshlogin->string());
        my $qsshloginpw = Q($sshlogin->pwstring());
        if($qsshloginpw ne $qsshlogin) {
            ::warning_once("Using password or SSHPASS with --(n)onall ".
                           "exposes the password",
                           "on the command line, ".
                           "making it visible to local users via `ps`.");
        }
        my $joblog = tmp_joblog($opt::joblog);
        if($joblog) {
            push @joblogs, $joblog;
            $joblog = "--joblog ".::Q($joblog);
        }
        my $quad = $opt::arg_file_sep || "::::";
        # If PARALLEL_ENV is set: Pass it on
        my $penv=$Global::parallel_env ?
            "PARALLEL_ENV=".Q($Global::parallel_env) : '';
        my $results;
        if(defined $opt::results) {
            $results = Q($opt::results) . $qsshlogin;
        }
        ::debug("init", "$penv $0 $suboptions -j1 $joblog ",
                ((defined $opt::tag) ? "--tagstring ".$qsshlogin : ""),
                ((defined $opt::results) ? "--results ".$results : ""),
                " -S $qsshloginpw ",
                join(" ",shell_quote(@command,$quad,@argfiles)),"\n");
        print $parallel_fh "$penv $0 $suboptions -j1 $joblog ",
            ((defined $opt::tag) ? "--tagstring ".$qsshlogin : ""),
            ((defined $opt::results) ? "--results ".$results : ""),
            " -S $qsshloginpw ",
            join(" ",shell_quote(@command,$quad,@argfiles)),"\0";
    }
    close $parallel_fh;
    $Global::exitstatus = $? >> 8;
    debug("init", "--onall exitvalue ", $?);
    if(@opt::basefile and $opt::cleanup) { cleanup_basefile(); }
    $Global::debug or unlink(@argfiles);
    my %seen;
    for my $joblog (@joblogs) {
        # Append to $joblog
        my $fh = open_or_exit("<", $joblog);
        # Skip first line (header);
        <$fh>;
        print $Global::joblog (<$fh>);
        close $fh;
        unlink($joblog);
    }
}


sub __SIGNAL_HANDLING__() {}


sub sigtstp() {
    # Send TSTP signal (Ctrl-Z) to all children process groups
    # Uses:
    #   %SIG
    # Returns: N/A
    signal_children("TSTP");
}

sub sigpipe() {
    # Send SIGPIPE signal to all children process groups
    # Uses:
    #   %SIG
    # Returns: N/A
    signal_children("PIPE");
}

sub signal_children() {
    # Send signal to all children process groups
    # and GNU   Parallel itself
    # Uses:
    #   %SIG
    # Returns: N/A
    my $signal = shift;
    debug("run", "Sending $signal ");
    kill $signal, map { -$_ } keys %Global::running;
    # Use default signal handler for GNU Parallel itself
    $SIG{$signal} = undef;
    kill $signal, $$;
}

sub save_original_signal_handler() {
    # Remember the original signal handler
    # Uses:
    #   %Global::original_sig
    # Returns: N/A
    $SIG{INT} = sub {
        if($opt::tmux) { ::qqx("tmux kill-session -t p$$"); }
        wait_and_exit(255);
    };
    $SIG{TERM} = sub {
        if($opt::tmux) { ::qqx("tmux kill-session -t p$$"); }
        wait_and_exit(255);
    };
    %Global::original_sig = %SIG;
    $SIG{TERM} = sub {}; # Dummy until jobs really start
    $SIG{ALRM} = 'IGNORE';
    # Allow Ctrl-Z to suspend and `fg` to continue
    $SIG{TSTP} = \&sigtstp;
    $SIG{PIPE} = \&sigpipe;
    $SIG{CONT} = sub {
        # Set $SIG{TSTP} again (it is undef'ed in sigtstp() )
        $SIG{TSTP} = \&sigtstp;
        for my $job (values %Global::running) {
            if($job->suspended()) {
                # Force jobs to suspend, if they are marked as suspended.
                # --memsupspend can suspend a job that will be resumed
                # if the user presses CTRL-Z followed by `fg`.
                $job->suspend();
            } else {
                # Resume the rest of the jobs
                $job->resume();
            }
        }
    };
}

sub list_running_jobs() {
    # Print running jobs on tty
    # Uses:
    #   %Global::running
    # Returns: N/A
    for my $job (values %Global::running) {
        ::status("$Global::progname: ".$job->replaced());
    }
}

sub start_no_new_jobs() {
    # Start no more jobs
    # Uses:
    #    %Global::original_sig
    #    %Global::unlink
    #    $Global::start_no_new_jobs
    # Returns: N/A
    unlink keys %Global::unlink;
    ::status
        ("$Global::progname: SIGHUP received. No new jobs will be started.",
         "$Global::progname: Waiting for these ".(keys %Global::running).
         " jobs to finish. Send SIGTERM to stop now.");
    list_running_jobs();
    $Global::start_no_new_jobs ||= 1;
}

sub reapers() {
    # Run reaper until there are no more left
    # Returns:
    #   @pids_reaped = pids of reaped processes
    my @pids_reaped;
    my $pid;
    while($pid = reaper()) {
        push @pids_reaped, $pid;
    }
    return @pids_reaped;
}

sub reaper() {
    # A job finished:
    # * Set exitstatus, exitsignal, endtime.
    # * Free ressources for new job
    # * Update median runtime
    # * Print output
    # * If --halt = now: Kill children
    # * Print progress
    # Uses:
    #   %Global::running
    #   $opt::timeout
    #   $Global::timeoutq
    #   $opt::keeporder
    #   $Global::total_running
    # Returns:
    #   $stiff = PID of child finished
    my $stiff;
    debug("run", "Reaper ");
    if(($stiff = waitpid(-1, &WNOHANG)) <= 0) {
        # No jobs waiting to be reaped
        return 0;
    }

    # $stiff = pid of dead process
    my $job = $Global::running{$stiff};

    # '-a <(seq 10)' will give us a pid not in %Global::running
    # The same will one of the ssh -M: ignore
    $job or return 0;
    delete $Global::running{$stiff};
    $Global::total_running--;
    if($job->{'commandline'}{'skip'}) {
        # $job->skip() was called
        $job->set_exitstatus(-2);
        $job->set_exitsignal(0);
    } else {
        $job->set_exitsignal($? & 127);
        if($job->exitstatus()) {
            # Exit status already set - probably by --timeout
        } elsif($? & 127) {
            # Killed by signal. Many shells return: 128 | $signal
            $job->set_exitstatus(128 | $?);
        } else {
            # Normal exit
            $job->set_exitstatus($? >> 8);
        }
    }

    debug("run", "\nseq ",$job->seq()," died (", $job->exitstatus(), ")");
    if($Global::delayauto or $Global::sshdelayauto) {
        if($job->exitstatus()) {
            # Job failed: Increase delay (if $opt::(ssh)delay set)
            $opt::delay &&= $opt::delay * 1.3;
            $opt::sshdelay &&= $opt::sshdelay * 1.3;
        } else {
            # Job succeeded: Decrease delay (if $opt::(ssh)delay set)
            $opt::delay &&= $opt::delay * 0.9;
            $opt::sshdelay &&= $opt::sshdelay * 0.9;
        }
        debug("run", "delay:$opt::delay ssh:$opt::sshdelay ");
    }
    $job->set_endtime(::now());
    my $sshlogin = $job->sshlogin();
    $sshlogin->dec_jobs_running();
    if($job->should_be_retried()) {
        # Free up file handles
        $job->free_ressources();
    } else {
        # The job is done
        $sshlogin->inc_jobs_completed();
        # Free the jobslot
        $job->free_slot();
        if($opt::timeout and not $job->exitstatus()) {
            # Update average runtime for timeout only for successful jobs
            $Global::timeoutq->update_median_runtime($job->runtime());
        }
        if($opt::keeporder and not $opt::latestline) {
            # --latestline fixes --keeporder in Job::row()
            $job->print_earlier_jobs();
        } else {
            $job->print();
        }
        if($job->should_we_halt() eq "now") {
            # Kill children
            ::kill_sleep_seq($job->pid());
            ::killall();
            ::wait_and_exit($Global::halt_exitstatus);
        }
    }
    $job->cleanup();

    if($opt::progress) {
        my $progress = progress();
        ::status_no_nl("\r",$progress->{'status'});
    }

    debug("run", "jobdone \n");
    return $stiff;
}


sub __USAGE__() {}


sub killall() {
    # Kill all jobs by killing their process groups
    # Uses:
    #   $Global::start_no_new_jobs = we are stopping
    #   $Global::killall = Flag to not run reaper
    $Global::start_no_new_jobs ||= 1;
    # Do not reap killed children: Ignore them instead
    $Global::killall ||= 1;
    kill_sleep_seq(keys %Global::running);
}

sub kill_sleep_seq(@) {
    # Send jobs TERM,TERM,KILL to processgroups
    # Input:
    #   @pids = list of pids that are also processgroups
    # Killing can be slow if you follow @term_seq
    # So run the killing in parallel
    if(not fork()) {
        # Convert pids to process groups ($processgroup = -$pid)
        my @pgrps = map { -$_ } @_;
        my @term_seq = split/,/,$opt::termseq;
        if(not @term_seq) {
            @term_seq = ("TERM",200,"TERM",100,"TERM",50,"KILL",25);
        }
        # for each signal+waittime: kill process groups still not dead
        while(@term_seq) {
            @pgrps = kill_sleep(shift @term_seq, shift @term_seq, @pgrps);
        }
        exit(0);
    }
}

sub kill_sleep() {
    # Kill pids with a signal and wait a while for them to die
    # Input:
    #   $signal = signal to send to @pids
    #   $sleep_max = number of ms to sleep at most before returning
    #   @pids = pids to kill (actually process groups)
    # Uses:
    #   $Global::killall = set by killall() to avoid calling reaper
    # Returns:
    #   @pids = pids still alive
    my ($signal, $sleep_max, @pids) = @_;
    ::debug("kill","kill_sleep $signal ",(join " ",sort @pids),"\n");
    kill $signal, @pids;
    my $sleepsum = 0;
    my $sleep = 0.001;

    while(@pids and $sleepsum < $sleep_max) {
        if($Global::killall) {
            # Killall => don't run reaper
            while(waitpid(-1, &WNOHANG) > 0) {
                $sleep = $sleep/2+0.001;
            }
        } elsif(reapers()) {
            $sleep = $sleep/2+0.001;
        }
        $sleep *= 1.1;
        ::usleep($sleep);
        $sleepsum += $sleep;
        # Keep only living children
        @pids = grep { kill(0, $_) } @pids;
    }
    return @pids;
}

sub wait_and_exit($) {
    # If we do not wait, we sometimes get segfault
    # Returns: N/A
    my $error = shift;
    unlink keys %Global::unlink;
    if($error) {
        # Kill all jobs without printing
        killall();
    }
    for (keys %Global::unkilled_children) {
        # Kill any (non-jobs) children (e.g. reserved processes)
        kill 9, $_;
        waitpid($_,0);
        delete $Global::unkilled_children{$_};
    }
    if($Global::unkilled_sqlworker) {
        waitpid($Global::unkilled_sqlworker,0);
    }
    # Avoid: Warning: unable to close filehandle properly: No space
    #        left on device during global destruction.
    $SIG{__WARN__} = sub {};
    if($opt::_parset) {
        # Make the shell script return $error
        print "$Global::parset_endstring\nreturn $error";
    }
    exit($error);
}

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

sub usage() {
    # Returns: N/A
    print join
        ("\n",
         "Usage:",
         "",
         "$Global::progname [options] [command [arguments]] < list_of_arguments",
         "$Global::progname [options] [command [arguments]] (::: arguments|:::: argfile(s))...",
         "cat ... | $Global::progname --pipe [options] [command [arguments]]",
         "",
         "-j n            Run n jobs in parallel",
         "-k              Keep same order",
         "-X              Multiple arguments with context replace",
         "--colsep regexp Split input on regexp for positional replacements",
         "{} {.} {/} {/.} {#} {%} {= perl code =} Replacement strings",
         "{3} {3.} {3/} {3/.} {=3 perl code =}    Positional replacement strings",
         "With --plus:    {} = {+/}/{/} = {.}.{+.} = {+/}/{/.}.{+.} = {..}.{+..} =",
         "                {+/}/{/..}.{+..} = {...}.{+...} = {+/}/{/...}.{+...}",
         "",
         "-S sshlogin     Example: foo\@server.example.com",
         "--slf ..        Use ~/.parallel/sshloginfile as the list of sshlogins",
         "--trc {}.bar    Shorthand for --transfer --return {}.bar --cleanup",
         "--onall         Run the given command with argument on all sshlogins",
         "--nonall        Run the given command with no arguments on all sshlogins",
         "",
         "--pipe          Split stdin (standard input) to multiple jobs.",
         "--recend str    Record end separator for --pipe.",
         "--recstart str  Record start separator for --pipe.",
         "",
         "GNU Parallel can do much more. See 'man $Global::progname' for details",
         "",
         "Academic tradition requires you to cite works you base your article on.",
         "If you use programs that use GNU Parallel to process data for an article in a",
         "scientific publication, please cite:",
         "",
         "  Tange, O. (2024, May 22). GNU Parallel 20240522 ('Tbilisi').",
         "  Zenodo. https://doi.org/10.5281/zenodo.11247979",
         "",
         # Before changing these lines, please read
         # https://www.gnu.org/software/parallel/parallel_design.html#citation-notice
         # https://git.savannah.gnu.org/cgit/parallel.git/tree/doc/citation-notice-faq.txt
         # You accept to be put in a  public hall of shame  by removing
         # these lines
         "This helps funding further development; AND IT WON'T COST YOU A CENT.",
         "If you pay 10000 EUR you should feel free to use GNU Parallel without citing.",
         "",
         "",);
}

sub citation_notice() {
    # if --will-cite or --plain: do nothing
    # if stderr redirected: do nothing
    # if $PARALLEL_HOME/will-cite: do nothing
    # else: print citation notice to stderr
    if($opt::willcite
       or
       $opt::plain
       or
       not -t $Global::original_stderr
       or
       grep { -e "$_/will-cite" } @Global::config_dirs) {
        # skip
    } else {
        ::status
            ("Academic tradition requires you to cite works you base your article on.",
             "If you use programs that use GNU Parallel to process data for an article in a",
             "scientific publication, please cite:",
             "",
             "  Tange, O. (2024, May 22). GNU Parallel 20240522 ('Tbilisi').",
             "  Zenodo. https://doi.org/10.5281/zenodo.11247979",
             "",
             # Before changing these line,  please read
             # https://www.gnu.org/software/parallel/parallel_design.html#citation-notice and
             # https://git.savannah.gnu.org/cgit/parallel.git/tree/doc/citation-notice-faq.txt
             # You accept to be put in a public hall of shame by
             # removing these lines
             "This helps funding further development; AND IT WON'T COST YOU A CENT.",
             "If you pay 10000 EUR you should feel free to use GNU Parallel without citing.",
             "",
             "More about funding GNU Parallel and the citation notice:",
             "https://www.gnu.org/software/parallel/parallel_design.html#citation-notice",
             "",
             "To silence this citation notice: run 'parallel --citation' once.",
             ""
            );
        mkdir $Global::config_dir;
        # Number of times the user has run GNU Parallel without showing
        # willingness to cite
        my $runs = 0;
        if(open (my $fh, "<", $Global::config_dir.
                 "/runs-without-willing-to-cite")) {
            $runs = <$fh>;
            close $fh;
        }
        $runs++;
        if(open (my $fh, ">", $Global::config_dir.
                 "/runs-without-willing-to-cite")) {
            print $fh $runs;
            close $fh;
            if($runs >= 10) {
                ::status("Come on: You have run parallel $runs times. ".
                         "Isn't it about time ",
                         "you run 'parallel --citation' once to silence ".
                         "the citation notice?",
                         "");
            }
        }
    }
}

sub status(@) {
    my @w = @_;
    my $fh = $Global::status_fd || *STDERR;
    print $fh map { ($_, "\n") } @w;
    flush $fh;
}

sub status_no_nl(@) {
    my @w = @_;
    my $fh = $Global::status_fd || *STDERR;
    print $fh @w;
    flush $fh;
}

sub warning(@) {
    my @w = @_;
    my $prog = $Global::progname || "parallel";
    status_no_nl(map { ($prog, ": Warning: ", $_, "\n"); } @w);
}

{
    my %warnings;
    sub warning_once(@) {
        my @w = @_;
        my $prog = $Global::progname || "parallel";
        $warnings{@w}++ or
            status_no_nl(map { ($prog, ": Warning: ", $_, "\n"); } @w);
    }
}

sub error(@) {
    my @w = @_;
    my $prog = $Global::progname || "parallel";
    status(map { ($prog.": Error: ". $_); } @w);
}

sub die_bug($) {
    my $bugid = shift;
    print STDERR
        ("$Global::progname: This should not happen. You have found a bug. ",
         "Please follow\n",
         "https://www.gnu.org/software/parallel/man.html#reporting-bugs\n",
         "\n",
         "Include this in the report:\n",
         "* The version number: $Global::version\n",
         "* The bugid: $bugid\n",
         "* The command line being run\n",
         "* The files being read (put the files on a webserver if they are big)\n",
         "\n",
         "If you get the error on smaller/fewer files, please include those instead.\n");
    ::wait_and_exit(255);
}

sub version() {
    # Returns: N/A
    print join
        ("\n",
         "GNU $Global::progname $Global::version",
         "Copyright (C) 2007-2024 Ole Tange, http://ole.tange.dk and Free Software",
         "Foundation, Inc.",
         "License GPLv3+: GNU GPL version 3 or later <https://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: https://www.gnu.org/software/${Global::progname}\n",
         "When using programs that use GNU Parallel to process data for publication",
         "please cite as described in 'parallel --citation'.\n",
        );
}

sub citation() {
    # Returns: N/A
    my ($all_argv_ref,$argv_options_removed_ref) = @_;
    my $all_argv = "@$all_argv_ref";
    my $no_opts = "@$argv_options_removed_ref";
    $all_argv=~s/--citation//;
    if($all_argv ne $no_opts) {
        ::warning("--citation ignores all other options and arguments.");
        ::status("");
    }

    ::status(
        "Academic tradition requires you to cite works you base your article on.",
        "If you use programs that use GNU Parallel to process data for an article in a",
        "scientific publication, please cite:",
        "",
        "\@software{tange_2024_11247979,",
        "      author       = {Tange, Ole},",
        "      title        = {GNU Parallel 20240522 ('Tbilisi')},",
        "      month        = May,",
        "      year         = 2023,",
        "      note         = {{GNU Parallel is a general parallelizer to run",
        "                       multiple serial command line programs in parallel",
        "                       without changing them.}},",
        "      publisher    = {Zenodo},",
        "      doi          = {10.5281/zenodo.11247979},",
        "      url          = {https://doi.org/10.5281/zenodo.11247979}",
        "}",
        "",
        "(Feel free to use \\nocite{tange_2024_11247979})",
        "",
        # Before changing these lines, please read
        # https://www.gnu.org/software/parallel/parallel_design.html#citation-notice and
        # https://git.savannah.gnu.org/cgit/parallel.git/tree/doc/citation-notice-faq.txt
        # You accept to be put in a public hall of shame by removing
        # these lines
        "This helps funding further development; AND IT WON'T COST YOU A CENT.",
        "If you pay 10000 EUR you should feel free to use GNU Parallel without citing.",
        "",
        "More about funding GNU Parallel and the citation notice:",
        "https://lists.gnu.org/archive/html/parallel/2013-11/msg00006.html",
        "https://www.gnu.org/software/parallel/parallel_design.html#citation-notice",
        "https://git.savannah.gnu.org/cgit/parallel.git/tree/doc/citation-notice-faq.txt",
        ""
        );
    while(not grep { -e "$_/will-cite" } @Global::config_dirs) {
        print "\nType: 'will cite' and press enter.\n> ";
        my $input = <STDIN>;
        if(not defined $input) {
            exit(255);
        }
        if($input =~ /will cite/i) {
            if(mkdir $Global::config_dir) {
                # Recompute @Global::config_dirs so we can break out of the loop.
                init_globals();
            }
            if(open (my $fh, ">", $Global::config_dir."/will-cite")) {
                close $fh;
                ::status(
                    "",
                    "Thank you for your support: You are the reason why there is funding to",
                    "continue maintaining GNU Parallel. On behalf of future versions of",
                    "GNU Parallel, which would not exist without your support:",
                    "",
                    "  THANK YOU SO MUCH",
                    "",
                    "It is really appreciated. The citation notice is now silenced.",
                    "");
            } else {
                ::status(
                      "",
                      "Thank you for your support. It is much appreciated. The citation",
                      "cannot permanently be silenced. Use '--will-cite' instead.",
                      "",
                      "If you use '--will-cite' in scripts to be run by others you are making",
                      "it harder for others to see the citation notice.  The development of",
                      "GNU Parallel is indirectly financed through citations, so if users",
                      "do not know they should cite then you are making it harder to finance",
                      "development. However, if you pay 10000 EUR, you should feel free to",
                      "use '--will-cite' in scripts.",
                      "");
                last;
            }
        }
    }
}

sub show_limits() {
    # Returns: N/A
    print("Maximal size of command: ",Limits::Command::real_max_length(),"\n",
          "Maximal usable size of command: ",
          $Global::usable_command_line_length,"\n",
          "\n",
          "Execution 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 embed() {
    # Give an embeddable version of GNU  Parallel
    # Tested with: bash, zsh, ksh, ash, dash, sh
    my $randomstring = "cut-here-".join"",
        map { (0..9,"a".."z","A".."Z")[rand(62)] } (1..20);
    if(not -f $0 or not -r $0) {
        ::error("--embed only works if parallel is a readable file");
        exit(255);
    }
    # Read the source from $0
    my $source = slurp_or_exit($0);
    my $user = $ENV{LOGNAME} || $ENV{USERNAME} || $ENV{USER};
    my $env_parallel_source;
    my $shell = $Global::shell;
    $shell =~ s:.*/::;
    for(which("env_parallel.$shell")) {
        -r $_ or next;
        # Read the source of env_parallel.shellname
        $env_parallel_source .= slurp_or_exit($_);
        last;
    }
    print "#!$Global::shell

# Copyright (C) 2007-2024 $user, Ole Tange, http://ole.tange.dk
# and Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, see <https://www.gnu.org/licenses/>
# or write to the Free Software Foundation, Inc., 51 Franklin St,
# Fifth Floor, Boston, MA 02110-1301 USA
";

        print q!
# Embedded GNU Parallel created with --embed
parallel() {
    # Start GNU  Parallel without leaving temporary files
    #
    # Not all shells support 'perl <(cat ...)'
    # This is a complex way of doing:
    #   perl <(cat <<'cut-here'
    #     [...]
    #     ) "$@"
    # and also avoiding:
    #   [1]+  Done   cat

    # Make a temporary fifo that perl can read from
    _fifo_with_GNU_Parallel_source=`perl -e 'use POSIX qw(mkfifo);
      do {
        $f = "/tmp/parallel-".join"",
          map { (0..9,"a".."z","A".."Z")[rand(62)] } (1..5);
      } while(-e $f);
      mkfifo($f,0600);
      print $f;'`
    # Put source code into temporary file
    # so it is easy to copy to the fifo
    _file_with_GNU_Parallel_source=`mktemp`;
!,
        "cat <<'$randomstring' > \$_file_with_GNU_Parallel_source\n",
        $source,
        $randomstring,"\n",
        q!
    # Copy the source code from the file to the fifo
    # and remove the file and fifo ASAP
    # 'sh -c' is needed to avoid
    #   [1]+  Done   cat
    sh -c "(rm $_file_with_GNU_Parallel_source; cat >$_fifo_with_GNU_Parallel_source; rm $_fifo_with_GNU_Parallel_source) < $_file_with_GNU_Parallel_source &"

    # Read the source from the fifo
    perl $_fifo_with_GNU_Parallel_source "$@"
}
!,
        $env_parallel_source,
        q!

# This will call the functions above
parallel -k echo ::: Put your code here
env_parallel --session
env_parallel -k echo ::: Put your code here
parset p,y,c,h -k echo ::: Put your code here
echo $p $y $c $h
echo You can also activate GNU Parallel for interactive use by:
echo . "$0"
!;
    ::status("Redirect the output to a file and add your changes at the end:",
        "  $0 --embed > new_script");
}

sub pack_combined_executable {
    my ($before_ref,$with_argsep_ref,$argv_ref) = @_;
    my @parallelopts;
    my $skip_next;
    # Remove '--combine-exec file' from options
    for(@{$before_ref}[0..(arrayindex($before_ref,$with_argsep_ref))-1]) {
        if (/^--combine-?exec(utable)?$/ || $skip_next) {
            # Also skip the filename given to --combine-exec
            $skip_next = !$skip_next;
            next;
        }
        push @parallelopts, $_;
    }
    # From ::: and to end
    my @argsep = @{$with_argsep_ref}[($#ARGV+1)..$#$with_argsep_ref];
    # The executable is now the first in @ARGV
    my $execname = shift @ARGV;
    # The rest of @ARGV are options for $execname
    my @execopts = @ARGV;
    debug("combine",
          "Parallel opts: @parallelopts ",
          "Executable: $execname ",
          "Execopts: @execopts ",
          "Argsep: @argsep\n");
    # Read the the executable
    my $exec = slurp_or_exit(which($execname));
    # Read the source of GNU Parallel and the executable
    my $parallel = slurp_or_exit($0);
    # Remove possibly __END__ from GNU Parallel
    $parallel =~ s/^__END__.*//s;
    if(-t $Global::original_stderr) {
        ::status(
              "Please be aware that combining GNU Parallel and '$execname'",
              "into a combined executable will make the whole executable",
              "licensed under GPLv3 (section 5.c).",
              "",
              "If the license of '$execname' is incompatible with GPLv3,",
              "you cannot legally convey copies of the combined executable",
              "to others. You can, however, still run them yourself.",
              "",
              "The combined executable will not have a citation notice,",
              "so it is your resposibilty to advice that academic tradition",
              "requires the users to cite GNU Parallel.",
              ""
            );
        my $input;
        do {
            ::status_no_nl("\nType: 'I agree' and press enter.\n> ");
            $input = <STDIN>;
            if(not defined $input) {
                exit(255);
            }
        } until($input =~ /I agree/i);
    }
    write_or_exit($opt::combineexec,
                  $parallel,
                  "\n__END__\n",
                  (map { "$_\0\n" } @parallelopts), "\0\0\n",
                  $execname, "\0\0\n",
                  (map { "$_\0\n" } @execopts), "\0\0\n",
                  (map { "$_\0\n" } @argsep), "\0\0\n",
                  $exec);
    # Set +x permission
    chmod 0700, $opt::combineexec;
    exit(0);
}

sub unpack_combined_executable {
    # If the script is a combined executable,
    # it will have stuff in <DATA> (I.e. after __END__)
    my $combine_exec = join("",<DATA>);
    if(length $combine_exec) {
        # Parse the <DATA>
        #
        # __END__
        # Option for GNU Parallel\0\n
        # Option for GNU Parallel\0\n
        # \0\0\n
        # Name of executable\0\0\n
        # Option for executable\0\n
        # Option for executable\0\n
        # \0\0\n
        # argsep + args if any\0\n
        # argsep + args if any\0\n
        # \0\0\n
        # <<binary of exec>>
        #
        # parallel --combine --pipe -j10% --recend '' myscript --myopt myval
        # __END__
        # --pipe\0\n       --pipe
        # -j10%\0\n        -j10%
        # --recend\0\n     --recend
        # \0\n             ''
        # \0\0\n           end-of-parallel-options
        # myscript\0\0\n   myscript
        # --myopt\0\n      --myopt
        # myval\0\n        myval
        # \0\0\n           end-of-myscript-options
        # \0\0\n           no argsep
        # <<binary of myscript>>
        #
        # parallel --combine -j10% myscript :::
        # __END__
        # -j10%\0\n
        # \0\0\n           end-of-parallel-options
        # myscript\0\0\n
        # \0\0\n           end-of-myscript-options
        # :::\0\n
        # \0\0\n
        # <<binary of myscript>>

        my ($opts,$execname,$execopts,$argsep,$exec) =
            split /\0\0\n/,$combine_exec,5;
        # Make a tmpdir with a file called $execname
        local %ENV;
        $ENV{TMPDIR} ||= "/tmp";
        my $dir = File::Temp::tempdir($ENV{'TMPDIR'} . "/parXXXXX", CLEANUP => 1);
        my $script = $dir."/".$execname;
        write_or_exit($script,$exec);
        # Set +x permission
        chmod 0700, $script;
        # Mark it for unlinking later
        $Global::unlink{$script}++;
        $Global::unlink{$dir}++;
        # pass the options for GNU Parallel
        my @opts = split /\0\n/, $opts;
        my @execopts = split /\0\n/, $execopts;
        if(length $argsep) {
            # Only add argsep if set
            unshift(@ARGV, split(/\0\n/,$argsep));
        }
        unshift(@ARGV,@opts,$script,@execopts);
    }
}


sub __GENERIC_COMMON_FUNCTION__() {}


sub mkdir_or_die($) {
    # If dir is not executable: die
    my $dir = shift;
    # The eval is needed to catch exception from mkdir
    eval { File::Path::mkpath($dir); };
    if(not -x $dir) {
        ::error("Cannot change into non-executable dir $dir: $!");
        ::wait_and_exit(255);
    }
}

sub tmpfile(@) {
    # Create tempfile as $TMPDIR/parXXXXX
    # Returns:
    #   $filehandle = opened file handle
    #   $filename = file name created
    my($filehandle,$filename) =
        ::tempfile(DIR=>$ENV{'TMPDIR'}, TEMPLATE => 'parXXXXX', @_);
    if(wantarray) {
        return($filehandle,$filename);
    } else {
        # Separate unlink due to NFS dealing badly with File::Temp
        unlink $filename;
        return $filehandle;
    }
}

sub tmpname($) {
    # Select a name that does not exist
    # Do not create the file as it may be used for creating a socket (by tmux)
    # Remember the name in $Global::unlink to avoid hitting the same name twice
    my $name = shift;
    my($tmpname);
    if(not -w $ENV{'TMPDIR'}) {
        my $qtmp = ::Q($ENV{'TMPDIR'});
        if(not -e $ENV{'TMPDIR'}) {
            ::error("Tmpdir $qtmp does not exist.","Try: mkdir -p $qtmp");
        } else {
            ::error("Tmpdir $qtmp is not writable.","Try: chmod +w $qtmp");
        }
        ::wait_and_exit(255);
    }
    do {
        $tmpname = $ENV{'TMPDIR'}."/".$name.
            join"", map { (0..9,"a".."z","A".."Z")[rand(62)] } (1..5);
    } while(-e $tmpname or $Global::unlink{$tmpname}++);
    return $tmpname;
}

sub tmpfifo() {
    # Find an unused name and mkfifo on it
    my $tmpfifo = tmpname("fif");
    mkfifo($tmpfifo,0600);
    return $tmpfifo;
}

sub rm(@) {
    # Remove file and remove it from %Global::unlink
    # Uses:
    #   %Global::unlink
    delete @Global::unlink{@_};
    unlink @_;
}

sub size_of_block_dev() {
    # Like -s but for block devices
    # Input:
    #   $blockdev = file name of block device
    # Returns:
    #   $size = in bytes, undef if error
    my $blockdev = shift;
    my $fh = open_or_exit("<", $blockdev);
    seek($fh,0,2) || ::die_bug("cannot seek $blockdev");
    my $size = tell($fh);
    close $fh;
    return $size;
}

sub qqx(@) {
    # Like qx but with clean environment (except for @keep)
    # and STDERR ignored
    # This is needed if the environment contains functions
    # that /bin/sh does not understand
    my %env;
    # ssh with ssh-agent needs PATH SSH_AUTH_SOCK SSH_AGENT_PID
    # ssh with Kerberos needs KRB5CCNAME
    # sshpass needs SSHPASS
    # tmux needs LC_CTYPE
    # lsh needs HOME LOGNAME
    my @keep = qw(PATH SSH_AUTH_SOCK SSH_AGENT_PID KRB5CCNAME LC_CTYPE
                  HOME LOGNAME SSHPASS);
    @env{@keep} = @ENV{@keep};
    local %ENV;
    %ENV = %env;
    if($Global::debug) {
        # && true is to force spawning a shell and not just exec'ing
        return qx{ @_ && true };
    } else {
        # CygWin does not respect 2>/dev/null
        # so we do that by hand
        # This trick does not work:
        # https://stackoverflow.com/q/13833088/363028
        # local *STDERR;
        # open(STDERR, ">", "/dev/null");
        open(local *CHILD_STDIN,  '<', '/dev/null') or die $!;
        open(local *CHILD_STDERR, '>', '/dev/null') or die $!;
        my $out;
        # eval is needed if open3 fails (e.g. command line too long)
        eval {
            my $pid = open3(
                '<&CHILD_STDIN',
                $out,
                '>&CHILD_STDERR',
                # && true is to force spawning a shell and not just exec'ing
                "@_ && true");
            my @arr = <$out>;
            close $out;
            # Make sure $? is set
            waitpid($pid, 0);
            return wantarray ? @arr : join "",@arr;
        } or do {
            # If eval fails, force $?=false
            `false`;
        };
    }
}

sub uniq(@) {
    # Remove duplicates and return unique values
    return keys %{{ map { $_ => 1 } @_ }};
}

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 undef_if_empty($) {
    if(defined($_[0]) and $_[0] eq "") {
        return undef;
    }
    return $_[0];
}

sub multiply_binary_prefix(@) {
    # Evalualte numbers with binary prefix
    # Ki=2^10, Mi=2^20, Gi=2^30, Ti=2^40, Pi=2^50, Ei=2^70, Zi=2^80, Yi=2^80
    # ki=2^10, mi=2^20, gi=2^30, ti=2^40, pi=2^50, ei=2^70, zi=2^80, yi=2^80
    # K =2^10, M =2^20, G =2^30, T =2^40, P =2^50, E =2^70, Z =2^80, Y =2^80
    # k =10^3, m =10^6, g =10^9, t=10^12, p=10^15, e=10^18, z=10^21, y=10^24
    # 13G = 13*1024*1024*1024 = 13958643712
    # Input:
    #   $s = string with prefixes
    # Returns:
    #   $value = int with prefixes multiplied
    my @v = @_;
    for(@v) {
        defined $_ or next;
        s/ki/*1024/gi;
        s/mi/*1024*1024/gi;
        s/gi/*1024*1024*1024/gi;
        s/ti/*1024*1024*1024*1024/gi;
        s/pi/*1024*1024*1024*1024*1024/gi;
        s/ei/*1024*1024*1024*1024*1024*1024/gi;
        s/zi/*1024*1024*1024*1024*1024*1024*1024/gi;
        s/yi/*1024*1024*1024*1024*1024*1024*1024*1024/gi;
        s/xi/*1024*1024*1024*1024*1024*1024*1024*1024*1024/gi;

        s/K/*1024/g;
        s/M/*1024*1024/g;
        s/G/*1024*1024*1024/g;
        s/T/*1024*1024*1024*1024/g;
        s/P/*1024*1024*1024*1024*1024/g;
        s/E/*1024*1024*1024*1024*1024*1024/g;
        s/Z/*1024*1024*1024*1024*1024*1024*1024/g;
        s/Y/*1024*1024*1024*1024*1024*1024*1024*1024/g;
        s/X/*1024*1024*1024*1024*1024*1024*1024*1024*1024/g;

        s/k/*1000/g;
        s/m/*1000*1000/g;
        s/g/*1000*1000*1000/g;
        s/t/*1000*1000*1000*1000/g;
        s/p/*1000*1000*1000*1000*1000/g;
        s/e/*1000*1000*1000*1000*1000*1000/g;
        s/z/*1000*1000*1000*1000*1000*1000*1000/g;
        s/y/*1000*1000*1000*1000*1000*1000*1000*1000/g;
        s/x/*1000*1000*1000*1000*1000*1000*1000*1000*1000/g;

        $_ = eval $_;
    }
    return wantarray ? @v : $v[0];
}

sub multiply_time_units($) {
    # Evalualte numbers with time units
    # s=1, m=60, h=3600, d=86400
    # Input:
    #   $s = string time units
    # Returns:
    #   $value = int in seconds
    my @v = @_;
    for(@v) {
        defined $_ or next;
        if(/[dhms]/i) {
            s/s/*1+/gi;
            s/m/*60+/gi;
            s/h/*3600+/gi;
            s/d/*86400+/gi;
            # 1m/3 => 1*60+/3 => 1*60/3
            s/\+(\D)/$1/gi;
        }
        $_ = eval $_."-0";
    }
    return wantarray ? @v : $v[0];
}

sub seconds_to_time_units() {
    # Convert seconds into ??d??h??m??s
    # s=1, m=60, h=3600, d=86400
    # Input:
    #   $s = int in seconds
    # Returns:
    #   $str = string time units
    my $s = shift;
    my $str;
    my $d = int($s/86400);
    $s -= $d * 86400;
    my $h = int($s/3600);
    $s -= $h * 3600;
    my $m = int($s/60);
    $s -= $m * 60;
    if($d) {
        $str = sprintf("%dd%02dh%02dm%02ds",$d,$h,$m,$s);
    } elsif($h) {
        $str = sprintf("%dh%02dm%02ds",$h,$m,$s);
    } elsif($m) {
        $str = sprintf("%dm%02ds",$m,$s);
    } else {
        $str = sprintf("%ds",$s);
    }
    return $str;
}

{
    my ($disk_full_fh, $b8193, $error_printed);
    sub exit_if_disk_full() {
        # Checks if $TMPDIR is full by writing 8kb to a tmpfile
        # If the disk is full: Exit immediately.
        # Returns:
        #   N/A
        if(not $disk_full_fh) {
            $disk_full_fh = ::tmpfile(SUFFIX => ".df");
            $b8193 = "b"x8193;
        }
        # Linux does not discover if a disk is full if writing <= 8192
        # Tested on:
        # bfs btrfs cramfs ext2 ext3 ext4 ext4dev jffs2 jfs minix msdos
        # ntfs reiserfs tmpfs ubifs vfat xfs
        # TODO this should be tested on different OS similar to this:
        #
        # doit() {
        #   sudo mount /dev/ram0 /mnt/loop; sudo chmod 1777 /mnt/loop
        #   seq 100000 | parallel --tmpdir /mnt/loop/ true &
        #   seq 6900000 > /mnt/loop/i && echo seq OK
        #   seq 6980868 > /mnt/loop/i
        #   seq 10000 > /mnt/loop/ii
        #   sleep 3
        #   sudo umount /mnt/loop/ || sudo umount -l /mnt/loop/
        #   echo >&2
        # }
        print $disk_full_fh $b8193;
        if(not $disk_full_fh
           or
           tell $disk_full_fh != 8193) {
            # On raspbian the disk can be full except for 10 chars.
            if(not $error_printed) {
                ::error("Output is incomplete.",
                        "Cannot append to buffer file in $ENV{'TMPDIR'}.",
                        "Is the disk full?",
                        "Change \$TMPDIR with --tmpdir or use --compress.");
                $error_printed = 1;
            }
            ::wait_and_exit(255);
        }
        truncate $disk_full_fh, 0;
        seek($disk_full_fh, 0, 0) || die;
    }
}

sub spacefree($$) {
    # Remove comments and spaces
    # Inputs:
    #   $spaces = keep 1 space?
    #   $s = string to remove spaces from
    # Returns:
    #   $s = with spaces removed
    my $spaces = shift;
    my $s = shift;
    $s =~ s/#.*//mg;
    if(1 == $spaces) {
        $s =~ s/\s+/ /mg;
    } elsif(2 == $spaces) {
        # Keep newlines
        $s =~ s/\n\n+/\n/sg;
        $s =~ s/[ \t]+/ /mg;
    } elsif(3 == $spaces) {
        # Keep perl code required space
        $s =~ s{([^a-zA-Z0-9/])\s+}{$1}sg;
        $s =~ s{([a-zA-Z0-9/])\s+([^:a-zA-Z0-9/])}{$1$2}sg;
    } else {
        $s =~ s/\s//mg;
    }
    return $s;
}

{
    my $hostname;
    sub hostname() {
        local $/ = "\n";
        if(not $hostname) {
            $hostname = `hostname`;
            chomp($hostname);
            $hostname ||= "nohostname";
        }
        return $hostname;
    }
}

sub which(@) {
    # Input:
    #   @programs = programs to find the path to
    # Returns:
    #   @full_path = full paths to @programs. Nothing if not found
    my @which;
    for my $prg (@_) {
        push(@which, grep { not -d $_ and -x $_ }
             map { $_."/".$prg } split(":",$ENV{'PATH'}));
        if($prg =~ m:/:) {
            # Test if program with full path exists
            push(@which, grep { not -d $_ and -x $_ } $prg);
        }
    }
    ::debug("which", "$which[0] in $ENV{'PATH'}\n");
    return wantarray ? @which : $which[0];
}

{
    my ($regexp,$shell,%fakename);

    sub parent_shell {
        # Input:
        #   $pid = pid to see if (grand)*parent is a shell
        # Returns:
        #   $shellpath = path to shell - undef if no shell found
        my $pid = shift;
        ::debug("init","Parent of $pid\n");
        if(not $regexp) {
            # All shells known to mankind
            #
            # ash bash csh dash fdsh fish fizsh ksh ksh93 mksh pdksh
            # posh rbash rc rush rzsh sash sh static-sh tcsh yash zsh

            my @shells = (qw(ash bash bsd-csh csh dash fdsh fish fizsh ksh
                          ksh93 lksh mksh pdksh posh rbash rc rush rzsh sash sh
                          static-sh tcsh yash zsh -sh -csh -bash),
                          '-sh (sh)' # sh on FreeBSD
                );
            # Can be formatted as:
            #   [sh]  -sh  sh  busybox sh  -sh (sh)
            #   /bin/sh /sbin/sh /opt/csw/sh
            # But not: foo.sh sshd crash flush pdflush scosh fsflush ssh
            $shell = "(?:".join("|",map { "\Q$_\E" } @shells).")";
            $regexp = '^((\[)(-?)('. $shell. ')(\])|(|\S+/|busybox )'.
                '(-?)('. $shell. '))( *$| [^(])';
            %fakename = (
                # sh disguises itself as -sh (sh) on FreeBSD
                "-sh (sh)" => ["sh"],
                # csh and tcsh disguise themselves as -sh/-csh
                # E.g.: ssh -tt csh@lo 'ps aux;true' |egrep ^csh
                # but sh also disguises itself as -sh
                # (TODO When does that happen?)
                "-sh" => ["sh"],
                "-csh" => ["tcsh", "csh"],
                # ash disguises itself as -ash
                "-ash" => ["ash", "dash", "sh"],
                # dash disguises itself as -dash
                "-dash" => ["dash", "ash", "sh"],
                # bash disguises itself as -bash
                "-bash" => ["bash", "sh"],
                # ksh disguises itself as -ksh
                "-ksh" => ["ksh", "sh"],
                # zsh disguises itself as -zsh
                "-zsh" => ["zsh", "sh"],
                );
        }
        if($^O eq "linux") {
            # Optimized for GNU/Linux
            my $testpid = $pid;
            my $shellpath;
            my $shellline;
            while($testpid) {
                if(open(my $fd, "<", "/proc/$testpid/cmdline")) {
                    local $/="\0";
                    chomp($shellline = <$fd>);
                    if($shellline =~ /$regexp/o) {
                        my $shellname = $4 || $8;
                        my $dash = $3 || $7;
                        if($shellname eq "sh" and $dash) {
                            # -sh => csh or sh
                            if($shellpath = readlink "/proc/$testpid/exe") {
                                ::debug("init","procpath $shellpath\n");
                                if($shellpath =~ m:/$shell$:o) {
                                    ::debug("init",
                                            "proc which ".$shellpath." => ");
                                    return $shellpath;
                                }
                            }
                        }
                        ::debug("init", "which ".$shellname." => ");
                        $shellpath = (which($shellname,
                                            @{$fakename{$shellname}}))[0];
                        ::debug("init", "shell path $shellpath\n");
                        return $shellpath;
                    }
                }
                # Get parent pid
                if(open(my $fd, "<", "/proc/$testpid/stat")) {
                    my $line = <$fd>;
                    close $fd;
                    # Parent pid is field 4
                    $testpid = (split /\s+/, $line)[3];
                } else {
                    # Something is wrong: fall back to old method
                    last;
                }
            }
        }
        # if -sh or -csh try readlink /proc/$$/exe
        my ($children_of_ref, $parent_of_ref, $name_of_ref) = pid_table();
        my $shellpath;
        my $testpid = $pid;
        while($testpid) {
            if($name_of_ref->{$testpid} =~ /$regexp/o) {
                my $shellname = $4 || $8;
                my $dash = $3 || $7;
                if($shellname eq "sh" and $dash) {
                    # -sh => csh or sh
                    if($shellpath = readlink "/proc/$testpid/exe") {
                        ::debug("init","procpath $shellpath\n");
                        if($shellpath =~ m:/$shell$:o) {
                            ::debug("init", "proc which ".$shellpath." => ");
                            return $shellpath;
                        }
                    }
                }
                ::debug("init", "which ".$shellname." => ");
                $shellpath = (which($shellname,@{$fakename{$shellname}}))[0];
                ::debug("init", "shell path $shellpath\n");
                $shellpath and last;
            }
            if($testpid == $parent_of_ref->{$testpid}) {
                # In Solaris zones, the PPID of the zsched process is itself
                last;
            }
            $testpid = $parent_of_ref->{$testpid};
        }
        return $shellpath;
    }
}

{
    my %pid_parentpid_cmd;

    sub pid_table() {
        # Returns:
        #   %children_of = { pid -> children of pid }
        #   %parent_of = { pid -> pid of parent }
        #   %name_of = { pid -> commandname }

        if(not %pid_parentpid_cmd) {
            # Filter for SysV-style `ps`
            my $sysv = q( ps -ef |).
                q(perl -ane '1..1 and /^(.*)CO?MM?A?N?D/ and $s=length $1;).
                q(s/^.{$s}//; print "@F[1,2] $_"' );
            # Minix uses cols 2,3 and can have newlines in the command
            # so lines not having numbers in cols 2,3 must be ignored
            my $minix = q( ps -ef |).
                q(perl -ane '1..1 and /^(.*)CO?MM?A?N?D/ and $s=length $1;).
                q(s/^.{$s}// and $F[2]>0 and $F[3]>0 and print "@F[2,3] $_"' );
            # BSD-style `ps`
            my $bsd = q(ps -o pid,ppid,command -ax);
            %pid_parentpid_cmd =
            (
             'aix' => $sysv,
             'android' => $sysv,
             'cygwin' => $sysv,
             'darwin' => $bsd,
             'dec_osf' => $sysv,
             'dragonfly' => $bsd,
             'freebsd' => $bsd,
             'gnu' => $sysv,
             'hpux' => $sysv,
             'linux' => $sysv,
             'mirbsd' => $bsd,
             'minix' => $minix,
             'msys' => $sysv,
             'MSWin32' => $sysv,
             'netbsd' => $bsd,
             'nto' => $sysv,
             'openbsd' => $bsd,
             'solaris' => $sysv,
             'svr5' => $sysv,
             'syllable' => "echo ps not supported",
            );
        }
        $pid_parentpid_cmd{$^O} or
            ::die_bug("pid_parentpid_cmd for $^O missing");

        my (@pidtable,%parent_of,%children_of,%name_of);
        # Table with pid -> children of pid
        @pidtable = `$pid_parentpid_cmd{$^O}`;
        my $p=$$;
        for (@pidtable) {
            # must match: 24436 21224 busybox ash
            # must match: 24436 21224 <<empty on MacOSX running cubase>>
            # must match: 24436 21224 <<empty on system running Viber>>
            #   or: perl -e 'while($0=" "){}'
            if(/^\s*(\S+)\s+(\S+)\s+(\S+.*)/
               or
               /^\s*(\S+)\s+(\S+)\s+()$/) {
                $parent_of{$1} = $2;
                push @{$children_of{$2}}, $1;
                $name_of{$1} = $3;
            } else {
                ::die_bug("pidtable format: $_");
            }
        }
        return(\%children_of, \%parent_of, \%name_of);
    }
}

sub now() {
    # Returns time since epoch as in seconds with 3 decimals
    # Uses:
    #   @Global::use
    # Returns:
    #   $time = time now with millisecond accuracy
    if(not $Global::use{"Time::HiRes"}) {
        if(eval "use Time::HiRes qw ( time );") {
            eval "sub TimeHiRestime { return Time::HiRes::time };";
        } else {
            eval "sub TimeHiRestime { return time() };";
        }
        $Global::use{"Time::HiRes"} = 1;
    }

    return (int(TimeHiRestime()*1000))/1000;
}

sub usleep($) {
    # Sleep this many milliseconds.
    # Input:
    #   $ms = milliseconds to sleep
    my $ms = shift;
    ::debug("timing",int($ms),"ms ");
    select(undef, undef, undef, $ms/1000);
}

sub make_regexp_ungreedy {
    my $regexp = shift;
    my $class_state = 0;
    my $escape_state = 0;
    my $found = 0;
    my $ungreedy = "";
    my $c;

    for $c (split (//, $regexp)) {
        if ($found) {
            if($c ne "?") { $ungreedy .= "?"; }
            $found = 0;
        }
        $ungreedy .= $c;

        if ($escape_state) { $escape_state = 0; next; }
        if ($c eq "\\") { $escape_state = 1; next; }
        if ($c eq '[') { $class_state  = 1; next; }
        if ($class_state) {
            if($c eq ']') { $class_state = 0; }
            next;
        }
        # Quantifiers: + * {...}
        if ($c =~ /[*}+]/) { $found = 1; }
    }
    if($found) { $ungreedy .= '?'; }
    return $ungreedy;
}


sub __KILLER_REAPER__() {}

sub reap_usleep() {
    # Reap dead children.
    # If no dead children: Sleep specified amount with exponential backoff
    # Input:
    #   $ms = milliseconds to sleep
    # Returns:
    #   $ms/2+0.001 if children reaped
    #   $ms*1.1 if no children reaped
    my $ms = shift;
    if(reapers()) {
        if(not $Global::total_completed % 100) {
            if($opt::timeout) {
                # Force cleaning the timeout queue for every 100 jobs
                # Fixes potential memleak
                $Global::timeoutq->process_timeouts();
            }
        }
        # Sleep exponentially shorter (1/2^n) if a job finished
        return $ms/2+0.001;
    } else {
        if($opt::timeout) {
            $Global::timeoutq->process_timeouts();
        }
        if($opt::memfree) {
            kill_youngster_if_not_enough_mem($opt::memfree*0.5);
        }
        if($opt::memsuspend) {
            suspend_young_if_not_enough_mem($opt::memsuspend);
        }
        if($opt::limit) {
            kill_youngest_if_over_limit();
        }
        exit_if_disk_full();
        if($Global::linebuffer) {
            my $something_printed = 0;
            if($opt::keeporder and not $opt::latestline) {
                for my $job (values %Global::running) {
                    $something_printed += $job->print_earlier_jobs();
                }
            } else {
                for my $job (values %Global::running) {
                    $something_printed += $job->print();
                }
            }
            if($something_printed) { $ms = $ms/2+0.001; }
        }
        if($ms > 0.002) {
            # When a child dies, wake up from sleep (or select(,,,))
            $SIG{CHLD} = sub { kill "ALRM", $$ };
            if($opt::delay and not $Global::linebuffer) {
                # The 0.004s is approximately the time it takes for one round
                my $next_earliest_start =
                    $Global::newest_starttime + $opt::delay - 0.004;
                my $remaining_ms = 1000 * ($next_earliest_start - ::now());
                # The next job can only start at $next_earliest_start
                # so sleep until then (but sleep at least $ms)
                usleep(::max($ms,$remaining_ms));
            } else {
                usleep($ms);
            }
            # --compress needs $SIG{CHLD} unset
            $SIG{CHLD} = 'DEFAULT';
        }
        # Sleep exponentially longer (1.1^n) if a job did not finish,
        # though at most 1000 ms.
        return (($ms < 1000) ? ($ms * 1.1) : ($ms));
    }
}

sub kill_youngest_if_over_limit() {
    # Check each $sshlogin we are over limit
    # If over limit: kill off the youngest child
    # Put the child back in the queue.
    # Uses:
    #   %Global::running
    my %jobs_of;
    my @sshlogins;

    for my $job (values %Global::running) {
        if(not $jobs_of{$job->sshlogin()}) {
            push @sshlogins, $job->sshlogin();
        }
        push @{$jobs_of{$job->sshlogin()}}, $job;
    }
    for my $sshlogin (@sshlogins) {
        for my $job (sort { $b->seq() <=> $a->seq() }
                     @{$jobs_of{$sshlogin}}) {
            if($sshlogin->limit() == 2) {
                $job->kill();
                last;
            }
        }
    }
}

sub suspend_young_if_not_enough_mem() {
    # Check each $sshlogin if there is enough mem.
    # If less than $limit free mem: suspend some of the young children
    # Else: Resume all jobs
    # Uses:
    #   %Global::running
    my $limit = shift;
    my %jobs_of;
    my @sshlogins;

    for my $job (values %Global::running) {
        if(not $jobs_of{$job->sshlogin()}) {
            push @sshlogins, $job->sshlogin();
        }
        push @{$jobs_of{$job->sshlogin()}}, $job;
    }
    for my $sshlogin (@sshlogins) {
        my $free = $sshlogin->memfree();
        if($free < 2*$limit) {
            # Suspend all jobs (resume some of them later)
            map { $_->suspended() or $_->suspend(); } @{$jobs_of{$sshlogin}};
            my @jobs = (sort { $b->seq() <=> $a->seq() }
                        @{$jobs_of{$sshlogin}});
            # how many should be running?
            # limit*1 => 1;
            # limit*1.5 => 2;
            # limit*1.75 => 4;
            # free < limit*(2-1/2^n);
            # =>
            # 1/(2-free/limit) < 2^n;
            my $run = int(1/(2-$free/$limit));
            $run = ::min($run,$#jobs);
            # Resume the oldest running
            for my $job ((sort { $a->seq() <=> $b->seq() } @jobs)[0..$run]) {
                ::debug("mem","\nResume ",$run+1, " jobs. Seq ",
                        $job->seq(), " resumed ",
                        $sshlogin->memfree()," < ",2*$limit);
                $job->resume();
            }
        } else {
            for my $job (@{$jobs_of{$sshlogin}}) {
                if($job->suspended()) {
                    $job->resume();
                    ::debug("mem","\nResume ",$#{$jobs_of{$sshlogin}}+1,
                            " jobs. Seq ", $job->seq(), " resumed ",
                            $sshlogin->memfree()," > ",2*$limit);
                    last;
                }
            }
        }
    }
}

sub kill_youngster_if_not_enough_mem() {
    # Check each $sshlogin if there is enough mem.
    # If less than 50% enough free mem: kill off the youngest child
    # Put the child back in the queue.
    # Uses:
    #   %Global::running
    my $limit = shift;
    my %jobs_of;
    my @sshlogins;

    for my $job (values %Global::running) {
        if(not $jobs_of{$job->sshlogin()}) {
            push @sshlogins, $job->sshlogin();
        }
        push @{$jobs_of{$job->sshlogin()}}, $job;
    }
    for my $sshlogin (@sshlogins) {
        for my $job (sort { $b->seq() <=> $a->seq() }
                     @{$jobs_of{$sshlogin}}) {
            if($sshlogin->memfree() < $limit) {
                ::debug("mem","\n",map { $_->seq()." " }
                        (sort { $b->seq() <=> $a->seq() }
                         @{$jobs_of{$sshlogin}}));
                ::debug("mem","\n", $job->seq(), "killed ",
                        $sshlogin->memfree()," < ",$limit);
                $job->kill();
                $job->set_killreason("mem");
                $sshlogin->memfree_recompute();
            } else {
                last;
            }
        }
        ::debug("mem","Free mem OK? ",
                $sshlogin->memfree()," > ",$limit);
    }
}


sub __DEBUGGING__() {}


sub debug(@) {
    # Uses:
    #   $Global::debug
    #   %Global::fh
    # Returns: N/A
    $Global::debug or return;
    @_ = grep { defined $_ ? $_ : "" } @_;
    if($Global::debug eq "all" or $Global::debug eq $_[0]) {
        if($Global::fh{2}) {
            # Original stderr was saved
            my $stderr = $Global::fh{2};
            print $stderr @_[1..$#_];
        } else {
            print STDERR @_[1..$#_];
        }
    }
}

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

    local $/ = "\n";
    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 = 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";
            ::status($err);
            return $err;
        } else {
            return Dumper(@dump_this);
        }
    } else {
        # Create a dummy Data::Dump:dump as Hans Schou sometimes has
        # it undefined
        eval "sub Data::Dump:dump {}";
        eval "use Data::Dump qw(dump);";
        return (Data::Dump::dump(@dump_this));
    }
}

sub my_croak(@) {
    eval "use Carp; 1";
    $Carp::Verbose = 1;
    croak(@_);
}

sub my_carp() {
    eval "use Carp; 1";
    $Carp::Verbose = 1;
    carp(@_);
}


sub __OBJECT_ORIENTED_PARTS__() {}


package SSHLogin;

sub new($$) {
    my $class = shift;
    my $s = shift;
    my $origs = $s;
    my %hostgroups;
    my $ncpus;
    my $sshcommand;
    my $user;
    my $password;
    my $host;
    my $port;
    my $local;
    my $string;
    # SSHLogins can have these formats:
    #   @grp+grp/ncpu//usr/bin/ssh user@server
    #   ncpu//usr/bin/ssh user@server
    #   /usr/bin/ssh user@server
    #   user@server
    #   ncpu/user@server
    #   @grp+grp/user@server
    #   above with: user:password@server
    #   above with: user@server:port
    # So:
    #   [@grp+grp][ncpu/][ssh command ][[user][:password]@][server[:port]]

    #   [@grp+grp]/ncpu//usr/bin/ssh user:pass@server:port
    if($s =~ s:^\@([^/]+)/?::) {
        # Look for SSHLogin hostgroups
        %hostgroups = map { $_ => 1 } split(/\+|,/, $1);
    }
    # An SSHLogin is always in the hostgroup of its "numcpu/host"
    $hostgroups{$s} = 1;

    #   [ncpu/]/usr/bin/ssh user:pass@server:port
    if ($s =~ s:^(\d+)/::) { $ncpus = $1; }

    # Why disallow space in password?
    # Example:
    #   C:/bin/ssh user:C:/bin/ssh@host
    # Should this parse as:
    #   user 'C' with password '/bin/ssh user:C:/bin/ssh'
    # or
    #   cmd 'C:/bin/ssh' user 'user' with password 'C:/bin/ssh'
    # This is impossible to determine.
    # With space forbidden in password it uniquely parses as the 2nd.
    #   [/usr/bin/ssh ]user:pass@server:port
    if($s =~ s/^(.*) //) { $sshcommand = $1; }

    #   [user:pass@]server:port
    if($s =~ s/^(.+)@//) {
        my $userpw = $1;
        # user[:pass]
        if($userpw =~ s/:(.*)//) {
            $password = $1;
            if($password eq "") { $password = $ENV{'SSHPASS'} }
            if(not ::which("sshpass")) {
                ::error("--sshlogin with password requires sshpass installed");
                ::wait_and_exit(255);
            }
        }
        $user = $userpw;
    }
    #   [server]:port
    if(not $s =~ /:.*:/
       and
       $s =~ s/^([-a-z0-9._]+)//i) {
        # Not IPv6 (IPv6 has 2 or more ':')
        $host = $1;
    } elsif($s =~ s/^(\\[\[\]box0-9a-f.]+)//i) {
        # RFC2673 allows for:
        #   \[b11010000011101] \[o64072/14] \[xd074/14] \[208.116.0.0/14]
        $host = $1;
    } elsif($s =~ s/^\[([0-9a-f:]+)\]//i
            or
            $s =~ s/^([0-9a-f:]+)//i) {
        # RFC5952
        #   [2001:db8::1]:80
        #   2001:db8::1.80
        #   2001:db8::1p80
        #   2001:db8::1#80
        #   2001:db8::1:80 - not supported
        #   2001:db8::1 port 80 - not supported
        $host = $1;
    }

    #   [:port]
    if($s =~ s/^:(\w+)//i) {
        $port = $1;
    } elsif($s =~ s/^[p\.\#](\w+)//i) {
        # RFC5952
        #   2001:db8::1.80
        #   2001:db8::1p80
        #   2001:db8::1#80
        $port = $1;
    }

    if($s and $s ne ':') {
        ::die_bug("SSHLogin parser failed on '$origs' => '$s'");
    }

    $string =
        # Only include the sshcommand in $string if it is set by user
        ($sshcommand && $sshcommand." ").
        ($user && $user."@").
        ($host && $host).
        ($port && ":$port");
    my $pwstring =
        # Only include the sshcommand in $string if it is set by user
        ($sshcommand && $sshcommand." ").
        ($user && $user. ($password && ":".$password)."@").
        ($host && $host).
        ($port && ":$port");
    if($host eq ':') {
        $local = 1;
        $string = ":";
    } else {
        $sshcommand ||= $opt::ssh || $ENV{'PARALLEL_SSH'} || "ssh";
    }
    # An SSHLogin is always in the hostgroup of its $string-name
    $hostgroups{$string} = 1;
    @Global::hostgroups{keys %hostgroups} = values %hostgroups;
    # Used for file names for loadavg
    my $no_slash_string = $string;
    $no_slash_string =~ s/[^-a-z0-9:]/_/gi;
    return bless {
        'string' => $string,
            'pwstring' => $pwstring,
            'jobs_running' => 0,
            'jobs_completed' => 0,
            'maxlength' => undef,
            'max_jobs_running' => undef,
            'orig_max_jobs_running' => undef,
            'ncpus' => $ncpus,
            'sshcommand' => $sshcommand,
            'user' => $user,
            'password' => $password,
            'host' => $host,
            'port' => $port,
            'hostgroups' => \%hostgroups,
            'local' => $local,
            'control_path_dir' => undef,
            'control_path' => undef,
            'time_to_login' => undef,
            'last_login_at' => undef,
            'loadavg_file' => $Global::cache_dir . "/tmp/sshlogin/" .
            $no_slash_string . "/loadavg",
            'loadavg' => undef,
            'last_loadavg_update' => 0,
            'swap_activity_file' => $Global::cache_dir . "/tmp/sshlogin/" .
            $no_slash_string . "/swap_activity",
            'swap_activity' => undef,
    }, ref($class) || $class;
}

sub DESTROY($) {
    my $self = shift;
    # Remove temporary files if they are created.
    ::rm($self->{'loadavg_file'});
    ::rm($self->{'swap_activity_file'});
}

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

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

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

sub sshcmd($) {
    # Give the ssh command without hostname
    # Returns:
    #   "sshpass -e ssh -p port -l user"
    my $self = shift;
    my @local;
    # [sshpass -e] ssh -p port -l user
    if($self->{'password'}) { push @local, "sshpass -e"; }
    # [ssh] -p port -l user
    # TODO sshpass + space
    push @local, $self->{'sshcommand'};
    # [-p port] -l user
    if($self->{'port'}) { push @local, '-p',$self->{'port'}; }
    # [-l user]
    if($self->{'user'}) { push @local, '-l',$self->{'user'}; }
    if($opt::controlmaster) {
        # Use control_path to make ssh faster
        my $control_path = $self->control_path_dir()."/ssh-%r@%h:%p";

        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} ||= 1;
            } else {
                push @local, "-S", $control_path;
                $SIG{'TERM'} = undef;
                # Run a sleep that outputs data, so it will discover
                # if the ssh connection closes.
                my $sleep = ::Q('$|=1;while(1){sleep 1;print "foo\n"}');
                # Ignore the 'foo' being printed
                open(STDOUT,">","/dev/null");
                # STDERR >/dev/null to ignore
                open(STDERR,">","/dev/null");
                open(STDIN,"<","/dev/null");
                exec(@local, "-MT", $self->{'host'}, "--",
                     "perl", "-e", $sleep);
            }
        }
        push @local, "-S", ::Q($control_path);
    }
    return "@local";
}

sub wrap($@) {
    # Input:
    #   @cmd = shell command to run on remote
    # Returns:
    #   $sshwrapped = ssh remote @cmd
    my $self = shift;
    my @remote = @_;
    return(join " ",
           $self->sshcmd(), $self->{'host'}, "--", "exec", @remote);
}

sub hexwrap($@) {
    # Input:
    #   @cmd = perl expresion to eval
    # Returns:
    #   $hexencoded = perl command that decodes hex and evals @cmd
    my $self = shift;
    my $cmd = join("",@_);

    # "#" is needed because Perl on MacOS X adds NULs
    # when running pack q/H10000000/
    my $hex = unpack "H*", $cmd."#";
    # csh does not deal well with > 1000 chars in one word
    # Insert space every 1000 char
    $hex =~ s/\G.{1000}\K/ /sg;
    # Explanation:
    # Write this without special chars: eval pack 'H*', join '',@ARGV
    # GNU_Parallel_worker = String so people can see this is from GNU Parallel
    # eval+          = way to write 'eval ' without space (gives warning)
    # pack+          = way to write 'pack ' without space
    # q/H10000000/,  = almost the same as "H*" but does not use *
    # join+q//,      = join '',
    return('perl -X -e '.
           'GNU_Parallel_worker,eval+pack+q/H10000000/,join+q//,@ARGV '.
           $hex);
}

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_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 in_hostgroups() {
    # Input:
    #   @hostgroups = the hostgroups to look for
    # Returns:
    #   true if intersection of @hostgroups and the hostgroups of this
    #        SSHLogin is non-empty
    my $self = shift;
    return grep { defined $self->{'hostgroups'}{$_} } @_;
}

sub hostgroups() {
    my $self = shift;
    return keys %{$self->{'hostgroups'}};
}

sub inc_jobs_completed($) {
    my $self = shift;
    $self->{'jobs_completed'}++;
    $Global::total_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;

    if(defined $self->{'max_jobs_running'}) {
        # max_jobs_running could be resat if -j is a changed file
        $Global::max_jobs_running += $self->{'max_jobs_running'};
    }
    # Initialize orig to the first non-zero value that comes around
    $self->{'orig_max_jobs_running'} ||= $self->{'max_jobs_running'};
}

sub memfree() {
    # Returns:
    #   $memfree in bytes
    my $self = shift;
    $self->memfree_recompute();
    # Return 1 if not defined.
    return (not defined $self->{'memfree'} or $self->{'memfree'})
}

sub memfree_recompute() {
    my $self = shift;
    my $script = memfreescript();

    # TODO add sshlogin and backgrounding
    # Run the script twice if it gives 0 (typically intermittent error)
    $self->{'memfree'} = ::qqx($script) || ::qqx($script);
    if(not $self->{'memfree'}) {
        ::die_bug("Less than 1 byte memory free");
    }
    #::debug("mem","New free:",$self->{'memfree'}," ");
}

{
    my $script;

    sub memfreescript() {
        # Returns:
        #   shellscript for giving available memory in bytes
        if(not $script) {
            my %script_of = (
                # /proc/meminfo
                # MemFree:          7012 kB
                # Buffers:         19876 kB
                # Cached:         431192 kB
                # SwapCached:          0 kB
                "linux" => (
                    q{
                        print 1024 * qx{
                        awk '/^((Swap)?Cached|MemFree|Buffers):/
                        { sum += \$2} END { print sum }'
                            /proc/meminfo }
                    }),
                # Android uses same code as GNU/Linux
                "android" => (
                    q{
                        print 1024 * qx{
                        awk '/^((Swap)?Cached|MemFree|Buffers):/
                        { sum += \$2} END { print sum }'
                            /proc/meminfo }
                    }),
                # $ vmstat 1 1
                #   procs         memory         page                   faults       cpu
                # r  b  w    avm    free re at  pi po  fr de  sr   in   sy  cs  us sy id
                # 1  0  0 242793  389737  5  1   0  0   0  0   0  107  978  60   1  1 99
                "hpux" => (
                    q{
                        print (((reverse `vmstat 1 1`)[0]
                            =~ /(?:\d+\D+){4}(\d+)/)[0]*1024)
                    }),
                # $ vmstat 1 2
                # kthr      memory            page            disk          faults      cpu
                # r b w   swap  free  re  mf pi po fr de sr s3 s4 -- --   in   sy   cs us sy id
                # 0 0 0 6496720 5170320 68 260 8 2  1  0  0 -0  3  0  0  309 1371  255  1  2 97
                # 0 0 0 6434088 5072656  7  15 8 0  0  0  0  0 261 0  0 1889 1899 3222  0  8 92
                #
                # The second free value is correct
                "solaris" => (
                    q{
                        print (((reverse `vmstat 1 2`)[0]
                                =~ /(?:\d+\D+){4}(\d+)/)[0]*1024)
                    }),
                # hw.pagesize: 4096
                # vm.stats.vm.v_cache_count: 0
                # vm.stats.vm.v_inactive_count: 79574
                # vm.stats.vm.v_free_count: 4507
                "freebsd" => (
                    q{
                        for(qx{/sbin/sysctl -a}) {
                            if (/^([^:]+):\s+(.+)\s*$/s) {
                                $sysctl->{$1} = $2;
                            }
                        }
                        print $sysctl->{"hw.pagesize"} *
                            ($sysctl->{"vm.stats.vm.v_cache_count"}
                             + $sysctl->{"vm.stats.vm.v_inactive_count"}
                             + $sysctl->{"vm.stats.vm.v_free_count"});
                    }),
                # Mach Virtual Memory Statistics: (page size of 4096 bytes)
                # Pages free:                         198061.
                # Pages active:                       159701.
                # Pages inactive:                      47378.
                # Pages speculative:                   29707.
                # Pages wired down:                    89231.
                # "Translation faults":            928901425.
                # Pages copy-on-write:             156988239.
                # Pages zero filled:               271267894.
                # Pages reactivated:                   48895.
                # Pageins:                           1798068.
                # Pageouts:                              257.
                # Object cache: 6603 hits of 1713223 lookups (0% hit rate)
                'darwin' => (
                    q{
                        $vm = `vm_stat`;
                        print (($vm =~ /page size of (\d+)/)[0] *
                               (($vm =~ /Pages free:\s+(\d+)/)[0] +
                                ($vm =~ /Pages inactive:\s+(\d+)/)[0]));
                    }),
                );
            my $perlscript = "";
            # Make a perl script that detects the OS ($^O) and runs
            # the appropriate command
            for my $os (keys %script_of) {
                $perlscript .= 'if($^O eq "'.$os.'") { '.$script_of{$os}.'}';
            }
            $script = "perl -e " . ::Q(::spacefree(1,$perlscript));
        }
        return $script;
    }
}

sub limit($) {
    # Returns:
    #  0 = Below limit. Start another job.
    #  1 = Over limit. Start no jobs.
    #  2 = Kill youngest job
    my $self = shift;

    if(not defined $self->{'limitscript'}) {
        my %limitscripts =
            ("io" => q!
             io() {
                 limit=$1;
                 io_file=$2;
                 # Do the measurement in the background
                 ((tmp=$(tempfile);
                 LANG=C iostat -x 1 2 > $tmp;
                 mv $tmp $io_file) </dev/null >/dev/null & );
                 perl -e '-e $ARGV[0] or exit(1);
                   for(reverse <>) {
                     /Device/ and last;
                     /(\S+)$/ and $max = $max > $1 ? $max : $1; }
                   exit ('$limit' < $max)' $io_file;
             };
             io %s %s
             !,
             "mem" => q!
             mem() {
                 limit=$1;
                 awk '/^((Swap)?Cached|MemFree|Buffers):/{ sum += $2}
                      END {
                         if (sum*1024 < '$limit'/2) { exit 2; }
                         else { exit (sum*1024 < '$limit') }
                      }' /proc/meminfo;
             };
             mem %s;
             !,
             "load" => q!
             load() {
                 limit=$1;
                 ps ax -o state,command |
                     grep -E '^[DOR].[^[]' |
                     wc -l |
                 perl -ne 'exit ('$limit' < $_)';
             };
             load %s
             !,
            );
        my ($cmd,@args) = split /\s+/,$opt::limit;
        if($limitscripts{$cmd}) {
            my $tmpfile = ::tmpname("parlmt");
            ++$Global::unlink{$tmpfile};
            $self->{'limitscript'} =
            ::spacefree(1, sprintf($limitscripts{$cmd},
                                   ::multiply_binary_prefix(@args),$tmpfile));
        } else {
            $self->{'limitscript'} = $opt::limit;
        }
    }

    my %env = %ENV;
    local %ENV = %env;
    $ENV{'SSHLOGIN'} = $self->string();
    system($Global::shell,"-c",$self->{'limitscript'});
    #::qqx($self->{'limitscript'});
    ::debug("limit","limit `".$self->{'limitscript'}."` result ".($?>>8)."\n");
    return $?>>8;
}


sub swapping($) {
    my $self = shift;
    my $swapping = $self->swap_activity();
    return (not defined $swapping or $swapping)
}

sub swap_activity($) {
    # If the currently known swap activity is too old:
    #   Recompute a new one in the background
    # Returns:
    #   last swap activity computed
    my $self = shift;
    # Should we update the swap_activity file?
    my $update_swap_activity_file = 0;
    # Test with (on 64 core machine):
    # seq 100 | parallel --lb -j100 'seq 1000 | parallel  --noswap -j 1 true'
    if(open(my $swap_fh, "<", $self->{'swap_activity_file'})) {
        my $swap_out = <$swap_fh>;
        close $swap_fh;
        if($swap_out =~ /^(\d+)$/) {
            $self->{'swap_activity'} = $1;
            ::debug("swap", "New swap_activity: ", $self->{'swap_activity'});
        }
        ::debug("swap", "Last update: ", $self->{'last_swap_activity_update'});
        if(time - $self->{'last_swap_activity_update'} > 10) {
            # last swap activity update was started 10 seconds ago
            ::debug("swap", "Older than 10 sec: ", $self->{'swap_activity_file'});
            $update_swap_activity_file = 1;
        }
    } else {
        ::debug("swap", "No swap_activity file: ", $self->{'swap_activity_file'});
        $self->{'swap_activity'} = undef;
        $update_swap_activity_file = 1;
    }
    if($update_swap_activity_file) {
        ::debug("swap", "Updating swap_activity file ", $self->{'swap_activity_file'});
        $self->{'last_swap_activity_update'} = time;
        my $dir = ::dirname($self->{'swap_activity_file'});
        -d $dir or eval { File::Path::mkpath($dir); };
        my $swap_activity;
        $swap_activity = swapactivityscript();
        if(not $self->local()) {
            $swap_activity = $self->wrap($swap_activity);
        }
        # Run swap_activity measuring.
        # 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->{'swap_activity_file'};
        my ($dummy_fh, $tmpfile) = ::tmpfile(SUFFIX => ".swp");
        ::debug("swap", "\n", $swap_activity, "\n");
        my $qtmp = ::Q($tmpfile);
        my $qfile = ::Q($file);
        ::qqx("($swap_activity > $qtmp && mv $qtmp $qfile || rm $qtmp &)");
    }
    return $self->{'swap_activity'};
}

{
    my $script;

    sub swapactivityscript() {
        # Returns:
        #   shellscript for detecting swap activity
        #
        # arguments for vmstat are OS dependant
        # swap_in and swap_out are in different columns depending on OS
        #
        if(not $script) {
            my %vmstat = (
                # linux: $7*$8
                # $ vmstat 1 2
                # procs -----------memory---------- ---swap-- -----io---- -system-- ----cpu----
                #  r  b   swpd   free   buff  cache   si   so    bi    bo   in   cs us sy id wa
                #  5  0  51208 1701096 198012 18857888    0    0    37   153   28   19 56 11 33  1
                #  3  0  51208 1701288 198012 18857972    0    0     0     0 3638 10412 15  3 82  0
                'linux' => ['vmstat 1 2 | tail -n1', '$7*$8'],

                # solaris: $6*$7
                # $ vmstat -S 1 2
                #  kthr      memory            page            disk          faults      cpu
                #  r b w   swap  free  si  so pi po fr de sr s3 s4 -- --   in   sy   cs us sy id
                #  0 0 0 4628952 3208408 0  0  3  1  1  0  0 -0  2  0  0  263  613  246  1  2 97
                #  0 0 0 4552504 3166360 0  0  0  0  0  0  0  0  0  0  0  246  213  240  1  1 98
                'solaris' => ['vmstat -S 1 2 | tail -1', '$6*$7'],

                # darwin (macosx): $21*$22
                # $ vm_stat -c 2 1
                # Mach Virtual Memory Statistics: (page size of 4096 bytes)
                #     free   active   specul inactive throttle    wired  prgable   faults     copy    0fill reactive   purged file-backed anonymous cmprssed cmprssor  dcomprs   comprs  pageins  pageout  swapins swapouts
                #   346306   829050    74871   606027        0   240231    90367  544858K 62343596  270837K    14178   415070      570102    939846      356      370      116      922  4019813        4        0        0
                #   345740   830383    74875   606031        0   239234    90369     2696      359      553        0        0      570110    941179      356      370        0        0        0        0        0        0
                'darwin' => ['vm_stat -c 2 1 | tail -n1', '$21*$22'],

                # ultrix: $12*$13
                # $ vmstat -S 1 2
                #  procs      faults    cpu      memory              page             disk
                #  r b w   in  sy  cs us sy id  avm  fre  si so  pi  po  fr  de  sr s0
                #  1 0 0    4  23   2  3  0 97 7743 217k   0  0   0   0   0   0   0  0
                #  1 0 0    6  40   8  0  1 99 7743 217k   0  0   3   0   0   0   0  0
                'ultrix' => ['vmstat -S 1 2 | tail -1', '$12*$13'],

                # aix: $6*$7
                # $ vmstat 1 2
                # System configuration: lcpu=1 mem=2048MB
                #
                # kthr    memory              page              faults        cpu
                # ----- ----------- ------------------------ ------------ -----------
                #  r  b   avm   fre  re  pi  po  fr   sr  cy  in   sy  cs us sy id wa
                #  0  0 333933 241803   0   0   0   0    0   0  10  143  90  0  0 99  0
                #  0  0 334125 241569   0   0   0   0    0   0  37 5368 184  0  9 86  5
                'aix' => ['vmstat 1 2 | tail -n1', '$6*$7'],

                # freebsd: $8*$9
                # $ vmstat -H 1 2
                #  procs      memory      page                    disks     faults         cpu
                #  r b w     avm    fre   flt  re  pi  po    fr  sr ad0 ad1   in   sy   cs us sy id
                #  1 0 0  596716   19560    32   0   0   0    33   8   0   0   11  220  277  0  0 99
                #  0 0 0  596716   19560     2   0   0   0     0   0   0   0   11  144  263  0  1 99
                'freebsd' => ['vmstat -H 1 2 | tail -n1', '$8*$9'],

                # mirbsd: $8*$9
                # $ vmstat 1 2
                #  procs   memory        page                    disks     traps         cpu
                #  r b w    avm    fre   flt  re  pi  po  fr  sr wd0 cd0  int   sys   cs us sy id
                #  0 0 0  25776 164968    34   0   0   0   0   0   0   0  230   259   38  4  0 96
                #  0 0 0  25776 164968    24   0   0   0   0   0   0   0  237   275   37  0  0 100
                'mirbsd' => ['vmstat 1 2 | tail -n1', '$8*$9'],

                # netbsd: $7*$8
                # $ vmstat 1 2
                #  procs    memory      page                       disks   faults      cpu
                #  r b      avm    fre  flt  re  pi   po   fr   sr w0 w1   in   sy  cs us sy id
                #  0 0   138452   6012   54   0   0    0    1    2  3  0    4  100  23  0  0 100
                #  0 0   138456   6008    1   0   0    0    0    0  0  0    7   26  19  0 0 100
                'netbsd' => ['vmstat 1 2 | tail -n1', '$7*$8'],

                # openbsd: $8*$9
                # $ vmstat 1 2
                #  procs    memory       page                    disks    traps          cpu
                #  r b w    avm     fre  flt  re  pi  po  fr  sr wd0 wd1  int   sys   cs us sy id
                #  0 0 0  76596  109944   73   0   0   0   0   0   0   1    5   259   22  0  1 99
                #  0 0 0  76604  109936   24   0   0   0   0   0   0   0    7   114   20  0  1 99
                'openbsd' => ['vmstat 1 2 | tail -n1', '$8*$9'],

                # hpux: $8*$9
                # $ vmstat 1 2
                #          procs           memory                   page                              faults       cpu
                #     r     b     w      avm    free   re   at    pi   po    fr   de    sr     in     sy    cs  us sy id
                #     1     0     0   247211  216476    4    1     0    0     0    0     0    102  73005    54   6 11 83
                #     1     0     0   247211  216421   43    9     0    0     0    0     0    144   1675    96  25269512791222387000 25269512791222387000 105
                'hpux' => ['vmstat 1 2 | tail -n1', '$8*$9'],

                # dec_osf (tru64): $11*$12
                # $ vmstat  1 2
                # Virtual Memory Statistics: (pagesize = 8192)
                #   procs      memory        pages                            intr       cpu
                #   r   w   u  act free wire fault  cow zero react  pin pout  in  sy  cs us sy id
                #   3 181  36  51K 1895 8696  348M  59M 122M   259  79M    0   5 218 302  4  1 94
                #   3 181  36  51K 1893 8696     3   15   21     0   28    0   4  81 321  1  1 98
                'dec_osf' => ['vmstat 1 2 | tail -n1', '$11*$12'],

                # gnu (hurd): $7*$8
                # $ vmstat -k 1 2
                # (pagesize: 4, size: 512288, swap size: 894972)
                #   free   actv  inact  wired   zeroed  react    pgins   pgouts  pfaults  cowpfs hrat    caobj  cache swfree
                # 371940  30844  89228  20276   298348      0    48192    19016   756105   99808  98%      876  20628 894972
                # 371940  30844  89228  20276       +0     +0       +0       +0      +42      +2  98%      876  20628 894972
                'gnu' => ['vmstat -k 1 2 | tail -n1', '$7*$8'],

                # -nto (qnx has no swap)
                #-irix
                #-svr5 (scosysv)
                );
            my $perlscript = "";
            # Make a perl script that detects the OS ($^O) and runs
            # the appropriate vmstat command
            for my $os (keys %vmstat) {
                $vmstat{$os}[1] =~ s/\$/\\\\\\\$/g; # $ => \\\$
                $perlscript .= 'if($^O eq "'.$os.'") { print `'.$vmstat{$os}[0].' | awk "{print ' .
                    $vmstat{$os}[1] . '}"` }';
            }
            $script = "perl -e " . ::Q($perlscript);
        }
        return $script;
    }
}

sub too_fast_remote_login($) {
    my $self = shift;
    if($self->{'last_login_at'} and $self->{'time_to_login'}) {
        # sshd normally allows 10 simultaneous logins
        # A login takes time_to_login
        # So time_to_login/5 should be safe
        # If now <= last_login + time_to_login/5: Then it is too soon.
        my $too_fast = (::now() <= $self->{'last_login_at'}
                        + $self->{'time_to_login'}/5);
        ::debug("run", "Too fast? $too_fast ");
        return $too_fast;
    } else {
        # No logins so far (or time_to_login not computed): it is not too fast
        return 0;
    }
}

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

sub set_last_login_at($$) {
    my $self = shift;
    $self->{'last_login_at'} = shift;
}

sub loadavg_too_high($) {
    my $self = shift;
    my $loadavg = $self->loadavg();
    if(defined $loadavg) {
        ::debug("load", "Load $loadavg > ",$self->max_loadavg());
        return $loadavg >= $self->max_loadavg();
    } else {
        # Unknown load: Assume load is too high
        return 1;
    }
}



sub loadavg($) {
    # If the currently know loadavg is too old:
    #   Recompute a new one in the background
    # The load average is computed as the number of processes waiting
    # for disk or CPU right now. So it is the server load this instant
    # and not averaged over several minutes. This is needed so GNU
    # Parallel will at most start one job that will push the load over
    # the limit.
    #
    # Returns:
    #   $last_loadavg = last load average computed (undef if none)

    my $self = shift;
    sub loadavg_cmd() {
        if(not $Global::loadavg_cmd) {
            # aix => "ps -ae -o state,command" # state wrong
            # bsd => "ps ax -o state,command"
            # sysv => "ps -ef -o s -o comm"
            # cygwin => perl -ne 'close STDERR; /Name/ and print"\n"; \
            #    /(Name|Pid|Ppid|State):\s+(\S+)/ and print "$2\t";' /proc/*/status |
            #    awk '{print $2,$1}'
            # dec_osf => bsd
            # dragonfly => bsd
            # freebsd => bsd
            # gnu => bsd
            # hpux => ps -el|awk '{print $2,$14,$15}'
            # irix => ps -ef -o state -o comm
            # linux => bsd
            # minix => ps el|awk '{print \$1,\$11}'
            # mirbsd => bsd
            # netbsd => bsd
            # openbsd => bsd
            # solaris => sysv
            # svr5 => sysv
            # ultrix => ps -ax | awk '{print $3,$5}'
            # unixware => ps -el|awk '{print $2,$14,$15}'
            my $ps = ::spacefree(1,q{
                $sysv="ps -ef -o s -o comm";
                $sysv2="ps -ef -o state -o comm";
                $bsd="ps ax -o state,command";
                # Treat threads as processes
                $bsd2="ps axH -o state,command";
                $psel="ps -el|awk '{ print \$2,\$14,\$15 }'";
                $cygwin=q{ perl -ne 'close STDERR; /Name/ and print"\n";
                    /(Name|Pid|Ppid|State):\s+(\S+)/ and print "$2\t";' /proc/*/status |
                    awk '{print $2,$1}' };
                $dummy="echo S COMMAND;echo R dummy";
                %ps=(
                    # TODO Find better code for AIX/Android
                    'aix' => "uptime",
                    'android' => "uptime",
                    'cygwin' => $cygwin,
                    'darwin' => $bsd,
                    'dec_osf' => $sysv2,
                    'dragonfly' => $bsd,
                    'freebsd' => $bsd2,
                    'gnu' => $bsd,
                    'hpux' => $psel,
                    'irix' => $sysv2,
                    'linux' => $bsd2,
                    'minix' => "ps el|awk '{print \$1,\$11}'",
                    'mirbsd' => $bsd,
                    'msys' => $cygwin,
                    'netbsd' => $bsd,
                    'nto' => $dummy,
                    'openbsd' => $bsd,
                    'solaris' => $sysv,
                    'svr5' => $psel,
                    'ultrix' => "ps -ax | awk '{print \$3,\$5}'",
                    'MSWin32' => $sysv,
                    );
                print `$ps{$^O}`;
            });
            # The command is too long for csh, so base64_wrap the command
            $Global::loadavg_cmd = $self->hexwrap($ps);
        }
        return $Global::loadavg_cmd;
    }
    # Should we update the loadavg file?
    my $update_loadavg_file = 0;
    if(open(my $load_fh, "<", $self->{'loadavg_file'})) {
        local $/; # $/ = undef => slurp whole file
        my $load_out = <$load_fh>;
        close $load_fh;
        if($load_out =~ /\S/) {
            # Content can be empty if ~/ is on NFS
            # due to reading being non-atomic.
            #
            # Count lines starting with D,O,R but command does not start with [
            my $load =()= ($load_out=~/(^\s?[DOR]\S* +(?=[^\[])\S)/gm);
            if($load > 0) {
                # load is overestimated by 1
                $self->{'loadavg'} = $load - 1;
                ::debug("load", "New loadavg: ", $self->{'loadavg'},"\n");
            } elsif ($load_out=~/average: (\d+.\d+)/) {
                # AIX does not support instant load average
                # 04:11AM   up 21 days,  12:55,  1 user,  load average: 1.85, 1.57, 1.55
                $self->{'loadavg'} = $1;
            } else {
                ::die_bug("loadavg_invalid_content: " .
                          $self->{'loadavg_file'} . "\n$load_out");
            }
        }
        $update_loadavg_file = 1;
    } else {
        ::debug("load", "No loadavg file: ", $self->{'loadavg_file'});
        $self->{'loadavg'} = undef;
        $update_loadavg_file = 1;
    }
    if($update_loadavg_file) {
        ::debug("load", "Updating loadavg file", $self->{'loadavg_file'}, "\n");
        $self->{'last_loadavg_update'} = time;
        my $dir = ::dirname($self->{'swap_activity_file'});
        -d $dir or eval { File::Path::mkpath($dir); };
        -w $dir or ::die_bug("Cannot write to $dir");
        my $cmd = "";
        if($self->{'string'} ne ":") {
            $cmd = $self->wrap(loadavg_cmd());
        } else {
            $cmd .= loadavg_cmd();
        }
        # As the command can take long to run if run remote
        # save it to a tmp file before moving it to the correct file
        ::debug("load", "Update load\n");
        my $file = ::Q($self->{'loadavg_file'});
        # tmpfile on same filesystem as $file
        my $tmpfile = $file.$$;
        $ENV{'SSHPASS'} = $self->{'password'};
        ::qqx("($cmd > $tmpfile && mv $tmpfile $file || rm $tmpfile & )");
    }
    return $self->{'loadavg'};
}

sub max_loadavg($) {
    my $self = shift;
    # If --load is a file it might be changed
    if($Global::max_load_file) {
        my $mtime = (stat($Global::max_load_file))[9];
        if($mtime > $Global::max_load_file_last_mod) {
            $Global::max_load_file_last_mod = $mtime;
            for my $sshlogin (values %Global::host) {
                $sshlogin->set_max_loadavg(undef);
            }
        }
    }
    if(not defined $self->{'max_loadavg'}) {
        $self->{'max_loadavg'} =
            $self->compute_max_loadavg($opt::load);
    }
    ::debug("load", "max_loadavg: ", $self->string(), " ", $self->{'max_loadavg'});
    return $self->{'max_loadavg'};
}

sub set_max_loadavg($$) {
    my $self = shift;
    $self->{'max_loadavg'} = shift;
}

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;
        } elsif (-f $loadspec) {
            $Global::max_load_file = $loadspec;
            $Global::max_load_file_last_mod = (stat($Global::max_load_file))[9];
            $load = $self->compute_max_loadavg(
                ::slurp_or_exit($Global::max_load_file)
                );
        } else {
            ::error("Parsing of --load failed.");
            ::die_usage();
        }
        if($load < 0.01) {
            $load = 0.01;
        }
    }
    return $load;
}

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

sub set_time_to_login($$) {
    my $self = shift;
    $self->{'time_to_login'} = shift;
}

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

sub orig_max_jobs_running($) {
    my $self = shift;
    return $self->{'orig_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("load", "Wanted procs: $wanted_processes\n");
    my $system_limit =
        $self->processes_available_by_system_limit($wanted_processes);
    ::debug("load", "Limited to procs: $system_limit\n");
    return $system_limit;
}

{
    my @children;
    my $max_system_proc_reached;
    my $more_filehandles;
    my %fh;
    my $tmpfhname;
    my $count_jobs_already_read;
    my @jobs;
    my $job;
    my @args;
    my $arg;

    sub reserve_filehandles($) {
        # Reserves filehandle
        my $n = shift;
        for (1..$n) {
            $more_filehandles &&= open($fh{$tmpfhname++}, "<", "/dev/null");
        }
    }

    sub reserve_process() {
        # Spawn a dummy process
        my $child;
        if($child = fork()) {
            push @children, $child;
            $Global::unkilled_children{$child} = 1;
        } elsif(defined $child) {
            # This is the child
            # The child takes one process slot
            # It will be killed later
            $SIG{'TERM'} = $Global::original_sig{'TERM'};
            if($^O eq "cygwin" or $^O eq "msys" or $^O eq "nto") {
                # The exec does not work on Cygwin and QNX
                sleep 10101010;
            } else {
                # 'exec sleep' takes less RAM than sleeping in perl
                exec 'sleep', 10101;
            }
            exit(0);
        } else {
            # Failed to spawn
            $max_system_proc_reached = 1;
        }
    }

    sub get_args_or_jobs() {
        # Get an arg or a job (depending on mode)
        if($Global::semaphore or ($opt::pipe and not $opt::tee)) {
            # Skip: No need to get args
            return 1;
        } 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--;
            return 1;
        } 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
                if($Global::JobQueue->{'commandlinequeue'}->{'arg_queue'}->empty()) {
                    if($Global::JobQueue->empty()) {
                        return 0;
                    } else {
                        $job = $Global::JobQueue->get();
                        push(@jobs, $job);
                        return 1;
                    }
                } else {
                    $arg = $Global::JobQueue->{'commandlinequeue'}->{'arg_queue'}->get();
                    push(@args, $arg);
                    return 1;
                }
            } else {
                # If there are no more command lines, then we have a process
                # per command line, so no need to go further
                if($Global::JobQueue->empty()) {
                    return 0;
                } else {
                    $job = $Global::JobQueue->get();
                    # Replacement must happen here due to seq()
                    $job and $job->replaced();
                    push(@jobs, $job);
                    return 1;
                }
            }
        }
    }

    sub cleanup() {
        # Cleanup: Close the files
        for (values %fh) { close $_ }
        # Cleanup: Kill the children
        for my $pid (@children) {
            kill 9, $pid;
            waitpid($pid,0);
            delete $Global::unkilled_children{$pid};
        }
        # Cleanup: Unget the command_lines or the @args
        $Global::JobQueue->{'commandlinequeue'}{'arg_queue'}->unget(@args);
        @args = ();
        $Global::JobQueue->unget(@jobs);
        @jobs = ();
    }

    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 $slow_spawning_warning_printed = 0;
        my $time = time;
        $more_filehandles = 1;
        $tmpfhname = "TmpFhNamE";

        # perl uses 7 filehandles for something?
        # parallel uses 1 for memory_usage
        # parallel uses 4 for ?
        reserve_filehandles(12);
        # Two processes for load avg and ?
        reserve_process();
        reserve_process();

        # For --retries count also jobs already run
        $count_jobs_already_read = $Global::JobQueue->next_seq();
        my $wait_time_for_getting_args = 0;
        my $start_time = time;
        if($wanted_processes < $Global::infinity) {
            $Global::dummy_jobs = 1;
        }
        while(1) {
            $system_limit >= $wanted_processes and last;
            not $more_filehandles and last;
            $max_system_proc_reached and last;

            my $before_getting_arg = time;
            if(!$Global::dummy_jobs) {
                get_args_or_jobs() or last;
            }
            $wait_time_for_getting_args += time - $before_getting_arg;
            $system_limit++;

            # Every simultaneous process uses 2 filehandles to write to
            # and 2 filehandles to read from
            reserve_filehandles(4);

            # System process limit
            reserve_process();

            my $forktime = time - $time - $wait_time_for_getting_args;
            ::debug("run", "Time to fork $system_limit procs: ".
                    $wait_time_for_getting_args, " ", $forktime,
                    " (processes so far: ", $system_limit,")\n");
            if($system_limit > 10 and
               $forktime > 1 and
               $forktime > $system_limit * 0.01) {
                # It took more than 0.01 second to fork a processes on avg.
                # Give the user a warning. He can press Ctrl-C if this
                # sucks.
                ::warning_once(
                      "Starting $system_limit processes took > $forktime sec.",
                      "Consider adjusting -j. Press CTRL-C to stop.");
            }
        }
        cleanup();

        if($system_limit < $wanted_processes) {
            # The system_limit is less than the wanted_processes
            if($system_limit < 1 and not $Global::JobQueue->empty()) {
                ::warning("Cannot spawn any jobs.",
                          "Try increasing 'ulimit -u' (try: ulimit -u `ulimit -Hu`)",
                          "or increasing 'nproc' in /etc/security/limits.conf",
                          "or increasing /proc/sys/kernel/pid_max");
                ::wait_and_exit(255);
            }
            if(not $more_filehandles) {
                ::warning("Only enough file handles to run ".
                          $system_limit. " jobs in parallel.",
                          "Try running 'parallel -j0 -N $system_limit --pipe parallel -j0'",
                          "or increasing 'ulimit -n' (try: ulimit -n `ulimit -Hn`)",
                          "or increasing 'nofile' in /etc/security/limits.conf",
                          "or increasing /proc/sys/fs/file-max");
            }
            if($max_system_proc_reached) {
                ::warning("Only enough available processes to run ".
                          $system_limit. " jobs in parallel.",
                          "Try increasing 'ulimit -u' (try: ulimit -u `ulimit -Hu`)",
                          "or increasing 'nproc' in /etc/security/limits.conf",
                          "or increasing /proc/sys/kernel/pid_max");
            }
        }
        if($] == 5.008008 and $system_limit > 1000) {
            # https://savannah.gnu.org/bugs/?36942
            $system_limit = 1000;
        }
        if($Global::JobQueue->empty()) {
            $system_limit ||= 1;
        }
        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;
    if($self->{'time_to_login'}) {
        return $wanted_processes;
    }

    # 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->string();
        ::warning("ssh to $serverlogin only allows ".
                  "for $ssh_limit simultaneous logins.",
                  "You may raise this by changing",
                  "/etc/ssh/sshd_config:MaxStartups and MaxSessions on $serverlogin.",
                  "You can also try --sshdelay 0.1",
                  "Using only ".($ssh_limit-1)." connections ".
                  "to avoid race conditions.");
        # 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 simul-login & ssh host echo simul-login & ...) |
    #   grep simul|wc -l
    # Input:
    #   $wanted_processes = Try for this many logins in parallel
    # Returns:
    #   $ssh_limit = Number of succesful parallel logins
    local $/ = "\n";
    my $self = shift;
    my $wanted_processes = shift;
    my $sshdelay = $opt::sshdelay ? "sleep $opt::sshdelay;" : "";
    # TODO sh -c wrapper to work for csh
    my $cmd = ($sshdelay.$self->wrap("echo simultaneouslogin").
               "</dev/null 2>&1 &")x$wanted_processes;
    ::debug("init","Trying $wanted_processes logins at ".$self->string()."\n");
    open (my $simul_fh, "-|", "($cmd)|grep simultaneouslogin | wc -l") or
        ::die_bug("simultaneouslogin");
    my $ssh_limit = <$simul_fh>;
    close $simul_fh;
    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
    # Input:
    #   $opt_P = string formatted as for -P
    # Returns:
    #   $processes = the number of processes to run on this sshlogin
    my $self = shift;
    my $opt_P = shift;
    my $processes;
    if(defined $opt_P) {
        if (-f $opt_P) {
            $Global::max_procs_file = $opt_P;
            my $opt_P_file = ::slurp_or_exit($Global::max_procs_file);
            if($opt_P_file !~ /\S/) {
                ::warning_once("$Global::max_procs_file is empty. ".
                               "Treated as 100%");
                $opt_P_file = "100%";
            }
            $processes = $self->user_requested_processes($opt_P_file);
        } else {
            if($opt_P eq "0") {
                # -P 0 = infinity (or at least close)
                $processes = $Global::infinity;
            } else {
                # -P +3 and -P -1
                $opt_P =~ s/^([-+])/\$self->ncpus()$1/;
                # -P 40%
                $opt_P =~ s:%$:*\$self->ncpus()/100:;
                $processes = eval $opt_P;
                if($processes <= 0) {
                    # Do not go below 1
                    $processes = 1;
                }
            }
        }
        $processes = ::ceil($processes);
    }
    return $processes;
}

sub ncpus($) {
    # Number of CPU threads
    # --use_sockets_instead_of_threads = count socket instead
    # --use_cores_instead_of_threads = count physical cores instead
    # Returns:
    #   $ncpus = number of cpu (threads) on this sshlogin
    local $/ = "\n";
    my $self = shift;
    if(not defined $self->{'ncpus'}) {
        if($self->local()) {
            if($opt::use_sockets_instead_of_threads) {
                $self->{'ncpus'} = socket_core_thread()->{'sockets'};
            } elsif($opt::use_cores_instead_of_threads) {
                $self->{'ncpus'} = socket_core_thread()->{'cores'};
            } else {
                $self->{'ncpus'} = socket_core_thread()->{'threads'};
            }
        } else {
            my $ncpu;
            $ENV{'SSHPASS'} = $self->{'password'};
            ::debug("init",("echo | ".$self->wrap("parallel --number-of-sockets")));
            if($opt::use_sockets_instead_of_threads
               or
                $opt::use_cpus_instead_of_cores) {
                $ncpu = ::qqx("echo | ".$self->wrap("parallel --number-of-sockets"));
            } elsif($opt::use_cores_instead_of_threads) {
                $ncpu = ::qqx("echo | ".$self->wrap("parallel --number-of-cores"));
            } else {
                $ncpu = ::qqx("echo | ".$self->wrap("parallel --number-of-threads"));
            }
            chomp $ncpu;
            if($ncpu =~ /^\s*[0-9]+\s*$/s) {
                $self->{'ncpus'} = $ncpu;
            } else {
                ::warning("Could not figure out ".
                          "number of cpus on ".$self->string." ($ncpu). Using 1.");
                $self->{'ncpus'} = 1;
            }
        }
    }
    return $self->{'ncpus'};
}


sub nproc() {
    # Returns:
    #   Number of threads using `nproc`
    my $no_of_threads = ::qqx("nproc");
    chomp $no_of_threads;
    return $no_of_threads;
}

sub no_of_sockets() {
    return socket_core_thread()->{'sockets'};
}

sub no_of_cores() {
    return socket_core_thread()->{'cores'};
}

sub no_of_threads() {
    return socket_core_thread()->{'threads'};
}

sub socket_core_thread() {
    # Returns:
    #   {
    #     'sockets' => #sockets = number of socket with CPU present
    #     'cores' => #cores = number of physical cores
    #     'threads' => #threads = number of compute cores (hyperthreading)
    #     'active' => #taskset_threads = number of taskset limited cores
    #   }
    my $cpu;
    if ($^O eq 'linux') {
        $cpu = sct_gnu_linux($cpu);
    } elsif ($^O eq 'android') {
        $cpu = sct_android($cpu);
    } elsif ($^O eq 'freebsd') {
        $cpu = sct_freebsd($cpu);
    } elsif ($^O eq 'netbsd') {
        $cpu = sct_netbsd($cpu);
    } elsif ($^O eq 'openbsd') {
        $cpu = sct_openbsd($cpu);
    } elsif ($^O eq 'gnu') {
        $cpu = sct_hurd($cpu);
    } elsif ($^O eq 'darwin') {
        $cpu = sct_darwin($cpu);
    } elsif ($^O eq 'solaris') {
        $cpu = sct_solaris($cpu);
    } elsif ($^O eq 'aix') {
        $cpu = sct_aix($cpu);
    } elsif ($^O eq 'hpux') {
        $cpu = sct_hpux($cpu);
    } elsif ($^O eq 'nto') {
        $cpu = sct_qnx($cpu);
    } elsif ($^O eq 'svr5') {
        $cpu = sct_openserver($cpu);
    } elsif ($^O eq 'irix') {
        $cpu = sct_irix($cpu);
    } elsif ($^O eq 'dec_osf') {
        $cpu = sct_tru64($cpu);
    } else {
        # Try all methods until we find something that works
        $cpu = (sct_gnu_linux($cpu)
                || sct_android($cpu)
                || sct_freebsd($cpu)
                || sct_netbsd($cpu)
                || sct_openbsd($cpu)
                || sct_hurd($cpu)
                || sct_darwin($cpu)
                || sct_solaris($cpu)
                || sct_aix($cpu)
                || sct_hpux($cpu)
                || sct_qnx($cpu)
                || sct_openserver($cpu)
                || sct_irix($cpu)
                || sct_tru64($cpu)
            );
    }
    if(not $cpu) {
        # Fall back: Set all to nproc
        my $nproc = nproc();
        if($nproc) {
            $cpu->{'sockets'} =
                $cpu->{'cores'} =
                $cpu->{'threads'} =
                $cpu->{'active'} =
                $nproc;
        }
    }
    if(not $cpu) {
        ::warning("Cannot figure out number of cpus. Using 1.");
        $cpu->{'sockets'} =
            $cpu->{'cores'} =
            $cpu->{'threads'} =
            $cpu->{'active'} =
            1
    }
    $cpu->{'sockets'} ||= 1;
    $cpu->{'threads'} ||= $cpu->{'cores'};
    $cpu->{'active'} ||= $cpu->{'threads'};
    chomp($cpu->{'sockets'},
          $cpu->{'cores'},
          $cpu->{'threads'},
          $cpu->{'active'});
    # Choose minimum of active and actual
    my $mincpu;
    $mincpu->{'sockets'} = ::min($cpu->{'sockets'},$cpu->{'active'});
    $mincpu->{'cores'} = ::min($cpu->{'cores'},$cpu->{'active'});
    $mincpu->{'threads'} = ::min($cpu->{'threads'},$cpu->{'active'});
    return $mincpu;
}

sub sct_gnu_linux($) {
    # Returns:
    #   { 'sockets' => #sockets
    #     'cores' => #cores
    #     'threads' => #threads
    #     'active' => #taskset_threads }
    my $cpu = shift;

    sub read_topology($) {
        my $prefix = shift;
        my %sibiling;
        my %socket;
        my $thread;
        for($thread = 0;
            -r "$prefix/cpu$thread/topology/physical_package_id";
            $thread++) {
            $socket{::slurp_or_exit(
                        "$prefix/cpu$thread/topology/physical_package_id")}++;
        }
        for($thread = 0;
            -r "$prefix/cpu$thread/topology/thread_siblings";
            $thread++) {
            $sibiling{::slurp_or_exit(
                          "$prefix/cpu$thread/topology/thread_siblings")}++;
        }
        $cpu->{'sockets'} = keys %socket;
        $cpu->{'cores'} = keys %sibiling;
        $cpu->{'threads'} = $thread;
    }

    sub read_cpuinfo(@) {
        my @cpuinfo = @_;
        $cpu->{'sockets'} = 0;
        $cpu->{'cores'} = 0;
        $cpu->{'threads'} = 0;
        my %seen;
        my %phy_seen;
        my $physicalid;
        for(@cpuinfo) {
            # physical id : 0
            if(/^physical id.*[:](.*)/) {
                $physicalid = $1;
                if(not $phy_seen{$1}++) {
                    $cpu->{'sockets'}++;
                }
            }
            # core id : 3
            if(/^core id.*[:](.*)/ and not $seen{$physicalid,$1}++) {
                $cpu->{'cores'}++;
            }
            # processor : 2
            /^processor.*[:]\s*\d/i and $cpu->{'threads'}++;
        }
        $cpu->{'cores'} ||= $cpu->{'threads'};
        $cpu->{'cpus'} ||= $cpu->{'threads'};
        $cpu->{'sockets'} ||= 1;
    }

    sub read_lscpu(@) {
        my @lscpu = @_;
        my $threads_per_core;
        my $cores_per_socket;
        for(@lscpu) {
            /^CPU.s.:\s*(\d+)/ and $cpu->{'threads'} = $1;
            /^Thread.s. per core:\s*(\d+)/ and $threads_per_core = $1;
            /^Core.s. per socket:\s*(\d+)/ and $cores_per_socket = $1;
            /^(CPU )?Socket.s.:\s*(\d+)/i and $cpu->{'sockets'} = $2;
        }
        if($cores_per_socket and $cpu->{'sockets'}) {
            $cpu->{'cores'} = $cores_per_socket * $cpu->{'sockets'};
        }
        if($threads_per_core and $cpu->{'cores'}) {
            $cpu->{'threads'} = $threads_per_core * $cpu->{'cores'};
        }
        if($threads_per_core and $cpu->{'threads'}) {
            $cpu->{'cores'} = $cpu->{'threads'} / $threads_per_core;
        }
        $cpu->{'cpus'} ||= $cpu->{'threads'};
    }

    local $/ = "\n"; # If delimiter is set, then $/ will be wrong
    my @cpuinfo;
    my @lscpu;
    if($ENV{'PARALLEL_CPUINFO'}) {
        # Use CPUINFO from environment - used for testing only
        read_cpuinfo(split/(?<=\n)/,$ENV{'PARALLEL_CPUINFO'});
    } elsif($ENV{'PARALLEL_LSCPU'}) {
        # Use LSCPU from environment - used for testing only
        read_lscpu(split/(?<=\n)/,$ENV{'PARALLEL_LSCPU'});
    } elsif(-r "$ENV{'PARALLEL_CPUPREFIX'}/cpu0/topology/thread_siblings") {
        # Use CPUPREFIX from environment - used for testing only
        read_topology($ENV{'PARALLEL_CPUPREFIX'});
    } elsif($cpu->{'sockets'} and $cpu->{'cores'} and $cpu->{'threads'}) {
        # Skip /proc/cpuinfo - already set
    } else {
        # Not debugging: Look at this computer
        if(!($cpu->{'sockets'} and $cpu->{'cores'} and $cpu->{'threads'})
           and
           open(my $in_fh, "-|", "lscpu")) {
            # Parse output from lscpu
            read_lscpu(<$in_fh>);
            close $in_fh;
        }
        if(!($cpu->{'sockets'} and $cpu->{'cores'} and $cpu->{'threads'})
           and
           -r "/sys/devices/system/cpu/cpu0/topology/thread_siblings") {
            read_topology("/sys/devices/system/cpu");
        }
        if(!($cpu->{'sockets'} and $cpu->{'cores'} and $cpu->{'threads'})
           and
           open(my $in_fh, "<", "/proc/cpuinfo")) {
            # Read /proc/cpuinfo
            read_cpuinfo(<$in_fh>);
            close $in_fh;
        }
    }
    if(-e "/proc/self/status"
       and not $ENV{'PARALLEL_CPUINFO'}
       and not $ENV{'PARALLEL_LSCPU'}) {
        # if 'taskset' is used to limit number of threads
        if(open(my $in_fh, "<", "/proc/self/status")) {
            while(<$in_fh>) {
                if(/^Cpus_allowed:\s*(\S+)/) {
                    my $a = $1;
                    $a =~ tr/,//d;
                    $cpu->{'active'} = unpack ("%32b*", pack ("H*",$a));
                }
            }
            close $in_fh;
        }
    }
    return $cpu;
}

sub sct_android($) {
    # Returns:
    #   { 'sockets' => #sockets
    #     'cores' => #cores
    #     'threads' => #threads
    #     'active' => #taskset_threads }
    # Use GNU/Linux
    return sct_gnu_linux($_[0]);
}

sub sct_freebsd($) {
    # Returns:
    #   { 'sockets' => #sockets
    #     'cores' => #cores
    #     'threads' => #threads
    #     'active' => #taskset_threads }
    local $/ = "\n";
    my $cpu = shift;
    $cpu->{'cores'} ||=
        (::qqx(qq{ sysctl -a dev.cpu | grep \%parent | awk '{ print \$2 }' | uniq | wc -l | awk '{ print \$1 }' })
         or
         ::qqx(qq{ sysctl hw.ncpu | awk '{ print \$2 }' }));
    $cpu->{'threads'} ||=
        (::qqx(qq{ sysctl hw.ncpu | awk '{ print \$2 }' })
         or
         ::qqx(qq{ sysctl -a dev.cpu | grep \%parent | awk '{ print \$2 }' | uniq | wc -l | awk '{ print \$1 }' }));
    return $cpu;
}

sub sct_netbsd($) {
    # Returns:
    #   { 'sockets' => #sockets
    #     'cores' => #cores
    #     'threads' => #threads
    #     'active' => #taskset_threads }
    local $/ = "\n";
    my $cpu = shift;
    $cpu->{'cores'} ||= ::qqx("sysctl -n hw.ncpu");
    return $cpu;
}

sub sct_openbsd($) {
    # Returns:
    #   { 'sockets' => #sockets
    #     'cores' => #cores
    #     'threads' => #threads
    #     'active' => #taskset_threads }
    local $/ = "\n";
    my $cpu = shift;
    $cpu->{'cores'} ||= ::qqx('sysctl -n hw.ncpu');
    return $cpu;
}

sub sct_hurd($) {
    # Returns:
    #   { 'sockets' => #sockets
    #     'cores' => #cores
    #     'threads' => #threads
    #     'active' => #taskset_threads }
    local $/ = "\n";
    my $cpu = shift;
    $cpu->{'cores'} ||= ::qqx("nproc");
    return $cpu;
}

sub sct_darwin($) {
    # Returns:
    #   { 'sockets' => #sockets
    #     'cores' => #cores
    #     'threads' => #threads
    #     'active' => #taskset_threads }
    local $/ = "\n";
    my $cpu = shift;
    $cpu->{'cores'} ||=
        (::qqx('sysctl -n hw.physicalcpu')
         or
         ::qqx(qq{ sysctl -a hw | grep [^a-z]physicalcpu[^a-z] | awk '{ print \$2 }' }));
    $cpu->{'threads'} ||=
        (::qqx('sysctl -n hw.logicalcpu')
         or
         ::qqx(qq{ sysctl -a hw | grep [^a-z]logicalcpu[^a-z] | awk '{ print \$2 }' }));
    return $cpu;
}

sub sct_solaris($) {
    # Returns:
    #   { 'sockets' => #sockets
    #     'cores' => #cores
    #     'threads' => #threads
    #     'active' => #taskset_threads }
    local $/ = "\n";
    my $cpu = shift;
    if(not $cpu->{'cores'}) {
        if(-x "/usr/bin/kstat") {
            my @chip_id = ::qqx("/usr/bin/kstat cpu_info|grep chip_id");
            if($#chip_id >= 0) {
                $cpu->{'sockets'} ||= $#chip_id +1;
            }
            my @core_id = ::qqx("/usr/bin/kstat -m cpu_info|grep -w core_id|uniq");
            if($#core_id >= 0) {
                $cpu->{'cores'} ||= $#core_id +1;
            }
        }
        if(-x "/usr/sbin/psrinfo") {
            my @psrinfo = ::qqx("/usr/sbin/psrinfo -p");
            if($#psrinfo >= 0) {
                $cpu->{'sockets'} ||= $psrinfo[0];
            }
        }
        if(-x "/usr/sbin/prtconf") {
            my @prtconf = ::qqx("/usr/sbin/prtconf | grep cpu..instance");
            if($#prtconf >= 0) {
                $cpu->{'cores'} ||= $#prtconf +1;
            }
        }
    }
    return $cpu;
}

sub sct_aix($) {
    # Returns:
    #   { 'sockets' => #sockets
    #     'cores' => #cores
    #     'threads' => #threads
    #     'active' => #taskset_threads }
    local $/ = "\n";
    my $cpu = shift;
    if(not $cpu->{'cores'}) {
        if(-x "/usr/sbin/lscfg") {
            if(open(my $in_fh, "-|",
                    "/usr/sbin/lscfg -vs |grep proc | wc -l|tr -d ' '")) {
                $cpu->{'cores'} = <$in_fh>;
                close $in_fh;
            }
        }
    }
    if(not $cpu->{'threads'}) {
        if(-x "/usr/bin/vmstat") {
            if(open(my $in_fh, "-|", "/usr/bin/vmstat 1 1")) {
                while(<$in_fh>) {
                    /lcpu=([0-9]*) / and $cpu->{'threads'} = $1;
                }
                close $in_fh;
            }
        }
    }
    return $cpu;
}

sub sct_hpux($) {
    # Returns:
    #   { 'sockets' => #sockets
    #     'cores' => #cores
    #     'threads' => #threads
    #     'active' => #taskset_threads }
    local $/ = "\n";
    my $cpu = shift;
    $cpu->{'cores'} ||=
        ::qqx(qq{ /usr/bin/mpsched -s 2>&1 | grep 'Locality Domain Count' | awk '{ print \$4 }'});
    $cpu->{'threads'} ||=
        ::qqx(qq{ /usr/bin/mpsched -s 2>&1 | perl -ne '/Processor Count\\D+(\\d+)/ and print "\$1"'});
    return $cpu;
}

sub sct_qnx($) {
    # Returns:
    #   { 'sockets' => #sockets
    #     'cores' => #cores
    #     'threads' => #threads
    #     'active' => #taskset_threads }
    local $/ = "\n";
    my $cpu = shift;
    # BUG: It is not known how to calculate this.

    return $cpu;
}

sub sct_openserver($) {
    # Returns:
    #   { 'sockets' => #sockets
    #     'cores' => #cores
    #     'threads' => #threads
    #     'active' => #taskset_threads }
    local $/ = "\n";
    my $cpu = shift;
    if(not $cpu->{'cores'}) {
        if(-x "/usr/sbin/psrinfo") {
            my @psrinfo = ::qqx("/usr/sbin/psrinfo");
            if($#psrinfo >= 0) {
                $cpu->{'cores'} = $#psrinfo +1;
            }
        }
    }
    $cpu->{'sockets'} ||= $cpu->{'cores'};
    return $cpu;
}

sub sct_irix($) {
    # Returns:
    #   { 'sockets' => #sockets
    #     'cores' => #cores
    #     'threads' => #threads
    #     'active' => #taskset_threads }
    local $/ = "\n";
    my $cpu = shift;
    $cpu->{'cores'} ||=
        ::qqx(qq{ hinv | grep HZ | grep Processor | awk '{print \$1}' });
    return $cpu;
}

sub sct_tru64($) {
    # Returns:
    #   { 'sockets' => #sockets
    #     'cores' => #cores
    #     'threads' => #threads
    #     'active' => #taskset_threads }
    local $/ = "\n";
    my $cpu = shift;
    $cpu->{'cores'} ||= ::qqx("sizer -pr");
    $cpu->{'sockets'} ||= $cpu->{'cores'};
    $cpu->{'threads'} ||= $cpu->{'cores'};

    return $cpu;
}

sub sshcommand($) {
    # Returns:
    #   $sshcommand = the command (incl options) to run when using ssh
    my $self = shift;
    if (not defined $self->{'sshcommand'}) {
        ::die_bug("sshcommand not set");
    }
    return $self->{'sshcommand'};
}

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

sub control_path_dir($) {
    # Returns:
    #   $control_path_dir = dir of control path (for -M)
    my $self = shift;
    if(not defined $self->{'control_path_dir'}) {
        $self->{'control_path_dir'} =
            # Use $ENV{'TMPDIR'} as that is typically not
            # NFS mounted.
            # The file system must support UNIX domain sockets
            File::Temp::tempdir($ENV{'TMPDIR'}
                                . "/ctrlpath-XXXX",
                                CLEANUP => 1);
    }
    return $self->{'control_path_dir'};
}

sub rsync_transfer_cmd($) {
    # Command to run to transfer a file
    # Input:
    #   $file = filename of file to transfer
    #   $workdir = destination dir
    # Returns:
    #   $cmd = rsync command to run to transfer $file ("" if unreadable)
    my $self = shift;
    my $file = shift;
    my $workdir = shift;
    if(not -r $file) {
        ::warning($file. " is not readable and will not be transferred.");
        return "true";
    }
    my $rsync_destdir;
    my $relpath = ($file !~ m:^/:) || ($file =~ m:/\./:); # Is the path relative or /./?
    if($relpath) {
        $rsync_destdir = ::shell_quote_file($workdir);
    } else {
        # rsync /foo/bar /
        $rsync_destdir = "/";
    }
    $file = ::shell_quote_file($file);
    # Make dir if it does not exist
    return($self->wrap("mkdir -p $rsync_destdir") . " && " .
           $self->rsync()." $file ".$self->{'host'}.":$rsync_destdir");
}

{
    my $rsync_fix;
    my $rsync_version;

    sub rsync($) {
        # rsync 3.1.x uses protocol 31 which is unsupported by 2.5.7.
        # If the version >= 3.1.0: downgrade to protocol 30
        # rsync 3.2.4 introduces a quoting bug: Add --old-args for that
        # Returns:
        #   $rsync = "rsync" or "rsync --protocol 30 --old-args"
        sub rsync_version {
            if(not $rsync_version) {
                my @out = `rsync --version`;
                if(not @out) {
                    if(::which("rsync")) {
                        ::die_bug("'rsync --version' gave no output.");
                    } else {
                        ::error("'rsync' is not in \$PATH.");
                        ::wait_and_exit(255);
                    }
                }
                for (@out) {
                    # rsync      version 3.1.3  protocol version 31
                    # rsync      version v3.2.3  protocol version 31
                    if(/version v?(\d+)\.(\d+)(\.(\d+))?/) {
                        # 3.2.27 => 03.0227
                        $rsync_version = sprintf "%02d.%02d%02d",$1,$2,$4;
                    }
                }
                $rsync_version or
                    ::die_bug("Cannot figure out version of rsync: @out");
            }
        }

        sub rsync_fixup {
            # rsync 3.1.x uses protocol 31 which is unsupported by 2.5.7.
            # If the version >= 3.1.0: downgrade to protocol 30
            # Returns:
            #   $rsync = "rsync" or "rsync --protocol 30"
            if(not $rsync_fix) {
                rsync_version();
                if($rsync_version >= 3.01) {
                    # Version 3.1.0 or later: Downgrade to protocol 30
                    $rsync_fix .= " --protocol 30";
                }
                if($rsync_version >= 3.0204) {
                    # Version 3.2.4 .. 3.2.8: --old-args
                    $rsync_fix .= " --old-args";
                }
            }
            return $rsync_fix;
        }
        my $self = shift;

        return "rsync".rsync_fixup()." ".$ENV{'PARALLEL_RSYNC_OPTS'}.
            " -e".::Q($self->sshcmd());
    }
}

sub cleanup_cmd($$$) {
    # Command to run to remove the remote file
    # Input:
    #   $file = filename to remove
    #   $workdir = destination dir
    # Returns:
    #   $cmd = ssh command to run to remove $file and empty parent dirs
    my $self = shift;
    my $file = shift;
    my $workdir = shift;
    my $f = $file;
    if($f =~ m:/\./:) {
        # foo/bar/./baz/quux => workdir/baz/quux
        # /foo/bar/./baz/quux => workdir/baz/quux
        $f =~ s:.*/\./:$workdir/:;
    } elsif($f =~ m:^[^/]:) {
        # foo/bar => workdir/foo/bar
        $f = $workdir."/".$f;
    }
    my @subdirs = split m:/:, ::dirname($f);
    my @rmdir;
    my $dir = "";
    for(@subdirs) {
        $dir .= $_."/";
        unshift @rmdir, ::shell_quote_file($dir);
    }
    my $rmdir = @rmdir ? "rmdir @rmdir 2>/dev/null;" : "";
    if(defined $opt::workdir and $opt::workdir eq "...") {
        $rmdir .= "rm -rf " . ::shell_quote_file($workdir).';';
    }
    my $rmf = "sh -c ".
        ::Q("rm -f ".::shell_quote_file($f)." 2>/dev/null;".$rmdir);
    return $self->wrap(::Q($rmf));
}

package JobQueue;

sub new($) {
    my $class = shift;
    my $commandref = shift;
    my $read_from = shift;
    my $context_replace = shift;
    my $max_number_of_args = shift;
    my $transfer_files = shift;
    my $return_files = shift;
    my $template_names = shift;
    my $template_contents = shift;
    my $commandlinequeue = CommandLineQueue->new
        ($commandref, $read_from, $context_replace, $max_number_of_args,
         $transfer_files, $return_files, $template_names, $template_contents);
    my @unget = ();
    return bless {
        'unget' => \@unget,
        'commandlinequeue' => $commandlinequeue,
        'this_job_no' => 0,
        'total_jobs' => undef,
    }, ref($class) || $class;
}

sub get($) {
    my $self = shift;

    $self->{'this_job_no'}++;
    if(@{$self->{'unget'}}) {
        my $job = shift @{$self->{'unget'}};
        # {%} may have changed, so flush computed values
        $job && $job->flush_cache();
        return $job;
    } else {
        my $commandline = $self->{'commandlinequeue'}->get();
        if(defined $commandline) {
            return Job->new($commandline);
        } else {
            $self->{'this_job_no'}--;
            return undef;
        }
    }
}

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

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

sub total_jobs($) {
    my $self = shift;
    if(not defined $self->{'total_jobs'}) {
        if($opt::pipe and not $opt::tee) {
            ::error("--pipe is incompatible with --eta/--bar/--shuf");
            ::wait_and_exit(255);
        }
        if($opt::totaljobs) {
            $self->{'total_jobs'} = $opt::totaljobs;
        } elsif($opt::sqlworker) {
            $self->{'total_jobs'} = $Global::sql->total_jobs();
        } else {
            my $record;
            my @arg_records;
            my $record_queue = $self->{'commandlinequeue'}{'arg_queue'};
            my $start = time;
            while($record = $record_queue->get()) {
                push @arg_records, $record;
                if(time - $start > 10) {
                    ::warning("Reading ".scalar(@arg_records).
                              " arguments took longer than 10 seconds.");
                    $opt::eta && ::warning("Consider removing --eta.");
                    $opt::bar && ::warning("Consider removing --bar.");
                    $opt::shuf && ::warning("Consider removing --shuf.");
                    last;
                }
            }
            while($record = $record_queue->get()) {
                push @arg_records, $record;
            }
            if($opt::shuf and @arg_records) {
                my $i = @arg_records;
                while (--$i) {
                    my $j = int rand($i+1);
                    @arg_records[$i,$j] = @arg_records[$j,$i];
                }
            }
            $record_queue->unget(@arg_records);
            # $#arg_records = number of args - 1
            # We have read one @arg_record for this job (so add 1 more)
            my $num_args = $#arg_records + 2;
            # This jobs is not started so -1
            my $started_jobs = $self->{'this_job_no'} - 1;
            my $max_args = ::max($Global::max_number_of_args,1);
            $self->{'total_jobs'} = ::ceil($num_args / $max_args)
                + $started_jobs;
            ::debug("init","Total jobs: ".$self->{'total_jobs'}.
                    " ($num_args/$max_args + $started_jobs)\n");
        }
    }
    return $self->{'total_jobs'};
}

sub flush_total_jobs($) {
    # Unset total_jobs to force recomputing
    my $self = shift;
    ::debug("init","flush Total jobs: ");
    $self->{'total_jobs'} = undef;
}

sub next_seq($) {
    my $self = shift;

    return $self->{'commandlinequeue'}->seq();
}

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


package Job;

sub new($) {
    my $class = shift;
    my $commandlineref = shift;
    return bless {
        'commandline' => $commandlineref, # CommandLine object
        'workdir' => undef, # --workdir
        # filehandle for stdin (used for --pipe)
        # filename for writing stdout to (used for --files)
        # remaining data not sent to stdin (used for --pipe)
        # tmpfiles to cleanup when job is done
        'unlink' => [],
        # amount of data sent via stdin (used for --pipe)
        'transfersize' => 0, # size of files using --transfer
        'returnsize' => 0, # size of files using --return
        '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,
        'exitsignal' => undef,
        # Timestamp for timeout if any
        'timeout' => undef,
        'virgin' => 1,
        # Output used for SQL and CSV-output
        'output' => { 1 => [], 2 => [] },
        'halfline' => { 1 => [], 2 => [] },
    }, ref($class) || $class;
}

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

sub replaced($) {
    my $self = shift;
    $self->{'commandline'} or ::die_bug("commandline empty");
    return $self->{'commandline'}->replaced();
}

{
    my $next_available_row;

    sub row($) {
        my $self = shift;
        if(not defined $self->{'row'}) {
            if($opt::keeporder) {
                $self->{'row'} = $self->seq();
            } else {
                $self->{'row'} = ++$next_available_row;
            }
        }
        return $self->{'row'};
    }
}

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

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

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

sub free_slot($) {
    my $self = shift;
    push @Global::slots, $self->slot();
}

{
    my($cattail);

    sub cattail() {
        # Returns:
        #   $cattail = perl program for:
        #     cattail "decomp-prg" wpid [file_stdin] [file_to_unlink]
        #     decomp-prg     = decompress program
        #     wpid           = pid of writer program
        #     file_stdin     = file_to_decompress
        #     file_to_unlink = unlink this file
        if(not $cattail) {
            $cattail = q{
                # cat followed by tail (possibly with rm as soon at the file is opened)
                # If $writerpid dead: finish after this round
                use Fcntl;
                $|=1;

                my ($comfile, $cmd, $writerpid, $read_file, $unlink_file) = @ARGV;
                if($read_file) {
                    open(IN,"<",$read_file) || die("cattail: Cannot open $read_file");
                } else {
                    *IN = *STDIN;
                }
                while(! -s $comfile) {
                    # Writer has not opened the buffer file, so we cannot remove it yet
                    $sleep = ($sleep < 30) ? ($sleep * 1.001 + 0.01) : ($sleep);
                    usleep($sleep);
                }
                # The writer and we have both opened the file, so it is safe to unlink it
                unlink $unlink_file;
                unlink $comfile;

                my $first_round = 1;
                my $flags;
                fcntl(IN, F_GETFL, $flags) || die $!; # Get the current flags on the filehandle
                $flags |= O_NONBLOCK; # Add non-blocking to the flags
                fcntl(IN, F_SETFL, $flags) || die $!; # Set the flags on the filehandle

                while(1) {
                    # clear EOF
                    seek(IN,0,1);
                    my $writer_running = kill 0, $writerpid;
                    $read = sysread(IN,$buf,131072);
                    if($read) {
                        if($first_round) {
                            # Only start the command if there any input to process
                            $first_round = 0;
                            open(OUT,"|-",$cmd) || die("cattail: Cannot run $cmd");
                        }

                        # Blocking print
                        while($buf) {
                            my $bytes_written = syswrite(OUT,$buf);
                            # syswrite may be interrupted by SIGHUP
                            substr($buf,0,$bytes_written) = "";
                        }
                        # Something printed: Wait less next time
                        $sleep /= 2;
                    } else {
                        if(eof(IN) and not $writer_running) {
                            # Writer dead: There will never be sent more to the decompressor
                            close OUT;
                            exit;
                        }
                        # TODO This could probably be done more efficiently using select(2)
                        # Nothing read: Wait longer before next read
                        # Up to 100 milliseconds
                        $sleep = ($sleep < 100) ? ($sleep * 1.001 + 0.01) : ($sleep);
                        usleep($sleep);
                    }
                }

                sub usleep {
                    # Sleep this many milliseconds.
                    my $secs = shift;
                    select(undef, undef, undef, $secs/1000);
                }
            };
            $cattail =~ s/#.*//mg;
            $cattail =~ s/\s+/ /g;
        }
        return $cattail;
    }
}

sub openoutputfiles($) {
    # Open files for STDOUT and STDERR
    # Set file handles in $self->fh
    my $self = shift;
    my ($outfhw, $errfhw, $outname, $errname);

    if($opt::latestline) {
        # Do not save to files: Use non-blocking pipe
        my ($outfhr, $errfhr);
        pipe($outfhr, $outfhw) || die;
        $self->set_fh(1,'w',$outfhw);
        $self->set_fh(2,'w',$outfhw);
        $self->set_fh(1,'r',$outfhr);
        $self->set_fh(2,'r',$outfhr);
        # Make it possible to read non-blocking from the pipe
        for my $fdno (1,2) {
            ::set_fh_non_blocking($self->fh($fdno,'r'));
        }
        # Return immediately because we do not need setting filenames
        return;
    } elsif($Global::linebuffer and not
       ($opt::keeporder or $Global::files or $opt::results or
        $opt::compress or $opt::compress_program or
        $opt::decompress_program)) {
        # Do not save to files: Use non-blocking pipe
        my ($outfhr, $errfhr);
        pipe($outfhr, $outfhw) || die;
        pipe($errfhr, $errfhw) || die;
        $self->set_fh(1,'w',$outfhw);
        $self->set_fh(2,'w',$errfhw);
        $self->set_fh(1,'r',$outfhr);
        $self->set_fh(2,'r',$errfhr);
        # Make it possible to read non-blocking from the pipe
        for my $fdno (1,2) {
            ::set_fh_non_blocking($self->fh($fdno,'r'));
        }
        # Return immediately because we do not need setting filenames
        return;
    } elsif($opt::results and not $Global::csvsep and not $Global::jsonout) {
        # If --results, but not --results *.csv/*.tsv
        my $out = $self->{'commandline'}->results_out();
        my $seqname;
        if($out eq $opt::results or $out =~ m:/$:) {
            # $opt::results = simple string or ending in /
            # => $out is a dir/
            # prefix/name1/val1/name2/val2/seq
            $seqname = $out."seq";
            # prefix/name1/val1/name2/val2/stdout
            $outname = $out."stdout";
            # prefix/name1/val1/name2/val2/stderr
            $errname = $out."stderr";
        } else {
            # $opt::results = replacement string not ending in /
            # => $out is a file
            $outname = $out;
            $errname = "$out.err";
            $seqname = "$out.seq";
        }
        ::write_or_exit($seqname, $self->seq());
        $outfhw = ::open_or_exit("+>", $outname);
        $errfhw = ::open_or_exit("+>", $errname);
        $self->set_fh(1,"unlink","");
        $self->set_fh(2,"unlink","");
        if($opt::sqlworker) {
            # Save the filenames in SQL table
            $Global::sql->update("SET Stdout = ?, Stderr = ? ".
                                 "WHERE Seq = ". $self->seq(),
                                 $outname, $errname);
        }
    } elsif(not $opt::ungroup) {
        # To group we create temporary files for STDOUT and STDERR
        # To avoid the cleanup unlink the files immediately (but keep them open)
        if($Global::files) {
            ($outfhw, $outname) = ::tmpfile(SUFFIX => ".par");
            ($errfhw, $errname) = ::tmpfile(SUFFIX => ".par");
            # --files => only remove stderr
            $self->set_fh(1,"unlink","");
            $self->set_fh(2,"unlink",$errname);
        } else {
            ($outfhw, $outname) = ::tmpfile(SUFFIX => ".par");
            ($errfhw, $errname) = ::tmpfile(SUFFIX => ".par");
            $self->set_fh(1,"unlink",$outname);
            $self->set_fh(2,"unlink",$errname);
        }
    } else {
        # --ungroup
        open($outfhw,">&",$Global::fh{1}) || die;
        open($errfhw,">&",$Global::fh{2}) || die;
        # File name must be empty as it will otherwise be printed
        $outname = "";
        $errname = "";
        $self->set_fh(1,"unlink",$outname);
        $self->set_fh(2,"unlink",$errname);
    }
    # Set writing FD
    $self->set_fh(1,'w',$outfhw);
    $self->set_fh(2,'w',$errfhw);
    $self->set_fh(1,'name',$outname);
    $self->set_fh(2,'name',$errname);
    if($opt::compress) {
        $self->filter_through_compress();
    } elsif(not $opt::ungroup) {
        $self->grouped();
    }
    if($Global::linebuffer) {
        # Make it possible to read non-blocking from
        # the buffer files
        # Used for --linebuffer with -k, --files, --res, --compress*
        for my $fdno (1,2) {
            ::set_fh_non_blocking($self->fh($fdno,'r'));
        }
    }
}

sub print_verbose_dryrun($) {
    # If -v set: print command to stdout (possibly buffered)
    # This must be done before starting the command
    my $self = shift;
    if($Global::verbose or $opt::dryrun) {
        my $fh = $self->fh(1,"w");
        if($Global::verbose <= 1) {
            print $fh $self->replaced(),"\n";
        } else {
            # Verbose level > 1: Print the rsync and stuff
            print $fh $self->wrapped(),"\n";
        }
    }
    if($opt::sqlworker) {
        $Global::sql->update("SET Command = ? WHERE Seq = ".$self->seq(),
                             $self->replaced());
    }
}

sub add_rm($) {
    # Files to remove when job is done
    my $self = shift;
    push @{$self->{'unlink'}}, @_;
}

sub get_rm($) {
    # Files to remove when job is done
    my $self = shift;
    return @{$self->{'unlink'}};
}

sub cleanup($) {
    # Remove files when job is done
    my $self = shift;
    unlink $self->get_rm();
    delete @Global::unlink{$self->get_rm()};
}

sub grouped($) {
    my $self = shift;
    # Set reading FD if using --group (--ungroup does not need)
    for my $fdno (1,2) {
        # Re-open the file for reading
        # so fdw can be closed seperately
        # and fdr can be seeked seperately (for --line-buffer)
        my $fdr = ::open_or_exit("<", $self->fh($fdno,'name'));
        $self->set_fh($fdno,'r',$fdr);
        # Unlink if not debugging
        $Global::debug or ::rm($self->fh($fdno,"unlink"));
    }
}

sub empty_input_wrapper($) {
    # If no input: exit(0)
    # If some input: Pass input as input to command on STDIN
    # This avoids starting the command if there is no input.
    # Input:
    #   $command = command to pipe data to
    # Returns:
    #   $wrapped_command = the wrapped command
    my $command = shift;
    # The optimal block size differs
    # It has been measured on:
    # AMD 6376: 59000
    # <big ppar --pipe --block 100M --test $1 -j1 'cat >/dev/null';
    my $script =
        ::spacefree(0,q{
            if(sysread(STDIN, $buf, 1)) {
                open($fh, "|-", @ARGV) || die;
                syswrite($fh, $buf);
                while($read = sysread(STDIN, $buf, 59000)) {
                    syswrite($fh, $buf);
                }
                close $fh;
                exit ($?&127 ? 128+($?&127) : 1+$?>>8)
            }
                  });
    ::debug("run",'Empty wrap: perl -e '.::Q($script)."\n");
    if($Global::cshell
       and
       length $command > 499) {
        # csh does not like words longer than 1000 (499 quoted)
        # $command = "perl -e '".base64_zip_eval()."' ".
        # join" ",string_zip_base64(
        #         'exec "'.::perl_quote_scalar($command).'"');
        return 'perl -e '.::Q($script)." ".
            base64_wrap("exec \"$Global::shell\",'-c',\"".
                                   ::perl_quote_scalar($command).'"');
    } else {
        return 'perl -e '.::Q($script)." ".
            $Global::shell." -c ".::Q($command);
    }
}

sub filter_through_compress($) {
    my $self = shift;
    # Send stdout to stdin for $opt::compress_program(1)
    # Send stderr to stdin for $opt::compress_program(2)
    # cattail get pid:  $pid = $self->fh($fdno,'rpid');
    my $cattail = cattail();

    for my $fdno (1,2) {
        # Make a communication file.
        my ($fh, $comfile) = ::tmpfile(SUFFIX => ".pac");
        close $fh;
        # Compressor: (echo > $comfile; compress pipe) > output
        # When the echo is written to $comfile,
        # it is known that output file is opened,
        # thus output file can then be removed by the decompressor.
        # empty_input_wrapper is needed for plzip
        my $qcom = ::Q($comfile);
        my $wpid = open(my $fdw,"|-", "(echo > $qcom; ".
                        empty_input_wrapper($opt::compress_program).") >".
                        ::Q($self->fh($fdno,'name'))) || die $?;
        $self->set_fh($fdno,'w',$fdw);
        $self->set_fh($fdno,'wpid',$wpid);
        # Decompressor: open output; -s $comfile > 0: rm $comfile output;
        #               decompress output > stdout
        my $rpid = open(my $fdr, "-|", "perl", "-e", $cattail, $comfile,
                        $opt::decompress_program, $wpid,
                        $self->fh($fdno,'name'),$self->fh($fdno,'unlink'))
            || die $?;
        $self->set_fh($fdno,'r',$fdr);
        $self->set_fh($fdno,'rpid',$rpid);
    }
}

sub set_fh($$$$) {
    # Set file handle
    my ($self, $fd_no, $key, $fh) = @_;
    $self->{'fd'}{$fd_no,$key} = $fh;
}

sub fh($) {
    # Get file handle
    my ($self, $fd_no, $key) = @_;
    return $self->{'fd'}{$fd_no,$key};
}

sub write_block($) {
    my $self = shift;
    my $stdin_fh = $self->fh(0,"w");
    if(fork()) {
        # Close in parent
        close $stdin_fh;
    } else {
        # If writing is to a closed pipe:
        #   Do not call signal handler, but let nothing be written
        local $SIG{PIPE} = undef;

        for my $part (
            grep { defined $_ }
            $self->{'header'},$self->{'block'}) {
            # syswrite may not write all in one go,
            # so make sure everything is written.
            my $written;
            while($written = syswrite($stdin_fh,$$part)) {
                substr($$part,0,$written) = "";
            }
        }
        close $stdin_fh;
        exit(0);
    }
}

sub write($) {
    my $self = shift;
    my $remaining_ref = shift;
    my $stdin_fh = $self->fh(0,"w");

    my $len = length $$remaining_ref;
    # syswrite may not write all in one go,
    # so make sure everything is written.
    my $written;

    # If writing is to a closed pipe:
    #   Do not call signal handler, but let nothing be written
    local $SIG{PIPE} = undef;
    while($written = syswrite($stdin_fh,$$remaining_ref)){
        substr($$remaining_ref,0,$written) = "";
    }
}

sub set_block($$$$$$) {
    # Copy stdin buffer from $block_ref up to $endpos
    # Prepend with $header_ref if virgin (i.e. not --roundrobin)
    # Remove $recstart and $recend if needed
    # Input:
    #   $header_ref = ref to $header to prepend
    #   $buffer_ref = ref to $buffer containing the block
    #   $endpos = length of $block to pass on
    #   $recstart = --recstart regexp
    #   $recend = --recend regexp
    # Returns:
    #   N/A
    my $self = shift;
    my ($header_ref,$buffer_ref,$endpos,$recstart,$recend) = @_;
    $self->{'header'} = $header_ref;
    if($opt::roundrobin or $opt::remove_rec_sep or defined $opt::retries) {
        my $a = "";
        if(($opt::roundrobin or defined $opt::retries) and $self->virgin()) {
            $a .= $$header_ref;
        }
        # Job is no longer virgin
        $self->set_virgin(0);
        # Make a full copy because $buffer will change
        $a .= substr($$buffer_ref,0,$endpos);
        $self->{'block'} = \$a;
        if($opt::remove_rec_sep) {
            remove_rec_sep($self->{'block'},$recstart,$recend);
        }
        $self->{'block_length'} = length ${$self->{'block'}};
    } else {
        $self->set_virgin(0);
        for(substr($$buffer_ref,0,$endpos)) {
            $self->{'block'} = \$_;
        }
        $self->{'block_length'} = $endpos + length ${$self->{'header'}};
    }
    $self->{'block_pos'} = 0;
    $self->add_transfersize($self->{'block_length'});
}

sub block_ref($) {
    my $self = shift;
    return $self->{'block'};
}

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

sub remove_rec_sep($) {
    # Remove --recstart and --recend from $block
    # Input:
    #   $block_ref = reference to $block to be modified
    #   $recstart = --recstart
    #   $recend = --recend
    # Uses:
    #   $opt::regexp = Are --recstart/--recend regexp?
    # Returns:
    #   N/A
    my ($block_ref,$recstart,$recend) = @_;
    # Remove record separator
    if($opt::regexp) {
        $$block_ref =~ s/$recend$recstart//gom;
        $$block_ref =~ s/^$recstart//os;
        $$block_ref =~ s/$recend$//os;
    } else {
        $$block_ref =~ s/\Q$recend$recstart\E//gom;
        $$block_ref =~ s/^\Q$recstart\E//os;
        $$block_ref =~ s/\Q$recend\E$//os;
    }
}

sub non_blocking_write($) {
    my $self = shift;
    my $something_written = 0;

    my $in = $self->fh(0,"w");
    my $rv = syswrite($in,
                      substr(${$self->{'block'}},$self->{'block_pos'}));
    if (!defined($rv) && $! == ::EAGAIN()) {
        # would block - but would have written
        $something_written = 0;
        # avoid triggering auto expanding block size
        $Global::no_autoexpand_block ||= 1;
    } elsif ($self->{'block_pos'}+$rv != $self->{'block_length'}) {
        # incomplete write
        # Remove the written part
        $self->{'block_pos'} += $rv;
        $something_written = $rv;
    } else {
        # successfully wrote everything
        # Empty block to free memory
        my $a = "";
        $self->set_block(\$a,\$a,0,"","");
        $something_written = $rv;
    }
    ::debug("pipe", "Non-block: ", $something_written);
    return $something_written;
}


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

sub set_virgin($$) {
    my $self = shift;
    $self->{'virgin'} = shift;
}

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

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

sub starttime($) {
    # Returns:
    #   UNIX-timestamp this job started
    my $self = shift;
    return sprintf("%.3f",$self->{'starttime'});
}

sub set_starttime($@) {
    my $self = shift;
    my $starttime = shift || ::now();
    $self->{'starttime'} = $starttime;
    $opt::sqlworker and
        $Global::sql->update("SET Starttime = ? WHERE Seq = ".$self->seq(),
                             $starttime);
}

sub runtime($) {
    # Returns:
    #   Run time in seconds with 3 decimals
    my $self = shift;
    return sprintf("%.3f",
                   int(($self->endtime() - $self->starttime())*1000)/1000);
}

sub endtime($) {
    # Returns:
    #   UNIX-timestamp this job ended
    #   0 if not ended yet
    my $self = shift;
    return ($self->{'endtime'} || 0);
}

sub set_endtime($$) {
    my $self = shift;
    my $endtime = shift;
    $self->{'endtime'} = $endtime;
    $opt::sqlworker and
        $Global::sql->update("SET JobRuntime = ? WHERE Seq = ".$self->seq(),
                             $self->runtime());
}

sub is_timedout($) {
    # Is the job timedout?
    # Input:
    #   $delta_time = time that the job may run
    # Returns:
    #   True or false
    my $self = shift;
    my $delta_time = shift;
    return time > $self->{'starttime'} + $delta_time;
}

sub kill($) {
    my $self = shift;
    $self->set_exitstatus(-1);
    ::kill_sleep_seq($self->pid());
}

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

sub set_killreason($) {
    my $self = shift;
    $self->{'killreason'} = shift;
}

sub suspend($) {
    my $self = shift;
    my @pgrps = map { -$_ } $self->pid();
    kill "STOP", @pgrps;
    $self->set_suspended(1);
}

sub set_suspended($$) {
    my $self = shift;
    $self->{'suspended'} = shift;
}

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

sub resume($) {
    my $self = shift;
    my @pgrps = map { -$_ } $self->pid();
    kill "CONT", @pgrps;
    $self->set_suspended(0);
}

sub failed($) {
    # return number of times failed for this $sshlogin
    # Input:
    #   $sshlogin
    # Returns:
    #   Number of times failed for $sshlogin
    my $self = shift;
    my $sshlogin = shift;
    return $self->{'failed'}{$sshlogin};
}

sub failed_here($) {
    # return number of times failed for the current $sshlogin
    # Returns:
    #   Number of times failed for this 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:
    #   $total_failures = the number of times this command has failed
    my $self = shift;
    my $total_failures = 0;
    for (values %{$self->{'failed'}}) {
        $total_failures += $_;
    }
    return $total_failures;
}

{
    my $script;

    sub postpone_exit_and_cleanup {
        # Command to remove files and dirs (given as args) without
        # affecting the exit value in $?/$status.
        if(not $script) {
            $script = "perl -e '".
                ::spacefree(0,q{
                    $bash=shift;
                    $csh=shift;
                    for(@ARGV){
                        unlink;
                        rmdir;
                    }
                    if($bash=~s/(\d+)h/$1/) {
                        exit $bash;
                    }
                    exit $csh;
                            }).
                # `echo \$?h` is needed to make fish not complain
                "' ".'"`echo \\\\\\\\\$?h`" "$status" ';
        }
        return $script
    }
}

{
    my $script;

    sub fifo_wrap() {
        # Script to create a fifo, run a command on the fifo
        # while copying STDIN to the fifo, and finally
        # remove the fifo and return the exit code of the command.
        if(not $script) {
            # {} == $PARALLEL_TMP for --fifo
            # To make it csh compatible a wrapper needs to:
            # * mkfifo
            # * spawn $command &
            # * cat > fifo
            # * waitpid to get the exit code from $command
            # * be less than 1000 chars long

            # The optimal block size differs
            # It has been measured on:
            # AMD 6376: 4095
            # ppar -a big --pipepart --block -1 --test $1 --fifo 'cat {} >/dev/null';
            $script = "perl -e '".
                (::spacefree
                 (0, q{
                     ($s,$c,$f) = @ARGV;
                     # mkfifo $PARALLEL_TMP
                     system "mkfifo", $f;
                     # spawn $shell -c $command &
                     $pid = fork || exec $s, "-c", $c;
                     open($o,">",$f) || die $!;
                     # cat > $PARALLEL_TMP
                     while(sysread(STDIN,$buf,4095)){
                         syswrite $o, $buf;
                     }
                     close $o;
                     # waitpid to get the exit code from $command
                     waitpid $pid,0;
                     # Cleanup
                     unlink $f;
                     exit $?/256;
                  }))."'";
        }
        return $script;
    }
}

sub wrapped($) {
    # Wrap command with:
    # * --shellquote
    # * --nice
    # * --cat
    # * --fifo
    # * --sshlogin
    # * --pipepart (@Global::cat_prepends)
    # * --tee (@Global::cat_prepends)
    # * --pipe
    # * --tmux
    # The ordering of the wrapping is important:
    # * --nice/--cat/--fifo should be done on the remote machine
    # * --pipepart/--pipe should be done on the local machine inside --tmux
    # Uses:
    #   @opt::shellquote
    #   $opt::nice
    #   $Global::shell
    #   $opt::cat
    #   $opt::fifo
    #   @Global::cat_prepends
    #   $opt::pipe
    #   $opt::tmux
    # Returns:
    #   $self->{'wrapped'} = the command wrapped with the above
    my $self = shift;
    if(not defined $self->{'wrapped'}) {
        my $command = $self->replaced();
        # Bug in Bash and Ksh when running multiline aliases
        # This will force them to run correctly, but will fail in
        # tcsh so we do not do it.
        # $command .= "\n\n";
        if(@opt::shellquote) {
            # Quote one time for each --shellquote
            my $c = $command;
            for(@opt::shellquote) {
                $c = ::Q($c);
            }
            # Prepend "echo" (it is written in perl because
            # quoting '-e' causes problem in some versions and
            # csh's version does something wrong)
            $command = q(perl -e '$,=" "; print "@ARGV\n";' -- ) . ::Q($c);
        }
        if($Global::parallel_env) {
            # If $PARALLEL_ENV set, put that in front of the command
            # Used for env_parallel.*
            if($Global::shell =~ /zsh/) {
                # The extra 'eval' will make aliases work, too
                $command = $Global::parallel_env."\n".
                    "eval ".::Q($command);
            } else {
                $command = $Global::parallel_env."\n".$command;
            }
        }
        if($opt::cat) {
            # In '--cat' and '--fifo' {} == $PARALLEL_TMP.
            # This is to make it possible to compute $PARALLEL_TMP on
            # the fly when running remotely.
            # $ENV{PARALLEL_TMP} is set in the remote wrapper before
            # the command is run.
            #
            # Prepend 'cat > $PARALLEL_TMP;'
            # Append 'unlink $PARALLEL_TMP without affecting $?'
            $command =
                'cat > "$PARALLEL_TMP";'.
                $command.";". postpone_exit_and_cleanup().
                                         '"$PARALLEL_TMP"';
        } elsif($opt::fifo) {
            # Prepend fifo-wrapper. In essence:
            #   mkfifo {}
            #   ( $command ) &
            #   # $command must read {}, otherwise this 'cat' will block
            #   cat > {};
            #   wait; rm {}
            # without affecting $?
            $command = fifo_wrap(). " ".
                $Global::shell. " ". ::Q($command). ' "$PARALLEL_TMP"'. ';';
        }
        # Wrap with ssh + tranferring of files
        $command = $self->sshlogin_wrap($command);
        if(@Global::cat_prepends) {
            # --pipepart: prepend:
            # < /tmp/foo perl -e 'while(@ARGV) {
            #   sysseek(STDIN,shift,0) || die; $left = shift;
            #   while($read = sysread(STDIN,$buf, ($left > 60800 ? 60800 : $left))){
            #     $left -= $read; syswrite(STDOUT,$buf);
            #   }
            # }'  0 0 0 11 |
            #
            # --pipepart --tee: prepend:
            #   < dash-a-file
            #
            # --pipe --tee: wrap:
            #   (rm fifo; ... ) < fifo
            #
            # --pipe --shard X:
            #   (rm fifo; ... ) < fifo
            $command = (shift @Global::cat_prepends). "($command)".
                (shift @Global::cat_appends);
        } elsif($opt::pipe and not $opt::roundrobin) {
            # Wrap with EOF-detector to avoid starting $command if EOF.
            $command = empty_input_wrapper($command);
        }
        if($opt::tmux) {
            # Wrap command with 'tmux'
            $command = $self->tmux_wrap($command);
        }
        if($Global::cshell
           and
           length $command > 499) {
            # csh does not like words longer than 1000 (499 quoted)
            # $command = "perl -e '".base64_zip_eval()."' ".
            # join" ",string_zip_base64(
            #         'exec "'.::perl_quote_scalar($command).'"');
            $command = base64_wrap("exec \"$Global::shell\",'-c',\"".
                                   ::perl_quote_scalar($command).'"');
        }
        $self->{'wrapped'} = $command;
    }
    return $self->{'wrapped'};
}

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

    if($opt::sqlworker) {
        # Identify worker as --sqlworker often runs on different machines
        # If local: Use hostname
        my $host = $sshlogin->local() ? ::hostname() : $sshlogin->host();
        $Global::sql->update("SET Host = ? WHERE Seq = ".$self->seq(), $host);
    }
}

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

sub string_base64($) {
    # Base64 encode strings into 1000 byte blocks.
    # 1000 bytes is the largest word size csh supports
    # Input:
    #   @strings = to be encoded
    # Returns:
    #   @base64 = 1000 byte block
    $Global::use{"MIME::Base64"} ||= eval "use MIME::Base64; 1;";
    my @base64 = unpack("(A1000)*",encode_base64((join"",@_),""));
    return @base64;
}

sub string_zip_base64($) {
    # Pipe string through 'bzip2 -9' and base64 encode it into 1000
    # byte blocks.
    # 1000 bytes is the largest word size csh supports
    # Zipping will make exporting big environments work, too
    # Input:
    #   @strings = to be encoded
    # Returns:
    #   @base64 = 1000 byte block
    my($zipin_fh, $zipout_fh,@base64);
    ::open3($zipin_fh,$zipout_fh,">&STDERR","bzip2 -9");
    if(fork) {
        close $zipin_fh;
        $Global::use{"MIME::Base64"} ||= eval "use MIME::Base64; 1;";
        # Split base64 encoded into 1000 byte blocks
        @base64 = unpack("(A1000)*",encode_base64((join"",<$zipout_fh>),""));
        close $zipout_fh;
    } else {
        close $zipout_fh;
        print $zipin_fh @_;
        close $zipin_fh;
        exit;
    }
    ::debug("base64","Orig:@_\nAs bzip2 base64:@base64\n");
    return @base64;
}

sub base64_zip_eval() {
    # Script that:
    #   * reads base64 strings from @ARGV
    #   * decodes them
    #   * pipes through 'bzip2 -dc'
    #   * evals the result
    # Reverse of string_zip_base64 + eval
    # Will be wrapped in ' so single quote is forbidden
    # Returns:
    #   $script = 1-liner for perl -e
    my $script = ::spacefree(0,q{
        @GNU_Parallel = split /_/, "use_IPC::Open3;_use_MIME::Base64";
        eval"@GNU_Parallel";
        $chld = $SIG{CHLD};
        $SIG{CHLD} = "IGNORE";
        # Search for bzip2. Not found => use default path
        my $zip = (grep { -x $_ } "/usr/local/bin/bzip2")[0] || "bzip2";
        # $in = stdin on $zip, $out = stdout from $zip
        # Forget my() to save chars for csh
        # my($in, $out,$eval);
        open3($in,$out,">&STDERR",$zip,"-dc");
        if(my $perlpid = fork) {
            close $in;
            $eval = join "", <$out>;
            close $out;
        } else {
            close $out;
            # Pipe decoded base64 into 'bzip2 -dc'
            print $in (decode_base64(join"",@ARGV));
            close $in;
            exit;
        }
        wait;
        $SIG{CHLD} = $chld;
        eval $eval;
                             });
    ::debug("base64",$script,"\n");
    return $script;
}

sub base64_wrap($) {
    # base64 encode Perl code
    # Split it into chunks of < 1000 bytes
    # Prepend it with a decoder that eval's it
    # Input:
    #   $eval_string = Perl code to run
    # Returns:
    #   $shell_command = shell command that runs $eval_string
    my $eval_string = shift;
    return
        "perl -e ".
        ::Q(base64_zip_eval())." ".
        join" ",::shell_quote(string_zip_base64($eval_string));
}

sub base64_eval($) {
    # Script that:
    #   * reads base64 strings from @ARGV
    #   * decodes them
    #   * evals the result
    # Reverse of string_base64 + eval
    # Will be wrapped in ' so single quote is forbidden.
    # Spaces are stripped so spaces cannot be significant.
    # The funny 'use IPC::Open3'-syntax is to avoid spaces and
    # to make it clear that this is a GNU  Parallel command
    # when looking at the process table.
    # Returns:
    #   $script = 1-liner for perl -e
    my $script = ::spacefree(0,q{
        @GNU_Parallel=("use","IPC::Open3;","use","MIME::Base64");
        eval "@GNU_Parallel";
        my $eval = decode_base64(join"",@ARGV);
        eval $eval;
                             });
    ::debug("base64",$script,"\n");
    return $script;
}

sub sshlogin_wrap($) {
    # Wrap the command with the commands needed to run remotely
    # Input:
    #   $command = command to run
    # Returns:
    #   $self->{'sshlogin_wrap'} = command wrapped with ssh+transfer commands
    sub monitor_parent_sshd_script {
        # This script is to solve the problem of
        # * not mixing STDERR and STDOUT
        # * terminating with ctrl-c
        # If its parent is ssh: all good
        # If its parent is init(1): ssh died, so kill children
        my $monitor_parent_sshd_script;

        if(not $monitor_parent_sshd_script) {
            $monitor_parent_sshd_script =
                # This will be packed in ', so only use "
                ::spacefree
                (0,'$shell = "'.($ENV{'PARALLEL_SHELL'} || '$ENV{SHELL}').'";'.
                            '$tmpdir = $ENV{"TMPDIR"} || "'.
                            ::perl_quote_scalar($ENV{'PARALLEL_REMOTE_TMPDIR'}).'";'.
                            '$nice = '.$opt::nice.';'.
                            '$termseq = "'.$opt::termseq.'";'.
                            # }
                            q{
                # Check that $tmpdir is writable
                -w $tmpdir ||
                    die("$tmpdir\040is\040not\040writable.".
                        "\040Set\040PARALLEL_REMOTE_TMPDIR");
                # Set $PARALLEL_TMP to a non-existent file name in $TMPDIR
                do {
                    $ENV{PARALLEL_TMP} = $tmpdir."/par".
                        join"", map { (0..9,"a".."z","A".."Z")[rand(62)] } (1..5);
                } while(-e $ENV{PARALLEL_TMP});
                # Set $script to a non-existent file name in $TMPDIR
                do {
                    $script = $tmpdir."/par-job-$ENV{PARALLEL_SEQ}_".
                        join"", map { (0..9,"a".."z","A".."Z")[rand(62)] } (1..5);
                } while(-e $script);
                # Create a script from the hex code
                # that removes itself and runs the commands
                open($fh,">",$script) || die;
                # \040 = space - but we remove spaces in the script
                # ' needed due to rc-shell
                print($fh("rm\040\'$script\'\n",$bashfunc.$cmd));
                close $fh;
                my $parent = getppid;
                my $done = 0;
                $SIG{CHLD} = sub { $done = 1; };
                $pid = fork;
                unless($pid) {
                    # Make own process group to be able to kill HUP it later
                    eval { setpgrp };
                    # Set nice value
                    eval { setpriority(0,0,$nice) };
                    # Run the script
                    exec($shell,$script);
                    die("exec\040failed: $!");
                }
                while((not $done) and (getppid == $parent)) {
                    # Parent pid is not changed, so sshd is alive
                    # Exponential sleep up to 1 sec
                    $s = $s < 1 ? 0.001 + $s * 1.03 : $s;
                    select(undef, undef, undef, $s);
                }
                if(not $done) {
                    # sshd is dead: User pressed Ctrl-C
                    # Kill as per --termseq
                    my @term_seq = split/,/,$termseq;
                    if(not @term_seq) {
                        @term_seq = ("TERM",200,"TERM",100,"TERM",50,"KILL",25);
                    }
                    while(@term_seq && kill(0,-$pid)) {
                        kill(shift @term_seq, -$pid);
                        select(undef, undef, undef, (shift @term_seq)/1000);
                    }
                }
                wait;
                exit ($?&127 ? 128+($?&127) : 1+$?>>8)
            });
        }
        return $monitor_parent_sshd_script;
    }

    sub vars_to_export {
        # Uses:
        #   @opt::env
        my @vars = ("parallel_bash_environment");
        for my $varstring (@opt::env) {
            # Split up --env VAR1,VAR2
            push @vars, split /,/, $varstring;
        }
        for (@vars) {
            if(-r $_ and not -d) {
                # Read as environment definition bug #44041
                # TODO parse this
                $Global::envdef = ::slurp_or_exit($_);
            }
        }
        if(grep { /^_$/ } @vars) {
            local $/ = "\n";
            # --env _
            # Include all vars that are not in a clean environment
            if(open(my $vars_fh, "<", $Global::config_dir . "/ignored_vars")) {
                my @ignore = <$vars_fh>;
                chomp @ignore;
                my %ignore;
                @ignore{@ignore} = @ignore;
                close $vars_fh;
                push @vars, grep { not defined $ignore{$_} } keys %ENV;
                @vars = grep { not /^_$/ } @vars;
            } else {
                ::error("Run '$Global::progname --record-env' ".
                        "in a clean environment first.");
                ::wait_and_exit(255);
            }
        }
        # Duplicate vars as BASH functions to include post-shellshock functions (v1+v2)
        # So --env myfunc should look for BASH_FUNC_myfunc() and BASH_FUNC_myfunc%%

        push(@vars, "PARALLEL_PID", "PARALLEL_SEQ",
             "PARALLEL_SSHLOGIN", "PARALLEL_SSHHOST",
             "PARALLEL_HOSTGROUPS", "PARALLEL_ARGHOSTGROUPS",
             "PARALLEL_JOBSLOT", $opt::process_slot_var,
             map { ("BASH_FUNC_$_()", "BASH_FUNC_$_%%") } @vars);
        # Keep only defined variables
        return grep { defined($ENV{$_}) } @vars;
    }

    sub env_as_eval {
        # Returns:
        #   $eval = '$ENV{"..."}=...; ...'
        my @vars = vars_to_export();
        my $csh_friendly = not grep { /\n/ } @ENV{@vars};
        my @bash_functions = grep { substr($ENV{$_},0,4) eq "() {" } @vars;
        my @non_functions = (grep { !/PARALLEL_ENV/ }
                             grep { substr($ENV{$_},0,4) ne "() {" } @vars);

        # eval of @envset will set %ENV
        my $envset = join"", map {
            '$ENV{"'.::perl_quote_scalar($_).'"}="'.
                ::perl_quote_scalar($ENV{$_}).'";'; } @non_functions;

        # running @bashfunc on the command line, will set the functions
        my @bashfunc = map {
            my $v=$_;
            s/BASH_FUNC_(.*)(\(\)|%%)/$1/;
            "$_$ENV{$v};\nexport -f $_ 2> /dev/null;\n" } @bash_functions;
        # eval $bashfuncset will set $bashfunc
        my $bashfuncset;
        if(@bashfunc) {
            # Functions are not supported for all shells
            if($Global::shell !~ m:(^|/)(ash|bash|rbash|zsh|rzsh|dash|ksh):) {
                ::warning("Shell functions may not be supported in $Global::shell.");
            }
            $bashfuncset =
                '@bash_functions=qw('."@bash_functions".");".
                ::spacefree(1,'$shell="'.($ENV{'PARALLEL_SHELL'} || '$ENV{SHELL}').'";'.q{
                    if($shell=~/csh/) {
                        print STDERR "CSH/TCSH DO NOT SUPPORT newlines IN VARIABLES/FUNCTIONS. Unset @bash_functions\n";
                        exec "false";
                    }
                            }).
                                "\n".'$bashfunc = "'.::perl_quote_scalar("@bashfunc").'";';
        } else {
            $bashfuncset = '$bashfunc = "";'
        }
        if($ENV{'parallel_bash_environment'}) {
            $bashfuncset .= '$bashfunc .= "eval\ \"\$parallel_bash_environment\"\;";';
        }
        ::debug("base64",$envset,$bashfuncset,"\n");
        return $csh_friendly,$envset,$bashfuncset;
    }

    my $self = shift;
    my $command = shift;
    # TODO test that *sh -c 'parallel --env' use *sh
    if(not defined $self->{'sshlogin_wrap'}{$command}) {
        my $sshlogin = $self->sshlogin();
        $ENV{'PARALLEL_SEQ'} = $self->seq();
        $ENV{$opt::process_slot_var} = -1 +
            ($ENV{'PARALLEL_JOBSLOT'} = $self->slot());
        $ENV{'PARALLEL_SSHLOGIN'} = $sshlogin->string();
        $ENV{'PARALLEL_SSHHOST'} = $sshlogin->host();
        if ($opt::hostgroups) {
            $ENV{'PARALLEL_HOSTGROUPS'} = join '+', $sshlogin->hostgroups();
            $ENV{'PARALLEL_ARGHOSTGROUPS'} = join '+', $self->hostgroups();
        }
        $ENV{'PARALLEL_PID'} = $$;
        if($sshlogin->local()) {
            if($opt::workdir) {
                # Create workdir if needed. Then cd to it.
                my $wd = $self->workdir();
                if($opt::workdir eq "." or $opt::workdir eq "...") {
                    # If $wd does not start with '/': Prepend $HOME
                    $wd =~ s:^([^/]):$ENV{'HOME'}/$1:;
                }
                ::mkdir_or_die($wd);
                my $post = "";
                if($opt::workdir eq "...") {
                    $post = ";".exitstatuswrapper("rm -rf ".::Q($wd).";");

                }
                $command = "cd ".::Q($wd)." || exit 255; " .
                    $command . $post;;
            }
            if(@opt::env) {
                # Prepend with environment setter, which sets functions in zsh
                my ($csh_friendly,$envset,$bashfuncset) = env_as_eval();
                my $perl_code = $envset.$bashfuncset.
                    '@ARGV="'.::perl_quote_scalar($command).'";'.
                    "exec\"$Global::shell\",\"-c\",\(\$bashfunc.\"\@ARGV\"\)\;die\"exec:\$\!\\n\"\;";
                if(length $perl_code > 999
                   or
                   not $csh_friendly
                   or
                   $command =~ /\n/) {
                    # csh does not deal well with > 1000 chars in one word
                    # csh does not deal well with $ENV with \n
                    $self->{'sshlogin_wrap'}{$command} = base64_wrap($perl_code);
                } else {
                    $self->{'sshlogin_wrap'}{$command} = "perl -e ".::Q($perl_code);
                }
            } else {
                $self->{'sshlogin_wrap'}{$command} = $command;
            }
        } else {
            my $pwd = "";
            if($opt::workdir) {
                # Create remote workdir if needed. Then cd to it.
                my $wd = ::pQ($self->workdir());
                $pwd = qq{system("mkdir","-p","--","$wd"); chdir "$wd" ||}.
                    qq{print(STDERR "parallel: Cannot chdir to $wd\\n") &&}.
                    qq{exit 255;};
            }
            my ($csh_friendly,$envset,$bashfuncset) = env_as_eval();
            my $cmd = $command;
            # q// does not quote \, so we must do that
            $cmd =~ s/\\/\\\\/g;

            my $remote_command = $sshlogin->hexwrap
                ($pwd.$envset.$bashfuncset.'$cmd='."q\0".$cmd."\0;".
                 monitor_parent_sshd_script());
            my ($pre,$post,$cleanup)=("","","");
            # --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 = exitstatuswrapper($post);
            }
            $self->{'sshlogin_wrap'}{$command} =
                ($pre
                 . $sshlogin->wrap($remote_command)
                 . ";"
                 . $post);
        }
    }
    return $self->{'sshlogin_wrap'}{$command};
}

sub fill_templates($) {
    # Replace replacement strings in template(s)
    # Returns:
    #   @templates - File names of replaced templates
    my $self = shift;

    if(%opt::template) {
        my @template_name =
            map { $self->{'commandline'}->replace_placeholders([$_],0,0) }
        @{$self->{'commandline'}{'template_names'}};
        ::debug("tmpl","Names: @template_name\n");
        for(my $i = 0; $i <= $#template_name; $i++) {
            ::write_or_exit
                ($template_name[$i],
                 $self->{'commandline'}->
                 replace_placeholders([$self->{'commandline'}
                                       {'template_contents'}[$i]],0,0));
        }
        if($opt::cleanup) {
            $self->add_rm(@template_name);
        }
    }
}

sub filter($) {
    # Replace replacement strings in filter(s) and evaluate them
    # Returns:
    #   $run - 1=yes, undef=no
    my $self = shift;
    my $run = 1;
    if(@opt::filter) {
        for my $eval ($self->{'commandline'}->
                      replace_placeholders(\@opt::filter,0,0)) {
            $run &&= eval $eval;
        }
        $self->{'commandline'}{'skip'} ||= not $run;
    }
    return $run;
}

sub transfer($) {
    # Files to transfer
    # Non-quoted and with {...} substituted
    # Returns:
    #   @transfer - File names of files to transfer
    my $self = shift;

    my $transfersize = 0;
    my @transfer = $self->{'commandline'}->
        replace_placeholders($self->{'commandline'}{'transfer_files'},0,0);
    for(@transfer) {
        # filesize
        if(-e $_) {
            $transfersize += (stat($_))[7];
        }
    }
    $self->add_transfersize($transfersize);
    return @transfer;
}

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

sub add_transfersize($) {
    my $self = shift;
    my $transfersize = shift;
    $self->{'transfersize'} += $transfersize;
    $opt::sqlworker and
        $Global::sql->update("SET Send = ? WHERE Seq = ".$self->seq(),
                             $self->{'transfersize'});
}

sub sshtransfer($) {
    # Returns for each transfer file:
    #   rsync $file remote:$workdir
    my $self = shift;
    my @pre;
    my $sshlogin = $self->sshlogin();
    my $workdir = $self->workdir();
    for my $file ($self->transfer()) {
        push @pre, $sshlogin->rsync_transfer_cmd($file,$workdir).";";
    }
    return join("",@pre);
}

sub return($) {
    # Files to return
    # Non-quoted and with {...} substituted
    # Returns:
    #   @non_quoted_filenames
    my $self = shift;
    return $self->{'commandline'}->
        replace_placeholders($self->{'commandline'}{'return_files'},0,0);
}

sub returnsize($) {
    # This is called after the job has finished
    # Returns:
    #   $number_of_bytes transferred in return
    my $self = shift;
    for my $file ($self->return()) {
        if(-e $file) {
            $self->{'returnsize'} += (stat($file))[7];
        }
    }
    return $self->{'returnsize'};
}

sub add_returnsize($) {
    my $self = shift;
    my $returnsize = shift;
    $self->{'returnsize'} += $returnsize;
    $opt::sqlworker and
        $Global::sql->update("SET Receive = ? WHERE Seq = ".$self->seq(),
                             $self->{'returnsize'});
}

sub sshreturn($) {
    # Returns for each return-file:
    #   rsync remote:$workdir/$file .
    my $self = shift;
    my $sshlogin = $self->sshlogin();
    my $pre = "";
    for my $file ($self->return()) {
        $file =~ s:^\./::g; # Remove ./ if any
        my $relpath = ($file !~ m:^/:) ||
            ($file =~ m:/\./:); # Is the path relative or /./?
        my $cd = "";
        my $wd = "";
        if($relpath) {
            #   rsync -avR /foo/./bar/baz.c remote:/tmp/
            # == (on old systems)
            #   rsync -avR --rsync-path="cd /foo; rsync" remote:bar/baz.c /tmp/
            $wd = ::shell_quote_file($self->workdir()."/");
        }
        # Only load File::Basename if actually needed
        $Global::use{"File::Basename"} ||= eval "use File::Basename; 1;";
        # dir/./file means relative to dir, so remove dir on remote
        $file =~ m:(.*)/\./:;
        my $basedir = $1 ? ::shell_quote_file($1."/") : "";
        my $nobasedir = $file;
        $nobasedir =~ s:.*/\./::;
        $cd = ::shell_quote_file(::dirname($nobasedir));
        my $rsync_cd = '--rsync-path='.::Q("cd $wd$cd; rsync");
        my $basename = ::Q(::shell_quote_file(::basename($file)));
        # --return
        #   mkdir -p /home/tange/dir/subdir/;
        #   rsync (--protocol 30) -rlDzR
        #     --rsync-path="cd /home/tange/dir/subdir/; rsync"
        #     server:file.gz /home/tange/dir/subdir/
        $pre .= "mkdir -p $basedir$cd" . " && " .
            $sshlogin->rsync(). " $rsync_cd -- ".$sshlogin->host().':'.
            $basename . " ".$basedir.$cd.";";
    }
    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 $workdir = $self->workdir();
    my $cleancmd = "";

    for my $file ($self->remote_cleanup()) {
        my @subworkdirs = parentdirs_of($file);
        $cleancmd .= $sshlogin->cleanup_cmd($file,$workdir).";";
    }
    if(defined $opt::workdir and $opt::workdir eq "...") {
        $cleancmd .= $sshlogin->wrap("rm -rf " . ::Q($workdir).';');
    }
    return $cleancmd;
}

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

sub exitstatuswrapper(@) {
    # Input:
    #   @shellcode = shell code to execute
    # Returns:
    #   shell script that returns current status after executing @shellcode
    if($Global::cshell) {
        return ('set _EXIT_status=$status; ' .
                join(" ",@_).
                'exit $_EXIT_status;');
    } elsif($Global::fish) {
        return ('export _EXIT_status=$status; ' .
                join(" ",@_).
                'exit $_EXIT_status;');
    } else {
        return ('_EXIT_status=$?; ' .
                join(" ",@_).
                'exit $_EXIT_status;');
    }
}

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 eq ".") {
                # . means current dir
                my $home = $ENV{'HOME'};
                eval 'use Cwd';
                my $cwd = cwd();
                $workdir = $cwd;
                if($home) {
                    # If homedir exists: remove the homedir from
                    # workdir if cwd starts with homedir
                    # E.g. /home/foo/my/dir => my/dir
                    # E.g. /tmp/my/dir => /tmp/my/dir
                    my ($home_dev, $home_ino) = (stat($home))[0,1];
                    my $parent = "";
                    my @dir_parts = split(m:/:,$cwd);
                    my $part;
                    while(defined ($part = shift @dir_parts)) {
                        $part eq "" and next;
                        $parent .= "/".$part;
                        my ($parent_dev, $parent_ino) = (stat($parent))[0,1];
                        if($parent_dev == $home_dev and $parent_ino == $home_ino) {
                            # dev and ino is the same: We found the homedir.
                            $workdir = join("/",@dir_parts);
                            last;
                        }
                    }
                }
                if($workdir eq "") {
                    $workdir = ".";
                }
            } elsif($opt::workdir eq "...") {
                $workdir = ".parallel/tmp/" . ::hostname() . "-" . $$
                    . "-" . $self->seq();
            } else {
                $workdir = $self->{'commandline'}->
                    replace_placeholders([$opt::workdir],0,0);
                #$workdir = $opt::workdir;
                # Rsync treats /./ special. We dont want that
                $workdir =~ s:/\./:/:g; # Remove /./
                $workdir =~ s:(.)/+$:$1:; # Remove ending / if any
                $workdir =~ s:^\./::g; # Remove starting ./ if any
            }
        } else {
            $workdir = ".";
        }
        $self->{'workdir'} = $workdir;
    }
    return $self->{'workdir'};
}

sub parentdirs_of($) {
    # Return:
    #   all parentdirs except . of this dir or file - sorted desc 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

    sub open3_setpgrp_internal {
        # Run open3+setpgrp followed by the command
        # Input:
        #   $stdin_fh = Filehandle to use as STDIN
        #   $stdout_fh = Filehandle to use as STDOUT
        #   $stderr_fh = Filehandle to use as STDERR
        #   $command = Command to run
        # Returns:
        #   $pid = Process group of job started
        my ($stdin_fh,$stdout_fh,$stderr_fh,$command) = @_;
        my $pid;
        local (*OUT,*ERR);
        open OUT, '>&', $stdout_fh or ::die_bug("Can't dup STDOUT: $!");
        open ERR, '>&', $stderr_fh or ::die_bug("Can't dup STDERR: $!");
        # The eval is needed to catch exception from open3
        eval {
            if(not $pid = ::open3($stdin_fh, ">&OUT", ">&ERR", "-")) {
                # Each child gets its own process group to make it safe to killall
                eval{ setpgrp(0,0) };
                eval{ setpriority(0,0,$opt::nice) };
                exec($Global::shell,"-c",$command)
                    || ::die_bug("open3-$stdin_fh ".substr($command,0,200));
            }
        };
        return $pid;
    }

    sub open3_setpgrp_external {
        # Run open3 on $command wrapped with a perl script doing setpgrp
        # Works on systems that do not support open3(,,,"-")
        # Input:
        #   $stdin_fh = Filehandle to use as STDIN
        #   $stdout_fh = Filehandle to use as STDOUT
        #   $stderr_fh = Filehandle to use as STDERR
        #   $command = Command to run
        # Returns:
        #   $pid = Process group of job started
        my ($stdin_fh,$stdout_fh,$stderr_fh,$command) = @_;
        local (*OUT,*ERR);
        open OUT, '>&', $stdout_fh or ::die_bug("Can't dup STDOUT: $!");
        open ERR, '>&', $stderr_fh or ::die_bug("Can't dup STDERR: $!");

        my $pid;
        my @setpgrp_wrap =
            ('perl','-e',
             "eval\{setpgrp\}\;eval\{setpriority\(0,0,$opt::nice\)\}\;".
             "exec '$Global::shell', '-c', \@ARGV");
        # The eval is needed to catch exception from open3
        eval {
            $pid = ::open3($stdin_fh, ">&OUT", ">&ERR", @setpgrp_wrap, $command)
                || ::die_bug("open3-$stdin_fh");
            1;
        };
        return $pid;
    }

    sub redefine_open3_setpgrp {
        my $setgprp_cache = shift;
        # Select and run open3_setpgrp_internal/open3_setpgrp_external
        no warnings 'redefine';
        my ($outfh,$name) = ::tmpfile(SUFFIX => ".tst");
        # Test to see if open3(x,x,x,"-") is fully supported
        # Can an exported bash function be called via open3?
        my $script = 'if($pid=::open3($i,$o,$e,"-")) { wait; } '.
            'else { exec("bash","-c","testfun && true"); }';
        my $bash =
            ::shell_quote_scalar_default(
            "testfun() { rm $name; }; export -f testfun; ".
            "perl -MIPC::Open3 -e ".
            ::Q(::Q($script))
            );
        my $redefine_eval;
        # Redirect STDERR temporarily,
        # so errors on MacOS X are ignored.
        open my $saveerr, ">&STDERR";
        open STDERR, '>', "/dev/null";
        # Run the test
        ::debug("init",qq{bash -c $bash 2>/dev/null});
        qx{ bash -c $bash 2>/dev/null };
        open STDERR, ">&", $saveerr;

        if(-e $name) {
            # Does not support open3(x,x,x,"-")
            # or does not have bash:
            # Use (slow) external version
            unlink($name);
            $redefine_eval = '*open3_setpgrp = \&open3_setpgrp_external';
            ::debug("init","open3_setpgrp_external chosen\n");
        } else {
            # Supports open3(x,x,x,"-")
            # This is 0.5 ms faster to run
            $redefine_eval = '*open3_setpgrp = \&open3_setpgrp_internal';
            ::debug("init","open3_setpgrp_internal chosen\n");
        }
        if(open(my $fh, ">", $setgprp_cache)) {
            print $fh $redefine_eval;
            close $fh;
        } else {
            ::debug("init","Cannot write to $setgprp_cache");
        }
        eval $redefine_eval;
    }

    sub open3_setpgrp {
        my $setgprp_cache = $Global::cache_dir . "/tmp/sshlogin/" .
            ::hostname() . "/setpgrp_func";
        sub read_cache() {
            -e $setgprp_cache || return 0;
            local $/ = undef;
            open(my $fh, "<", $setgprp_cache) || return 0;
            eval <$fh> || return 0;
            close $fh;
            return 1;
        }
        if(not read_cache()) {
            redefine_open3_setpgrp($setgprp_cache);
        }
        # The sub is now redefined. Call it
        return open3_setpgrp(@_);
    }

    my $job = shift;
    # Get the shell command to be executed (possibly with ssh infront).
    my $command = $job->wrapped();
    my $pid;

    if($Global::interactive or $Global::stderr_verbose) {
        $job->interactive_start();
    }
    # Must be run after $job->interactive_start():
    # $job->interactive_start() may call $job->skip()
    if($job->{'commandline'}{'skip'}
       or
       not $job->filter()) {
        # $job->skip() was called or job filtered
        $command = "true";
    }
    $job->openoutputfiles();
    $job->print_verbose_dryrun();
    my($stdout_fh,$stderr_fh) = ($job->fh(1,"w"),$job->fh(2,"w"));
    if($opt::dryrun or $opt::sqlmaster) { $command = "true"; }
    $ENV{'PARALLEL_SEQ'} = $job->seq();
    $ENV{'PARALLEL_PID'} = $$;
    $ENV{$opt::process_slot_var} = -1 +
        ($ENV{'PARALLEL_JOBSLOT'} = $job->slot());
    $ENV{'PARALLEL_TMP'} = ::tmpname("par");
    $job->add_rm($ENV{'PARALLEL_TMP'});
    $job->fill_templates();
    $ENV{'SSHPASS'} = $job->{'sshlogin'}->{'password'};
    ::debug("run", $Global::total_running, " processes . Starting (",
            $job->seq(), "): $command\n");
    if($opt::pipe) {
        my ($stdin_fh) = ::gensym();
        $pid = open3_setpgrp($stdin_fh,$stdout_fh,$stderr_fh,$command);
        if($opt::roundrobin and not $opt::keeporder) {
            # --keep-order will make sure the order will be reproducible
            ::set_fh_non_blocking($stdin_fh);
        }
        $job->set_fh(0,"w",$stdin_fh);
        if($opt::tee or $opt::shard or $opt::bin) { $job->set_virgin(0); }
    } elsif(($opt::tty or $opt::open_tty) and -c "/dev/tty" and
            open(my $devtty_fh, "<", "/dev/tty")) {
        # Give /dev/tty to the command if no one else is using it
        # The eval is needed to catch exception from open3
        local (*IN,*OUT,*ERR);
        open OUT, '>&', $stdout_fh or ::die_bug("Can't dup STDOUT: $!");
        open ERR, '>&', $stderr_fh or ::die_bug("Can't dup STDERR: $!");
        *IN = $devtty_fh;
        # The eval is needed to catch exception from open3
        my @wrap = ('perl','-e',
                            "eval\{setpriority\(0,0,$opt::nice\)\}\;".
                            "exec '$Global::shell', '-c', \@ARGV");
        eval {
            $pid = ::open3("<&IN", ">&OUT", ">&ERR", @wrap, $command)
                || ::die_bug("open3-/dev/tty");
            1;
        };
        close $devtty_fh;
        $job->set_virgin(0);
    } elsif($Global::semaphore) {
        # Allow sem to read from stdin
        $pid = open3_setpgrp("<&STDIN",$stdout_fh,$stderr_fh,$command);
        $job->set_virgin(0);
    } else {
        $pid = open3_setpgrp(::gensym(),$stdout_fh,$stderr_fh,$command);
        $job->set_virgin(0);
    }
    if($pid) {
        # A job was started
        $Global::total_running++;
        $Global::total_started++;
        $job->set_pid($pid);
        $job->set_starttime();
        $Global::running{$job->pid()} = $job;
        if($opt::timeout) {
            $Global::timeoutq->insert($job);
        }
        $Global::newest_job = $job;
        $Global::newest_starttime = ::now();
        return $job;
    } else {
        # No more processes
        ::debug("run", "Cannot spawn more jobs.\n");
        return undef;
    }
}

sub interactive_start($) {
    my $self = shift;
    my $command = $self->wrapped();
    if($Global::interactive) {
        my $answer;
        ::status_no_nl("$command ?...");
        do{
            my $tty_fh = ::open_or_exit("<","/dev/tty");
            $answer = <$tty_fh>;
            close $tty_fh;
            # Sometime we get an empty string (not even \n)
            # Do not know why, so let us just ignore it and try again
        } while(length $answer < 1);
        if (not ($answer =~ /^\s*y/i)) {
            $self->{'commandline'}->skip();
        }
    } else {
        print $Global::original_stderr "$command\n";
    }
}

{
    my $tmuxsocket;
    my $qsocket;

    sub tmux_wrap($) {
        # Wrap command with tmux for session pPID
        # Input:
        #   $actual_command = the actual command being run (incl ssh wrap)
        my $self = shift;
        my $actual_command = shift;
        # Temporary file name. Used for fifo to communicate exit val
        my $tmpfifo = ::tmpname("tmx");
        $self->add_rm($tmpfifo);
        if(length($tmpfifo) >=100) {
            ::error("tmux does not support sockets with path > 100.");
            ::wait_and_exit(255);
        }
        if($opt::tmuxpane) {
            # Move the command into a pane in window 0
            $actual_command = $ENV{'PARALLEL_TMUX'}.' joinp -t :0 ; '.
                $ENV{'PARALLEL_TMUX'}.' select-layout -t :0 tiled ; '.
                $actual_command;
        }
        my $visual_command = $self->replaced();
        my $title = $visual_command;
        if($visual_command =~ /\0/) {
            ::error("Command line contains NUL. tmux is confused by NUL.");
            ::wait_and_exit(255);
        }
        # ; causes problems
        # ascii 194-245 annoys tmux
        $title =~ tr/[\011-\016;\302-\365]/ /s;
        $title = ::Q($title);

        my $l_act = length($actual_command);
        my $l_tit = length($title);
        my $l_fifo = length($tmpfifo);
        # The line to run contains a 118 chars extra code + the title 2x
        my $l_tot = 2 * $l_tit + $l_act + $l_fifo;

        my $quoted_space75 = ::Q(" ")x75;
        while($l_tit < 1000 and
              (
               (890 < $l_tot and $l_tot < 1350)
               or
               (9250 < $l_tot and $l_tot < 9800)
              )) {
            # tmux blocks for certain lengths:
            # 900 < title + command < 1200
            # 9250 < title + command < 9800
            # but only if title < 1000, so expand the title with 75 spaces
            # The measured lengths are:
            # 996 < (title + whole command) < 1127
            # 9331 < (title + whole command) < 9636
            $title .= $quoted_space75;
            $l_tit = length($title);
            $l_tot = 2 * $l_tit + $l_act + $l_fifo;
        }

        my $tmux;
        $ENV{'PARALLEL_TMUX'} ||= "tmux";
        if(not $tmuxsocket) {
            $tmuxsocket = ::tmpname("tms");
            $qsocket = ::Q($tmuxsocket);
            ::debug("tmux", "Start: $ENV{'PARALLEL_TMUX'} -S $qsocket attach");
            if($opt::fg) {
                if(not fork) {
                    # Run tmux in the foreground
                    # Wait for the socket to appear
                    while (not -e $tmuxsocket) { }
                    `$ENV{'PARALLEL_TMUX'} -S $qsocket attach`;
                    exit;
                }
            }
            ::status("See output with: $ENV{'PARALLEL_TMUX'} -S $qsocket attach");
        }
        $tmux = "sh -c ".::Q(
            $ENV{'PARALLEL_TMUX'}.
            " -S $qsocket new-session -s p$$ -d \"sleep .2\" >/dev/null 2>&1").";" .
            $ENV{'PARALLEL_TMUX'}.
            " -S $qsocket new-window -t p$$ -n $title";

        ::debug("tmux", "title len:", $l_tit, " act ", $l_act, " max ",
                $Limits::Command::line_max_len, " tot ",
                $l_tot, "\n");
        return "mkfifo ".::Q($tmpfifo)." && $tmux ".
            # Run in tmux
            ::Q
            (
             "(".$actual_command.');'.
             # The triple print is needed - otherwise the testsuite fails
             q[ perl -e 'while($t++<3){ print $ARGV[0],"\n" }' $?h/$status >> ].
             ::Q($tmpfifo)."&".
             "echo $title; echo \007Job finished at: `date`;sleep 10"
            ).
            # Run outside tmux
            # Read a / separated line: 0h/2 for csh, 2/0 for bash.
            # If csh the first will be 0h, so use the second as exit value.
            # Otherwise just use the first value as exit value.
            q{; exec perl -e '$/="/";$_=<>;$c=<>;unlink $ARGV; }.
            q{/(\d+)h/ and exit($1);exit$c' }.::Q($tmpfifo);
    }
}

sub is_already_in_results($) {
    # Do we already have results for this job?
    # Returns:
    #   $job_already_run = bool whether there is output for this or not
    my $job = $_[0];
    if($Global::csvsep) {
        if($opt::joblog) {
            # OK: You can look for job run in joblog
            return 0
        } else {
            ::warning_once(
                  "--resume --results .csv/.tsv/.json is not supported yet\n");
            # TODO read and parse the file
            return 0
        }
    }
    my $out = $job->{'commandline'}->results_out();
    ::debug("run", "Test ${out}stdout", -e "${out}stdout", "\n");
    return(-e $out."stdout" or -f $out);
}

sub is_already_in_joblog($) {
    my $job = shift;
    return vec($Global::job_already_run,$job->seq(),1);
}

sub set_job_in_joblog($) {
    my $job = shift;
    vec($Global::job_already_run,$job->seq(),1) = 1;
}

    sub retry() {
        # This command should be retried
            my $self = shift;

        $self->set_endtime(undef);
        $self->reset_exitstatus();
        $self->set_killreason(undef);
        $Global::JobQueue->unget($self);
        ::debug("run", "Retry ", $self->seq(), "\n");
        return 1;
    }

sub should_be_retried($) {
    # Should this job be retried?
    # Returns
    #   0 - do not retry
    #   1 - job queued for retry
    my $self = shift;
    if($opt::memfree and $self->killreason() eq "mem") {
        # Job was killed due to memfree => retry
        return $self->retry();
    }
    if (not defined $opt::retries) { return 0; }
    if(not $self->exitstatus() and not $self->exitsignal()) {
        # 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();
        my $retries = $self->{'commandline'}->
            replace_placeholders([$opt::retries],0,0);
        # 0 = Inf
        if($retries == 0) { $retries = 2**31; }
        # Ignore files already unlinked to avoid memory leak
        $self->{'unlink'} = [ grep { -e $_ } @{$self->{'unlink'}} ];
        map { -e $_ or delete $Global::unlink{$_} } keys %Global::unlink;
        if($self->total_failed() == $retries) {
            # This has been retried enough
            return 0;
        } else {
            # This command should be retried
            return $self->retry();
        }
    }
}

{
    my (%print_later,$job_seq_to_print);

    sub print_earlier_jobs($) {
        # Print jobs whose output is postponed due to --keep-order
        # Returns: N/A
        my $job = shift;
        $print_later{$job->seq()} = $job;
        $job_seq_to_print ||= 1;
        my $returnsize = 0;
        ::debug("run", "Looking for: $job_seq_to_print ",
                "This: ", $job->seq(), "\n");
        for(;vec($Global::job_already_run,$job_seq_to_print,1);
            $job_seq_to_print++) {}
        while(my $j = $print_later{$job_seq_to_print}) {
            $returnsize += $j->print();
            if($j->endtime()) {
                # Job finished - look at the next
                delete $print_later{$job_seq_to_print};
                $job_seq_to_print++;
                next;
            } else {
                # Job not finished yet - look at it again next round
                last;
            }
        }
        return $returnsize;
    }
}

sub print($) {
    # Print the output of the jobs
    # Returns: N/A
    my $self = shift;

    ::debug("print", ">>joboutput ", $self->replaced(), "\n");
    if($opt::dryrun) {
        # Nothing was printed to this job:
        # cleanup tmp files if --files was set
        ::rm($self->fh(1,"name"));
    }
    if($opt::pipe and $self->virgin() and not $opt::tee) {
        # Skip --joblog, --dryrun, --verbose
    } else {
        if($opt::ungroup) {
            # NULL returnsize = 0 returnsize
            $self->returnsize() or $self->add_returnsize(0);
            if($Global::joblog and defined $self->{'exitstatus'}) {
                # Add to joblog when finished
                $self->print_joblog();
                # Printing is only relevant for grouped/--line-buffer output.
                $opt::ungroup and return;
            }
        }
        # Check for disk full
        ::exit_if_disk_full();
    }

    my $returnsize = $self->returnsize();
    my @fdno;
    if($opt::latestline) {
        @fdno = (1);
    } else {
        @fdno = (sort { $a <=> $b } keys %Global::fh);
    }
    for my $fdno (@fdno) {
        # Sort by file descriptor numerically: 1,2,3,..,9,10,11
        $fdno == 0 and next;
        my $out_fh = $Global::fh{$fdno};
        my $in_fh = $self->fh($fdno,"r");
        if(not $in_fh) {
            if(not $Job::file_descriptor_warning_printed{$fdno}++) {
                # ::warning("File descriptor $fdno not defined\n");
            }
            next;
        }
        ::debug("print", "File descriptor $fdno (", $self->fh($fdno,"name"), "):\n");
        if($Global::linebuffer) {
            # Line buffered print out
            $self->print_linebuffer($fdno,$in_fh,$out_fh);
        } elsif($Global::files) {
            $self->print_files($fdno,$in_fh,$out_fh);
        } elsif($opt::results) {
            $self->print_results($fdno,$in_fh,$out_fh);
        } else {
            $self->print_normal($fdno,$in_fh,$out_fh);
        }
        flush $out_fh;
    }
    ::debug("print", "<<joboutput\n");
    if(defined $self->{'exitstatus'}
       and not ($self->virgin() and $opt::pipe)) {
        if($Global::joblog and not $opt::sqlworker) {
            # Add to joblog when finished
            $self->print_joblog();
        }
        if($opt::sqlworker and not $opt::results) {
            $Global::sql->output($self);
        }
        if($Global::csvsep) {
            # Add output to CSV when finished
            $self->print_csv();
        }
        if($Global::jsonout) {
            $self->print_json();
        }
    }
    return $returnsize - $self->returnsize();
}

{
    my %jsonmap;

    sub print_json($) {
        my $self = shift;
        sub jsonquote($) {
            my $a = shift;
            if(not $jsonmap{"\001"}) {
                map { $jsonmap{sprintf("%c",$_)} =
                          sprintf '\u%04x', $_ } 0..31;
            }
            $a =~ s/\\/\\\\/g;
            $a =~ s/\"/\\"/g;
            $a =~ s/([\000-\037])/$jsonmap{$1}/g;
            return $a;
        }

        my $cmd;
        if($Global::verbose <= 1) {
            $cmd = jsonquote($self->replaced());
        } else {
            # Verbose level > 1: Print the rsync and stuff
            $cmd = jsonquote(join " ", @{$self->{'commandline'}});
        }
        my $record_ref = $self->{'commandline'}{'arg_list_flat_orig'};

        # Memory optimization: Overwrite with the joined output
        $self->{'output'}{1} = join("", @{$self->{'output'}{1}});
        $self->{'output'}{2} = join("", @{$self->{'output'}{2}});
        # {
        #   "Seq": 12,
        #   "Host": "/usr/bin/ssh foo@lo",
        #   "Starttime": 1608344711.743,
        #   "JobRuntime": 0.01,
        #   "Send": 0,
        #   "Receive": 10,
        #   "Exitval": 0,
        #   "Signal": 0,
        #   "Command": "echo 1",
        #   "V": [
        #     "1"
        #   ],
        #   "Stdout": "1\n",
        #   "Stderr": ""
        # }
        #
        printf($Global::csv_fh
               q({ "Seq": %s, "Host": "%s", "Starttime": %s, "JobRuntime": %s, ).
               q("Send": %s, "Receive": %s, "Exitval": %s, "Signal": %s, ).
               q("Command": "%s", "V": [ %s ], "Stdout": "%s", "Stderr": "%s" }).
               "\n",
               $self->seq(),
               jsonquote($self->sshlogin()->string()),
               $self->starttime(), sprintf("%0.3f",$self->runtime()),
               $self->transfersize(), $self->returnsize(),
               $self->exitstatus(), $self->exitsignal(), $cmd,
               (join ",",
                map { '"'.jsonquote($_).'"' } @$record_ref[1..$#$record_ref],
               ),
               jsonquote($self->{'output'}{1}),
               jsonquote($self->{'output'}{2})
            );
    }
}

{
    my $header_printed;

    sub print_csv($) {
        my $self = shift;
        my $cmd;
        if($Global::verbose <= 1) {
            $cmd = $self->replaced();
        } else {
            # Verbose level > 1: Print the rsync and stuff
            $cmd = join " ", @{$self->{'commandline'}};
        }
        my $record_ref = $self->{'commandline'}{'arg_list_flat_orig'};

        if(not $header_printed) {
            # Variable headers
            # Normal => V1..Vn
            # --header : => first value from column
            my @V;
            if($opt::header) {
                my $i = 1;
                @V = (map { $Global::input_source_header{$i++} }
                      @$record_ref[1..$#$record_ref]);
            } else {
                my $V = "V1";
                @V = (map { $V++ } @$record_ref[1..$#$record_ref]);
            }
            print $Global::csv_fh
                (map { $$_ }
                 combine_ref("Seq", "Host", "Starttime", "JobRuntime",
                             "Send", "Receive", "Exitval", "Signal", "Command",
                             @V,
                             "Stdout","Stderr"
                 )),"\n";
            $header_printed++;
        }
        # Memory optimization: Overwrite with the joined output
        $self->{'output'}{1} = join("", @{$self->{'output'}{1}});
        $self->{'output'}{2} = join("", @{$self->{'output'}{2}});
        print $Global::csv_fh
            (map { $$_ }
             combine_ref
             ($self->seq(),
              $self->sshlogin()->string(),
              $self->starttime(), sprintf("%0.3f",$self->runtime()),
              $self->transfersize(), $self->returnsize(),
              $self->exitstatus(), $self->exitsignal(), \$cmd,
              \@$record_ref[1..$#$record_ref],
              \$self->{'output'}{1},
              \$self->{'output'}{2})),"\n";
    }
}

sub combine_ref($) {
    # Inspired by Text::CSV_PP::_combine (by Makamaka Hannyaharamitu)
    my @part = @_;
    my $sep = $Global::csvsep;
    my $quot = '"';
    my @out = ();

    my $must_be_quoted;
    for my $column (@part) {
        # Memory optimization: Content transferred as reference
        if(ref $column ne "SCALAR") {
            # Convert all columns to scalar references
            my $v = $column;
            $column = \$v;
        }
        if(not defined $$column) {
            $$column = '';
            next;
        }

        $must_be_quoted = 0;

        if($$column =~ s/$quot/$quot$quot/go){
            # Replace " => ""
            $must_be_quoted ||=1;
        }
        if($$column =~ /[\s\Q$sep\E]/o){
            # Put quotes around if the column contains ,
            $must_be_quoted ||=1;
        }

        $Global::use{"bytes"} ||= eval "use bytes; 1;";
        if ($$column =~ /\0/) {
            # Contains \0 => put quotes around
            $must_be_quoted ||=1;
        }
        if($must_be_quoted){
            push @out, \$sep, \$quot, $column, \$quot;
        } else {
            push @out, \$sep, $column;
        }
    }
    # Remove the first $sep: ,val,"val" => val,"val"
    shift @out;
    return @out;
}

sub print_files($) {
    # Print the name of the file containing stdout on stdout
    # Uses:
    #   $opt::pipe
    #   $opt::group = Print when job is done
    #   $opt::linebuffer = Print ASAP
    # Returns: N/A
    my $self = shift;
    my ($fdno,$in_fh,$out_fh) = @_;

    # If the job is dead: close printing fh. Needed for --compress
    close $self->fh($fdno,"w");
    if($? and $opt::compress) {
        ::error($opt::compress_program." failed.");
        $self->set_exitstatus(255);
    }
    if($opt::compress) {
        # Kill the decompressor which will not be needed
        CORE::kill "TERM", $self->fh($fdno,"rpid");
    }
    close $in_fh;

    if($opt::pipe and $self->virgin()) {
        # Nothing was printed to this job:
        # cleanup unused tmp files because --files was set
        for my $fdno (1,2) {
            ::rm($self->fh($fdno,"name"));
            ::rm($self->fh($fdno,"unlink"));
        }
    } elsif($fdno == 1 and $self->fh($fdno,"name")) {
        print $out_fh $self->tag(),$self->fh($fdno,"name"), $Global::files_sep;
        if($Global::membuffer) {
            push @{$self->{'output'}{$fdno}},
                $self->tag(), $self->fh($fdno,"name");
        }
        $self->add_returnsize(-s $self->fh($fdno,"name"));
        # Mark as printed - do not print again
        $self->set_fh($fdno,"name",undef);
    }
}


# Different print types
# (--ll | --ll --bar | --lb | --group | --parset | --sql-worker)
# (--files | --results (.json|.csv|.tsv) )
# --color-failed
# --color
# --keep-order
# --tag
# --bar
{
    my ($up,$eol,$currow,$maxrow);
    my ($minvisible,%print_later,%notvisible);
    my (%binmodeset,%tab);

    sub latestline_init() {
        # cursor_up cuu1 = up one line
        $up = `sh -c "tput cuu1 </dev/tty" 2>/dev/null`;
        chomp($up);
        $eol = `sh -c "tput el </dev/tty" 2>/dev/null`;
        chomp($eol);
        if($eol eq "") { $eol = "\033[K"; }
        $currow = 1;
        $maxrow = 1;
        $minvisible = 1;
        for(0..8) {
            $tab{$_} = " "x(8-($_%8));
        }
    }

    sub mbtrunc($$) {
        # Simple mbtrunc to avoid using Text::WideChar::Util
        my $str = shift;
        my $len = shift;
        if(::mbswidth($str) == length($str)) {
            $str = substr($str,0,$len);
        } else {
            # mb chars (ヌー平行) are wider than 1 char on screen
            # We need at most $len chars - they may be wide
            $str =~ s/(.{$len}).*/$1/;
            my $rlen = int((::mbswidth($str) - $len)/2+0.5);
            do {
                $str =~ s/.{$rlen}$//;
                $rlen = int((::mbswidth($str) - $len)/2+0.5);
            } while($rlen >= 1);
        }
        return $str;
    }

    sub print_latest_line($) {
        my $self = shift;
        my $out_fh = shift;
        if(not defined $self->{$out_fh,'latestline'}) { return; }
        my $row = $self->row();
        # Is row visible?
        if(not ($minvisible <= $row
                and
                $row < $minvisible + ::terminal_rows() - 1)) {
            return;
        }
        if(not $binmodeset{$out_fh}++) {
            # Enable utf8 if possible
            eval q{ binmode $out_fh, "encoding(utf8)"; };
        }
        my ($color,$reset_color) = $self->color();
        my $termcol = ::terminal_columns();
        my $untabify_tag = ::decode_utf8($self->untabtag());
        my $untabify_str =
            ::untabify(::decode_utf8($self->{$out_fh,'latestline'}));
        # -1 to make space for $truncated_str
        my $maxtaglen = $termcol - 1;
        $untabify_tag = mbtrunc($untabify_tag,$maxtaglen);
        my $taglen = ::mbswidth($untabify_tag);
        my $maxstrlen = $termcol - $taglen - 1;
        $untabify_str = mbtrunc($untabify_str,$maxstrlen);
        my $strlen = ::mbswidth($untabify_str);
        my $truncated_tag = "";
        my $truncated_str = "";
        if($termcol - $taglen < 2) {
            $truncated_tag = ">";
        } else {
            if($termcol - $taglen - $strlen <= 2) {
                $truncated_str = ">";
            }
        }
        $maxrow = ($row > $maxrow) ? $row : $maxrow;
        printf($out_fh
               ("%s%s%s%s". # up down \r eol
                "%s%s". # tag trunc_tag
                "%s%s%s%s". # color line trunc reset_color
                "%s" # down
               ),
               "$up"x($currow - $row), "\n"x($row - $currow), "\r", $eol,
               $untabify_tag,$truncated_tag,
               $color, $untabify_str, $truncated_str, $reset_color,
               "\n"x($maxrow - $row + 1));
        $currow = $maxrow + 1;
    }

    sub print_linebuffer($) {
        my $self = shift;
        my ($fdno,$in_fh,$out_fh) = @_;
        if(defined $self->{'exitstatus'}) {
            # If the job is dead: close printing fh. Needed for --compress
            close $self->fh($fdno,"w");
            if($opt::compress) {
                if($?) {
                    ::error($opt::compress_program." failed.");
                    $self->set_exitstatus(255);
                }
                # Blocked reading in final round
                for my $fdno (1,2) { ::set_fh_blocking($self->fh($fdno,'r')); }
            }
            if($opt::latestline) { $print_later{$self->row()} = $self; }
        }
        if(not $self->virgin()) {
            if($Global::files or ($opt::results and not $Global::csvsep)) {
                # Print filename
                if($fdno == 1 and not $self->fh($fdno,"printed")) {
                    print $out_fh $self->tag(),$self->fh($fdno,"name"),"\n";
                    if($Global::membuffer) {
                        push(@{$self->{'output'}{$fdno}}, $self->tag(),
                             $self->fh($fdno,"name"));
                    }
                    $self->set_fh($fdno,"printed",1);
                }
                # No need for reading $in_fh, as it is from "cat >/dev/null"
            } else {
                # Read halflines and print full lines
                my $outputlength = 0;
                my $halfline_ref = $self->{'halfline'}{$fdno};
                my ($buf,$i,$rv);
                # 1310720 gives 1.2 GB/s
                # 131072  gives 0.9 GB/s
                # The optimal block size differs
                # It has been measured on:
                # AMD 6376: 60800 (>70k is also reasonable)
                # Intel i7-3632QM: 52-59k, 170-175k
                # seq 64 | ppar --_test $1 --lb \
                #   'yes {} `seq 1000`|head -c 10000000' >/dev/null
                while($rv = sysread($in_fh, $buf, 60800)) {
                    $outputlength += $rv;
                    # TODO --recend
                    # Treat both \n and \r as line end
                    # Only test for \r if there is no \n
                    # Test:
                    #   perl -e '$a="x"x1000000;
                    #        $b="$a\r$a\n$a\r$a\n";
                    #        map { print $b,$_ } 1..10'
                    $i = ((rindex($buf,"\n")+1) || (rindex($buf,"\r")+1));
                    if($i) {
                        if($opt::latestline) {
                            # Keep the latest full line
                            my $l = join('', @$halfline_ref,
                                         substr($buf,0,$i-1));
                            # "ab\rb\n" = "bb", but we cannot process that correctly.
                            # Line may be:
                            #    foo \r bar \n
                            #    foo \r bar \r baz \r
                            # If so: Remove 'foo \r'
                            $l =~ s/.*\r//g;
                            my $j = ((rindex($l,"\n")+1) ||
                                     (rindex($l,"\r")+1));
                            $self->{$out_fh,'latestline'} = substr($l,$j);
                            # Remove the processed part
                            # by keeping the unprocessed part
                            @$halfline_ref = (substr($buf,$i));
                        } else {
                            # One or more complete lines were found
                            if($Global::color) {
                                my $print = join("",@$halfline_ref,
                                                 substr($buf,0,$i));
                                chomp($print);
                                my ($color,$reset_color) = $self->color();
                                my $colortag = $color.$self->tag();
                                # \n => reset \n color tag
                                $print =~ s{([\n\r])(?=.|$)}
                                {$reset_color$1$colortag}gs;
                                print($out_fh $colortag, $print,
                                      $reset_color, "\n");
                            } elsif($opt::tag or defined $opt::tagstring) {
                                # Replace ^ with $tag within the full line
                                if($Global::cache_replacement_eval) {
                                    # Replace with the same value for tag
                                    my $tag = $self->tag();
                                    unshift @$halfline_ref, $tag;
                                    # TODO --recend that can be partially in
                                    # @$halfline_ref
                                    substr($buf,0,$i-1) =~
                                        s/([\n\r])(?=.|$)/$1$tag/gs;
                                } else {
                                    # Replace with freshly computed tag-value
                                    unshift @$halfline_ref, $self->tag();
                                    substr($buf,0,$i-1) =~
                                        s/([\n\r])(?=.|$)/$1.$self->tag()/gse;
                                }
                                # The length changed,
                                # so find the new ending pos
                                $i = ::max((rindex($buf,"\n")+1),
                                           (rindex($buf,"\r")+1));
                                # Print the partial line (halfline)
                                # and the last half
                                print $out_fh @$halfline_ref, substr($buf,0,$i);
                            } else {
                                # Print the partial line (halfline)
                                # and the last half
                                print $out_fh @$halfline_ref, substr($buf,0,$i);
                            }
                            # Buffer in memory for SQL and CSV-output
                            if($Global::membuffer) {
                                push(@{$self->{'output'}{$fdno}},
                                     @$halfline_ref, substr($buf,0,$i));
                            }
                            # Remove the printed part by keeping the unprinted
                            @$halfline_ref = (substr($buf,$i));
                        }
                    } else {
                        # No newline, so append to the halfline
                        push @$halfline_ref, $buf;
                    }
                }
                $self->add_returnsize($outputlength);
                if($opt::latestline) { $self->print_latest_line($out_fh); }
            }
            if(defined $self->{'exitstatus'}) {
                if($Global::files or ($opt::results and not $Global::csvsep)) {
                    $self->add_returnsize(-s $self->fh($fdno,"name"));
                } else {
                    if($opt::latestline) {
                        # Force re-computing color if --colorfailed
                        if($opt::colorfailed) { delete $self->{'color'}; }
                        if($self->{$out_fh,'latestline'} ne "") {
                            $self->print_latest_line($out_fh);
                        }
                        if(@{$self->{'halfline'}{$fdno}}) {
                            my $l = join('', @{$self->{'halfline'}{$fdno}});
                            if($l ne "") {
                                $self->{$out_fh,'latestline'} = $l;
                            }
                        } else {
                            $self->{$out_fh,'latestline'} = undef;
                        }
                        # Print latest line from jobs that are already done
                        while($print_later{$minvisible}) {
                            $print_later{$minvisible}->print_latest_line($out_fh);
                            delete $print_later{$minvisible};
                            $minvisible++;
                        }
                        # Print latest line from jobs that are on screen now
                        for(my $row = $minvisible;
                            $row < $minvisible -1 + ::terminal_rows();
                            $row++) {
                            $print_later{$row} and
                                $print_later{$row}->print_latest_line($out_fh);
                        }
                    } else {
                        # If the job is dead: print the remaining partial line
                        # read remaining (already done for $opt::latestline)
                        my $halfline_ref = $self->{'halfline'}{$fdno};
                        if(grep /./, @$halfline_ref) {
                            my $returnsize = 0;
                            for(@{$self->{'halfline'}{$fdno}}) {
                                $returnsize += length $_;
                            }
                            $self->add_returnsize($returnsize);
                            if($opt::tag or defined $opt::tagstring) {
                                # Prepend $tag the the remaining half line
                                unshift @$halfline_ref, $self->tag();
                            }
                            # Print the partial line (halfline)
                            print $out_fh @{$self->{'halfline'}{$fdno}};
                            # Buffer in memory for SQL and CSV-output
                            if($Global::membuffer) {
                                push(@{$self->{'output'}{$fdno}}, @$halfline_ref);
                            }
                            @$halfline_ref = ();
                        }
                    }
                }
                if($self->fh($fdno,"rpid") and
                   CORE::kill 0, $self->fh($fdno,"rpid")) {
                    # decompress still running
                } else {
                    # decompress done: close fh
                    close $in_fh;
                    if($? and $opt::compress) {
                        ::error($opt::decompress_program." failed.");
                        $self->set_exitstatus(255);
                    }
                }
            }
        }
    }
}

sub free_ressources() {
    my $self = shift;
    if(not $opt::ungroup) {
        my $fh;
        for my $fdno (sort { $a <=> $b } keys %Global::fh) {
            $fh = $self->fh($fdno,"w");
            $fh and close $fh;
            $fh = $self->fh($fdno,"r");
            $fh and close $fh;
        }
    }
}

sub print_parset($) {
    # Wrap output with shell script code to set as variables
    my $self = shift;
    my ($fdno,$in_fh,$out_fh) = @_;
    my $outputlength = 0;

    ::debug("parset","print $Global::parset");
    if($Global::parset eq "assoc") {
        # Start: (done in parse_parset())
        #   eval "`echo 'declare -A myassoc; myassoc=(
        # Each: (done here)
        #   [$'a\tb']=$'a\tb\tc  ddd'
        # End: (done in wait_and_exit())
        #   )'`"
        print '[',::Q($self->{'commandline'}->
                      replace_placeholders(["\257<\257>"],0,0)),']=';
    } elsif($Global::parset eq "array") {
        # Start: (done in parse_parset())
        #   eval "`echo 'myassoc=(
        # Each: (done here)
        #   $'a\tb\tc  ddd'
        # End: (done in wait_and_exit())
        #   )'`"
    } elsif($Global::parset eq "var") {
        # Start: (done in parse_parset())
        #   <empty>
        # Each: (done here)
        #   var=$'a\tb\tc  ddd'
        # End: (done in wait_and_exit())
        #   <empty>
        if(not @Global::parset_vars) {
            ::error("Too few named destination variables");
            ::wait_and_exit(255);
        }
        print shift @Global::parset_vars,"=";
    }
    local $/ = "\n";
    my $tag = $self->tag();
    my @out;
    while(<$in_fh>) {
        $outputlength += length $_;
        # Tag lines with \r, too
        $_ =~ s/(?<=[\r])(?=.|$)/$tag/gs;
        push @out, $tag,$_;
    }
    # Remove last newline
    # This often makes it easier to use the output in shell
    @out and ${out[$#out]} =~ s/\n$//s;
    print ::Q(join("",@out)),"\n";
    return $outputlength;
}

sub print_normal($) {
    my $self = shift;
    my ($fdno,$in_fh,$out_fh) = @_;
    my $buf;
    close $self->fh($fdno,"w");
    if($? and $opt::compress) {
        ::error($opt::compress_program." failed.");
        $self->set_exitstatus(255);
    }
    if(not $self->virgin()) {
        seek $in_fh, 0, 0;
        # $in_fh is now ready for reading at position 0
        my $outputlength = 0;
        my @output;

        if($Global::parset and $fdno == 1) {
            $outputlength += $self->print_parset($fdno,$in_fh,$out_fh);
        } elsif(defined $opt::tag or defined $opt::tagstring
                or $Global::color or $opt::colorfailed) {
            if($Global::color or $opt::colorfailed) {
                my ($color,$reset_color) = $self->color();
                my $colortag = $color.$self->tag();
                # Read line by line
                local $/ = "\n";
                while(<$in_fh>) {
                    $outputlength += length $_;
                    # Tag lines with \r, too
                    chomp;
                    s{([\n\r])(?=.|$)}{$reset_color$1$colortag}gs;
                    print $out_fh $colortag,$_,$reset_color,"\n";
                }
            } else {
                my $tag = $self->tag();
                my $pretag = 1;
                my $s;
                while(sysread($in_fh,$buf,32767)) {
                    $outputlength += length $buf;
                    $buf =~ s/(?<=[\r\n])(?=.)/$tag/gs;
                    print $out_fh ($pretag ? $tag : ""),$buf;
                    if($Global::membuffer) {
                        push @{$self->{'output'}{$fdno}},
                            ($pretag ? $tag : ""),$buf;
                    }
                    # Should next print start with a tag?
                    $s = substr($buf, -1);
                    # This is faster than ($s eq "\n") || ($s eq "\r")
                    $pretag = ($s eq "\n") ? 1 : ($s eq "\r");
                }
            }
        } else {
            # Most efficient way of copying data from $in_fh to $out_fh
            # Intel i7-3632QM: 25k-
            while(sysread($in_fh,$buf,32767)) {
                print $out_fh $buf;
                $outputlength += length $buf;
                if($Global::membuffer) {
                    push @{$self->{'output'}{$fdno}}, $buf;
                }
            }
        }
        if($fdno == 1) {
            $self->add_returnsize($outputlength);
        }
        close $in_fh;
        if($? and $opt::compress) {
            ::error($opt::decompress_program." failed.");
            $self->set_exitstatus(255);
        }
    }
}

sub print_results($) {
    my $self = shift;
    my ($fdno,$in_fh,$out_fh) = @_;
    my $buf;
    close $self->fh($fdno,"w");
    if($? and $opt::compress) {
        ::error($opt::compress_program." failed.");
        $self->set_exitstatus(255);
    }
    if(not $self->virgin()) {
        seek $in_fh, 0, 0;
        # $in_fh is now ready for reading at position 0
        my $outputlength = 0;
        my @output;

        if($Global::membuffer) {
            # Read data into membuffer
            if($opt::tag or $opt::tagstring) {
                # Read line by line
                local $/ = "\n";
                my $tag = $self->tag();
                while(<$in_fh>) {
                    $outputlength += length $_;
                    # Tag lines with \r, too
                    $_ =~ s/(?<=[\r])(?=.|$)/$tag/gs;
                    push @{$self->{'output'}{$fdno}}, $tag, $_;
                }
            } else {
                # Most efficient way of copying data from $in_fh to $out_fh
                while(sysread($in_fh,$buf,60000)) {
                    $outputlength += length $buf;
                    push @{$self->{'output'}{$fdno}}, $buf;
                }
            }
        } else {
            # Not membuffer: No need to read the file
            if($opt::compress) {
                $outputlength = -1;
            } else {
                # Determine $outputlength = file length
                seek($in_fh, 0, 2) || ::die_bug("cannot seek result");
                $outputlength = tell($in_fh);
            }
        }
        if($fdno == 1) { $self->add_returnsize($outputlength); }
        close $in_fh;
        if($? and $opt::compress) {
            ::error($opt::decompress_program." failed.");
            $self->set_exitstatus(255);
        }
    }
}

sub print_joblog($) {
    my $self = shift;
    my $cmd;
    if($Global::verbose <= 1) {
        $cmd = $self->replaced();
    } else {
        # Verbose level > 1: Print the rsync and stuff
        $cmd = $self->wrapped();
    }
    # Newlines make it hard to parse the joblog
    $cmd =~ s/\n/\0/g;
    print $Global::joblog
        join("\t", $self->seq(), $self->sshlogin()->string(),
             $self->starttime(), sprintf("%10.3f",$self->runtime()),
             $self->transfersize(), $self->returnsize(),
             $self->exitstatus(), $self->exitsignal(), $cmd
        ). "\n";
    flush $Global::joblog;
    $self->set_job_in_joblog();
}

sub tag($) {
    my $self = shift;
    if(not defined $self->{'tag'} or not $Global::cache_replacement_eval) {
        if(defined $opt::tag or defined $opt::tagstring) {
            $self->{'tag'} =
                ($self->{'commandline'}->
                 replace_placeholders([$opt::tagstring],0,0)).
                "\t";
        } else {
            # No tag
            $self->{'tag'} = "";
        }
    }
    return $self->{'tag'};
}

sub untabtag($) {
    # tag with \t replaced with spaces
    my $self = shift;
    my $tag = $self->tag();
    if(not defined $self->{'untab'}{$tag}) {
        $self->{'untab'}{$tag} = ::untabify($tag);
    }
    return $self->{'untab'}{$tag};
}

{
    my (@color,$eol,$reset_color,$init);

    sub init_color() {
        if(not $init) {
            $init = 1;
            # color combinations that are readable: black/white text
            # on colored background, but not white on yellow
            my @color_combinations =
                # Force each color code to have the same length in chars
                # This will make \t work as expected
                ((map { [sprintf("%03d",$_),"000"] }
                  6..7,9..11,13..15,40..51,75..87,113..123,147..159,
                  171..182,185..231,249..254),
                 (map { [sprintf("%03d",$_),231] }
                  1..9,12..13,16..45,52..81,88..114,124..149,
                  160..178,180,182..184,196..214,232..250));
            # reorder list so adjacent colors are dissimilar
            # %23 and %7 were found experimentally
            my @order = reverse sort {
                    (($a%23) <=> ($b%23))
                        or
                        (($b%7) <=> ($a%7));
            } 0..$#color_combinations;
            @order = @order[54 .. $#color_combinations, 0 .. 53];
            @color = map {
                # TODO Can this be done with `tput` codes?
                "\033[48;5;".$_->[0].";38;5;".$_->[1]."m"
            } @color_combinations[ @order ];

            # clr_eol el = clear to end of line
            $eol = `sh -c "tput el </dev/tty" 2>/dev/null`;
            chomp($eol);
            if($eol eq "") { $eol = "\033[K"; }
            # exit_attribute_mode sgr0 = turn off all attributes
            $reset_color = `sh -c "tput sgr0 </dev/tty" 2>/dev/null`;
            chomp($reset_color);
            if($reset_color eq "") { $reset_color = "\033[m"; }
        }
    }

    sub color($) {
        my $self = shift;
        if(not defined $self->{'color'}) {
            if($Global::color) {
                # Choose a value based on the seq
                $self->{'color'} = $color[$self->seq() % ($#color+1)].$eol;
                $self->{'reset_color'} = $reset_color;
            } else {
                $self->{'color'} = "";
                $self->{'reset_color'} = "";
            }
            if($opt::colorfailed) {
                if($self->exitstatus()) {
                    # White on Red
                    # Can this be done more generally?
                    $self->{'color'} =
                        "\033[48;5;"."196".";38;5;"."231"."m".$eol;
                    $self->{'reset_color'} = $reset_color;
                }
            }
        }
        return ($self->{'color'},$self->{'reset_color'});
    }
}

sub hostgroups($) {
    my $self = shift;
    if(not defined $self->{'hostgroups'}) {
        $self->{'hostgroups'} =
            $self->{'commandline'}->{'arg_list'}[0][0]->{'hostgroups'};
    }
    return @{$self->{'hostgroups'}};
}

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

sub set_exitstatus($$) {
    my $self = shift;
    my $exitstatus = shift;
    if($exitstatus) {
        # Overwrite status if non-zero
        $self->{'exitstatus'} = $exitstatus;
    } else {
        # Set status but do not overwrite
        # Status may have been set by --timeout
        $self->{'exitstatus'} ||= $exitstatus;
    }
    $opt::sqlworker and
        $Global::sql->update("SET Exitval = ? WHERE Seq = ".$self->seq(),
                             $exitstatus);
}

sub reset_exitstatus($) {
    my $self = shift;
    undef $self->{'exitstatus'};
}

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

sub set_exitsignal($$) {
    my $self = shift;
    my $exitsignal = shift;
    $self->{'exitsignal'} = $exitsignal;
    $opt::sqlworker and
        $Global::sql->update("SET _Signal = ? WHERE Seq = ".$self->seq(),
                             $exitsignal);
}

{
    my $total_jobs;

    sub should_we_halt {
        # Should we halt? Immediately? Gracefully?
        # Returns: N/A
        my $job = shift;
        my $limit;
        if($Global::semaphore) {
            # Emulate Bash's +128 if there is a signal
            $Global::halt_exitstatus =
                ($job->exitstatus()
                 or
                 $job->exitsignal() ? $job->exitsignal() + 128 : 0);
        }
        if($job->exitstatus() or $job->exitsignal()) {
            # Job failed
            $Global::exitstatus++;
            $Global::total_failed++;
            if($Global::halt_fail) {
                ::status("$Global::progname: This job failed:",
                         $job->replaced());
                $limit = $Global::total_failed;
            }
        } elsif($Global::halt_success) {
            ::status("$Global::progname: This job succeeded:",
                     $job->replaced());
            $limit = $Global::total_completed - $Global::total_failed;
        }
        if($Global::halt_done) {
            ::status("$Global::progname: This job finished:",
                     $job->replaced());
            $limit = $Global::total_completed;
        }
        if(not defined $limit) {
            return ""
        }
        #  --halt # => 1..100 (number of jobs failed, 101 means > 100)
        #  --halt % => 1..100 (pct of jobs failed)
        if($Global::halt_pct and not $Global::halt_count) {
            $total_jobs ||= $Global::JobQueue->total_jobs();
            # From the pct compute the number of jobs that must fail/succeed
            $Global::halt_count = $total_jobs * $Global::halt_pct;
        }
        if($limit >= $Global::halt_count) {
            # At least N jobs have failed/succeded/completed
            # or at least N% have failed/succeded/completed
            # So we should prepare for exit
            if($Global::halt_fail or $Global::halt_done) {
                # Set exit status
                if(not defined $Global::halt_exitstatus) {
                    if($Global::halt_pct) {
                        # --halt now,fail=X% or soon,fail=X%
                        # --halt now,done=X% or soon,done=X%
                        $Global::halt_exitstatus =
                            ::ceil($Global::total_failed / $total_jobs * 100);
                    } elsif($Global::halt_count) {
                        # --halt now,fail=X or soon,fail=X
                        # --halt now,done=X or soon,done=X
                        $Global::halt_exitstatus =
                            ::min($Global::total_failed,101);
                    }
                    if($Global::halt_count and $Global::halt_count == 1) {
                        # --halt now,fail=1 or soon,fail=1
                        # --halt now,done=1 or soon,done=1
                        # Emulate Bash's +128 if there is a signal
                        $Global::halt_exitstatus =
                            ($job->exitstatus()
                             or
                             $job->exitsignal() ? $job->exitsignal() + 128 : 0);
                    }
                }
                ::debug("halt","Pct: ",$Global::halt_pct,
                        " count: ",$Global::halt_count,
                        " status: ",$Global::halt_exitstatus,"\n");
            } elsif($Global::halt_success) {
                $Global::halt_exitstatus = 0;
            }
            if($Global::halt_when eq "soon") {
                $Global::start_no_new_jobs ||= 1;
                if(scalar(keys %Global::running) > 0) {
                    # Only warn if there are more jobs running
                    ::status
                        ("$Global::progname: Starting no more jobs. ".
                         "Waiting for ". (keys %Global::running).
                         " jobs to finish.");
                }
            }
            return($Global::halt_when);
        }
        return "";
    }
}


package CommandLine;

sub new($) {
    my $class = shift;
    my $seq = shift;
    my $commandref = shift;
    $commandref || die;
    my $arg_queue = shift;
    my $context_replace = shift;
    my $max_number_of_args = shift; # for -N and normal (-n1)
    my $transfer_files = shift;
    my $return_files = shift;
    my $template_names = shift;
    my $template_contents = shift;
    my $replacecount_ref = shift;
    my $len_ref = shift;
    my %replacecount = %$replacecount_ref;
    my %len = %$len_ref;
    for (keys %$replacecount_ref) {
        # Total length of this replacement string {} replaced with all args
        $len{$_} = 0;
    }
    return bless {
        'command' => $commandref,
        'seq' => $seq,
        'len' => \%len,
        'arg_list' => [],
        'arg_list_flat' => [],
        'arg_list_flat_orig' => [undef],
        'arg_queue' => $arg_queue,
        'max_number_of_args' => $max_number_of_args,
        'replacecount' => \%replacecount,
        'context_replace' => $context_replace,
        'transfer_files' => $transfer_files,
        'return_files' => $return_files,
        'template_names' => $template_names,
        'template_contents' => $template_contents,
        'replaced' => undef,
    }, ref($class) || $class;
}

sub flush_cache() {
    my $self = shift;
    for my $arglist (@{$self->{'arg_list'}}) {
        for my $arg (@$arglist) {
            $arg->flush_cache();
        }
    }
    $self->{'arg_queue'}->flush_cache();
    $self->{'replaced'} = undef;
}

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

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

sub slot($) {
    # Find the number of a free job slot and return it
    # Uses:
    #   @Global::slots - list with free jobslots
    # Returns:
    #   $jobslot = number of jobslot
    my $self = shift;
    if(not $self->{'slot'}) {
        if(not @Global::slots) {
            # $max_slot_number will typically be $Global::max_jobs_running
            push @Global::slots, ++$Global::max_slot_number;
        }
        $self->{'slot'} = shift @Global::slots;
    }
    return $self->{'slot'};
}

{
    my $already_spread;
    my $darwin_max_len;

    sub populate($) {
        # Add arguments from arg_queue until the number of arguments or
        # max line length is reached
        # Uses:
        #   $Global::usable_command_line_length
        #   $opt::cat
        #   $opt::fifo
        #   $Global::JobQueue
        #   $opt::m
        #   $opt::X
        #   $Global::max_jobs_running
        # Returns: N/A
        my $self = shift;
        my $next_arg;
        my $max_len = $Global::usable_command_line_length || die;
        if($^O eq "darwin") {
            # Darwin's limit is affected by:
            # * number of environment names (variables+functions)
            # * size of environment
            # * the length of arguments:
            #   a one-char argument lowers the limit by 5
            #   To be safe assume all arguments are one-char
            # The max_len is cached between runs, but if the size of
            # the environment is different we need to recompute the
            # usable max length for this run of GNU Parallel
            # See https://unix.stackexchange.com/a/604943/2972
            if(not $darwin_max_len) {
                my $envc = (keys %ENV);
                my $envn = length join"",(keys %ENV);
                my $envv = length join"",(values %ENV);
                $darwin_max_len = -146+($max_len - $envn - $envv) - $envc*10;
                ::debug("init",
                        "length: $darwin_max_len ".
                        "3+($max_len - $envn - $envv)/5 - $envc*2");
            }
            $max_len = $darwin_max_len;
        }
        if($opt::cat or $opt::fifo) {
            # Get the empty arg added by --pipepart (if any)
            $Global::JobQueue->{'commandlinequeue'}->{'arg_queue'}->get();
            # $PARALLEL_TMP will point to a tempfile that will be used as {}
            $Global::JobQueue->{'commandlinequeue'}->{'arg_queue'}->
                unget([Arg->new('"$PARALLEL_TMP"')]);
        }
        while (not $self->{'arg_queue'}->empty()) {
            $next_arg = $self->{'arg_queue'}->get();
            if(not defined $next_arg) {
                next;
            }
            $self->push($next_arg);
            if($self->len() >= $max_len) {
                # Command length is now > max_length
                # If there are arguments: remove the last
                # If there are no arguments: Error
                # 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);
                    ::error("Command line too long (".
                            $self->len(). " >= ".
                            $max_len.
                            ") at input ".
                            $self->{'arg_queue'}->arg_number().
                            ": ".
                            ((length $args > 50) ?
                             (substr($args,0,50))."..." :
                             $args));
                    $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(($opt::m or $opt::X) and not $already_spread
           and $self->{'arg_queue'}->empty() and $Global::max_jobs_running) {
            # -m or -X and EOF => Spread the arguments over all jobslots
            # (unless they are already spread)
            $already_spread ||= 1;
            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());
                }
            }
            $Global::JobQueue->flush_total_jobs();
        }

        if($opt::sqlmaster) {
            # Insert the V1..Vn for this $seq in SQL table
            # instead of generating one
            $Global::sql->insert_records($self->seq(), $self->{'command'},
                                         $self->{'arg_list_flat_orig'});
        }
    }
}

sub push($) {
    # Add one or more records as arguments
    # Returns: N/A
    my $self = shift;
    my $record = shift;
    push @{$self->{'arg_list_flat_orig'}}, map { $_->orig() } @$record;
    push @{$self->{'arg_list_flat'}}, @$record;
    push @{$self->{'arg_list'}}, $record;
    # Make @arg available for {= =}
    *Arg::arg = $self->{'arg_list_flat_orig'};

    my $quote_arg = ($Global::quote_replace and not $Global::quoting);
    my $col;
    for my $perlexpr (keys %{$self->{'replacecount'}}) {
        if($perlexpr =~ /^(-?\d+)(?:\D.*|)$/) {
            # Positional replacement string
            # Deal with negative positional replacement string
            $col = ($1 < 0) ? $1 : $1-1;
            if(defined($record->[$col])) {
                $self->{'len'}{$perlexpr} +=
                    length $record->[$col]->replace($perlexpr,$quote_arg,$self);
            }
        } else {
            for my $arg (@$record) {
                if(defined $arg) {
                    $self->{'len'}{$perlexpr} +=
                        length $arg->replace($perlexpr,$quote_arg,$self);
                }
            }
        }
    }
}

sub pop($) {
    # Remove last argument
    # Returns:
    #   the last record
    my $self = shift;
    my $record = pop @{$self->{'arg_list'}};
    # pop off arguments from @$record
    splice @{$self->{'arg_list_flat_orig'}}, -($#$record+1), $#$record+1;
    splice @{$self->{'arg_list_flat'}}, -($#$record+1), $#$record+1;
    my $quote_arg = ($Global::quote_replace and not $Global::quoting);
    for my $perlexpr (keys %{$self->{'replacecount'}}) {
        if($perlexpr =~ /^(\d+) /) {
            # Positional
            defined($record->[$1-1]) or next;
            $self->{'len'}{$perlexpr} -=
                length $record->[$1-1]->replace($perlexpr,$quote_arg,$self);
        } else {
            for my $arg (@$record) {
                if(defined $arg) {
                    $self->{'len'}{$perlexpr} -=
                        length $arg->replace($perlexpr,$quote_arg,$self);
                }
            }
        }
    }
    return $record;
}

sub pop_all($) {
    # Remove all arguments and zeros the length of replacement perlexpr
    # Returns:
    #   all records
    my $self = shift;
    my @popped = @{$self->{'arg_list'}};
    for my $perlexpr (keys %{$self->{'replacecount'}}) {
        $self->{'len'}{$perlexpr} = 0;
    }
    $self->{'arg_list'} = [];
    $self->{'arg_list_flat_orig'} = [undef];
    $self->{'arg_list_flat'} = [];
    return @popped;
}

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

sub number_of_recargs($) {
    # The number of args in records
    # Returns:
    #   number of args records
    my $self = shift;
    my $sum = 0;
    my $nrec = scalar @{$self->{'arg_list'}};
    if($nrec) {
        $sum = $nrec * (scalar @{$self->{'arg_list'}[0]});
    }
    return $sum;
}

sub args_as_string($) {
    # Returns:
    #  all unmodified arguments joined with ' ' (similar to {})
    my $self = shift;
    return (join " ", map { $_->orig() }
            map { @$_ } @{$self->{'arg_list'}});
}

sub results_out($) {
    sub max_file_name_length {
        # Figure out the max length of a subdir
        # TODO and the max total length
        # Ext4 = 255,130816
        # Uses:
        #   $Global::max_file_length is set
        # Returns:
        #   $Global::max_file_length
        my $testdir = shift;

        my $upper = 100_000_000;
        # Dir length of 8 chars is supported everywhere
        my $len = 8;
        my $dir = "d"x$len;
        do {
            rmdir($testdir."/".$dir);
            $len *= 16;
            $dir = "d"x$len;
        } while ($len < $upper and mkdir $testdir."/".$dir);
        # Then search for the actual max length between $len/16 and $len
        my $min = $len/16;
        my $max = $len;
        while($max-$min > 5) {
            # If we are within 5 chars of the exact value:
            # it is not worth the extra time to find the exact value
            my $test = int(($min+$max)/2);
            $dir = "d"x$test;
            if(mkdir $testdir."/".$dir) {
                rmdir($testdir."/".$dir);
                $min = $test;
            } else {
                $max = $test;
            }
        }
        $Global::max_file_length = $min;
        return $min;
    }

    my $self = shift;
    my $out = $self->replace_placeholders([$opt::results],0,0);
    if($out eq $opt::results) {
        # $opt::results simple string: Append args_as_dirname
        my $args_as_dirname = $self->args_as_dirname(0);
        # Output in: prefix/name1/val1/name2/val2/stdout
        $out = $opt::results."/".$args_as_dirname;
        if(-d $out or eval{ File::Path::mkpath($out); }) {
            # OK
        } else {
            # mkpath failed: Argument too long or not quoted
            # Set $Global::max_file_length, which will keep the individual
            # dir names shorter than the max length
            max_file_name_length($opt::results);
            # Quote dirnames with +
            $args_as_dirname = $self->args_as_dirname(1);
            # prefix/name1/val1/name2/val2/
            $out = $opt::results."/".$args_as_dirname;
            File::Path::mkpath($out);
        }
        $out .="/";
    } else {
        if($out =~ m:/$:s) {
            # / = dir
            if(-d $out or eval{ File::Path::mkpath($out); }) {
                # OK
            } else {
                ::error("Cannot make dir '$out'.");
                ::wait_and_exit(255);
            }
        } else {
            $out =~ m:(.*)/:s;
            File::Path::mkpath($1);
        }
    }
    return $out;
}

{
    my %map;
    my %stringmap;
    my $sep;

    # test: '' . .. a. a.. + ++ 0..255 on fat12 ext4
    sub args_as_dirname($) {
        # Returns:
        #  all arguments joined with '/' (similar to {})
        #  Chars that are not safe on all file systems are quoted.
        sub init() {
            # ext4: / \t \n \0 \\ \r
            # fat: 0..31 " * / : < > ? \ | Maybe also: # [ ] ; = ,
            # exfat: 128..255
            # Other FS: , [ ] { } ( ) ! ; " ' * ? < > |
            #
            # Quote these as:
            #   +  = ++
            #   \0 = +0
            #   \t = +t
            #   \\ = +b (backslash)
            #   \n = +n
            #   \r = +r
            #   / = +z (zlash)
            #   ? = +y (whY?)
            #   " = +d (double quote)
            #   ' = +q (quote)
            #   * = +a (asterisk)
            #   < = +l (less than)
            #   > = +g (greater than)
            #   : = +k (kolon)
            #   ! = +x (eXclamation)
            #   | = +p (pipe)
            #   # = +h (hash)
            #   ; = +s (semicolon)
            #   = = +e (equal)
            #   , = +c (comma)
            #   1..32 128..255 = +XX (hex value)
            #   [ ] = +e +f
            #   ( ) = +i +j
            #   { } = +v +w
            # Quote '' as +m (eMpty)
            # Quote .  as +_
            # Quote .. as +__
            #   (Unused: ou)
            %map = qw(
                +   ++
                \0  +0
                \t  +t
                \\  +b
                \n  +n
                \r  +r
                /   +z
                ?   +y
                "   +d
                '   +q
                *   +a
                <   +l
                >   +g
                :   +k
                !   +x
                |   +p
                #   +h
                ;   +s
                =   +e
                ,   +c
                [   +e
                (   +i
                {   +v
                ]   +f
                )   +j
                }   +w
                );
            # 1..32 128..255 = +XX (hex value)
            map { $map{sprintf "%c",$_} = sprintf "+%02x",$_ } 1..32, 128..255;
            # Default value = itself
            map { $map{sprintf "%c",$_} ||= sprintf "%c",$_ } 0..255;
            # Quote '' as +m (eMpty)
            $stringmap{""} = "+m";
            # Quote .  as +_
            $stringmap{"."} = "+_";
            # Quote .. as +__
            $stringmap{".."} = "+__";
            # Set dir separator
            eval 'use File::Spec; $sep = File::Spec->catfile("", "");';
            $sep ||= '/';
        }
        # If $Global::max_file_length: Keep subdirs < $Global::max_file_length
        my $self = shift;
        my $quote = shift;
        my @res = ();
        if(not $sep) { init(); }

        for my $rec_ref (@{$self->{'arg_list'}}) {
            # If headers are used, sort by them.
            # Otherwise keep the order from the command line.
            my @header_indexes_sorted = header_indexes_sorted($#$rec_ref+1);
            for my $n (@header_indexes_sorted) {
                CORE::push(@res,
                           $Global::input_source_header{$n},
                           $quote ?
                           (
                            grep { $_ ne "\0noarg" } map {
                                my $s = $_;
                                # Quote + as ++
                                $s =~ s/(.)/$map{$1}/gs;
                                if($Global::max_file_length) {
                                    # Keep each subdir shorter than the longest
                                    # allowed file name
                                    $s = substr($s,0,$Global::max_file_length);
                                }
                                $s; }
                            $rec_ref->[$n-1]->orig()
                           ) :
                           (
                            grep { $_ ne "\0noarg" } map {
                                my $s = $_;
                                # Quote / as +z and + as ++
                                $s =~ s/($sep|\+)/$map{$1}/gos;
                                if($Global::max_file_length) {
                                    # Keep each subdir shorter than the longest
                                    # allowed file name
                                    $s = substr($s,0,$Global::max_file_length);
                                }
                                $s; }
                            $rec_ref->[$n-1]->orig()
                           )
                    );
            }
        }
        return join $sep, map { $stringmap{$_} || $_ } @res;
    }
}

sub header_indexes_sorted($) {
    # Sort headers first by number then by name.
    # E.g.: 1a 1b 11a 11b
    # Returns:
    #  Indexes of %Global::input_source_header sorted
    my $max_col = shift;

    no warnings 'numeric';
    for my $col (1 .. $max_col) {
        # Make sure the header is defined. If it is not: use column number
        if(not defined $Global::input_source_header{$col}) {
            $Global::input_source_header{$col} = $col;
        }
    }
    my @header_indexes_sorted = sort {
        # Sort headers numerically then asciibetically
        $Global::input_source_header{$a} <=> $Global::input_source_header{$b}
        or
            $Global::input_source_header{$a} cmp $Global::input_source_header{$b}
    } 1 .. $max_col;
    return @header_indexes_sorted;
}

sub len($) {
    # Uses:
    #   @opt::shellquote
    # The length of the command line with args substituted
    my $self = shift;
    my $len = 0;
    # Add length of the original command with no args
    # Length of command w/ all replacement args removed
    $len += $self->{'len'}{'noncontext'} + @{$self->{'command'}} -1;
    ::debug("length", "noncontext + command: $len\n");
    # MacOS has an overhead of 8 bytes per argument
    my $darwin = ($^O eq "darwin") ? 8 : 0;
    my $recargs = $self->number_of_recargs();
    if($self->{'context_replace'}) {
        # Context is duplicated for each arg
        $len += $recargs * $self->{'len'}{'context'};
        for my $replstring (keys %{$self->{'replacecount'}}) {
            # If the replacements string is more than once: mulitply its length
            $len += $self->{'len'}{$replstring} *
                $self->{'replacecount'}{$replstring};
            ::debug("length", $replstring, " ", $self->{'len'}{$replstring}, "*",
                    $self->{'replacecount'}{$replstring}, "\n");
        }
        # echo 11 22 33 44 55 66 77 88 99 1010
        # echo 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10
        # 5 +  ctxgrp*arg
        ::debug("length", "Ctxgrp: ", $self->{'len'}{'contextgroups'},
                " Groups: ", $self->{'len'}{'noncontextgroups'}, "\n");
        # Add space between context groups
        $len += ($recargs-1) * ($self->{'len'}{'contextgroups'});
        if($darwin) {
            $len += $recargs * $self->{'len'}{'contextgroups'} * $darwin;
        }
    } else {
        # Each replacement string may occur several times
        # Add the length for each time
        $len += 1*$self->{'len'}{'context'};
        ::debug("length", "context+noncontext + command: $len\n");
        for my $replstring (keys %{$self->{'replacecount'}}) {
            # (space between recargs + length of replacement)
            # * number this replacement is used
            $len += ($recargs -1 + $self->{'len'}{$replstring}) *
                $self->{'replacecount'}{$replstring};
            if($darwin) {
                $len += ($recargs * $self->{'replacecount'}{$replstring}
                         * $darwin);
            }
        }
    }
    if(defined $Global::parallel_env) {
        # If we are using --env, add the prefix for that, too.
        $len += length $Global::parallel_env;
    }
    if($Global::quoting) {
        # Pessimistic length if -q is set
        # Worse than worst case: ' => "'" + " => '"'
        # TODO can we count the number of expanding chars?
        #   and count them in arguments, too?
        $len *= 3;
    }
    if(@opt::shellquote) {
        # Pessimistic length if --shellquote is set
        # Worse than worst case: ' => "'"
        for(@opt::shellquote) {
            $len *= 3;
        }
        $len *= 5;
    }
    if(@opt::sshlogin) {
        # Pessimistic length if remote
        # Worst case is BASE64 encoding 3 bytes -> 4 bytes
        $len = int($len*4/3);
    }
    return $len;
}

sub replaced($) {
    # Uses:
    #   $Global::quote_replace
    #   $Global::quoting
    # Returns:
    #   $replaced = command with place holders replaced and prepended
    my $self = shift;
    if(not defined $self->{'replaced'}) {
        # Don't quote arguments if the input is the full command line
        my $quote_arg = ($Global::quote_replace and not $Global::quoting);
        # or if ($opt::cat or $opt::pipe) as they use $PARALLEL_TMP
        $quote_arg = ($opt::cat || $opt::fifo) ? 0 : $quote_arg;
        $self->{'replaced'} = $self->
            replace_placeholders($self->{'command'},$Global::quoting,
                                 $quote_arg);
        my $len = length $self->{'replaced'};
        if ($len != $self->len()) {
            ::debug("length", $len, " != ", $self->len(),
                    " ", $self->{'replaced'}, "\n");
        } else {
            ::debug("length", $len, " == ", $self->len(),
                    " ", $self->{'replaced'}, "\n");
        }
    }
    return $self->{'replaced'};
}

sub replace_placeholders($$$$) {
    # Replace foo{}bar with fooargbar
    # Input:
    #   $targetref = command as shell words
    #   $quote = should everything be quoted?
    #   $quote_arg = should replaced arguments be quoted?
    # Uses:
    #   @Arg::arg = arguments as strings to be use in {= =}
    # Returns:
    #   @target with placeholders replaced
    my $self = shift;
    my $targetref = shift;
    my $quote = shift;
    my $quote_arg = shift;
    my %replace;

    # Token description:
    #   \0spc = unquoted space
    #   \0end = last token element
    #   \0ign = dummy token to be ignored
    #   \257<...\257> = replacement expression
    #   " " = quoted space, that splits -X group
    #   text = normal text - possibly part of -X group
    my $spacer = 0;
    my @tokens = grep { length $_ > 0 } map {
        if(/^\257<|^ $/) {
            # \257<...\257> or space
            $_
        } else {
            # Split each space/tab into a token
            split /(?=\s)|(?<=\s)/
        }
    }
    # Split \257< ... \257> into own token
    map { split /(?=\257<)|(?<=\257>)/ }
    # Insert "\0spc" between every element
    # This space should never be quoted
    map { $spacer++ ? ("\0spc",$_) : $_ }
    map { $_ eq "" ? "\0empty" : $_ }
    @$targetref;

    if(not @tokens) {
        # @tokens is empty: Return empty array
        return @tokens;
    }
    ::debug("replace", "Tokens ".join":",@tokens,"\n");
    # Make it possible to use $arg[2] in {= =}
    *Arg::arg = $self->{'arg_list_flat_orig'};
    # Flat list:
    # $self->{'arg_list'} = [ [Arg11, Arg12], [Arg21, Arg22], [Arg31, Arg32] ]
    # $self->{'arg_list_flat'} = [ Arg11, Arg12, Arg21, Arg22, Arg31, Arg32 ]
    if(not @{$self->{'arg_list_flat'}}) {
        @{$self->{'arg_list_flat'}} = Arg->new("");
    }
    my $argref = $self->{'arg_list_flat'};
    # Number of arguments - used for positional arguments
    my $n = $#$argref+1;

    # $self is actually a CommandLine-object,
    # but it looks nice to be able to say {= $job->slot() =}
    my $job = $self;
    # @replaced = tokens with \257< \257> replaced
    my @replaced;
    if($self->{'context_replace'}) {
        my @ctxgroup;
        for my $t (@tokens,"\0end") {
            # \0end = last token was end of tokens.
            if($t eq "\t" or $t eq " " or $t eq "\0end" or $t eq "\0spc") {
                # Context group complete: Replace in it
                if(grep { /^\257</ } @ctxgroup) {
                    # Context group contains a replacement string:
                    # Copy once per arg
                    my $space = "\0ign";
                    for my $arg (@$argref) {
                        my $normal_replace;
                        # Push output
                        # Put unquoted space before each context group
                        # except the first
                        CORE::push @replaced, $space, map {
                            $a = $_;
                            if($a =~
                                s{\257<(-?\d+)?(.*)\257>}
                            {
                                if($1) {
                                    # Positional replace
                                    # Find the relevant arg and replace it
                                    ($argref->[$1 > 0 ? $1-1 : $n+$1] ? # If defined: replace
                                     $argref->[$1 > 0 ? $1-1 : $n+$1]->
                                     replace($2,$quote_arg,$self)
                                     : "");
                                } else {
                                    # Normal replace
                                    $normal_replace ||= 1;
                                    ($arg ? $arg->replace($2,$quote_arg,$self) : "");
                                }
                            }sgxe) {
                                # Token is \257<..\257>
                            } else {
                                if($Global::escape_string_present) {
                                    # Command line contains \257:
                                    # Unescape it \257\256 => \257
                                    $a =~ s/\257\256/\257/g;
                                }
                            }
                            $a
                        } @ctxgroup;
                        $normal_replace or last;
                        $space = "\0spc";
                    }
                } else {
                    # Context group has no a replacement string: Copy it once
                    CORE::push @replaced, map {
                        $Global::escape_string_present and s/\257\256/\257/g; $_;
                    } @ctxgroup;
                }
                # New context group
                @ctxgroup=();
            }
            if($t eq "\0spc" or $t eq " ") {
                CORE::push @replaced,$t;
            } else {
                CORE::push @ctxgroup,$t;
            }
        }
    } else {
        # @group = @token
        # Replace in group
        # Push output
        # repquote = no if {} first on line, no if $quote, yes otherwise
        for my $t (@tokens) {
            if($t =~ /^\257</) {
                my $space = "\0ign";
                for my $arg (@$argref) {
                    my $normal_replace;
                    $a = $t;
                    $a =~
                        s{\257<(-?\d+)?(.*)\257>}
                    {
                        if($1) {
                            # Positional replace
                            # Find the relevant arg and replace it
                            ($argref->[$1 > 0 ? $1-1 : $n+$1] ?
                             # If defined: replace
                             $argref->[$1 > 0 ? $1-1 : $n+$1]->
                             replace($2,$quote_arg,$self)
                             : "");
                        } else {
                            # Normal replace
                            $normal_replace ||= 1;
                            ($arg ? $arg->replace($2,$quote_arg,$self) : "");
                        }
                    }sgxe;
                    CORE::push @replaced, $space, $a;
                    $normal_replace or last;
                    $space = "\0spc";
                }
            } else {
                # No replacement
                CORE::push @replaced, map {
                    $Global::escape_string_present and s/\257\256/\257/g; $_;
                } $t;
            }
        }
    }
    *Arg::arg = [];
    ::debug("replace","Replaced: ".join":",@replaced,"\n");

    # Put tokens into groups that may be quoted.
    my @quotegroup;
    my @quoted;
    for (map { $_ eq "\0empty" ? "" : $_ }
         grep { $_ ne "\0ign" and $_ ne "\0noarg" and $_ ne "'\0noarg'" }
         @replaced, "\0end") {
        if($_ eq "\0spc" or $_ eq "\0end") {
            # \0spc splits quotable groups
            if($quote) {
                if(@quotegroup) {
                    CORE::push @quoted, ::Q(join"",@quotegroup);;
                }
            } else {
                CORE::push @quoted, join"",@quotegroup;
            }
            @quotegroup = ();
        } else {
            CORE::push @quotegroup, $_;
        }
    }
    ::debug("replace","Quoted: ".join":",@quoted,"\n");
    return wantarray ? @quoted : "@quoted";
}

sub skip($) {
    # Skip this job
    my $self = shift;
    $self->{'skip'} = 1;
}


package CommandLineQueue;

sub new($) {
    my $class = shift;
    my $commandref = shift;
    my $read_from = shift;
    my $context_replace = shift || 0;
    my $max_number_of_args = shift;
    my $transfer_files = shift;
    my $return_files = shift;
    my $template_names = shift;
    my $template_contents = shift;
    my @unget = ();
    my $posrpl;
    my ($replacecount_ref, $len_ref);
    my @command = @$commandref;
    my $seq = 1;
    # Replace replacement strings with {= perl expr =}
    # '{=' 'perlexpr' '=}'  => '{= perlexpr =}'
    @command = merge_rpl_parts(@command);

    # Protect matching inside {= perl expr =}
    # by replacing {= and =} with \257< and \257>
    # in options that can contain replacement strings:
    # @command, --transferfile, --return,
    # --tagstring, --workdir, --results
    for(@command, @$transfer_files, @$return_files,
        @$template_names, @$template_contents,
        $opt::tagstring, $opt::workdir, $opt::results, $opt::retries,
        @opt::filter) {
        # Skip if undefined
        defined($_) or next;
        # Escape \257 => \257\256
        $Global::escape_string_present += s/\257/\257\256/g;
        # Needs to match rightmost left parens (Perl defaults to leftmost)
        # to deal with: {={==} and {={==}=}
        # Replace {= -> \257<  and  =} -> \257>
        #
        # Complex way to do:
        #   s/{=(.*)=}/\257<$1\257>/g
        # which would not work
        s[\Q$Global::parensleft\E # Match {=
          # Match . unless the next string is {= or =}
          #   needed to force matching the shortest {= =}
          ((?:(?! \Q$Global::parensleft\E|\Q$Global::parensright\E ).)*?)
          \Q$Global::parensright\E ] # Match =}
        {\257<$1\257>}gxs;
        for my $rpl (sort { length $b <=> length $a } keys %Global::rpl) {
            # Replace long --rpl's before short ones, as a short may be a
            # substring of a long:
            #   --rpl '% s/a/b/' --rpl '%% s/b/a/'
            #
            # Replace the shorthand string (--rpl)
            # with the {= perl expr =}
            #
            # Avoid searching for shorthand strings inside existing {= perl expr =}
            #
            # Replace $$1 in {= perl expr =} with groupings in shorthand string
            #
            #   --rpl '{/(\.\S+)/(\.\S+)} s/$$1/$$2/g;'
            #     echo {/.tar/.gz} ::: UU.tar.gz
            my ($prefix,$grp_regexp,$postfix) =
                $rpl =~ /^( [^(]*  )    # Prefix - e.g. {%%
                          ( \(.*\) )?   # Group capture regexp - e.g (.*)
                          ( [^)]*  )$   # Postfix - e.g }
                        /xs;
            $grp_regexp ||= '';
            my $rplval = $Global::rpl{$rpl};
            while(s{( (?: ^|\257> ) (?: [^\257]*|[\257][^<>] )*? )
                      # Don't replace after \257 unless \257>
                    \Q$prefix\E $grp_regexp \Q$postfix\E}
                  {
                      # The start remains the same
                      my $unchanged = $1;
                      # Dummy entry to start at 1.
                      my @grp = (1);
                      # $2 = first ()-group in $grp_regexp
                      # Put $2 in $grp[1], Put $3 in $grp[2]
                      # so first ()-group in $grp_regexp is $grp[1];
                      for(my $i = 2; defined $grp[$#grp]; $i++) {
                          push @grp, eval '$'.$i;
                      }
                      my $rv = $rplval;
                      # replace $$1 with $_pAr_gRp1, $$2 with $_pAr_gRp2
                      # in the code to be executed
                      $rv =~ s/\$\$ (\d+)/\$_pAr_gRp$1/gx;
                      # prepend with $_pAr_gRp1 = perlquote($1),
                      my $set_args = "";
                      for(my $i = 1;defined $grp[$i]; $i++) {
                          $set_args .= "\$_pAr_gRp$i = \"" .
                              ::perl_quote_scalar($grp[$i]) . "\";";
                      }
                      $unchanged . "\257<" . $set_args . $rv . "\257>"
                  }gxes) {
            }
            # Do the same for the positional replacement strings
            $posrpl = $rpl;
            if($posrpl =~ s/^\{//) {
                # Only do this if the shorthand start with {
                $prefix=~s/^\{//;
                # Don't replace after \257 unless \257>
                while(s{( (?: ^|\257> ) (?: [^\257]*|[\257][^<>] )*? )
                  \{(-?\d+) \s* \Q$prefix\E $grp_regexp \Q$postfix\E}
                      {
                      # The start remains the same
                      my $unchanged = $1;
                      my $position = $2;
                      # Dummy entry to start at 1.
                      my @grp = (1);
                      # $3 = first ()-group in $grp_regexp
                      # Put $3 in $grp[1], Put $4 in $grp[2]
                      # so first ()-group in $grp_regexp is $grp[1];
                      for(my $i = 3; defined $grp[$#grp]; $i++) {
                          push @grp, eval '$'.$i;
                      }
                      my $rv = $rplval;
                      # replace $$1 with $_pAr_gRp1, $$2 with $_pAr_gRp2
                      # in the code to be executed
                      $rv =~ s/\$\$ (\d+)/\$_pAr_gRp$1/gx;
                      # prepend with $_pAr_gRp1 = perlquote($1),
                      my $set_args = "";
                      for(my $i = 1;defined $grp[$i]; $i++) {
                          $set_args .= "\$_pAr_gRp$i = \"" .
                              ::perl_quote_scalar($grp[$i]) . "\";";
                      }
                      $unchanged . "\257<" . $position . $set_args . $rv . "\257>"
                  }gxes) {
                }
            }
        }
    }
    # Add {} if no replacement strings in @command
    ($replacecount_ref, $len_ref, @command) =
        replacement_counts_and_lengths($transfer_files, $return_files,
                                       $template_names, $template_contents,
                                       @command);
    if("@command" =~ /^[^ \t\n=]*\257</) {
        # Replacement string is (part of) the command (and not just
        # argument or variable definition V1={})
        # E.g. parallel {}, parallel my_{= s/_//=}, parallel {2}
        # Do no quote (Otherwise it will fail if the input contains spaces)
        $Global::quote_replace = 0;
    }

    if($opt::sqlmaster and $Global::sql->append()) {
        $seq = $Global::sql->max_seq() + 1;
    }

    return bless {
        ('unget' => \@unget,
         'command' => \@command,
         'replacecount' => $replacecount_ref,
         'arg_queue' => RecordQueue->new($read_from,$opt::colsep),
         'context_replace' => $context_replace,
         'len' => $len_ref,
         'max_number_of_args' => $max_number_of_args,
         'size' => undef,
         'transfer_files' => $transfer_files,
         'return_files' => $return_files,
         'template_names' => $template_names,
         'template_contents' => $template_contents,
         'seq' => $seq,
         )
    }, ref($class) || $class;
}

sub merge_rpl_parts($) {
    # '{=' 'perlexpr' '=}'  => '{= perlexpr =}'
    # Input:
    #   @in = the @command as given by the user
    # Uses:
    #   $Global::parensleft
    #   $Global::parensright
    # Returns:
    #   @command with parts merged to keep {= and =} as one
    my @in = @_;
    my @out;
    my $l = quotemeta($Global::parensleft);
    my $r = quotemeta($Global::parensright);

    while(@in) {
        my $s = shift @in;
        $_ = $s;
        # Remove matching (right most) parens
        while(s/(.*)$l.*?$r/$1/os) {}
        if(/$l/o) {
            # Missing right parens
            while(@in) {
                $s .= " ".shift @in;
                $_ = $s;
                while(s/(.*)$l.*?$r/$1/os) {}
                if(not /$l/o) {
                    last;
                }
            }
        }
        push @out, $s;
    }
    return @out;
}

sub replacement_counts_and_lengths($$@) {
    # Count the number of different replacement strings.
    # Find the lengths of context for context groups and non-context
    # groups.
    # If no {} found in @command: add it to @command
    #
    # Input:
    #   \@transfer_files = array of filenames to transfer
    #   \@return_files = array of filenames to return
    #   \@template_names = array of names to copy to
    #   \@template_contents = array of contents to write
    #   @command = command template
    # Output:
    #   \%replacecount, \%len, @command
    my $transfer_files = shift;
    my $return_files = shift;
    my $template_names = shift;
    my $template_contents = shift;
    my @command = @_;
    my (%replacecount,%len);
    my $sum = 0;
    while($sum == 0) {
        # Count how many times each replacement string is used
        my @cmd = @command;
        my $contextlen = 0;
        my $noncontextlen = 0;
        my $contextgroups = 0;
        for my $c (@cmd) {
            while($c =~ s/ \257<( (?: [^\257]*|[\257][^<>] )*?)\257> /\000/xs) {
                # %replacecount = { "perlexpr" => number of times seen }
                # e.g { "s/a/b/" => 2 }
                $replacecount{$1}++;
                $sum++;
            }
            # Measure the length of the context around the {= perl expr =}
            # Use that {=...=} has been replaced with \000 above
            # So there is no need to deal with \257<
            while($c =~ s/ (\S*\000\S*) //xs) {
                my $w = $1;
                $w =~ tr/\000//d; # Remove all \000's
                $contextlen += length($w);
                $contextgroups++;
            }
            # All {= perl expr =} have been removed: The rest is non-context
            $noncontextlen += length $c;
        }
        for(@$transfer_files, @$return_files,
            @$template_names, @$template_contents,
            @opt::filter,
            $opt::tagstring, $opt::workdir, $opt::results, $opt::retries) {
            # Options that can contain replacement strings
            defined($_) or next;
            my $t = $_;
            while($t =~ s/ \257<( (?: [^\257]*|[\257][^<>] )* )\257> //xs) {
                # %replacecount = { "perlexpr" => number of times seen }
                # e.g { "$_++" => 2 }
                # But for tagstring we just need to mark it as seen
                $replacecount{$1} ||= 1;
            }
        }
        if($opt::bar) {
            # If the command does not contain {} force it to be computed
            # as it is being used by --bar
            $replacecount{""} ||= 1;
        }

        $len{'context'} = 0+$contextlen;
        $len{'noncontext'} = $noncontextlen;
        $len{'contextgroups'} = $contextgroups;
        $len{'noncontextgroups'} = @cmd-$contextgroups;
        ::debug("length", "@command Context: ", $len{'context'},
                " Non: ", $len{'noncontext'}, " Ctxgrp: ", $len{'contextgroups'},
                " NonCtxGrp: ", $len{'noncontextgroups'}, "\n");
        if($sum == 0) {
            if(not @command) {
                # Default command = {}
                @command = ("\257<\257>");
            } elsif(($opt::pipe or $opt::pipepart)
                    and not $opt::fifo and not $opt::cat) {
                # With --pipe / --pipe-part you can have no replacement
                last;
            } else {
                # Append {} to the command if there are no {...}'s and no {=...=}
                push @command, ("\257<\257>");
            }
        }
    }
    return(\%replacecount,\%len,@command);
}

sub get($) {
    my $self = shift;
    if(@{$self->{'unget'}}) {
        my $cmd_line = shift @{$self->{'unget'}};
        return ($cmd_line);
    } else {
        if($opt::sqlworker) {
            # Get the sequence number from the SQL table
            $self->set_seq($SQL::next_seq);
            # Get the command from the SQL table
            $self->{'command'} = $SQL::command_ref;
            my @command;
            # Recompute replace counts based on the read command
            ($self->{'replacecount'},
             $self->{'len'}, @command) =
                replacement_counts_and_lengths($self->{'transfer_files'},
                                               $self->{'return_files'},
                                               $self->{'template_name'},
                                               $self->{'template_contents'},
                                               @$SQL::command_ref);
            if("@command" =~ /^[^ \t\n=]*\257</) {
                # Replacement string is (part of) the command (and not just
                # argument or variable definition V1={})
                # E.g. parallel {}, parallel my_{= s/_//=}, parallel {2}
                # Do no quote (Otherwise it will fail if the input contains spaces)
                $Global::quote_replace = 0;
            }
        }

        my $cmd_line = CommandLine->new($self->seq(),
                                        $self->{'command'},
                                        $self->{'arg_queue'},
                                        $self->{'context_replace'},
                                        $self->{'max_number_of_args'},
                                        $self->{'transfer_files'},
                                        $self->{'return_files'},
                                        $self->{'template_names'},
                                        $self->{'template_contents'},
                                        $self->{'replacecount'},
                                        $self->{'len'},
            );
        $cmd_line->populate();
        ::debug("run","cmd_line->number_of_args ",
                $cmd_line->number_of_args(), "\n");
        if(not $Global::no_more_input and ($opt::pipe or $opt::pipepart)) {
            if($cmd_line->replaced() eq "") {
                # Empty command - pipe requires a command
                ::error("--pipe/--pipepart must have a command to pipe into ".
                        "(e.g. 'cat').");
                ::wait_and_exit(255);
            }
        } elsif($cmd_line->number_of_args() == 0) {
            # We did not get more args - maybe at EOF string?
            return undef;
        }
        $self->set_seq($self->seq()+1);
        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("run", "CommandLineQueue->empty $empty");
    return $empty;
}

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

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

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


package Limits::Command;

# Maximal command line length (for -m and -X)
sub max_length($) {
    # Find the max_length of a command line and cache it
    # Returns:
    #   number of chars on the longest command line allowed
    if(not $Limits::Command::line_max_len) {
        # Disk cache of max command line length
        my $len_cache = $Global::cache_dir . "/tmp/sshlogin/" . ::hostname() .
            "/linelen";
        my $cached_limit;
        local $/ = undef;
        if(open(my $fh, "<", $len_cache)) {
            $cached_limit = <$fh>;
            $cached_limit || ::warning("Invalid content in $len_cache");
            close $fh;
        }
        if(not $cached_limit) {
            $cached_limit = real_max_length();
            # If $HOME is write protected: Do not fail
            my $dir = ::dirname($len_cache);
            -d $dir or eval { File::Path::mkpath($dir); };
            open(my $fh, ">", $len_cache.$$);
            print $fh $cached_limit;
            close $fh;
            rename $len_cache.$$, $len_cache || ::die_bug("rename cache file");
        }
        $Limits::Command::line_max_len = tmux_length($cached_limit);
    }
    return int($Limits::Command::line_max_len);
}

sub real_max_length() {
    # Find the max_length of a command line
    # Returns:
    #   The maximal command line length with 1 byte arguments
    # return find_max(" c");
    return find_max("c");
}

sub find_max($) {
    my $string = shift;
    # This is slow on Cygwin, so give Cygwin users a warning
    if($^O eq "cygwin" or $^O eq "msys") {
        ::warning("Finding the maximal command line length. ".
                  "This may take up to 1 minute.")
    }
    # Use an upper bound of 100 MB if the shell allows for infinite
    # long lengths
    my $upper = 100_000_000;
    my $lower;
    # 1000 is supported everywhere, so the search can start anywhere 1..999
    # 324 makes the search much faster on Cygwin, so let us use that
    my $len = 324;
    do {
        if($len > $upper) { return $len };
        $lower = $len;
        $len *= 4;
        ::debug("init", "Maxlen: $lower<$len<$upper(".($upper-$lower)."): ");
    } while (is_acceptable_command_line_length($len,$string));
    # Then search for the actual max length between
    # last successful length ($len/16) and upper bound
    return binary_find_max(int($len/16),$len,$string);
}


# Prototype forwarding
sub binary_find_max($$$);
sub binary_find_max($$$) {
    # Given a lower and upper bound find the max (length or args) of a
    # command line
    # Returns:
    #   number of chars on the longest command line allowed
    my ($lower, $upper, $string) = (@_);
    if($lower == $upper
       or $lower == $upper-1
       or $lower/$upper > 0.99) {
        # $lower is +- 1 or within 1%: Don't search more
        return $lower;
    }
    # Unevenly split binary search which is faster for Microsoft Windows.
    # Guessing too high is cheap. Guessing too low is expensive.
    my $split = ($^O eq "cygwin" or $^O eq "msys") ? 0.93 : 0.5;
    my $middle = int (($upper-$lower)*$split + $lower);
    ::debug("init", "Maxlen: $lower<$middle<$upper(".($upper-$lower)."): ");
    if (is_acceptable_command_line_length($middle,$string)) {
        return binary_find_max($middle,$upper,$string);
    } else {
        return binary_find_max($lower,$middle,$string);
    }
}

{
    my $prg;

    sub is_acceptable_command_line_length($$) {
        # Test if a command line of this length can run
        # in the current environment
        # If the string is " x" it tests how many args are allowed
        # Returns:
        #   0 if the command line length is too long
        #   1 otherwise
        my $len = shift;
        my $string = shift;
        if($Global::parallel_env) {
            $len += length $Global::parallel_env;
        }
        # Force using non-built-in command
        $prg ||= ::which("echo");
        my $l = length ::qqx("$prg ".${string}x(($len-1-length $prg)/length $string));
        if($l < $len/2) {
            # The command returned OK, but did not output $len chars
            # => this failed (Centos3 does this craziness)
            return 0
        }
        ::debug("init", "$len=$?\n");
        return not $?;
    }
}

sub tmux_length($) {
    # If $opt::tmux set, find the limit for tmux
    # tmux 1.8 has a 2kB limit
    # tmux 1.9 has a 16kB limit
    # tmux 2.0 has a 16kB limit
    # tmux 2.1 has a 16kB limit
    # tmux 2.2 has a 16kB limit
    # Input:
    #   $len = maximal command line length
    # Returns:
    #   $tmux_len = maximal length runable in tmux
    local $/ = "\n";
    my $len = shift;
    if($opt::tmux) {
        $ENV{'PARALLEL_TMUX'} ||= "tmux";
        if(not ::which($ENV{'PARALLEL_TMUX'})) {
            ::error($ENV{'PARALLEL_TMUX'}." not found in \$PATH.");
            ::wait_and_exit(255);
        }
        my @out;
        for my $l (1, 2020, 16320, 30000, $len) {
            my $tmpfile = ::tmpname("tms");
            my $qtmp = ::Q($tmpfile);
            my $tmuxcmd = $ENV{'PARALLEL_TMUX'}.
                " -S $qtmp new-session -d -n echo $l".
                ("t"x$l). " && echo $l; rm -f $qtmp";
            push @out, ::qqx($tmuxcmd);
            ::rm($tmpfile);
        }
        ::debug("tmux","tmux-out ",@out);
        chomp @out;
        # The arguments is given 3 times on the command line
        # and the tmux wrapping is around 30 chars
        # (29 for tmux1.9, 33 for tmux1.8)
        my $tmux_len = ::max(@out);
        $len = ::min($len,int($tmux_len/4-33));
        ::debug("tmux","tmux-length ",$len);
    }
    return $len;
}


package RecordQueue;

sub new($) {
    my $class = shift;
    my $fhs = shift;
    my $colsep = shift;
    my @unget = ();
    my $arg_sub_queue;
    if($opt::sqlworker) {
        # Open SQL table
        $arg_sub_queue = SQLRecordQueue->new();
    } elsif(defined $colsep) {
        # Open one file with colsep or CSV
        $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($) {
    # Returns:
    #   reference to array of Arg-objects
    my $self = shift;
    if(@{$self->{'unget'}}) {
        $self->{'arg_number'}++;
        # Flush cached computed replacements in Arg-objects
        # To fix: parallel --bar echo {%} ::: a b c ::: d e f
        my $ret = shift @{$self->{'unget'}};
        if($ret) {
            map { $_->flush_cache() } @$ret;
        }
        return $ret;
    }
    my $ret = $self->{'arg_sub_queue'}->get();
    if($ret) {
        if(grep { index($_->orig(),"\0") > 0 } @$ret) {
            # Allow for \0 in position 0 because GNU  Parallel uses "\0noarg"
            # to mean no-string
            ::warning("A NUL character in the input was replaced with \\0.",
                      "NUL cannot be passed through in the argument list.",
                      "Did you mean to use the --null option?");
            for(grep { index($_->orig(),"\0") > 0 } @$ret) {
                # Replace \0 with \\0
                my $a = $_->orig();
                $a =~ s/\0/\\0/g;
                $_->set_orig($a);
            }
        }
        if(defined $Global::max_number_of_args
           and $Global::max_number_of_args == 0) {
            ::debug("run", "Read 1 but return 0 args\n");
            # \0noarg => nothing (not the empty string)
            map { $_->set_orig("\0noarg"); } @$ret;
        }
        # Flush cached computed replacements in Arg-objects
        # To fix: parallel --bar echo {%} ::: a b c ::: d e f
        map { $_->flush_cache() } @$ret;
    }
    return $ret;
}

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

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

sub flush_cache($) {
    my $self = shift;
    for my $record (@{$self->{'unget'}}) {
        for my $arg (@$record) {
            $arg->flush_cache();
        }
    }
    $self->{'arg_sub_queue'}->flush_cache();
}

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($) {
    # Returns:
    #   reference to array of Arg-objects
    my $self = shift;
    if(@{$self->{'unget'}}) {
        return shift @{$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("run", "RecordColQueue::arg $arg\n");
            my $line = $arg->orig();
            ::debug("run", "line='$line'\n");
            if($line ne "") {
                if($opt::csv) {
                    # Parse CSV and put it into a record
                    chomp $line;
                    if(not $Global::csv->parse($line)) {
                        die "CSV has unexpected format: ^$line^";
                    }
                    for($Global::csv->fields()) {
                        push @out_record, Arg->new($_);
                    }
                } else {
                    # Split --colsep into record
                    for my $s (split /$opt::colsep/o, $line, -1) {
                        push @out_record, Arg->new($s);
                    }
                }
            } else {
                push @out_record, Arg->new("");
            }
        }
        return \@out_record;
    } else {
        return undef;
    }
}

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

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

sub flush_cache($) {
    my $self = shift;
    for my $arg (@{$self->{'unget'}}) {
        $arg->flush_cache();
    }
    $self->{'arg_sub_queue'}->flush_cache();
}


package SQLRecordQueue;

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

sub get($) {
    # Returns:
    #   reference to array of Arg-objects
    my $self = shift;
    if(@{$self->{'unget'}}) {
        return shift @{$self->{'unget'}};
    }
    return $Global::sql->get_record();
}

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

sub empty($) {
    my $self = shift;
    if(@{$self->{'unget'}}) { return 0; }
    my $get = $self->get();
    if(defined $get) {
        $self->unget($get);
    }
    my $empty = not $get;
    ::debug("run", "SQLRecordQueue->empty $empty");
    return $empty;
}

sub flush_cache($) {
    my $self = shift;
    for my $record (@{$self->{'unget'}}) {
        for my $arg (@$record) {
            $arg->flush_cache();
        }
    }
}


package MultifileQueue;

@Global::unget_argv=();

sub new($$) {
    my $class = shift;
    my $fhs = shift;
    for my $fh (@$fhs) {
        if(-t $fh and -t ($Global::status_fd || *STDERR)) {
            ::warning(
                  "Input is read from the terminal. You are either an expert",
                  "(in which case: YOU ARE AWESOME!) or maybe you forgot",
                  "::: or :::: or -a or to pipe data into parallel. If so",
                  "consider going through the tutorial: man parallel_tutorial",
                  "Press CTRL-D to exit.");
        }
    }
    return bless {
        'unget' => \@Global::unget_argv,
        'fhs' => $fhs,
        'arg_matrix' => undef,
    }, ref($class) || $class;
}

sub get($) {
    my $self = shift;
    if($opt::link) {
        return $self->link_get();
    } else {
        return $self->nest_get();
    }
}

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

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

sub flush_cache($) {
    my $self = shift;
    for my $record (@{$self->{'unget'}}, @{$self->{'arg_matrix'}}) {
        for my $arg (@$record) {
            $arg->flush_cache();
        }
    }
}

sub link_get($) {
    my $self = shift;
    if(@{$self->{'unget'}}) {
        return shift @{$self->{'unget'}};
    }
    my @record = ();
    my $prepend;
    my $empty = 1;
    for my $i (0..$#{$self->{'fhs'}}) {
        my $fh = $self->{'fhs'}[$i];
        my $arg = read_arg_from_fh($fh);
        if(defined $arg) {
            # Record $arg for recycling at end of file
            push @{$self->{'arg_matrix'}[$i]}, $arg;
            push @record, $arg;
            $empty = 0;
        } else {
            ::debug("run", "EOA ");
            # End of file: Recycle arguments
            push @{$self->{'arg_matrix'}[$i]}, shift @{$self->{'arg_matrix'}[$i]};
            # return last @{$args->{'args'}{$fh}};
            push @record, @{$self->{'arg_matrix'}[$i]}[-1];
        }
    }
    if($empty) {
        return undef;
    } else {
        return \@record;
    }
}

sub nest_get($) {
    my $self = shift;
    if(@{$self->{'unget'}}) {
        return shift @{$self->{'unget'}};
    }
    my @record = ();
    my $prepend;
    my $empty = 1;
    my $no_of_inputsources = $#{$self->{'fhs'}} + 1;
    if(not $self->{'arg_matrix'}) {
        # Initialize @arg_matrix with one arg from each file
        # read one line from each file
        my @first_arg_set;
        my $all_empty = 1;
        for (my $fhno = 0; $fhno < $no_of_inputsources ; $fhno++) {
            my $arg = read_arg_from_fh($self->{'fhs'}[$fhno]);
            if(defined $arg) {
                $all_empty = 0;
            }
            $self->{'arg_matrix'}[$fhno][0] = $arg || Arg->new("");
            push @first_arg_set, $self->{'arg_matrix'}[$fhno][0];
        }
        if($all_empty) {
            # All filehandles were at eof or eof-string
            return undef;
        }
        return [@first_arg_set];
    }

    # Treat the case with one input source special.  For multiple
    # input sources we need to remember all previously read values to
    # generate all combinations. But for one input source we can
    # forget the value after first use.
    if($no_of_inputsources == 1) {
        my $arg = read_arg_from_fh($self->{'fhs'}[0]);
        if(defined($arg)) {
            return [$arg];
        }
        return undef;
    }
    for (my $fhno = $no_of_inputsources - 1; $fhno >= 0; $fhno--) {
        if(eof($self->{'fhs'}[$fhno])) {
            next;
        } else {
            # read one
            my $arg = read_arg_from_fh($self->{'fhs'}[$fhno]);
            defined($arg) || next; # If we just read an EOF string: Treat this as EOF
            my $len = $#{$self->{'arg_matrix'}[$fhno]} + 1;
            $self->{'arg_matrix'}[$fhno][$len] = $arg;
            # make all new combinations
            my @combarg = ();
            for (my $fhn = 0; $fhn < $no_of_inputsources; $fhn++) {
                push(@combarg, [0, $#{$self->{'arg_matrix'}[$fhn]}],
                     # Is input source --link'ed to the next?
                     $opt::linkinputsource[$fhn+1]);
            }
            # Find only combinations with this new entry
            $combarg[2*$fhno] = [$len,$len];
            # map combinations
            # [ 1, 3, 7 ], [ 2, 4, 1 ]
            # =>
            # [ m[0][1], m[1][3], m[2][7] ], [ m[0][2], m[1][4], m[2][1] ]
            my @mapped;
            for my $c (expand_combinations(@combarg)) {
                my @a;
                for my $n (0 .. $no_of_inputsources - 1 ) {
                    push @a,  $self->{'arg_matrix'}[$n][$$c[$n]];
                }
                push @mapped, \@a;
            }
            # append the mapped to the ungotten arguments
            push @{$self->{'unget'}}, @mapped;
            # get the first
            if(@mapped) {
                return shift @{$self->{'unget'}};
            }
        }
    }
    # all are eof or at EOF string; return from the unget queue
    return shift @{$self->{'unget'}};
}

{
    my $cr_count = 0;
    my $nl_count = 0;
    my $dos_crnl_determined;
    sub read_arg_from_fh($) {
        # Read one Arg from filehandle
        # Returns:
        #   Arg-object with one read line
        #   undef if end of file
        my $fh = shift;
        my $prepend;
        my $arg;
        my $half_record = 0;
        do {{
            # This makes 10% faster
            if(not defined ($arg = <$fh>)) {
                if(defined $prepend) {
                    return Arg->new($prepend);
                } else {
                    return undef;
                }
            }
            if(not $dos_crnl_determined and not defined $opt::d) {
                # Warn if input has CR-NL and -d is not set
                if($arg =~ /\r$/) {
                    $cr_count++;
                } else {
                    $nl_count++;
                }
                if($cr_count == 3 or $nl_count == 3) {
                    $dos_crnl_determined = 1;
                    if($nl_count == 0 and $cr_count == 3) {
                        ::warning('The first three values end in CR-NL. '.
                                  'Consider using -d "\r\n"');
                    }
                }
            }
            if($opt::csv) {
                # We need to read a full CSV line.
                if(($arg =~ y/"/"/) % 2 ) {
                    # The number of " on the line is uneven:
                    # If we were in a half_record => we have a full record now
                    # If we were outside a half_record =>
                    #    we are in a half record now
                    $half_record = not $half_record;
                }
                if($half_record) {
                    # CSV half-record with quoting:
                    #   col1,"col2 2""x3"" board newline  <-this one
                    #   cont",col3
                    $prepend .= $arg;
                    redo;
                } else {
                    # Now we have a full CSV record
                }
            }
            # Remove delimiter
            chomp $arg;
            if($Global::end_of_file_string and
               $arg eq $Global::end_of_file_string) {
                # Ignore the rest of input file
                close $fh;
                ::debug("run", "EOF-string ($arg) met\n");
                if(defined $prepend) {
                    return Arg->new($prepend);
                } else {
                    return undef;
                }
            }
            if(defined $prepend) {
                $arg = $prepend.$arg; # For line continuation
                undef $prepend;
            }
            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;
                }
            }
            }} while (1 == 0); # Dummy loop {{}} for redo
        if(defined $arg) {
            return Arg->new($arg);
        } else {
            ::die_bug("multiread arg undefined");
        }
    }
}

# Prototype forwarding
sub expand_combinations(@);
sub expand_combinations(@) {
    # Input:
    #   ([xmin,xmax], [ymin,ymax], ...)
    # Returns: ([x,y,...],[x,y,...])
    # where xmin <= x <= xmax and ymin <= y <= ymax
    my $minmax_ref = shift;
    my $link = shift; # This is linked to the next input source
    my $xmin = $$minmax_ref[0];
    my $xmax = $$minmax_ref[1];
    my @p;
    if(@_) {
        my @rest = expand_combinations(@_);
        if($link) {
            # Linked to next col with --link/:::+/::::+
            # TODO BUG does not wrap values if not same number of vals
            push(@p, map { [$$_[0], @$_] }
                 grep { $xmin <= $$_[0] and $$_[0] <= $xmax } @rest);
        } else {
            # If there are more columns: Compute those recursively
            for(my $x = $xmin; $x <= $xmax; $x++) {
                push @p, map { [$x, @$_] } @rest;
            }
        }
    } else {
        for(my $x = $xmin; $x <= $xmax; $x++) {
            push @p, [$x];
        }
    }
    return @p;
}


package Arg;

sub new($) {
    my $class = shift;
    my $orig = shift;
    my @hostgroups;
    if($opt::hostgroups) {
        if($orig =~ s:@(.+)::) {
            # We found hostgroups on the arg
            @hostgroups = split(/\+|,/, $1);
            if(not grep { defined $Global::hostgroups{$_} } @hostgroups) {
                # This hostgroup is not defined using -S
                # Add it
                ::warning("Adding hostgroups: @hostgroups");
                # Add sshlogin
                for(grep { not defined $Global::hostgroups{$_} } @hostgroups) {
                    my $sshlogin = SSHLogin->new($_);
                    my $sshlogin_string = $sshlogin->string();
                    $Global::host{$sshlogin_string} = $sshlogin;
                    $Global::hostgroups{$sshlogin_string} = 1;
                }
            }
        } else {
            # No hostgroup on the arg => any hostgroup
            @hostgroups = (keys %Global::hostgroups);
        }
    }
    return bless {
        'orig' => $orig,
        'hostgroups' => \@hostgroups,
    }, ref($class) || $class;
}

sub Q($) {
    # Q alias for ::shell_quote_scalar
    my $ret = ::Q($_[0]);
    no warnings 'redefine';
    *Q = \&::Q;
    return $ret;
}

sub pQ($) {
    # pQ alias for ::perl_quote_scalar
    my $ret = ::pQ($_[0]);
    no warnings 'redefine';
    *pQ = \&::pQ;
    return $ret;
}

sub hash($) {
    $Global::use{"DBI"} ||= eval "use B; 1;";
    B::hash(@_);
}

sub total_jobs() {
    return $Global::JobQueue->total_jobs();
}

{
    my %perleval;
    my $job;
    sub skip() {
        # shorthand for $job->skip();
        $job->skip();
    }
    sub slot() {
        # shorthand for $job->slot();
        $job->slot();
    }
    sub seq() {
        # shorthand for $job->seq();
        $job->seq();
    }
    sub uq() {
        # Do not quote this arg
        $Global::unquote_arg = 1;
    }
    sub yyyy_mm_dd_hh_mm_ss(@) {
        # ISO8601 2038-01-19T03:14:08
        ::strftime("%Y-%m-%dT%H:%M:%S", localtime(shift || time()));
    }
    sub yyyy_mm_dd_hh_mm(@) {
        # ISO8601 2038-01-19T03:14
        ::strftime("%Y-%m-%dT%H:%M", localtime(shift || time()));
    }
    sub yyyy_mm_dd(@) {
        # ISO8601 2038-01-19
        ::strftime("%Y-%m-%d", localtime(shift || time()));
    }
    sub hh_mm_ss(@) {
        # ISO8601 03:14:08
        ::strftime("%H:%M:%S", localtime(shift || time()));
    }
    sub hh_mm(@) {
        # ISO8601 03:14
        ::strftime("%H:%M", localtime(shift || time()));
    }
    sub yyyymmddhhmmss(@) {
        # ISO8601 20380119 + ISO8601 031408
        ::strftime("%Y%m%d%H%M%S", localtime(shift || time()));
    }
    sub yyyymmddhhmm(@) {
        # ISO8601 20380119 + ISO8601 0314
        ::strftime("%Y%m%d%H%M", localtime(shift || time()));
    }
    sub yyyymmdd(@) {
        # ISO8601 20380119
        ::strftime("%Y%m%d", localtime(shift || time()));
    }
    sub hhmmss(@) {
        # ISO8601 031408
        ::strftime("%H%M%S", localtime(shift || time()));
    }
    sub hhmm(@) {
        # ISO8601 0314
        ::strftime("%H%M", localtime(shift || time()));
    }

    sub replace($$$$) {
        # Calculates the corresponding value for a given perl expression
        # Returns:
        #   The calculated string (quoted if asked for)
        my $self = shift;
        my $perlexpr = shift; # E.g. $_=$_ or s/.gz//
        my $quote = shift; # should the string be quoted?
        # This is actually a CommandLine-object,
        # but it looks nice to be able to say {= $job->slot() =}
        $job = shift;
        # Positional replace treated as normal replace
        $perlexpr =~ s/^(-?\d+)? *//;
        if(not $Global::cache_replacement_eval
           or
           not $self->{'cache'}{$perlexpr}) {
            # Only compute the value once
            # Use $_ as the variable to change
            local $_;
            if($Global::trim eq "n") {
                $_ = $self->{'orig'};
            } else {
                # Trim the input
                $_ = trim_of($self->{'orig'});
            }
            ::debug("replace", "eval ", $perlexpr, " ", $_, "\n");
            if(not $perleval{$perlexpr}) {
                # Make an anonymous function of the $perlexpr
                # And more importantly: Compile it only once
                if($perleval{$perlexpr} =
                   eval('sub { no strict; no warnings; my $job = shift; '.
                        $perlexpr.' }')) {
                    # All is good
                } else {
                    # The eval failed. Maybe $perlexpr is invalid perl?
                    ::error("Cannot use $perlexpr: $@");
                    ::wait_and_exit(255);
                }
            }
            # Execute the function
            $perleval{$perlexpr}->($job);
            $self->{'cache'}{$perlexpr} = $_;
            if($Global::unquote_arg) {
                # uq() was called in perlexpr
                $self->{'cache'}{'unquote'}{$perlexpr} = 1;
                # Reset for next perlexpr
                $Global::unquote_arg = 0;
            }
        }
        # Return the value quoted if needed
        if($self->{'cache'}{'unquote'}{$perlexpr}) {
            return($self->{'cache'}{$perlexpr});
        } else {
            return($quote ? Q($self->{'cache'}{$perlexpr})
                   : $self->{'cache'}{$perlexpr});
        }
    }
}

sub flush_cache($) {
    # Flush cache of computed values
    my $self = shift;
    $self->{'cache'} = undef;
}

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

sub set_orig($$) {
    my $self = shift;
    $self->{'orig'} = shift;
}

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 my $arg (@strings) { $arg =~ s/^\s+//; }
    } elsif($Global::trim eq "r") {
        for my $arg (@strings) { $arg =~ s/\s+$//; }
    } elsif($Global::trim eq "rl" or $Global::trim eq "lr") {
        for my $arg (@strings) { $arg =~ s/^\s+//; $arg =~ s/\s+$//; }
    } else {
        ::error("--trim must be one of: r l rl lr.");
        ::wait_and_exit(255);
    }
    return wantarray ? @strings : "@strings";
}


package TimeoutQueue;

sub new($) {
    my $class = shift;
    my $delta_time = shift;
    my ($pct);
    if($delta_time =~ /(\d+(\.\d+)?)%/) {
        # Timeout in percent
        $pct = $1/100;
        $delta_time = 1_000_000;
    }
    $delta_time = ::multiply_time_units($delta_time);

    return bless {
        'queue' => [],
        'delta_time' => $delta_time,
        'pct' => $pct,
        'remedian_idx' => 0,
        'remedian_arr' => [],
        'remedian' => undef,
    }, ref($class) || $class;
}

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

sub set_delta_time($$) {
    my $self = shift;
    $self->{'delta_time'} = shift;
}

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

sub set_remedian($$) {
    # Set median of the last 999^3 (=997002999) values using Remedian
    #
    # Rousseeuw, Peter J., and Gilbert W. Bassett Jr. "The remedian: A
    # robust averaging method for large data sets." Journal of the
    # American Statistical Association 85.409 (1990): 97-104.
    my $self = shift;
    my $val = shift;
    my $i = $self->{'remedian_idx'}++;
    my $rref = $self->{'remedian_arr'};
    $rref->[0][$i%999] = $val;
    $rref->[1][$i/999%999] = (sort @{$rref->[0]})[$#{$rref->[0]}/2];
    $rref->[2][$i/999/999%999] = (sort @{$rref->[1]})[$#{$rref->[1]}/2];
    $self->{'remedian'} = (sort @{$rref->[2]})[$#{$rref->[2]}/2];
}

sub update_median_runtime($) {
    # Update delta_time based on runtime of finished job if timeout is
    # a percentage
    my $self = shift;
    my $runtime = shift;
    if($self->{'pct'}) {
        $self->set_remedian($runtime);
        $self->{'delta_time'} = $self->{'pct'} * $self->remedian();
        ::debug("run", "Timeout: $self->{'delta_time'}s ");
    }
}

sub process_timeouts($) {
    # Check if there was a timeout
    my $self = shift;
    # $self->{'queue'} is sorted by start time
    while (@{$self->{'queue'}}) {
        my $job = $self->{'queue'}[0];
        if($job->endtime()) {
            # Job already finished. No need to timeout the job
            # This could be because of --keep-order
            shift @{$self->{'queue'}};
        } elsif($job->is_timedout($self->{'delta_time'})) {
            # Need to shift off queue before kill
            # because kill calls usleep that calls process_timeouts
            shift @{$self->{'queue'}};
            ::warning("This job was killed because it timed out:",
                      $job->replaced());
            $job->kill();
        } else {
            # Because they are sorted by start time the rest are later
            last;
        }
    }
}

sub insert($) {
    my $self = shift;
    my $in = shift;
    push @{$self->{'queue'}}, $in;
}


package SQL;

sub new($) {
    my $class = shift;
    my $dburl = shift;
    $Global::use{"DBI"} ||= eval "use DBI; 1;";
    # +DBURL = append to this DBURL
    my $append = $dburl=~s/^\+//;
    my %options = parse_dburl(get_alias($dburl));
    my %driveralias = ("sqlite" => "SQLite",
                       "sqlite3" => "SQLite",
                       "pg" => "Pg",
                       "postgres" => "Pg",
                       "postgresql" => "Pg",
                       "csv" => "CSV",
                       "oracle" => "Oracle",
                       "ora" => "Oracle");
    my $driver = $driveralias{$options{'databasedriver'}} ||
        $options{'databasedriver'};
    my $database = $options{'database'};
    my $host = $options{'host'} ? ";host=".$options{'host'} : "";
    my $port = $options{'port'} ? ";port=".$options{'port'} : "";
    my $dsn = "DBI:$driver:dbname=$database$host$port";
    my $userid = $options{'user'};
    my $password = $options{'password'};;
    if(not grep /$driver/, DBI->available_drivers) {
        ::error("$driver not supported. Are you missing a perl DBD::$driver module?");
        ::wait_and_exit(255);
    }
    my $dbh;
    if($driver eq "CSV") {
        # CSV does not use normal dsn
        if(-d $database) {
            $dbh = DBI->connect("dbi:CSV:", "", "", { f_dir => "$database", })
                or die $DBI::errstr;
        } else {
            ::error("$database is not a directory.");
            ::wait_and_exit(255);
        }
    } else {
        $dbh = DBI->connect($dsn, $userid, $password,
                           { RaiseError => 1, AutoInactiveDestroy => 1 })
        or die $DBI::errstr;
    }
    $dbh->{'PrintWarn'} = $Global::debug || 0;
    $dbh->{'PrintError'} = $Global::debug || 0;
    $dbh->{'RaiseError'} = 1;
    $dbh->{'ShowErrorStatement'} = 1;
    $dbh->{'HandleError'} = sub {};
    if(not defined $options{'table'}) {
        ::error("The DBURL ($dburl) must contain a table.");
        ::wait_and_exit(255);
    }

    return bless {
        'dbh' => $dbh,
        'driver' => $driver,
        'max_number_of_args' => undef,
        'table' => $options{'table'},
        'append' => $append,
    }, ref($class) || $class;
}

# Prototype forwarding
sub get_alias($);
sub get_alias($) {
    my $alias = shift;
    $alias =~ s/^(sql:)*//; # Accept aliases prepended with sql:
    if ($alias !~ /^:/) {
        return $alias;
    }

    # Find the alias
    my $path;
    if (-l $0) {
        ($path) = readlink($0) =~ m|^(.*)/|;
    } else {
        ($path) = $0 =~ m|^(.*)/|;
    }

    my @deprecated = ("$ENV{HOME}/.dburl.aliases",
                      "$path/dburl.aliases", "$path/dburl.aliases.dist");
    for (@deprecated) {
        if(-r $_) {
            ::warning("$_ is deprecated. ".
                      "Use .sql/aliases instead (read man sql).");
        }
    }
    my @urlalias=();
    check_permissions("$ENV{HOME}/.sql/aliases");
    check_permissions("$ENV{HOME}/.dburl.aliases");
    my @search = ("$ENV{HOME}/.sql/aliases",
                  "$ENV{HOME}/.dburl.aliases", "/etc/sql/aliases",
                  "$path/dburl.aliases", "$path/dburl.aliases.dist");
    for my $alias_file (@search) {
        # local $/ needed if -0 set
        local $/ = "\n";
        if(-r $alias_file) {
            my $in = ::open_or_exit("<",$alias_file);
            push @urlalias, <$in>;
            close $in;
        }
    }
    my ($alias_part,$rest) = $alias=~/(:\w*)(.*)/;
    # If we saw this before: we have an alias loop
    if(grep {$_ eq $alias_part } @Private::seen_aliases) {
        ::error("$alias_part is a cyclic alias.");
        exit -1;
    } else {
        push @Private::seen_aliases, $alias_part;
    }

    my $dburl;
    for (@urlalias) {
        /^$alias_part\s+(\S+.*)/ and do { $dburl = $1; last; }
    }

    if($dburl) {
        return get_alias($dburl.$rest);
    } else {
        ::error("$alias is not defined in @search");
        exit(-1);
    }
}

sub check_permissions($) {
    my $file = shift;

    if(-e $file) {
        if(not -o $file) {
            my $username = (getpwuid($<))[0];
            ::warning("$file should be owned by $username: ".
                      "chown $username $file");
        }
        my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
            $atime,$mtime,$ctime,$blksize,$blocks) = stat($file);
        if($mode & 077) {
            my $username = (getpwuid($<))[0];
            ::warning("$file should be only be readable by $username: ".
                      "chmod 600 $file");
        }
    }
}

sub parse_dburl($) {
    my $url = shift;
    my %options = ();
    # sql:mysql://[[user][:password]@][host][:port]/[database[/table][?query]]

    if($url=~m!^(?:sql:)? # You can prefix with 'sql:'
               ((?:oracle|ora|mysql|pg|postgres|postgresql)(?:s|ssl|)|
                 (?:sqlite|sqlite2|sqlite3|csv)):// # Databasedriver ($1)
               (?:
                ([^:@/][^:@]*|) # Username ($2)
                (?:
                 :([^@]*) # Password ($3)
                )?
               @)?
               ([^:/]*)? # Hostname ($4)
               (?:
                :
                ([^/]*)? # Port ($5)
               )?
               (?:
                /
                ([^/?]*)? # Database ($6)
               )?
               (?:
                /
                ([^?]*)? # Table ($7)
               )?
               (?:
                \?
                (.*)? # Query ($8)
               )?
              $!ix) {
        $options{databasedriver} = ::undef_if_empty(lc(uri_unescape($1)));
        $options{user} = ::undef_if_empty(uri_unescape($2));
        $options{password} = ::undef_if_empty(uri_unescape($3));
        $options{host} = ::undef_if_empty(uri_unescape($4));
        $options{port} = ::undef_if_empty(uri_unescape($5));
        $options{database} = ::undef_if_empty(uri_unescape($6));
        $options{table} = ::undef_if_empty(uri_unescape($7));
        $options{query} = ::undef_if_empty(uri_unescape($8));
        ::debug("sql", "dburl $url\n");
        ::debug("sql", "databasedriver ", $options{databasedriver},
                " user ", $options{user},
                " password ", $options{password}, " host ", $options{host},
                " port ", $options{port}, " database ", $options{database},
                " table ", $options{table}, " query ", $options{query}, "\n");
    } else {
        ::error("$url is not a valid DBURL");
        exit 255;
    }
    return %options;
}

sub uri_unescape($) {
    # Copied from http://cpansearch.perl.org/src/GAAS/URI-1.55/URI/Escape.pm
    # to avoid depending on URI::Escape
    # This section is (C) Gisle Aas.
    # Note from RFC1630:  "Sequences which start with a percent sign
    # but are not followed by two hexadecimal characters are reserved
    # for future extension"
    my $str = shift;
    if (@_ && wantarray) {
        # not executed for the common case of a single argument
        my @str = ($str, @_);  # need to copy
        foreach (@str) {
            s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
        }
        return @str;
    }
    $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg if defined $str;
    $str;
}

sub run($) {
    my $self = shift;
    my $stmt = shift;
    if($self->{'driver'} eq "CSV") {
        $stmt=~ s/;$//;
        if($stmt eq "BEGIN" or
           $stmt eq "COMMIT") {
            return undef;
        }
    }
    my @retval;
    my $dbh = $self->{'dbh'};
    ::debug("sql","$opt::sqlmaster$opt::sqlworker run $stmt\n");
    # Execute with the rest of the args - if any
    my $rv;
    my $sth;
    my $lockretry = 0;
    while($lockretry < 10) {
        $sth = $dbh->prepare($stmt);
        if($sth
           and
           eval { $rv = $sth->execute(@_) }) {
            last;
        } else {
            if($@ =~ /no such table|Table .* doesn.t exist|relation ".*" does not exist/
               or
               $DBI::errstr =~ /no such table|Table .* doesn.t exist|relation ".*" does not exist/) {
                # This is fine:
                # It is just a worker that reported back too late -
                # another worker had finished the job first
                # and the table was then dropped
                $rv = $sth = 0;
                last;
            }
            if($DBI::errstr =~ /locked/) {
                ::debug("sql", "Lock retry: $lockretry");
                $lockretry++;
                ::usleep(rand()*300);
            } elsif(not $sth) {
                # Try again
                $lockretry++;
            } else {
                ::error($DBI::errstr);
                ::wait_and_exit(255);
            }
        }
    }
    if($lockretry >= 10) {
        ::die_bug("retry > 10: $DBI::errstr");
    }
    if($rv < 0 and $DBI::errstr){
        ::error($DBI::errstr);
        ::wait_and_exit(255);
    }
    return $sth;
}

sub get($) {
    my $self = shift;
    my $sth = $self->run(@_);
    my @retval;
    # If $sth = 0 it means the table was dropped by another process
    while($sth) {
        my @row = $sth->fetchrow_array();
        @row or last;
        push @retval, \@row;
    }
    return \@retval;
}

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

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

sub update($) {
    my $self = shift;
    my $stmt = shift;
    my $table = $self->table();
    $self->run("UPDATE $table $stmt",@_);
}

sub output($) {
    my $self = shift;
    my $commandline = shift;

    $self->update("SET Stdout = ?, Stderr = ? WHERE Seq = ".
                  $commandline->seq(),
                  join("",@{$commandline->{'output'}{1}}),
                  join("",@{$commandline->{'output'}{2}}));
}

sub max_number_of_args($) {
    # Maximal number of args for this table
    my $self = shift;
    if(not $self->{'max_number_of_args'}) {
        # Read the number of args from the SQL table
        my $table = $self->table();
        my $v = $self->get("SELECT * FROM $table LIMIT 1;");
        my @reserved_columns = qw(Seq Host Starttime JobRuntime Send
            Receive Exitval _Signal Command Stdout Stderr);
        if(not $v) {
            ::error("$table contains no records");
        }
        # Count the number of Vx columns
        $self->{'max_number_of_args'} = $#{$v->[0]} - $#reserved_columns;
    }
    return $self->{'max_number_of_args'};
}

sub set_max_number_of_args($$) {
    my $self = shift;
    $self->{'max_number_of_args'} = shift;
}

sub create_table($) {
    my $self = shift;
    if($self->append()) { return; }
    my $max_number_of_args = shift;
    $self->set_max_number_of_args($max_number_of_args);
    my $table = $self->table();
    $self->run(qq(DROP TABLE IF EXISTS $table;));
    # BIGINT and TEXT are not supported in these databases or are too small
    my %vartype = (
        "Oracle" => { "BIGINT" => "NUMBER(19,0)",
                      "TEXT" => "CLOB", },
        "mysql" => { "TEXT" => "BLOB", },
        "CSV" => { "BIGINT" => "INT",
                   "FLOAT" => "REAL", },
        );
    my $BIGINT = $vartype{$self->{'driver'}}{"BIGINT"} || "BIGINT";
    my $TEXT = $vartype{$self->{'driver'}}{"TEXT"} || "TEXT";
    my $FLOAT = $vartype{$self->{'driver'}}{"FLOAT"} || "FLOAT(44)";
    my $v_def = join "", map { "V$_ $TEXT," } (1..$self->max_number_of_args());
    $self->run(qq{CREATE TABLE $table
                (Seq $BIGINT,
                 Host $TEXT,
                 Starttime $FLOAT,
                 JobRuntime $FLOAT,
                 Send $BIGINT,
                 Receive $BIGINT,
                 Exitval $BIGINT,
                 _Signal $BIGINT,
                 Command $TEXT,}.
               $v_def.
               qq{Stdout $TEXT,
                 Stderr $TEXT);});
}

sub insert_records($) {
    my $self = shift;
    my $seq = shift;
    my $command_ref = shift;
    my $record_ref = shift;
    my $table = $self->table();
    # For SQL encode the command with \257 space as split points
    my $command = join("\257 ",@$command_ref);
    my @v_cols = map { ", V$_" } (1..$self->max_number_of_args());
    # Two extra value due to $seq, Exitval, Send
    my $v_vals = join ",", map { "?" } (1..$self->max_number_of_args()+4);
    $self->run("INSERT INTO $table (Seq,Command,Exitval,Send @v_cols) ".
               "VALUES ($v_vals);", $seq, $command, -1000,
               0, @$record_ref[1..$#$record_ref]);
}


sub get_record($) {
    my $self = shift;
    my @retval;
    my $table = $self->table();
    my @v_cols = map { ", V$_" } (1..$self->max_number_of_args());
    my $rand = "Reserved-".$$.rand();
    my $v;
    my $more_pending;

    do {
        if($self->{'driver'} eq "CSV") {
            # Sub SELECT is not supported in CSV
            # So to minimize the race condition below select a job at random
            my $r = $self->get("SELECT Seq, Command @v_cols FROM $table ".
                               "WHERE Exitval = -1000 LIMIT 100;");
            $v = [ sort { rand() > 0.5 } @$r ];
        } else {
            # Avoid race condition where multiple workers get the same job
            # by setting Stdout to a unique string
            # (SELECT * FROM (...) AS dummy) is needed due to sillyness in MySQL
            $self->update("SET Stdout = ?,Exitval = ? ".
                          "WHERE Seq = (".
                          "  SELECT * FROM (".
                          "    SELECT min(Seq) FROM $table WHERE Exitval = -1000".
                          "  ) AS dummy".
                          ") AND Exitval = -1000;", $rand, -1210);
            # If a parallel worker overwrote the unique string this will get nothing
            $v = $self->get("SELECT Seq, Command @v_cols FROM $table ".
                            "WHERE Stdout = ?;", $rand);
        }
        if($v->[0]) {
            my $val_ref = $v->[0];
            # Mark record as taken
            my $seq = shift @$val_ref;
            # Save the sequence number to use when running the job
            $SQL::next_seq = $seq;
            $self->update("SET Exitval = ? WHERE Seq = ".$seq, -1220);
            # Command is encoded with '\257 space' as splitting char
            my @command = split /\257 /, shift @$val_ref;
            $SQL::command_ref = \@command;
            for (@$val_ref) {
                push @retval, Arg->new($_);
            }
        } else {
            # If the record was updated by another job in parallel,
            # then we may not be done, so see if there are more jobs pending
            $more_pending =
                $self->get("SELECT Seq FROM $table WHERE Exitval = ?;", -1210);
        }
    } while (not $v->[0] and $more_pending->[0]);

    if(@retval) {
        return \@retval;
    } else {
        return undef;
    }
}

sub total_jobs($) {
    my $self = shift;
    my $table = $self->table();
    my $v = $self->get("SELECT count(*) FROM $table;");
    if($v->[0]) {
        return $v->[0]->[0];
    } else {
        ::die_bug("SQL::total_jobs");
    }
}

sub max_seq($) {
    my $self = shift;
    my $table = $self->table();
    my $v = $self->get("SELECT max(Seq) FROM $table;");
    if($v->[0]) {
        return $v->[0]->[0];
    } else {
        ::die_bug("SQL::max_seq");
    }
}

sub finished($) {
    # Check if there are any jobs left in the SQL table that do not
    # have a "real" exitval
    my $self = shift;
    if($opt::wait or $Global::start_sqlworker) {
        my $table = $self->table();
        my $rv = $self->get("select Seq,Exitval from $table ".
                            "where Exitval <= -1000 limit 1");
        return not $rv->[0];
    } else {
        return 1;
    }
}

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_HOME/semaphores/id-<name> Each
# file in $PARALLEL_HOME/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.

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_locks = $Global::cache_dir . "/semaphores";
    -d $parallel_locks or ::mkdir_or_die($parallel_locks);
    my $lockdir = "$parallel_locks/$id";
    my $lockfile = $lockdir.".lock";
    if(-d $parallel_locks and -w $parallel_locks
       and -r $parallel_locks and -x $parallel_locks) {
        # skip
    } else {
        ::error("Semaphoredir must be writable: '$parallel_locks'");
        ::wait_and_exit(255);
    }

    if($count < 1) { ::die_bug("semaphore-count: $count"); }
    return bless {
        'lockfile' => $lockfile,
        'lockfh' => Symbol::gensym(),
        'lockdir' => $lockdir,
        'id' => $id,
        'idfile' => $lockdir."/".$id,
        'pid' => $$,
        'pidfile' => $lockdir."/".$$.'@'.::hostname(),
        'count' => $count + 1 # nlinks returns a link for the 'id-' as well
    }, ref($class) || $class;
}

sub remove_dead_locks($) {
    my $self = shift;
    my $lockdir = $self->{'lockdir'};

    for my $d (glob "$lockdir/*") {
        $d =~ m:$lockdir/([0-9]+)\@([-\._a-z0-9]+)$:o or next;
        my ($pid, $host) = ($1, $2);
        if($host eq ::hostname()) {
            if(kill 0, $pid) {
                ::debug("sem", "Alive: $pid $d\n");
            } else {
                ::debug("sem", "Dead: $d\n");
                ::rm($d);
            }
        }
    }
}

sub acquire($) {
    my $self = shift;
    my $sleep = 1; # 1 ms
    my $start_time = time;
    while(1) {
        # Can we get a lock?
        $self->atomic_link_if_count_less_than() and last;
        $self->remove_dead_locks();
        # Retry slower and slower up to 1 second
        $sleep = ($sleep < 1000) ? ($sleep * 1.1) : ($sleep);
        # Random to avoid every sleeping job waking up at the same time
        ::usleep(rand()*$sleep);
        if($opt::semaphoretimeout) {
            if($opt::semaphoretimeout > 0
               and
               time - $start_time > $opt::semaphoretimeout) {
                # Timeout: Take the semaphore anyway
                ::warning("Semaphore timed out. Stealing the semaphore.");
                if(not -e $self->{'idfile'}) {
                    open (my $fh, ">", $self->{'idfile'}) or
                        ::die_bug("timeout_write_idfile: $self->{'idfile'}");
                    close $fh;
                }
                link $self->{'idfile'}, $self->{'pidfile'};
                last;
            }
            if($opt::semaphoretimeout < 0
               and
               time - $start_time > -$opt::semaphoretimeout) {
                # Timeout: Exit
                ::warning("Semaphore timed out. Exiting.");
                exit(1);
                last;
            }
        }
    }
    ::debug("sem", "acquired $self->{'pid'}\n");
}

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

sub pid_change($) {
    # This should do what release()+acquire() would do without having
    # to re-acquire the semaphore
    my $self = shift;

    my $old_pidfile =  $self->{'pidfile'};
    $self->{'pid'} = $$;
    $self->{'pidfile'} = $self->{'lockdir'}."/".$$.'@'.::hostname();
    my $retval = link $self->{'idfile'}, $self->{'pidfile'};
    ::debug("sem","link($self->{'idfile'},$self->{'pidfile'})=$retval\n");
    ::rm($old_pidfile);
}

sub atomic_link_if_count_less_than($) {
    # Link $file1 to $file2 if nlinks to $file1 < $count
    my $self = shift;
    my $retval = 0;
    $self->lock();
    my $nlinks = $self->nlinks();
    ::debug("sem","$nlinks<$self->{'count'} ");
    if($nlinks < $self->{'count'}) {
        -d $self->{'lockdir'} or ::mkdir_or_die($self->{'lockdir'});
        if(not -e $self->{'idfile'}) {
            open (my $fh, ">", $self->{'idfile'}) or
                ::die_bug("write_idfile: $self->{'idfile'}");
            close $fh;
        }
        $retval = link $self->{'idfile'}, $self->{'pidfile'};
        ::debug("sem","link($self->{'idfile'},$self->{'pidfile'})=$retval\n");
    }
    $self->unlock();
    ::debug("sem", "atomic $retval");
    return $retval;
}

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

sub lock($) {
    my $self = shift;
    my $sleep = 100; # 100 ms
    my $total_sleep = 0;
    $Global::use{"Fcntl"} ||= eval "use Fcntl qw(:DEFAULT :flock); 1;";
    my $locked = 0;
    while(not $locked) {
        if(tell($self->{'lockfh'}) == -1) {
            # File not open
            open($self->{'lockfh'}, ">", $self->{'lockfile'})
                or ::debug("run", "Cannot open $self->{'lockfile'}");
        }
        if($self->{'lockfh'}) {
            # File is open
            chmod 0666, $self->{'lockfile'}; # assuming you want it a+rw
            if(flock($self->{'lockfh'}, LOCK_EX()|LOCK_NB())) {
                # The file is locked: No need to retry
                $locked = 1;
                last;
            } else {
                if ($! =~ m/Function not implemented/) {
                    ::warning("flock: $!",
                              "Will wait for a random while.");
                    ::usleep(rand(5000));
                    # File cannot be locked: No need to retry
                    $locked = 2;
                    last;
                }
            }
        }
        # Locking failed in first round
        # Sleep and try again
        $sleep = ($sleep < 1000) ? ($sleep * 1.1) : ($sleep);
        # Random to avoid every sleeping job waking up at the same time
        ::usleep(rand()*$sleep);
        $total_sleep += $sleep;
        if($opt::semaphoretimeout) {
            if($opt::semaphoretimeout > 0
               and
               $total_sleep/1000 > $opt::semaphoretimeout) {
                # Timeout: Take the semaphore anyway
                ::warning("Semaphore timed out. Taking the semaphore.");
                $locked = 3;
                last;
            }
            if($opt::semaphoretimeout < 0
               and
               $total_sleep/1000 > -$opt::semaphoretimeout) {
                # Timeout: Exit
                ::warning("Semaphore timed out. Exiting.");
                $locked = 4;
                last;
            }
        } else {
            if($total_sleep/1000 > 30) {
                ::warning("Semaphore stuck for 30 seconds. ".
                          "Consider using --semaphoretimeout.");
            }
        }
    }
    ::debug("run", "locked $self->{'lockfile'}");
}

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

# Keep perl -w happy

$opt::x = $Semaphore::timeout = $Semaphore::wait =
$Job::file_descriptor_warning_printed = $Global::envdef = @Arg::arg =
$Global::max_slot_number = $opt::session;

package main;


sub main() {
    unpack_combined_executable();
    save_stdin_stdout_stderr();
    save_original_signal_handler();
    parse_options();
    ::debug("init", "Open file descriptors: ", join(" ",keys %Global::fh), "\n");
    my $number_of_args;
    if($Global::max_number_of_args) {
        $number_of_args = $Global::max_number_of_args;
    } elsif ($opt::X or $opt::m or $opt::xargs) {
        $number_of_args = undef;
    } else {
        $number_of_args = 1;
    }

    my @command = @ARGV;
    my @input_source_fh;
    if($opt::pipepart) {
        if($opt::tee) {
            @input_source_fh = map { open_or_exit("<",$_) } @opt::a;
            # Remove the first: It will be the file piped.
            shift @input_source_fh;
            if(not @input_source_fh and not $opt::pipe) {
                @input_source_fh = (*STDIN);
            }
        } else {
            # -a is used for data - not for command line args
            @input_source_fh = map { open_or_exit("<",$_) } "/dev/null";
        }
    } else {
        @input_source_fh = map { open_or_exit("<",$_) } @opt::a;
        if(not @input_source_fh and not $opt::pipe) {
            @input_source_fh = (*STDIN);
        }
    }

    if($opt::skip_first_line) {
        # Skip the first line for the first file handle
        my $fh = $input_source_fh[0];
        <$fh>;
    }

    set_input_source_header(\@command,\@input_source_fh);
    if($opt::filter_hosts and (@opt::sshlogin or @opt::sshloginfile)) {
        # Parallel check all hosts are up. Remove hosts that are down
        filter_hosts();
    }
    if($opt::sqlmaster and $opt::sqlworker) {
        # Start a real --sqlworker in the background later
        $Global::start_sqlworker = 1;
        $opt::sqlworker = undef;
    }

    $Global::start_time = ::now();
    if($opt::nonall or $opt::onall) {
        onall(\@input_source_fh,@command);
        wait_and_exit(min(undef_as_zero($Global::exitstatus),254));
    }

    $Global::JobQueue = JobQueue->new(
        \@command, \@input_source_fh, $Global::ContextReplace,
        $number_of_args, \@Global::transfer_files, \@Global::ret_files,
        \@Global::template_names, \@Global::template_contents
        );

    if($opt::sqlmaster) {
        # Create SQL table to hold joblog + output
        # Figure out how many arguments are in a job
        # (It is affected by --colsep, -N, $number_source_fh)
        my $record_queue = $Global::JobQueue->{'commandlinequeue'}{'arg_queue'};
        my $record = $record_queue->get();
        my $no_of_values = $number_of_args * (1+$#{$record});
        $record_queue->unget($record);
        $Global::sql->create_table($no_of_values);
        if($opt::sqlworker) {
            # Start a real --sqlworker in the background later
            $Global::start_sqlworker = 1;
            $opt::sqlworker = undef;
        }
    }

    if($opt::pipepart) {
        pipepart_setup();
    } elsif($opt::pipe) {
        if($opt::tee) {
            pipe_tee_setup();
        } elsif($opt::shard or $opt::bin) {
            pipe_shard_setup();
        } elsif($opt::groupby) {
            pipe_group_by_setup();
        }
    }

    if($opt::eta or $opt::bar or $opt::shuf or $Global::halt_pct) {
        # Count the number of jobs or shuffle all jobs
        # before starting any.
        # Must be done after ungetting any --pipepart jobs.
        $Global::JobQueue->total_jobs();
    }
    # Compute $Global::max_jobs_running
    # Must be done after ungetting any --pipepart jobs.
    max_jobs_running();
    init_run_jobs();
    my $sem;
    if($Global::semaphore) {
        $sem = acquire_semaphore();
    }
    $SIG{TERM} = $Global::original_sig{TERM};
    $SIG{HUP} = \&start_no_new_jobs;

    if($opt::progress) {
        ::status_no_nl(init_progress());
    }
    if($opt::tee or $opt::shard or $opt::bin) {
        # All jobs must be running in parallel for --tee/--shard/--bin
        while(start_more_jobs()) {}
        $Global::start_no_new_jobs = 1;
        if(not $Global::JobQueue->empty()) {
            if($opt::tee) {
                ::error("--tee requires --jobs to be higher. Try --jobs 0.");
            } elsif($opt::bin) {
                ::error("--bin requires --jobs to be higher than the number of",
                        "arguments. Increase --jobs.");
            } elsif($opt::shard) {
                ::error("--shard requires --jobs to be higher than the number of",
                        "arguments. Increase --jobs.");
            } else {
                ::die_bug("--bin/--shard/--tee should not get here");
            }
            ::wait_and_exit(255);
        }
    } elsif($opt::pipe and not $opt::pipepart and not $opt::semaphore) {
        # Fill all jobslots
        while(start_more_jobs()) {}
        spreadstdin();
    } else {
        # Reap the finished jobs and start more
        while(reapers() + start_more_jobs()) {}
    }
    ::debug("init", "Start draining\n");
    drain_job_queue(@command);
    ::debug("init", "Done draining\n");
    reapers();
    ::debug("init", "Done reaping\n");
    if($Global::semaphore) { $sem->release(); }
    cleanup();
    ::debug("init", "Halt\n");
    halt();
}

main();