parallel: --colour-failed implemented.

src/parallel

@@ -1822,8 +1822,12 @@ sub options_completion_hash() {
 	 ("tag-string|tagstring=s".
 	  "[Tag lines with a string]:str" => \$opt::tagstring),
 	 "ctag[Color tag]:str" => \$opt::ctag,
-	 "ctag-string|ctagstring=s[Color tagstring]:str" => \$opt::ctagstring,
-	 "color|colour[Colorize output]" => \$opt::color,
+	 "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,
@@ -11133,8 +11137,18 @@ sub print_files($) {
     }
 }
 
+
+# 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,$reset_color,$init,$curseq,$maxseq);
+    my ($up,$init,$curseq,$maxseq);
 
     sub print_linebuffer($) {
 	sub print_llb($) {
@@ -11142,12 +11156,13 @@ sub print_files($) {
 	    my $out_fh = shift;
 	    my $str = shift;
 	    my $seq = $self->seq();
+	    my ($color,$reset_color) = $self->color();
 	    $maxseq = $seq > $maxseq ? $seq : $maxseq;
 	    print($out_fh
 		  "$up"x($curseq - $seq),
 		  "\n"x($seq - $curseq),
 		  "\r", $self->tag(),
-		  $str, $eol, $reset_color,
+		  $color,$str,$reset_color,
 		  "\n"x($maxseq-$seq+1));
 	    $curseq = $maxseq + 1;
 	}
@@ -11169,16 +11184,10 @@ sub print_files($) {
 	}
 	if(not $init) {
 	    $init = 1;
-	    if($Global::color or $opt::latestline) {
+	    if($opt::latestline) {
 		# cursor_up cuu1 = up one line
 		$up = `tput cuu1 </dev/tty`;
 		chomp($up);
-		# clr_eol el = clear to end of line
-		$eol = `tput el </dev/tty`;
-		chomp($eol);
-		# exit_attribute_mode sgr0 = turn off all attributes
-		$reset_color = `tput sgr0 </dev/tty`;
-		chomp($reset_color);
 		$curseq = 1;
 		$maxseq = 1;
 	    }
@@ -11234,10 +11243,13 @@ sub print_files($) {
 				my $print = join("",@$halfline_ref,
 						 substr($buf,0,$i));
 				chomp($print);
-				my $tag = $self->tag();
-				$print =~ s/([\n\r])(?=.|$)/$eol$reset_color$1$tag/gs;
-				print $out_fh $tag, $print, $eol,
-				    $reset_color, "\n";
+				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) {
@@ -11403,21 +11415,35 @@ sub print_normal($) {
 	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 $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";
-	    my $tag = $self->tag();
 		while(<$in_fh>) {
 		    $outputlength += length $_;
 		    # Tag lines with \r, too
-		$_ =~ s/(?<=[\r])(?=.|$)/$tag/gs;
-		if($Global::color) {
-		    print_color($out_fh,$tag,$_);
-		} else {
-		    print $out_fh $tag,$_;
+		    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}}, $tag, $_;
+			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 {
@@ -11516,12 +11542,27 @@ sub print_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'};
+}
+
 {
-    my @color;
-    my $color_on = "";
-    my ($up,$eol,$reset_color,$init,$curseq,$maxseq);
+    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
@@ -11545,46 +11586,37 @@ sub print_joblog($) {
 		"\033[48;5;".$_->[0].";38;5;".$_->[1]."m"
 	    } @color_combinations;
 
-	# cursor_up cuu1 = up one line
-	$up = `tput cuu1 </dev/tty`;
-	chomp($up);
 	    # clr_eol el = clear to end of line
 	    $eol = `tput el </dev/tty`;
 	    chomp($eol);
 	    # exit_attribute_mode sgr0 = turn off all attributes
 	    $reset_color = `tput sgr0 </dev/tty`;
 	    chomp($reset_color);
-	$curseq = 1;
-	$maxseq = 1;
+	}
     }
 	
-    sub print_color() {
-	# @text is a single line
-	my ($out_fh,@text) = @_;
-	chomp(@text);
-	print $out_fh @text,$reset_color,"\n";
-
-    }
-
-    sub tag($) {
+    sub color($) {
 	my $self = shift;
-	if(not defined $self->{'tag'} or not $Global::cache_replacement_eval) {
+	if(not defined $self->{'color'}) {
+	    if($Global::color or $opt::colorfailed) {
+		init_color();
 		if($Global::color) {
-		if(not $init) { init_color() }
 		    # Choose a value based on the seq
-		$color_on = $color[$self->seq() % ($#color+1)].$eol;
+		    $self->{'color'} = $color[$self->seq() % ($#color+1)].$eol;
+		}
+		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;
+		    }
 		}
-	    if(defined $opt::tag or defined $opt::tagstring) {
-		$self->{'tag'} =
-		    $color_on .
-		    ($self->{'commandline'}->
-		     replace_placeholders([$opt::tagstring],0,0)).
-		    "\t";
 	    } else {
-		$self->{'tag'} = $color_on;
+		$self->{'color'} = "";
 	    }
 	}
-	return $self->{'tag'};
+	return ($self->{'color'},$reset_color);
     }
 }
 

src/parallel.pod

@@ -748,7 +748,8 @@ B<--transfer>, B<--transferfile> or B<--return>.
 See also: B<--basefile> B<--transfer> B<--transferfile> B<--sshlogin>
 B<--return>
 
-=item B<--color> (beta testing)
+
+=item B<--color> (alpha testing)
 
 Colour output.
 
@@ -757,6 +758,23 @@ Colour the output. Each job gets its own colour combination
 
 B<--color> is ignored when using B<-u>.
 
+See also: B<--color-failed>
+
+
+=item B<--color-failed> (alpha testing)
+
+=item B<--cf> (alpha testing)
+
+Colour the output from failing jobs white on red.
+
+Useful if you have a lot of jobs and want to focus on the failing
+jobs.
+
+B<--color-failed> is ignored when using B<-u>, B<--line-buffer> and
+unreliable when using B<--latest-line>.
+
+See also: B<--color>
+
 
 =item B<--colsep> I<regexp>
 

testsuite/REQUIREMENTS

@@ -38,7 +38,7 @@ install_packages() {
     shell_pkgs="$shell_pkgs tcsh yash zsh busybox-static"
 
     # Databases
-    database_pkgs="postgresql mysql-server sqlite"
+    database_pkgs="postgresql mysql-server sqlite influxdb influxdb-client"
 
     # Build Tools
     build_pkgs="bison libxxhash-dev libzstd-dev liblz4-dev libssl-dev"

testsuite/tests-to-run/parallel-local-0.3s.sh

@@ -16,6 +16,22 @@ export -f stdsort
 # Test amount of parallelization
 # parallel --shuf --jl /tmp/myjl -j1 'export JOBS={1};'bash tests-to-run/parallel-local-0.3s.sh ::: {1..16} ::: {1..5}
 
+par_PARALLEL_HOME_not_exist() {
+    echo '### bug #62311: --pipepart + ::: fail'
+    tmp1=$(mktemp)
+    rm $tmp1
+    PARALLEL_HOME=$tmp1 parallel echo ::: OK
+    rm -r $tmp1
+    echo Should warn:
+    PARALLEL_HOME=/does-not-exist parallel -k echo ::: should warn
+}
+
+par_colour_failed() {
+    echo '--colour-failed --colour'
+    parallel --colour-failed -kv 'seq {1};exit {2}' ::: 1 2 ::: 0 1 2
+    parallel --colour --colour-failed -kv 'seq {1};exit {2}' ::: 1 2 ::: 0 1 2
+}
+
 par_pipepart_triple_colon() {
     echo '### bug #62311: --pipepart + ::: fail'
     tmp1=$(mktemp)

testsuite/tests-to-run/parallel-local-parsort.sh

@@ -5,7 +5,7 @@
 # SPDX-License-Identifier: GPL-3.0-or-later
 
 setup() {
-    tmp=$(tempfile)
+    tmp=$(mktemp)
     perl -pe 's/\n/\n\0/' >$tmp <<EOF
 chr1	1	Sample 1
 chr1	11	Sample 1

testsuite/wanted-results/parallel-local-0.3s

@@ -6,6 +6,13 @@ par_PARALLEL_ENV	### PARALLEL_ENV as file
 par_PARALLEL_ENV	OK as file
 par_PARALLEL_ENV	### PARALLEL_ENV as fifo
 par_PARALLEL_ENV	OK as fifo
+par_PARALLEL_HOME_not_exist	### bug #62311: --pipepart + ::: fail
+par_PARALLEL_HOME_not_exist	OK
+par_PARALLEL_HOME_not_exist	Should warn:
+par_PARALLEL_HOME_not_exist	parallel: Warning: $PARALLEL_HOME (/does-not-exist) does not exist.
+par_PARALLEL_HOME_not_exist	parallel: Warning: Using ~/.parallel
+par_PARALLEL_HOME_not_exist	should
+par_PARALLEL_HOME_not_exist	warn
 par_PARALLEL_HOME_with_+	bug #59453: PARALLEL_HOME with plus sign causes error: config not readable
 par_PARALLEL_HOME_with_+	Parallel_home_with+
 par_X_eta_div_zero	### bug #34422: parallel -X --eta crashes with div by zero
@@ -57,6 +64,37 @@ par_blocking_redir	stderr
 par_blocking_redir	stderr
 par_blocking_redir	stdout
 par_blocking_redir	stdout
+par_colour_failed	--colour-failed --colour
+par_colour_failed	seq 1;exit 0(B
+par_colour_failed	1(B
+par_colour_failed	seq 1;exit 1(B
+par_colour_failed	1(B
+par_colour_failed	seq 1;exit 2(B
+par_colour_failed	1(B
+par_colour_failed	seq 2;exit 0(B
+par_colour_failed	1(B
+par_colour_failed	2(B
+par_colour_failed	seq 2;exit 1(B
+par_colour_failed	1(B
+par_colour_failed	2(B
+par_colour_failed	seq 2;exit 2(B
+par_colour_failed	1(B
+par_colour_failed	2(B
+par_colour_failed	seq 1;exit 0(B
+par_colour_failed	1(B
+par_colour_failed	seq 1;exit 1(B
+par_colour_failed	1(B
+par_colour_failed	seq 1;exit 2(B
+par_colour_failed	1(B
+par_colour_failed	seq 2;exit 0(B
+par_colour_failed	1(B
+par_colour_failed	2(B
+par_colour_failed	seq 2;exit 1(B
+par_colour_failed	1(B
+par_colour_failed	2(B
+par_colour_failed	seq 2;exit 2(B
+par_colour_failed	1(B
+par_colour_failed	2(B
 par_colsep_0	bug --colsep 0
 par_colsep_0	OK
 par_colsep_0	OK
@@ -957,10 +995,10 @@ par_sem_quote	### sem --quote should not add empty argument
 par_sem_quote	echo
 par_sem_quote	
 par_shellcompletion	### --shellcompletion
-par_shellcompletion	329fc284cae55cbfed49ed5546eb2b29  -
-par_shellcompletion	329fc284cae55cbfed49ed5546eb2b29  -
-par_shellcompletion	4869360b2bf2f084c17bdc60413faace  -
-par_shellcompletion	4869360b2bf2f084c17bdc60413faace  -
+par_shellcompletion	863f31c091219fc53dc89fd707f5995b  -
+par_shellcompletion	863f31c091219fc53dc89fd707f5995b  -
+par_shellcompletion	88a69a99c93b79b5ed6491c80e9762b0  -
+par_shellcompletion	88a69a99c93b79b5ed6491c80e9762b0  -
 par_slow_pipe_regexp	### bug #53718: --pipe --regexp -N blocks
 par_slow_pipe_regexp	This should take a few ms, but took more than 2 hours
 par_slow_pipe_regexp	      0       1       1