tange/parallel
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/parallel.git synced 2024-11-25 23:47:53 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

parallel: --shebang-wrap for FreeBSD. cattail refactored.

Browse source
This commit is contained in:
Ole Tange 2014-06-23 02:08:24 +02:00
parent d8161294b2
commit 21753cbbd7
1 changed files with 118 additions and 65 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

71
src/parallel
View file

@ -1171,10 +1171,27 @@ sub read_options {
exec "$0 --skip-first-line -a $argfile @ARGV";
}
if($opt::shebang_wrap) {
my $parser = shift @ARGV;
my $scriptfile = shell_quote_scalar(shift @ARGV);
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 = shell_quote_scalar(shift @ARGV);
# exec myself to split $ARGV[0] into separate fields
exec "$0 --internal-pipe-means-argfiles $parser $scriptfile ::: @ARGV";
exec "$0 --internal-pipe-means-argfiles @options @parser $script ::: @ARGV";
}
}
@ -4315,10 +4332,14 @@ sub slot {
return $self->{'commandline'}->slot();
}
{
my($cattail);
sub cattail {
# Returns:
# $cattail = perl program for: cattail "decompress program" writerpid [file_to_decompress or stdin] [file_to_unlink]
my $cattail = q{
if(not $cattail) {
$cattail = q{
# cat followed by tail.
# If $writerpid dead: finish after this round
use Fcntl;
@ -4373,8 +4394,12 @@ sub cattail {
select(undef, undef, undef, $secs/1000);
}
};
$cattail =~ s/#.*//mg;
$cattail =~ s/\s+/ /g;
}
return $cattail;
}
}
sub openoutputfiles {
# Open files for STDOUT and STDERR
@ -4836,6 +4861,7 @@ sub sshlogin_wrap {
if($opt::pipe and $opt::ctrlc
or
not $opt::pipe and not $opt::noctrlc) {
# TODO Determine if this is needed
# Propagating CTRL-C to kill remote jobs requires
# remote jobs to be run with a terminal.
$ssh_options = "-tt -oLogLevel=quiet";
@ -4850,13 +4876,40 @@ sub sshlogin_wrap {
my $wd = ::shell_quote_file($self->workdir());
$remote_pre .= ::shell_quote_scalar("mkdir -p ") . $wd .
::shell_quote_scalar("; cd ") . $wd .
::shell_quote_scalar(qq{ || exit 255;});
# exit 255 (instead of exec false) would be the correct thing,
# but that fails on tcsh
::shell_quote_scalar(qq{ || exec false;});
}
my $signal_script = "perl -e '".
q{
use IO::Poll;
$SIG{CHLD} = sub {exit ($?&127 ? 128+($?&127) : 1+$?>>8)};
$p = IO::Poll->new;
$p->mask(STDOUT, POLLHUP);
$pid=fork; unless($pid) {setpgrp; exec $ENV{SHELL}, "-c", @ARGV; die "exec: $!\n"}
$p->poll;
kill SIGHUP, -$pid unless $done;
wait; exit ($?&127 ? 128+($?&127) : 1+$?>>8)
} . "' ";
# q{
# use IO::Poll;
# $SIG{CHLD} = sub {$done = 1};
# $p = IO::Poll->new;
# $p->mask(STDOUT, POLLHUP);
# $pid=fork; unless($pid) {setpgrp; exec $ENV{SHELL}, "-c", @ARGV; die "exec: $!\n"}
# $p->poll;
# kill SIGHUP, -$pid unless $done;
# wait; exit ($?&127 ? 128+($?&127) : 1+$?>>8)
# } . "' ";
$signal_script =~ s/\s+/ /g;
$self->{'sshlogin_wrap'} =
($pre
. "$sshcmd $ssh_options $serverlogin $parallel_env "
. $remote_pre
. ::shell_quote_scalar($next_command_line) . ";"
# . ::shell_quote_scalar($signal_script . ::shell_quote_scalar($next_command_line))
. ::shell_quote_scalar($next_command_line)
. ";"
. $post);
}
}
@ -5488,7 +5541,7 @@ sub set_exitsignal {
or
tell $disk_full_fh == $pos) {
::error("Output is incomplete. Cannot append to buffer file in \$TMPDIR. Is the disk full?\n");
::error("Change \$TMPDIR with --tmpdir.\n");
::error("Change \$TMPDIR with --tmpdir or use --compress.\n");
::wait_and_exit(255);
}
truncate $disk_full_fh, $pos;
@ -7091,6 +7144,6 @@ sub mkdir_or_die {
}
# Keep perl -w happy
$opt::x = $Semaphore::timeout = $Semaphore::wait = $opt::shebang = $Global::no_more_file_handles_warned =
$Job::file_descriptor_warning_printed = 0;
$opt::x = $Semaphore::timeout = $Semaphore::wait = $Global::no_more_file_handles_warned =
$Job::file_descriptor_warning_printed = $Global::max_slot_number = 0;