http://www.perlmonks.org?node_id=448715
Category: Utility Scripts
Author/Contact Info northwind
Description:

Perl Process Killer (PPK)
Usage:  ppk {process name, required} {iterations, optional}

Basically, think of this script as the system command kill on steroids.  I originally wrote this script to allow me to reclaim CPU cycles from errant cron jobs that I did not have the authority to modify (system permissions and real world authority are two very different things).  My solution was to run this program any time I was logged in.  Thus, when I was logged in, I could get useful work done; and when I wasn't, the multiple heavyweight cron processes could have their way with the machine...

The code below has been updated to reflect the comments/input of merlyn and graff.  One of my previous posts implied that this code would work under Solaris, Irix, and Linux.  Because I have not had a chance to test the updated code under Solaris or Irix, I am backing off and stating that the code will run under Linux and should run on many other platforms.  Unix::Process would probably improve the robustness of the program (as long as your system has ps on it).  My problem with the Unix::Process module is its lack of documentation; thus my choice to switch modes with $^O (wow, making this script more cross-platform friendly nearly doubled its size).

As a special note, I would not recommend running this program as root because a mistyped command line parameter (i.e. ".*") will bring your system down!  Also, this script is for use exclusively under Unix, or Unix like, operating systems (if the system command ps could be rewritten in pure Perl, then the OS restriction could be lifted).

Update: Added Linux as an OS in its own right instead of depending on the default.

#!/usr/bin/perl

#
# Perl Process Killer (PPK)
# ppk {process name, reqired} {iterations, optional}
#

use strict;
use warnings;

my $loop = -1;
my @immortal;
my $flags;
my $process;
my $id;
my $only_one = 0;
my @level = qw/1 2 3 15 9 -9/;

sub check_match
{
  die "ACK, GASP:  $id failed to match on $_[0]" if( (not $only_one) &
+& ((not defined $_[1]) || (not defined $_[2])) );
  die "ACK, GASP:  $id failed to match on $_[0]" if($only_one && (not 
+defined $_[1]));
}

die "ACK, GASP:  Need program name to search for!\n"
  if( (not defined $ARGV[0]) || ($ARGV[0] =~ m/^\s*\d+\s*$/) );
# Other operating systems can be supported, I just do not have access 
+to them
# to configure $^O, $flags, $process, and $id properly.
# $^O should be matched against the platform you wish to add support f
+or
# $flags must be set so "ps $flags" returns (at least) the User ID, Pr
+ocess ID, and Command Name
# $process is a regexp that matches against the Command Name
# $id is a regexp that matches the User ID and Process ID; putting the
+m into $1 and $2, respectivly
# Also, don't forget to anchor your $process and $id matches!
if($^O =~ m/linux/i)
{
  $flags = "-ea";
  eval { $process = qr/\s+(?:\d+[:])+?\d+\s+.*?$ARGV[0].*?\s*$/; };
  if($@)
  {
    $@ =~ s/\s+at\s+.*?$0.*$//i;
    die "ACK, GASP:  \"$ARGV[0]\" is an invalid command line argument:
+\n" .
        "            $@";
  }
  $id = qr/^\s*(\d+)\s+/;
  $only_one = 1;
}
elsif($^O =~ m/irix/i)
{
  $flags = "-eaf";
  eval { $process = qr/\s+(?:\d+[:])+?\d+\s+.*?$ARGV[0].*?\s*$/; };
  if($@)
  {
    $@ =~ s/\s+at\s+.*?$0.*$//i;
    die "ACK, GASP:  \"$ARGV[0]\" is an invalid command line argument:
+\n" .
        "            $@";
  }
  $id = qr/^\s*(\w+)\s+(\d+)\s+/;
}
else  # Provide crippled functionality...
{
  $flags = "";
  eval { $process = qr/\d+\s+.*?$ARGV[0].*?\s*$/; };
  if($@)
  {
    $@ =~ s/\s+at\s+.*?$0.*$//i;
    die "ACK, GASP:  \"$ARGV[0]\" is an invalid command line argument:
+\n" .
        "            $@";
  }
  $id = qr/^\s*(\d+)\s+/;
  $only_one = 1;
}

if( (defined $ARGV[1]) && !($ARGV[1] =~ m/\D/o) && ($ARGV[1] > 0) ) { 
+$loop = int($ARGV[1]); }

my $login = (getpwuid($>))[0] || getlogin() || (getpwuid($<))[0];
while($loop != 0)
{
  $loop-- if($loop > 0);
  foreach (map { $_->[0] }
           sort { $b->[1] <=> $a->[1] } 
           map { m/$id/;
                 check_match($_, $1, ((not $only_one) ? $2 : ""));
                 [$_, ((not $only_one) ? $2 : $1)] }
           grep { m/$process/ } `ps $flags`)
  {
    m/$id/;
    check_match($_, $1, ((not $only_one) ? $2 : ""));
    next if( ((not $only_one) && ($1 ne $login) && ($login ne "root"))
               ||
             (((not $only_one) ? $2 : $1) == $$)
               ||
             (scalar grep { ((not $only_one) ? $2 : $1) == $_ } @immor
+tal) );
    my $successful = 0;
    foreach (@level)
    {
      if((kill $_, ((not $only_one) ? $2 : $1)) >= 1)
      {
        $successful = 1;
        last;
      }
    }
    if(not $successful)
    {
      warn "WARNING:  I cannot kill PID " . ((not $only_one) ? $2 : $1
+) . "!\n";
      push @immortal, ((not $only_one) ? $2 : $1);
    }
  }
  sleep(1) if($loop != 0);
}