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) {
-	    # 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,$_;
+		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";
 		}
-		if($Global::membuffer) {
-		    push @{$self->{'output'}{$fdno}}, $tag, $_;
+	    } 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 {
@@ -11516,75 +11542,81 @@ 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() {
-	$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
-	@color_combinations = @color_combinations[
-	    sort { ($a%23 <=> $b%23) or ($b%7 <=> $a%7) }
-	    0..$#color_combinations
-	    ];
-	@color = map {
-	    # TODO Can this be done with `tput` codes?
-	    "\033[48;5;".$_->[0].";38;5;".$_->[1]."m"
-	} @color_combinations;
+	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
+	    @color_combinations = @color_combinations[
+		sort { ($a%23 <=> $b%23) or ($b%7 <=> $a%7) }
+		0..$#color_combinations
+		];
+	    @color = map {
+		# TODO Can this be done with `tput` codes?
+		"\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;
+	    # 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);
+	}
     }
-
-    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($Global::color) {
-		if(not $init) { init_color() }
-		# Choose a value based on the seq
-		$color_on = $color[$self->seq() % ($#color+1)].$eol;
-	    }
-	    if(defined $opt::tag or defined $opt::tagstring) {
-		$self->{'tag'} =
-		    $color_on .
-		    ($self->{'commandline'}->
-		     replace_placeholders([$opt::tagstring],0,0)).
-		    "\t";
+	if(not defined $self->{'color'}) {
+	    if($Global::color or $opt::colorfailed) {
+		init_color();
+		if($Global::color) {
+		    # Choose a value based on the seq
+		    $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;
+		    }
+		}
 	    } 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