From 2467d0b5bea78c1a53a0dbc3e8a67d4b32e6fa19 Mon Sep 17 00:00:00 2001
From: Ole Tange <ole@tange.dk>
Date: Tue, 22 Mar 2016 20:06:08 +0100
Subject: [PATCH] niceload: --prg searches for substrings if no the string
 matches nothing.

---
 src/niceload     | 122 +++++++++++++++++++++++++++++++++++++++++++++--
 src/niceload.pod |   8 ++--
 2 files changed, 122 insertions(+), 8 deletions(-)

diff --git a/src/niceload b/src/niceload
index 6bfb555e..39720b3c 100755
--- a/src/niceload
+++ b/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 } @_ }};
@@ -665,7 +777,7 @@ sub read_sensor {
     }
     # Read as much as we can (non_block)
     my ($eof,@lines) = nonblockGetLines($fh);
-    
+
     # new load = last full line
     foreach my $line (@lines) {
 	if(defined $line) {
@@ -695,7 +807,7 @@ sub load_status {
 	    while (not defined $self->{'load_status'}) {
 		sleep 1;
 		$self->{'load_status'} = $self->read_sensor();
-	    } 
+	    }
 	    $self->{'load_status_cache_time'} = time - 0.001;
 	}
     } else {
diff --git a/src/niceload.pod b/src/niceload.pod
index 6a91761a..c61af0fe 100644
--- a/src/niceload.pod
+++ b/src/niceload.pod
@@ -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>