line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Proc::Exists; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
15327
|
use strict; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
47
|
|
4
|
2
|
|
|
2
|
|
689
|
use Proc::Exists::Configuration; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
56
|
|
5
|
2
|
|
|
2
|
|
7
|
use vars qw (@ISA @EXPORT_OK $VERSION); |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
131
|
|
6
|
|
|
|
|
|
|
eval { require warnings; }; #it's ok if we can't load warnings |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
require Exporter; |
9
|
2
|
|
|
2
|
|
8
|
use base 'Exporter'; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
1355
|
|
10
|
|
|
|
|
|
|
@EXPORT_OK = qw( pexists ); |
11
|
|
|
|
|
|
|
@ISA = qw( Exporter ); |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
$VERSION = '0.99_02'; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my $use_pureperl = $Proc::Exists::Configuration::want_pureperl; |
16
|
|
|
|
|
|
|
if(!$use_pureperl) { |
17
|
|
|
|
|
|
|
eval { |
18
|
|
|
|
|
|
|
require XSLoader; |
19
|
|
|
|
|
|
|
XSLoader::load('Proc::Exists', $VERSION); |
20
|
|
|
|
|
|
|
$Proc::Exists::_loader = 'XSLoader'; |
21
|
|
|
|
|
|
|
1; |
22
|
|
|
|
|
|
|
} or do { |
23
|
|
|
|
|
|
|
require DynaLoader; |
24
|
|
|
|
|
|
|
push @ISA, 'DynaLoader'; |
25
|
|
|
|
|
|
|
$Proc::Exists::_loader = 'DynaLoader'; |
26
|
|
|
|
|
|
|
bootstrap Proc::Exists $VERSION; |
27
|
|
|
|
|
|
|
}; if($@) { |
28
|
|
|
|
|
|
|
#NOTE: don't need to worry about i18n, {XS|Dyna}Loader complain in english. |
29
|
|
|
|
|
|
|
if($@ =~ /Proc::Exists\s+object\s+version\s+\S+\s+does\s+not\s+match\s+bootstrap\s+parameter/ ) { |
30
|
|
|
|
|
|
|
warn "WARNING: it looks like you have a previous Proc::Exists ". |
31
|
|
|
|
|
|
|
"version's object file(s) somewhere in \@INC! you will have ". |
32
|
|
|
|
|
|
|
"to remove these and reinstall Proc::Exists. for now, we are ". |
33
|
|
|
|
|
|
|
"falling back to pureperl, expect degraded performance: $@\n"; |
34
|
|
|
|
|
|
|
} else { |
35
|
|
|
|
|
|
|
warn "WARNING: can't load XS. falling back to pureperl, ". |
36
|
|
|
|
|
|
|
"expect degraded performance: $@\n"; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
$use_pureperl = 1; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
if($use_pureperl) { |
43
|
|
|
|
|
|
|
#warn "using pure perl mode, expect degraded performance\n"; |
44
|
|
|
|
|
|
|
my $pp_pexists = sub { |
45
|
|
|
|
|
|
|
my @pids = @_; |
46
|
|
|
|
|
|
|
my %args = ref($pids[-1]) ? %{pop(@pids)} : (); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
die "can't specify both 'any' and 'all' arg" if($args{all} && $args{any}); |
49
|
|
|
|
|
|
|
if(wantarray) { |
50
|
|
|
|
|
|
|
die "can't specify 'all' argument in list context" if($args{all}); |
51
|
|
|
|
|
|
|
die "can't specify 'any' argument in list context" if($args{any}); |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
my @results; |
55
|
|
|
|
|
|
|
foreach my $pid (@pids) { |
56
|
|
|
|
|
|
|
#ASSUMPTION: no systems allow a negative int as a PID |
57
|
|
|
|
|
|
|
if($pid !~ /^\d+$/) { |
58
|
|
|
|
|
|
|
if($pid =~ /^-\d+$/) { |
59
|
|
|
|
|
|
|
die "got negative pid: '$pid'"; |
60
|
|
|
|
|
|
|
} elsif($pid =~ /^-?\d+\./) { |
61
|
|
|
|
|
|
|
die "got non-integer pid: '$pid'"; |
62
|
|
|
|
|
|
|
} else { |
63
|
|
|
|
|
|
|
die "got non-number pid: '$pid'"; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
my $ret; |
68
|
|
|
|
|
|
|
if (kill 0, $pid) { |
69
|
|
|
|
|
|
|
$ret = 1; |
70
|
|
|
|
|
|
|
} else { |
71
|
|
|
|
|
|
|
if($! == $Proc::Exists::Configuration::EPERM) { |
72
|
|
|
|
|
|
|
$ret = 1; |
73
|
|
|
|
|
|
|
} elsif($! == $Proc::Exists::Configuration::ESRCH) { |
74
|
|
|
|
|
|
|
$ret = 0; |
75
|
|
|
|
|
|
|
} elsif($^O eq "MSWin32") { |
76
|
|
|
|
|
|
|
die "can't do pure perl on MSWin32 - \$!: (".(0+$!)."): $!"; |
77
|
|
|
|
|
|
|
} else { |
78
|
|
|
|
|
|
|
die "unknown numeric \$!: (".(0+$!)."): $!, pureperl, OS: $^O"; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
if($ret) { |
83
|
|
|
|
|
|
|
return $pid if($args{any}); |
84
|
|
|
|
|
|
|
push @results, $pid; |
85
|
|
|
|
|
|
|
} elsif($args{all}) { |
86
|
|
|
|
|
|
|
return 0; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
#NOTE: as documented in the pod, any returns undef for false, |
90
|
|
|
|
|
|
|
# because some systems use pid==0 |
91
|
|
|
|
|
|
|
return if($args{any}); |
92
|
|
|
|
|
|
|
return wantarray ? @results : scalar @results; |
93
|
|
|
|
|
|
|
}; |
94
|
|
|
|
|
|
|
*pexists = \&$pp_pexists; |
95
|
|
|
|
|
|
|
$Proc::Exists::pureperl = 1; |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
} else { |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
my $xs_pexists = sub { |
100
|
27
|
|
|
27
|
|
19998
|
my @pids = @_; |
101
|
27
|
100
|
|
|
|
74
|
my %args = ref($pids[-1]) ? %{pop(@pids)} : (); |
|
9
|
|
|
|
|
28
|
|
102
|
|
|
|
|
|
|
|
103
|
27
|
100
|
|
|
|
52
|
if(wantarray) { |
104
|
8
|
100
|
|
|
|
29
|
die "can't specify 'all' argument in list context" if($args{all}); |
105
|
7
|
100
|
|
|
|
20
|
die "can't specify 'any' argument in list context" if($args{any}); |
106
|
6
|
|
|
|
|
35343
|
return _list_pexists([@pids]); |
107
|
|
|
|
|
|
|
} else { |
108
|
19
|
100
|
66
|
|
|
72
|
die "can't specify both 'any' and 'all' arg" if($args{all} && $args{any}); |
109
|
18
|
|
100
|
|
|
35485
|
return _scalar_pexists([@pids], $args{any} || 0, $args{all} || 0); |
|
|
|
100
|
|
|
|
|
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
}; |
112
|
|
|
|
|
|
|
*pexists = \&$xs_pexists; |
113
|
|
|
|
|
|
|
$Proc::Exists::pureperl = 0; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
# !wantarray : return number of matches |
118
|
|
|
|
|
|
|
# !wantarray && any : return pid of first match if any match, else undef |
119
|
|
|
|
|
|
|
# !wantarray && all : return a true value if all match, else a false value |
120
|
|
|
|
|
|
|
# wantarray : return list of matching pids |
121
|
|
|
|
|
|
|
# wantarray && any : undefined, makes no sense |
122
|
|
|
|
|
|
|
# ALTERNATELY: could return list of size one with first matching pid, |
123
|
|
|
|
|
|
|
# else bare return |
124
|
|
|
|
|
|
|
# wantarray && all : undefined, makes no sense |
125
|
|
|
|
|
|
|
# ALTERNATELY: could return list of all pids on true, else bare return |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
1; |
128
|
|
|
|
|
|
|
__END__ |