mirror of
https://git.savannah.gnu.org/git/parallel.git
synced 2024-11-29 09:27:56 +00:00
niceload: --prg searches for substrings if no the string matches nothing.
This commit is contained in:
Ole Tange
parent
bf91e06e00
commit
2467d0b5be
118
src/niceload
118
src/niceload
|
|
@ -24,7 +24,7 @@
|
|||
use strict;
|
||||
use Getopt::Long;
|
||||
$Global::progname="niceload";
|
||||
$Global::version = 20160222;
|
||||
$Global::version = 20160223;
|
||||
Getopt::Long::Configure("bundling","require_order");
|
||||
get_options_from_array(\@ARGV) || die_usage();
|
||||
if($opt::version) {
|
||||
|
|
@ -67,8 +67,37 @@ my $process = Process->new($opt::nice,@ARGV);
|
|||
$::exitstatus = 0;
|
||||
if(@opt::prg) {
|
||||
# Find all pids of prg
|
||||
my $out = `pidof -x @opt::prg`;
|
||||
$process->set_pid(split /\s+/,$out);
|
||||
my($children_of, $parent_of, $name_of) = pid_table();
|
||||
my @exact_name_pids;
|
||||
my @substr_name_pids;
|
||||
for my $name (@opt::prg) {
|
||||
push(@exact_name_pids,
|
||||
grep { index($name_of->{$_},$name) == 0 and $_ } keys %$name_of);
|
||||
push(@substr_name_pids,
|
||||
grep { index($name_of->{$_},$name) != -1 and $_ } keys %$name_of);
|
||||
}
|
||||
# Remove current pid
|
||||
@exact_name_pids = grep { $_ != $$ } @exact_name_pids;
|
||||
@substr_name_pids = grep { $_ != $$ } @substr_name_pids;
|
||||
my @pids;
|
||||
if(@exact_name_pids) {
|
||||
@pids = @exact_name_pids;
|
||||
} elsif(@substr_name_pids) {
|
||||
warning("@opt::prg no exact matches. Using substrings.");
|
||||
my %name_pids;
|
||||
for(@substr_name_pids) {
|
||||
$name_of->{$_} =~ s/ .*//;
|
||||
push @{$name_pids{$name_of->{$_}}},$_;
|
||||
}
|
||||
warning("Niceloading",
|
||||
map { "$_ (".(join",",@{$name_pids{$_}}).")" } keys %name_pids
|
||||
);
|
||||
@pids = @substr_name_pids;
|
||||
} else {
|
||||
error("@opt::prg no matches.");
|
||||
exit(1);
|
||||
}
|
||||
$process->set_pid(@pids);
|
||||
$::resume_process = $process;
|
||||
$SIG{TERM} = $SIG{INT} = \&resume;
|
||||
} elsif(@opt::pid) {
|
||||
|
|
@ -101,11 +130,94 @@ while($process->is_alive()) {
|
|||
|
||||
exit($::exitstatus);
|
||||
|
||||
{
|
||||
my %pid_parentpid_cmd;
|
||||
|
||||
sub pid_table {
|
||||
# Returns:
|
||||
# %children_of = { pid -> children of pid }
|
||||
# %parent_of = { pid -> pid of parent }
|
||||
# %name_of = { pid -> commandname }
|
||||
|
||||
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;).
|
||||
q(s/^.{$s}//; print "@F[1,2] $_"' );
|
||||
# Crazy msys: ' is not accepted on the cmd line, but " are treated as '
|
||||
my $msys = q( ps -ef | perl -ane "1..1 and /^(.*)CO?MM?A?N?D/ and $s=length $1;).
|
||||
q(s/^.{$s}//; print qq{@F[1,2] $_}" );
|
||||
# BSD-style `ps`
|
||||
my $bsd = q(ps -o pid,ppid,command -ax);
|
||||
%pid_parentpid_cmd =
|
||||
(
|
||||
'aix' => $sysv,
|
||||
'cygwin' => $sysv,
|
||||
'darwin' => $bsd,
|
||||
'dec_osf' => $sysv,
|
||||
'dragonfly' => $bsd,
|
||||
'freebsd' => $bsd,
|
||||
'gnu' => $sysv,
|
||||
'hpux' => $sysv,
|
||||
'linux' => $sysv,
|
||||
'mirbsd' => $bsd,
|
||||
'msys' => $msys,
|
||||
'MSWin32' => $sysv,
|
||||
'netbsd' => $bsd,
|
||||
'nto' => $sysv,
|
||||
'openbsd' => $bsd,
|
||||
'solaris' => $sysv,
|
||||
'svr5' => $sysv,
|
||||
'syllable' => "echo ps not supported",
|
||||
);
|
||||
}
|
||||
$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
|
||||
@pidtable = `$pid_parentpid_cmd{$^O}`;
|
||||
my $p=$$;
|
||||
for (@pidtable) {
|
||||
# must match: 24436 21224 busybox ash
|
||||
# must match: 24436 21224 <<empty on MacOSX running cubase>>
|
||||
# or: perl -e 'while($0=" "){}'
|
||||
if(/^\s*(\S+)\s+(\S+)\s+(\S+.*)/
|
||||
or
|
||||
$^O eq "darwin" and /^\s*(\S+)\s+(\S+)\s+()$/) {
|
||||
$parent_of{$1} = $2;
|
||||
push @{$children_of{$2}}, $1;
|
||||
$name_of{$1} = $3;
|
||||
} else {
|
||||
::die_bug("pidtable format: $_");
|
||||
}
|
||||
}
|
||||
return(\%children_of, \%parent_of, \%name_of);
|
||||
}
|
||||
}
|
||||
|
||||
sub resume {
|
||||
$::resume_process->resume();
|
||||
exit(0);
|
||||
}
|
||||
|
||||
sub status {
|
||||
my @w = @_;
|
||||
my $fh = *STDERR;
|
||||
print $fh @w;
|
||||
flush $fh;
|
||||
}
|
||||
|
||||
sub warning {
|
||||
my @w = @_;
|
||||
my $prog = $Global::progname || "niceload";
|
||||
status(map { ($prog, ": Warning: ", $_, "\n"); } @w);
|
||||
}
|
||||
|
||||
sub error {
|
||||
my @w = @_;
|
||||
my $prog = $Global::progname || "niceload";
|
||||
status(map { ($prog, ": Error: ", $_, "\n"); } @w);
|
||||
}
|
||||
|
||||
sub uniq {
|
||||
# Remove duplicates and return unique values
|
||||
return keys %{{ map { $_ => 1 } @_ }};
|
||||
|
|
|
|||
|
|
@ -117,12 +117,14 @@ Process ID of process to suspend. You can specify multiple process IDs
|
|||
with multiple B<-p> I<PID>.
|
||||
|
||||
|
||||
=item B<--prg> I<program>
|
||||
=item B<--prg> I<program> (alpha testing)
|
||||
|
||||
=item B<--program> I<program>
|
||||
=item B<--program> I<program> (alpha testing)
|
||||
|
||||
Name of running program to suspend. You can specify multiple programs
|
||||
with multiple B<--prg> I<program>.
|
||||
with multiple B<--prg> I<program>. If no processes with the name
|
||||
I<program> is found, B<niceload> with search for substrings containing
|
||||
I<program>.
|
||||
|
||||
|
||||
=item B<--quote>
|
||||
|
|
|
|||
Loading…
Reference in a new issue