forked from jwbargsten/perl-proc-processtable
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Killall.pm
111 lines (88 loc) · 2.66 KB
/
Killall.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
#
# Kill all instances of a process by pattern-matching the command-line
#
# (c) 2000 by Aaron Sherman, see documentation, below for details.
package Proc::Killall;
require Exporter;
use Carp;
use Proc::ProcessTable;
use Config;
use strict;
use vars qw(@EXPORT @EXPORT_OK @ISA $VERSION);
@EXPORT=qw(killall);
@EXPORT_OK=qw(killall);
@ISA=qw(Exporter);
$VERSION='1.0';
sub VERSION {$VERSION}
# Private function for checking to see if a signal identifier is
# valid.
sub is_sig {
my $sig = shift;
if (defined($sig)) {
if ($sig =~ /^-?(\d+)/) {
my $n = $1;
my @sigs = split ' ', $Config{sig_num};
return grep {$_ == $n} @sigs;
} elsif ($sig =~ /^[A-Z][A-Z0-9]+$/) {
my @sigs = split ' ', $Config{sig_name};
return grep {$_ eq $sig} @sigs;
} else {
return 0;
}
} else {
return 0;
}
}
# usage: killall(signal, pattern)
# return: number of procs killed
sub killall {
croak("Usage: killall(signal, pattern)") unless @_==2;
my $signal = shift;
my $pat = shift;
my $self = shift;
$self = 0 unless defined $self;
my $nkilled = 0;
croak("killall: Unsupported signal: $signal") unless is_sig($signal);
my $t = new Proc::ProcessTable;
my $BANG = undef;
foreach my $p (@{$t->table}) {
my $cmndline = $p->{cmndline} || $p->{fname};
if ($cmndline =~ /$pat/) {
next unless $p->pid != $$ || $self;
if (kill $signal, $p->pid) {
$nkilled++;
} else {
$BANG = $!;
}
}
}
$! = $BANG if defined $BANG;
return $nkilled;
}
1;
__END__
=head1 NAME
killall - Kill all instances of a process by pattern matching the command-line
=head1 SYNOPSIS
use Proc::Killall;
killall('HUP', 'xterm'); # SIGHUP all xterms
killall('KILL', '^netscape$'); # SIGKILL to "netscape"
=head1 DESCRIPTION
This module provides one function, C<killall()>, which takes two parameters:
a signal name or number (see C<kill()>) and a process pattern. This pattern
is matched against the process' command-line as the C<ps> command would
show it (C<ps> is not used internally, instead a package called
C<Proc::ProcessTable> is used).
C<killall> searches the process table and sends that signal to all processes
which match the pattern. The return value is the number of processes that
were succesfully signaled. If any kills failed, the C<$!> variable
will be set based on that last one that failed (even if a successful kill
happened afterward).
=head1 AUTHOR
Written in 2000 by Aaron Sherman E<lt>ajs@ajs.comE<gt>
C<Proc::Killall> is copyright 2000 by Aaron Sherman, and may be
distributed under the same terms as Perl itself.
=head1 PREREQUISITES
C<Proc::ProcessTable> is required for C<Proc::Killall> to function.
=head1 SEE ALSO
L<perl>, L<perlfunc>, L<perlvar>, L<Proc::ProcessTable>