File Coverage

blib/lib/Monitoring/Plugin/Performance.pm
Criterion Covered Total %
statement 86 86 100.0
branch 22 22 100.0
condition 12 17 70.5
subroutine 18 18 100.0
pod 6 6 100.0
total 144 149 96.6


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