line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Nagios::Monitoring::Plugin::Performance;
|
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
4051
|
use 5.006;
|
|
4
|
|
|
|
|
47
|
|
4
|
|
|
|
|
|
|
|
5
|
4
|
|
|
4
|
|
21
|
use strict;
|
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
99
|
|
6
|
4
|
|
|
4
|
|
20
|
use warnings;
|
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
134
|
|
7
|
|
|
|
|
|
|
|
8
|
4
|
|
|
4
|
|
248
|
use Carp;
|
|
4
|
|
|
|
|
29
|
|
|
4
|
|
|
|
|
285
|
|
9
|
4
|
|
|
4
|
|
18
|
use base qw(Class::Accessor::Fast);
|
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
1656
|
|
10
|
|
|
|
|
|
|
__PACKAGE__->mk_ro_accessors(
|
11
|
|
|
|
|
|
|
qw(label value uom warning critical min max)
|
12
|
|
|
|
|
|
|
);
|
13
|
|
|
|
|
|
|
|
14
|
4
|
|
|
4
|
|
6669
|
use Nagios::Monitoring::Plugin::Functions;
|
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
357
|
|
15
|
4
|
|
|
4
|
|
1353
|
use Nagios::Monitoring::Plugin::Threshold;
|
|
4
|
|
|
|
|
13
|
|
|
4
|
|
|
|
|
36
|
|
16
|
4
|
|
|
4
|
|
105
|
use Nagios::Monitoring::Plugin::Range;
|
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
26
|
|
17
|
|
|
|
|
|
|
our ($VERSION) = $Nagios::Monitoring::Plugin::Functions::VERSION;
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub import {
|
20
|
4
|
|
|
4
|
|
478
|
my ($class, %attr) = @_;
|
21
|
4
|
|
100
|
|
|
28
|
$_ = $attr{use_die} || 0;
|
22
|
4
|
|
|
|
|
16
|
Nagios::Monitoring::Plugin::Functions::_use_die($_);
|
23
|
|
|
|
|
|
|
}
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# This is NOT the same as N::P::Functions::value_re. We leave that to be the strict
|
26
|
|
|
|
|
|
|
# version. This one allows commas to be part of the numeric value.
|
27
|
|
|
|
|
|
|
my $value = qr/[-+]?[\d\.,]+/;
|
28
|
|
|
|
|
|
|
my $value_re = qr/$value(?:e$value)?/;
|
29
|
|
|
|
|
|
|
my $value_with_negative_infinity = qr/$value_re|~/;
|
30
|
|
|
|
|
|
|
sub _parse {
|
31
|
41
|
|
|
41
|
|
55
|
my $class = shift;
|
32
|
41
|
|
|
|
|
72
|
my $string = shift;
|
33
|
41
|
|
|
|
|
518
|
$string =~ /^'?([^'=]+)'?=($value_re)([\w%]*);?($value_with_negative_infinity\:?$value_re?)?;?($value_with_negative_infinity\:?$value_re?)?;?($value_re)?;?($value_re)?/o;
|
34
|
41
|
100
|
66
|
|
|
380
|
return undef unless ((defined $1 && $1 ne "") && (defined $2 && $2 ne ""));
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
35
|
37
|
|
|
|
|
173
|
my @info = ($1, $2, $3, $4, $5, $6, $7);
|
36
|
|
|
|
|
|
|
# We convert any commas to periods, in the value fields
|
37
|
37
|
100
|
|
|
|
53
|
map { defined $info[$_] && $info[$_] =~ s/,/./go } (1, 3, 4, 5, 6);
|
|
185
|
|
|
|
|
641
|
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# Check that $info[1] is an actual value
|
40
|
|
|
|
|
|
|
# We do this by returning undef if a warning appears
|
41
|
37
|
|
|
|
|
38
|
my $performance_value;
|
42
|
|
|
|
|
|
|
{
|
43
|
37
|
|
|
|
|
37
|
my $not_value;
|
|
37
|
|
|
|
|
32
|
|
44
|
37
|
|
|
1
|
|
185
|
local $SIG{__WARN__} = sub { $not_value++ };
|
|
1
|
|
|
|
|
6
|
|
45
|
37
|
|
|
|
|
100
|
$performance_value = $info[1]+0;
|
46
|
37
|
100
|
|
|
|
170
|
return undef if $not_value;
|
47
|
|
|
|
|
|
|
}
|
48
|
36
|
|
|
|
|
112
|
my $p = $class->new(
|
49
|
|
|
|
|
|
|
label => $info[0], value => $performance_value, uom => $info[2], warning => $info[3], critical => $info[4],
|
50
|
|
|
|
|
|
|
min => $info[5], max => $info[6]
|
51
|
|
|
|
|
|
|
);
|
52
|
36
|
|
|
|
|
486
|
return $p;
|
53
|
|
|
|
|
|
|
}
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# Map undef to ''
|
56
|
|
|
|
|
|
|
sub _nvl {
|
57
|
185
|
|
|
185
|
|
859
|
my ($self, $value) = @_;
|
58
|
185
|
100
|
|
|
|
762
|
defined $value ? $value : ''
|
59
|
|
|
|
|
|
|
}
|
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub perfoutput {
|
62
|
37
|
|
|
37
|
1
|
216
|
my $self = shift;
|
63
|
|
|
|
|
|
|
# Add quotes if label contains a space character
|
64
|
37
|
|
|
|
|
97
|
my $label = $self->label;
|
65
|
37
|
100
|
|
|
|
262
|
if ($label =~ / /) {
|
66
|
2
|
|
|
|
|
5
|
$label = "'$label'";
|
67
|
|
|
|
|
|
|
}
|
68
|
37
|
|
|
|
|
98
|
my $out = sprintf "%s=%s%s;%s;%s;%s;%s",
|
69
|
|
|
|
|
|
|
$label,
|
70
|
|
|
|
|
|
|
$self->value,
|
71
|
|
|
|
|
|
|
$self->_nvl($self->uom),
|
72
|
|
|
|
|
|
|
$self->_nvl($self->warning),
|
73
|
|
|
|
|
|
|
$self->_nvl($self->critical),
|
74
|
|
|
|
|
|
|
$self->_nvl($self->min),
|
75
|
|
|
|
|
|
|
$self->_nvl($self->max);
|
76
|
|
|
|
|
|
|
# Previous implementation omitted trailing ;; - do we need this?
|
77
|
37
|
|
|
|
|
181
|
$out =~ s/;;$//;
|
78
|
37
|
|
|
|
|
204
|
return $out;
|
79
|
|
|
|
|
|
|
}
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub parse_perfstring {
|
82
|
29
|
|
|
29
|
1
|
13577
|
my ($class, $perfstring) = @_;
|
83
|
29
|
|
|
|
|
48
|
my @perfs = ();
|
84
|
29
|
|
|
|
|
31
|
my $obj;
|
85
|
29
|
|
|
|
|
66
|
while ($perfstring) {
|
86
|
41
|
|
|
|
|
146
|
$perfstring =~ s/^\s*//;
|
87
|
|
|
|
|
|
|
# If there is more than 1 equals sign, split it out and parse individually
|
88
|
41
|
100
|
|
|
|
53
|
if (@{[$perfstring =~ /=/g]} > 1) {
|
|
41
|
|
|
|
|
175
|
|
89
|
14
|
|
|
|
|
69
|
$perfstring =~ s/^(.*?=.*?)\s//;
|
90
|
14
|
100
|
|
|
|
38
|
if (defined $1) {
|
91
|
13
|
|
|
|
|
32
|
$obj = $class->_parse($1);
|
92
|
|
|
|
|
|
|
} else {
|
93
|
|
|
|
|
|
|
# This could occur if perfdata was soemthing=value=
|
94
|
|
|
|
|
|
|
# Since this is invalid, we reset the string and continue
|
95
|
1
|
|
|
|
|
3
|
$perfstring = "";
|
96
|
1
|
|
|
|
|
4
|
$obj = $class->_parse($perfstring);
|
97
|
|
|
|
|
|
|
}
|
98
|
|
|
|
|
|
|
} else {
|
99
|
27
|
|
|
|
|
59
|
$obj = $class->_parse($perfstring);
|
100
|
27
|
|
|
|
|
49
|
$perfstring = "";
|
101
|
|
|
|
|
|
|
}
|
102
|
41
|
100
|
|
|
|
186
|
push @perfs, $obj if $obj;
|
103
|
|
|
|
|
|
|
}
|
104
|
29
|
|
|
|
|
130
|
return @perfs;
|
105
|
|
|
|
|
|
|
}
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub rrdlabel {
|
108
|
15
|
|
|
15
|
1
|
12234
|
my $self = shift;
|
109
|
15
|
|
|
|
|
39
|
my $name = $self->clean_label;
|
110
|
|
|
|
|
|
|
# Shorten
|
111
|
15
|
|
|
|
|
67
|
return substr( $name, 0, 19 );
|
112
|
|
|
|
|
|
|
}
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub clean_label {
|
115
|
20
|
|
|
20
|
1
|
56
|
my $self = shift;
|
116
|
20
|
|
|
|
|
48
|
my $name = $self->label;
|
117
|
20
|
100
|
|
|
|
163
|
if ($name eq "/") {
|
|
|
100
|
|
|
|
|
|
118
|
3
|
|
|
|
|
4
|
$name = "root";
|
119
|
|
|
|
|
|
|
} elsif ( $name =~ s/^\/// ) {
|
120
|
6
|
|
|
|
|
17
|
$name =~ s/\//_/g;
|
121
|
|
|
|
|
|
|
}
|
122
|
|
|
|
|
|
|
# Convert all other characters
|
123
|
20
|
|
|
|
|
70
|
$name =~ s/\W/_/g;
|
124
|
20
|
|
|
|
|
53
|
return $name;
|
125
|
|
|
|
|
|
|
}
|
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# Backward compatibility: create a threshold object on the fly as requested
|
128
|
|
|
|
|
|
|
sub threshold
|
129
|
|
|
|
|
|
|
{
|
130
|
90
|
|
|
90
|
1
|
43991
|
my $self = shift;
|
131
|
90
|
|
|
|
|
255
|
return Nagios::Monitoring::Plugin::Threshold->set_thresholds(
|
132
|
|
|
|
|
|
|
warning => $self->warning, critical => $self->critical
|
133
|
|
|
|
|
|
|
);
|
134
|
|
|
|
|
|
|
}
|
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# Constructor - unpack thresholds, map args to hashref
|
137
|
|
|
|
|
|
|
sub new
|
138
|
|
|
|
|
|
|
{
|
139
|
48
|
|
|
48
|
1
|
7157
|
my $class = shift;
|
140
|
48
|
|
|
|
|
206
|
my %arg = @_;
|
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# Convert thresholds
|
143
|
48
|
100
|
|
|
|
142
|
if (my $threshold = delete $arg{threshold}) {
|
144
|
7
|
|
66
|
|
|
36
|
$arg{warning} ||= $threshold->warning . "";
|
145
|
7
|
|
66
|
|
|
191
|
$arg{critical} ||= $threshold->critical . "";
|
146
|
|
|
|
|
|
|
}
|
147
|
|
|
|
|
|
|
|
148
|
48
|
|
|
|
|
287
|
$class->SUPER::new(\%arg);
|
149
|
|
|
|
|
|
|
}
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
1;
|
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
__END__
|