#!/usr/bin/perl -w

=head1 NAME

keepcool - throttle a process with STOP und CONT calls

=head1 SYNOPSIS

 keepcool [-sr=stop-ratio] [-sf=scalefactor] [-d] program args...
 keepcool [-sr=stop-ratio] [-sf=scalefactor] [-d] -p process-id

=head1 DESCRIPTION

The first invocation runs a program specified on the commandline. The
second form of invocation attaches to an already running process.

nice(1) is nice to other processes, but if there are no other
processes, it makes no difference to ressource usage. And if a process
uses too much of other ressources than CPU (e.g. disk IO,
heat dissipation, etc.), then it doesn't help either.

keepcool sends the other process STOP and CONT signals to throttle
it thus keeping the laptop cool and leaving more ressources to others.

The C<-sr stop-ratio> parameter specifies, how many time units the
process should be in stop mode per working unit. It defaults to 5, so
that the process pauses for five time units after having worked for
one time unit. Floating point values are accepted as argument.

The C<-sf scalefactor> parameter specifies, what the time unit is, in
seconds. It defaults to 1 second. Floating point values are accepted
as argument.

The C<-d> option turns on quite noisy and self explaining debug mode.

The C<-v> option prints the version number of the script to STDOUT and
exits.

The C<-h> option printd Usage information and exits.

=head1 SIGINT

The program catches SIGINT and exits with the guarantee that the other
process is in running mode. In that case it writes to STDERR a message
that includes the process number of the other process.

=head1 EXAMPLES

Compress a big file:

  keepcool gzip -9 very-big-file.txt

Same thing but switch ten times more often between work and stop mode
by setting a small scalefactor:

  keepcool -sf 0.1 gzip -9 very-big-file.txt

Same thing but with pauses as long as work units by setting a sleep
retio of 1:

  keepcool -sf 0.1 -sr 1 gzip -9 very-big-file.txt

=head1 SCRIPT CATEGORIES

UNIX : System_administration

=head1 PREREQUISITES

POSIX, Time::HiRes

=head1 README

keepcool - throttle a process with STOP und CONT calls

Tiny utility to manage ressources ad hoc by slowing down eager
processes.

=head1 AUTHORS

Andreas Koenig wrote the first half of the script, Slaven Rezic
contributed so much good advice, that the other half magically jumped
into existence.

=cut

use strict;

use Time::HiRes qw(sleep);
our($VERSION) = map { sprintf "%.3f", $_ / 1000 } q$Rev: 344 $ =~ /(\d+)/;

use Config;
defined $Config{sig_name} || die "No sigs?";

use POSIX qw(:sys_wait_h setsid);

use Getopt::Long;
sub Usage {
  qq{Usage:
  $0 [--sr=stop-ratio] [--sf=scalefactor] [--d] program args...
  $0 [--sr=stop-ratio] [--sf=scalefactor] [--d] -p process-id
};
}
our %Opt;
Getopt::Long::Configure("require_order");
GetOptions(\%Opt,
           "d!",
           "h!",
           "p=i",
           "sf=f",
           "sr=f",
           "v!",
          ) or die Usage;
if ($Opt{v}) {
  print "rev. ", $VERSION, "\n";
  exit;
} elsif ($Opt{h}) {
  print Usage;
  exit;
}
die Usage unless @ARGV || $Opt{p};
$Opt{sf} ||= 1;
$Opt{sr} ||= 5;

our $RUNSECS = $Opt{sf};
our $STOPSECS = $Opt{sf}*$Opt{sr};

print "Starting..." if $Opt{d};

defined(my $pid = $Opt{p} || fork) or die "Can't fork: $!";

if ($pid) { # parent or attached process

  printf "supervising pid %d with runsecs %.2f stopsecs %.2f",
      $pid, $RUNSECS, $STOPSECS if $Opt{d};

  my( %Signo, @Signame );
  my $SIGNAL = 0;
  $SIG{INT} = sub {
    my $sig = shift;
    warn "Caught signal '$sig'. Leaving process '$pid' running without throttling.\n";
    $SIGNAL++;
  };

  my $i = 0;
  for my $name (split(' ', $Config{sig_name})) {
    $Signo{$name} = $i;
    $Signame[$i] = $name;
    $i++;
  }

  my $loop = 0;
  $|=1;
 ENDLESS: while () {
    kill $Signo{CONT}, $pid or last;
    if ($Opt{d}) {
      print ">";
    }
    sleep $RUNSECS unless $SIGNAL;
    last if $SIGNAL;
    if ($Opt{p}) {
      kill 0, $pid or last;
    } else {
      my $kid = waitpid($pid, WNOHANG);
      last if $kid == $pid or $kid == -1;
    }
    kill $Signo{STOP}, $pid or last;
    if ($Opt{d}) {
      print "|";
    }
    sleep $STOPSECS unless $SIGNAL;
    # last if $SIGNAL; ### nonono, that way we can leave while the app is stopped
  }
  print "Bye\n" if $Opt{d};
} else {
  setsid or die "Can't start a new session: $!";
  exec @ARGV;
}