parallel: Fixed bug #51920: BUG: Set $/ in lots of places before calling chomp.

parallel: chomp used more aggressively.
This commit is contained in:
Ole Tange 2017-09-07 22:33:25 +02:00
parent 1e62be2464
commit 68114b93e7
4 changed files with 110 additions and 45 deletions

View file

@ -1,5 +1,6 @@
People who have helped GNU Parallel different ways. People who have helped GNU Parallel different ways.
Jonathan Kamens: Bug patch for chomp.
John Rusnak: Feedback on all documentation. John Rusnak: Feedback on all documentation.
FrithMartin: Bug patch for orphan blocks. FrithMartin: Bug patch for orphan blocks.
Rasmus Villemoes: Code snips for signal processing. Rasmus Villemoes: Code snips for signal processing.

View file

@ -211,6 +211,8 @@ Haiku of the month:
New in this release: New in this release:
https://til.hashrocket.com/posts/ggt1jaes4y-download-all-of-humble-bundle-books-in-parallel
<<Citation not OK: BAMClipper: removing primers from alignments to minimize false-negative mutations in amplicon next-generation sequencing https://www.nature.com/articles/s41598-017-01703-6>> <<Citation not OK: BAMClipper: removing primers from alignments to minimize false-negative mutations in amplicon next-generation sequencing https://www.nature.com/articles/s41598-017-01703-6>>
<<Wrong citation https://iris.sissa.it/retrieve/handle/20.500.11767/36149/10823/And%C3%B2_tesi.pdf>> <<Wrong citation https://iris.sissa.it/retrieve/handle/20.500.11767/36149/10823/And%C3%B2_tesi.pdf>>

View file

@ -1611,6 +1611,7 @@ sub parse_semaphore {
if(defined $opt::semaphorename) { if(defined $opt::semaphorename) {
$Semaphore::name = $opt::semaphorename; $Semaphore::name = $opt::semaphorename;
} else { } else {
local $/ = "\n";
$Semaphore::name = `tty`; $Semaphore::name = `tty`;
chomp $Semaphore::name; chomp $Semaphore::name;
} }
@ -1919,6 +1920,7 @@ sub read_options {
} }
for my $profile (@profiles) { for my $profile (@profiles) {
if(-r $profile) { if(-r $profile) {
local $/ = "\n";
open (my $in_fh, "<", $profile) || open (my $in_fh, "<", $profile) ||
::die_bug("read-profile: $profile"); ::die_bug("read-profile: $profile");
while(<$in_fh>) { while(<$in_fh>) {
@ -3135,6 +3137,7 @@ sub read_sshloginfile {
# Uses: # Uses:
# @Global::sshlogin # @Global::sshlogin
# Returns: N/A # Returns: N/A
local $/ = "\n";
my $file = shift; my $file = shift;
my $close = 1; my $close = 1;
my $in_fh; my $in_fh;
@ -3427,6 +3430,7 @@ sub parse_host_filtering {
# \%maxlen = max command len on {host} # \%maxlen = max command len on {host}
# \%echo = echo received from {host} # \%echo = echo received from {host}
# \@down_hosts = list of hosts with no answer # \@down_hosts = list of hosts with no answer
local $/ = "\n";
my (%ncores, %ncpus, %time_to_login, %maxlen, %echo, @down_hosts); my (%ncores, %ncpus, %time_to_login, %maxlen, %echo, @down_hosts);
for (@_) { for (@_) {
::debug("init",$_); ::debug("init",$_);
@ -4295,7 +4299,7 @@ sub qqx {
# tmux needs LC_CTYPE # tmux needs LC_CTYPE
my @keep = qw(PATH SSH_AUTH_SOCK SSH_AGENT_PID KRB5CCNAME LC_CTYPE); my @keep = qw(PATH SSH_AUTH_SOCK SSH_AGENT_PID KRB5CCNAME LC_CTYPE);
@env{@keep} = @ENV{@keep}; @env{@keep} = @ENV{@keep};
local(%ENV); local %ENV;
%ENV = %env; %ENV = %env;
if($Global::debug) { if($Global::debug) {
return qx{ @_ && true }; return qx{ @_ && true };
@ -4375,43 +4379,42 @@ sub multiply_binary_prefix {
# $s = string with prefixes # $s = string with prefixes
# Returns: # Returns:
# $value = int with prefixes multiplied # $value = int with prefixes multiplied
my $s = shift; my @v = @_;
if(not $s) { for(@v) {
return $s; 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 $_;
} }
$s =~ s/ki/*1024/gi; return wantarray ? @v : $v[0];
$s =~ s/mi/*1024*1024/gi;
$s =~ s/gi/*1024*1024*1024/gi;
$s =~ s/ti/*1024*1024*1024*1024/gi;
$s =~ s/pi/*1024*1024*1024*1024*1024/gi;
$s =~ s/ei/*1024*1024*1024*1024*1024*1024/gi;
$s =~ s/zi/*1024*1024*1024*1024*1024*1024*1024/gi;
$s =~ s/yi/*1024*1024*1024*1024*1024*1024*1024*1024/gi;
$s =~ s/xi/*1024*1024*1024*1024*1024*1024*1024*1024*1024/gi;
$s =~ s/K/*1024/g;
$s =~ s/M/*1024*1024/g;
$s =~ s/G/*1024*1024*1024/g;
$s =~ s/T/*1024*1024*1024*1024/g;
$s =~ s/P/*1024*1024*1024*1024*1024/g;
$s =~ s/E/*1024*1024*1024*1024*1024*1024/g;
$s =~ s/Z/*1024*1024*1024*1024*1024*1024*1024/g;
$s =~ s/Y/*1024*1024*1024*1024*1024*1024*1024*1024/g;
$s =~ s/X/*1024*1024*1024*1024*1024*1024*1024*1024*1024/g;
$s =~ s/k/*1000/g;
$s =~ s/m/*1000*1000/g;
$s =~ s/g/*1000*1000*1000/g;
$s =~ s/t/*1000*1000*1000*1000/g;
$s =~ s/p/*1000*1000*1000*1000*1000/g;
$s =~ s/e/*1000*1000*1000*1000*1000*1000/g;
$s =~ s/z/*1000*1000*1000*1000*1000*1000*1000/g;
$s =~ s/y/*1000*1000*1000*1000*1000*1000*1000*1000/g;
$s =~ s/x/*1000*1000*1000*1000*1000*1000*1000*1000*1000/g;
$s = eval $s;
::debug($s);
return $s;
} }
{ {
@ -4479,6 +4482,7 @@ sub spacefree {
{ {
my $hostname; my $hostname;
sub hostname { sub hostname {
local $/ = "\n";
if(not $hostname) { if(not $hostname) {
$hostname = `hostname`; $hostname = `hostname`;
chomp($hostname); chomp($hostname);
@ -4796,6 +4800,7 @@ sub my_memory_usage {
use strict; use strict;
use FileHandle; use FileHandle;
local $/ = "\n";
my $pid = $$; my $pid = $$;
if(-e "/proc/$pid/stat") { if(-e "/proc/$pid/stat") {
my $fh = FileHandle->new("</proc/$pid/stat"); my $fh = FileHandle->new("</proc/$pid/stat");
@ -5153,7 +5158,8 @@ sub limit {
my $tmpfile = ::tmpname("parlmt"); my $tmpfile = ::tmpname("parlmt");
$Global::unlink{$tmpfile}; $Global::unlink{$tmpfile};
$self->{'limitscript'} = $self->{'limitscript'} =
::spacefree(1, sprintf($limitscripts{$cmd},@args,$tmpfile)); ::spacefree(1, sprintf($limitscripts{$cmd},
::multiply_binary_prefix(@args),$tmpfile));
} else { } else {
$self->{'limitscript'} = $opt::limit; $self->{'limitscript'} = $opt::limit;
} }
@ -5874,6 +5880,7 @@ sub simultaneous_sshlogin {
# (ssh host echo simultaneouslogin & ssh host echo simultaneouslogin & ...)|grep simul|wc -l # (ssh host echo simultaneouslogin & ssh host echo simultaneouslogin & ...)|grep simul|wc -l
# Returns: # Returns:
# Number of succesful logins # Number of succesful logins
local $/ = "\n";
my $self = shift; my $self = shift;
my $wanted_processes = shift; my $wanted_processes = shift;
my $sshcmd = $self->sshcommand(); my $sshcmd = $self->sshcommand();
@ -5944,6 +5951,7 @@ sub user_requested_processes {
} }
sub ncpus { sub ncpus {
local $/ = "\n";
my $self = shift; my $self = shift;
if(not defined $self->{'ncpus'}) { if(not defined $self->{'ncpus'}) {
my $sshcmd = $self->sshcommand(); my $sshcmd = $self->sshcommand();
@ -6168,6 +6176,7 @@ sub no_of_cpus_freebsd {
# Returns: # Returns:
# Number of physical CPUs on FreeBSD # Number of physical CPUs on FreeBSD
# undef if not FreeBSD # undef if not FreeBSD
local $/ = "\n";
my $no_of_cpus = my $no_of_cpus =
(::qqx(qq{ sysctl -a dev.cpu | grep \%parent | awk '{ print \$2 }' | uniq | wc -l | awk '{ print \$1 }' }) (::qqx(qq{ sysctl -a dev.cpu | grep \%parent | awk '{ print \$2 }' | uniq | wc -l | awk '{ print \$1 }' })
or or
@ -6180,6 +6189,7 @@ sub no_of_cores_freebsd {
# Returns: # Returns:
# Number of CPU cores on FreeBSD # Number of CPU cores on FreeBSD
# undef if not FreeBSD # undef if not FreeBSD
local $/ = "\n";
my $no_of_cores = my $no_of_cores =
(::qqx(qq{ sysctl hw.ncpu | awk '{ print \$2 }' }) (::qqx(qq{ sysctl hw.ncpu | awk '{ print \$2 }' })
or or
@ -6192,6 +6202,7 @@ sub no_of_cpus_netbsd {
# Returns: # Returns:
# Number of physical CPUs on NetBSD # Number of physical CPUs on NetBSD
# undef if not NetBSD # undef if not NetBSD
local $/ = "\n";
my $no_of_cpus = ::qqx("sysctl -n hw.ncpu"); my $no_of_cpus = ::qqx("sysctl -n hw.ncpu");
chomp $no_of_cpus; chomp $no_of_cpus;
return $no_of_cpus; return $no_of_cpus;
@ -6201,6 +6212,7 @@ sub no_of_cores_netbsd {
# Returns: # Returns:
# Number of CPU cores on NetBSD # Number of CPU cores on NetBSD
# undef if not NetBSD # undef if not NetBSD
local $/ = "\n";
my $no_of_cores = ::qqx("sysctl -n hw.ncpu"); my $no_of_cores = ::qqx("sysctl -n hw.ncpu");
chomp $no_of_cores; chomp $no_of_cores;
return $no_of_cores; return $no_of_cores;
@ -6210,6 +6222,7 @@ sub no_of_cpus_openbsd {
# Returns: # Returns:
# Number of physical CPUs on OpenBSD # Number of physical CPUs on OpenBSD
# undef if not OpenBSD # undef if not OpenBSD
local $/ = "\n";
my $no_of_cpus = ::qqx('sysctl -n hw.ncpu'); my $no_of_cpus = ::qqx('sysctl -n hw.ncpu');
chomp $no_of_cpus; chomp $no_of_cpus;
return $no_of_cpus; return $no_of_cpus;
@ -6219,6 +6232,7 @@ sub no_of_cores_openbsd {
# Returns: # Returns:
# Number of CPU cores on OpenBSD # Number of CPU cores on OpenBSD
# undef if not OpenBSD # undef if not OpenBSD
local $/ = "\n";
my $no_of_cores = ::qqx('sysctl -n hw.ncpu'); my $no_of_cores = ::qqx('sysctl -n hw.ncpu');
chomp $no_of_cores; chomp $no_of_cores;
return $no_of_cores; return $no_of_cores;
@ -6228,6 +6242,7 @@ sub no_of_cpus_hurd {
# Returns: # Returns:
# Number of physical CPUs on HURD # Number of physical CPUs on HURD
# undef if not HURD # undef if not HURD
local $/ = "\n";
my $no_of_cpus = ::qqx("nproc"); my $no_of_cpus = ::qqx("nproc");
chomp $no_of_cpus; chomp $no_of_cpus;
return $no_of_cpus; return $no_of_cpus;
@ -6237,6 +6252,7 @@ sub no_of_cores_hurd {
# Returns: # Returns:
# Number of physical CPUs on HURD # Number of physical CPUs on HURD
# undef if not HURD # undef if not HURD
local $/ = "\n";
my $no_of_cores = ::qqx("nproc"); my $no_of_cores = ::qqx("nproc");
chomp $no_of_cores; chomp $no_of_cores;
return $no_of_cores; return $no_of_cores;
@ -6312,6 +6328,7 @@ sub no_of_cpus_aix {
# Returns: # Returns:
# Number of physical CPUs on AIX # Number of physical CPUs on AIX
# undef if not AIX # undef if not AIX
local $/ = "\n";
my $no_of_cpus = 0; my $no_of_cpus = 0;
if(-x "/usr/sbin/lscfg") { if(-x "/usr/sbin/lscfg") {
open(my $in_fh, "-|", "/usr/sbin/lscfg -vs |grep proc | wc -l|tr -d ' '") open(my $in_fh, "-|", "/usr/sbin/lscfg -vs |grep proc | wc -l|tr -d ' '")
@ -7741,6 +7758,7 @@ sub sshlogin_wrap {
} }
} }
if(grep { /^_$/ } @vars) { if(grep { /^_$/ } @vars) {
local $/ = "\n";
# --env _ # --env _
# Include all vars that are not in a clean environment # Include all vars that are not in a clean environment
if(open(my $vars_fh, "<", $ENV{'PARALLEL_HOME'} . "/ignored_vars")) { if(open(my $vars_fh, "<", $ENV{'PARALLEL_HOME'} . "/ignored_vars")) {
@ -10177,6 +10195,7 @@ sub tmux_length {
# $len = maximal command line length # $len = maximal command line length
# Returns: # Returns:
# $tmux_len = maximal length runable in tmux # $tmux_len = maximal length runable in tmux
local $/ = "\n";
my $len = shift; my $len = shift;
if($opt::tmux) { if($opt::tmux) {
$ENV{'PARALLEL_TMUX'} ||= "tmux"; $ENV{'PARALLEL_TMUX'} ||= "tmux";
@ -10568,7 +10587,7 @@ sub read_arg_from_fh {
} }
} }
# Remove delimiter # Remove delimiter
$arg =~ s:$/$::; chomp $arg;
if($Global::end_of_file_string and if($Global::end_of_file_string and
$arg eq $Global::end_of_file_string) { $arg eq $Global::end_of_file_string) {
# Ignore the rest of input file # Ignore the rest of input file

View file

@ -72,7 +72,7 @@ change GNU B<parallel>.
=head1 OPTIONS =head1 OPTIONS
=over 9 =over 4
=item I<command> =item I<command>
@ -1042,6 +1042,49 @@ B<-l 0> is an alias for B<-l 1>.
Implies B<-X> unless B<-m>, B<--xargs>, or B<--pipe> is set. Implies B<-X> unless B<-m>, B<--xargs>, or B<--pipe> is set.
=item B<--limit> "I<command> I<args>" (alpha testing)
Dynamic job limit. Before starting a new job run I<command> with
I<args>. The exit value of I<command> determines what GNU B<parallel>
will do:
=over 4
=item Z<>0
Below limit. Start another job.
=item Z<>1
Over limit. Start no jobs.
=item Z<>2
Way over limit. Kill the youngest job.
=back
You can use any shell command. There are 3 predefined commands:
=over 10
=item "io I<n>"
Limit for I/O. The amount of disk I/O will be computed as a value
0-100, where 0 is no I/O and 100 is at least one disk is 100%
saturated.
=item "load I<n>"
Similar to B<--load>.
=item "mem I<n>"
Similar to B<--memfree>.
=back
=item B<--line-buffer> (beta testing) =item B<--line-buffer> (beta testing)
=item B<--lb> (beta testing) =item B<--lb> (beta testing)
@ -3198,10 +3241,10 @@ Check the uptime of the servers in I<~/.parallel/sshloginfile>:
=head1 EXAMPLE: Colorize output =head1 EXAMPLE: Colorize output
Give each job a new color. Most terminals support ANSI colors with the Give each job a new color. Most terminals support ANSI colors with the
escape code "\033[30;XXm" where 30 <= XX <= 37: escape code "\033[30;3Xm" where 0 <= X <= 7:
parallel --tagstring '\033[30;{=$_=++$::color%8+30=}m' seq {} ::: {1..10} parallel --tagstring '\033[30;3{=$_=++$::color%8=}m' seq {} ::: {1..10}
parallel --rpl '{color} $_="\033[30;".++$::color%8+30."=}m"' \ parallel --rpl '{color} $_="\033[30;3".(++$::color%8)."m"' \
--tagstring {color} seq {} ::: {1..10} --tagstring {color} seq {} ::: {1..10}
To get rid of the initial \t (which comes from B<--tagstring>): To get rid of the initial \t (which comes from B<--tagstring>):