parallel: --ctag(string) implemented.

This commit is contained in:
Ole Tange 2021-08-04 21:05:40 +02:00
parent 42aec9a964
commit 5adcd33f7b
5 changed files with 118 additions and 34 deletions

View file

@ -255,7 +255,7 @@ from:tange@gnu.org
to:parallel@gnu.org, bug-parallel@gnu.org
stable-bcc: Jesse Alama <jessealama@fastmail.fm>
Subject: GNU Parallel 20210822 ('turkish fire/greek fire/tysk syndflod/Tunesia') released <<[stable]>>
Subject: GNU Parallel 20210822 ('South Africa/Kristina Timanovskaya/turkish fire/greek fire/tysk syndflod/Tunesia') released <<[stable]>>
GNU Parallel 20210822 ('') <<[stable]>> has been released. It is available for download at: lbry://@GnuParallel:4

View file

@ -1555,6 +1555,8 @@ sub options_hash() {
"nice=i" => \$opt::nice,
"tag" => \$opt::tag,
"tagstring|tag-string=s" => \$opt::tagstring,
"ctag" => \$opt::ctag,
"ctagstring|ctag-string=s" => \$opt::ctagstring,
"onall" => \$opt::onall,
"nonall" => \$opt::nonall,
"filter-hosts|filterhosts|filter-host" => \$opt::filter_hosts,
@ -1785,6 +1787,15 @@ sub parse_options(@) {
if(defined $opt::null) { $/ = "\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) {
$Global::color = 1;
}
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.*\Q$Global::parensright\E/
@ -2027,10 +2038,6 @@ sub parse_options(@) {
not ($opt::xargs or $opt::m)) {
$Global::ContextReplace = 1;
}
if(defined $opt::tag and not defined $opt::tagstring) {
# Default = {}
$opt::tagstring = $Global::parensleft.$Global::parensright;
}
if(grep /^$Global::arg_sep\+?$|^$Global::arg_file_sep\+?$/o, @ARGV) {
# Deal with ::: :::+ :::: and ::::+
@ARGV = read_args_from_command_line();
@ -5840,13 +5847,15 @@ sub which(@) {
if($shellpath = readlink "/proc/$testpid/exe") {
::debug("init","procpath $shellpath\n");
if($shellpath =~ m:/$shell$:o) {
::debug("init", "proc which ".$shellpath." => ");
::debug("init",
"proc which ".$shellpath." => ");
return $shellpath;
}
}
}
::debug("init", "which ".$shellname." => ");
$shellpath = (which($shellname,@{$fakename{$shellname}}))[0];
$shellpath = (which($shellname,
@{$fakename{$shellname}}))[0];
::debug("init", "shell path $shellpath\n");
return $shellpath;
}
@ -5907,11 +5916,13 @@ sub which(@) {
if(not %pid_parentpid_cmd) {
# Filter for SysV-style `ps`
my $sysv = q( ps -ef | perl -ane '1..1 and /^(.*)CO?MM?A?N?D/ and $s=length $1;).
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 | perl -ane '1..1 and /^(.*)CO?MM?A?N?D/ and $s=length $1;).
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);
@ -5939,7 +5950,8 @@ sub which(@) {
'syllable' => "echo ps not supported",
);
}
$pid_parentpid_cmd{$^O} or ::die_bug("pid_parentpid_cmd for $^O missing");
$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
@ -6111,7 +6123,8 @@ sub kill_youngest_if_over_limit() {
push @{$jobs_of{$job->sshlogin()}}, $job;
}
for my $sshlogin (@sshlogins) {
for my $job (sort { $b->seq() <=> $a->seq() } @{$jobs_of{$sshlogin}}) {
for my $job (sort { $b->seq() <=> $a->seq() }
@{$jobs_of{$sshlogin}}) {
if($sshlogin->limit() == 2) {
$job->kill();
last;
@ -6141,7 +6154,8 @@ sub suspend_young_if_not_enough_mem() {
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}};
my @jobs = (sort { $b->seq() <=> $a->seq() }
@{$jobs_of{$sshlogin}});
# how many should be running?
# limit*1 => 1;
# limit*1.5 => 2;
@ -6162,8 +6176,8 @@ sub suspend_young_if_not_enough_mem() {
for my $job (@{$jobs_of{$sshlogin}}) {
if($job->suspended()) {
$job->resume();
::debug("mem","\nResume ",$#{$jobs_of{$sshlogin}}+1, " jobs. Seq ",
$job->seq(), " resumed ",
::debug("mem","\nResume ",$#{$jobs_of{$sshlogin}}+1,
" jobs. Seq ", $job->seq(), " resumed ",
$sshlogin->memfree()," > ",2*$limit);
last;
}
@ -6189,7 +6203,8 @@ sub kill_youngster_if_not_enough_mem() {
push @{$jobs_of{$job->sshlogin()}}, $job;
}
for my $sshlogin (@sshlogins) {
for my $job (sort { $b->seq() <=> $a->seq() } @{$jobs_of{$sshlogin}}) {
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() }
@ -10162,8 +10177,10 @@ sub interactive_start($) {
::status("See output with: $ENV{'PARALLEL_TMUX'} -S $tmuxsocket attach");
}
$tmux = "sh -c '".
$ENV{'PARALLEL_TMUX'}." -S $tmuxsocket new-session -s p$$ -d \"sleep .2\" >/dev/null 2>&1';" .
$ENV{'PARALLEL_TMUX'}." -S $tmuxsocket new-window -t p$$ -n $title";
$ENV{'PARALLEL_TMUX'}.
" -S $tmuxsocket new-session -s p$$ -d \"sleep .2\" >/dev/null 2>&1';" .
$ENV{'PARALLEL_TMUX'}.
" -S $tmuxsocket new-window -t p$$ -n $title";
::debug("tmux", "title len:", $l_tit, " act ", $l_act, " max ",
$Limits::Command::line_max_len, " tot ",
@ -10175,7 +10192,8 @@ sub interactive_start($) {
(
"(".$actual_command.');'.
# The triple print is needed - otherwise the testsuite fails
q[ perl -e 'while($t++<3){ print $ARGV[0],"\n" }' $?h/$status >> ].$tmpfifo."&".
q[ perl -e 'while($t++<3){ print $ARGV[0],"\n" }' $?h/$status >> ].
$tmpfifo."&".
"echo $title; echo \007Job finished at: `date`;sleep 10"
).
# Run outside tmux
@ -10361,7 +10379,8 @@ sub print($) {
sub jsonquote($) {
my $a = shift;
if(not $jsonmap{"\001"}) {
map { $jsonmap{sprintf("%c",$_)} = sprintf '\u%04x', $_ } 0..31;
map { $jsonmap{sprintf("%c",$_)} =
sprintf '\u%04x', $_ } 0..31;
}
$a =~ s/\\/\\\\/g;
$a =~ s/\"/\\"/g;
@ -10609,15 +10628,19 @@ sub print_linebuffer($) {
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])(?=.|$)/$tag/gs;
substr($buf,0,$i-1) =~
s/(?<=[\n\r])(?=.|$)/$tag/gs;
# The length changed, so find the new ending pos
$i = ::max((rindex($buf,"\n")+1), (rindex($buf,"\r")+1));
$i = ::max((rindex($buf,"\n")+1),
(rindex($buf,"\r")+1));
} else {
# Replace with freshly computed value of tag
unshift @$halfline_ref, $self->tag();
substr($buf,0,$i-1) =~ s/(?<=[\n\r])(?=.|$)/$self->tag()/gse;
substr($buf,0,$i-1) =~
s/(?<=[\n\r])(?=.|$)/$self->tag()/gse;
# The length changed, so find the new ending pos
$i = ::max((rindex($buf,"\n")+1), (rindex($buf,"\r")+1));
$i = ::max((rindex($buf,"\n")+1),
(rindex($buf,"\r")+1));
}
}
# Print the partial line (halfline) and the last half
@ -10862,18 +10885,52 @@ sub print_joblog($) {
$self->set_job_in_joblog();
}
{
my @color;
sub tag($) {
sub init_color() {
# color combinations that are readable: black/white text
# on colored background, but not white on yellow
@color =
# 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..231,249..254),
(map { [sprintf("%03d",$_),231] }
1..9,12..13,16..45,52..81,88..116,124..151,153,
160..180,182..185,187..189,196..214,232..252,
255..254));
# reorder list so adjacent colors are dissimilar
# %7 and %17 were found experimentally
@color = @color[
sort { ($b%7 <=> $a%7) or ($a%17 <=> $b%17) } 0..$#color
];
}
my $self = shift;
if(not defined $self->{'tag'} or not $Global::cache_replacement_eval) {
if($opt::tag or defined $opt::tagstring) {
if($Global::color) {
if(not @color) { init_color() }
# Choose a value based on the seq
my $col = @color[$self->seq() % ($#color+1)];
$self->{'tag'} = "\033[48;5;".$col->[0].
";38;5;".$col->[1]."m".
($self->{'commandline'}->
replace_placeholders([$opt::tagstring],0,0)).
"\033[00m\t";
} else {
$self->{'tag'} = $self->{'commandline'}->
replace_placeholders([$opt::tagstring],0,0)."\t";
}
} else {
$self->{'tag'} = "";
}
}
return $self->{'tag'};
}
}
sub hostgroups($) {
my $self = shift;

View file

@ -740,6 +740,16 @@ Even quoted newlines are parsed correctly:
When used with B<--pipe> only pass full CSV-records.
=item B<--ctag> I<str> (alpha testing)
Color tag. See B<--tag>.
=item B<--ctagstring> I<str> (alpha testing)
Color tagstring. See B<--tagstring>.
=item B<--delay> I<mytime>
Delay starting next job by I<mytime>. GNU B<parallel> will pause
@ -2695,7 +2705,7 @@ to GNU B<parallel> giving each child its own process group, which is
then killed. Process groups are dependant on the tty.
=item B<--tag>
=item B<--tag> (alpha testing)
Tag lines with arguments. Each output line will be prepended with the
arguments and TAB (\t). When combined with B<--onall> or B<--nonall>
@ -2703,8 +2713,10 @@ the lines will be prepended with the sshlogin instead.
B<--tag> is ignored when using B<-u>.
B<--ctag> gives the tag a color.
=item B<--tagstring> I<str>
=item B<--tagstring> I<str> (alpha testing)
Tag lines with a string. Each output line will be prepended with
I<str> and TAB (\t). I<str> can contain replacement strings such as
@ -2712,6 +2724,8 @@ B<{}>.
B<--tagstring> is ignored when using B<-u>, B<--onall>, and B<--nonall>.
B<--ctagstring> gives the tag a color.
=item B<--tee>

View file

@ -16,6 +16,14 @@ 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_ctagstring() {
echo '### --ctag --ctagstring should be different from --tag --tagstring'
parallel --tag echo ::: 1 ::: a| wc -c
parallel --ctag echo ::: 1 ::: a | wc -c
parallel --tagstring 'I{1}\tB{2}' echo ::: 1 ::: a | wc -c
parallel --ctagstring 'I{1}\tB{2}' echo ::: 1 ::: a | wc -c
}
par_pct() {
echo '### Test {%...} {%%...} {#...} {##...}'
a=z.z.z.foo

View file

@ -108,6 +108,11 @@ par_csv_pipe 11000"
par_csv_pipe More records in single block
par_csv_pipe 9000"
par_csv_pipe 11000"
par_ctagstring ### --ctag --ctagstring should be different from --tag --tagstring
par_ctagstring 8
par_ctagstring 33
par_ctagstring 10
par_ctagstring 35
par_delimiter ### Test --delimiter and -d: Delimiter instead of newline
par_delimiter # Yes there is supposed to be an extra newline for -d N
par_delimiter This is line 1