File Coverage

blib/lib/Nagios/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

package Nagios::Plugin::Performance;

use 5.006;

use strict;
use warnings;

use Carp;
use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_ro_accessors(
    qw(label value uom warning critical min max)
);

use Nagios::Plugin::Functions;
use Nagios::Plugin::Threshold;
use Nagios::Plugin::Range;
our ($VERSION) = $Nagios::Plugin::Functions::VERSION;

sub import {
	my ($class, %attr) = @_;
	$_ = $attr{use_die} || 0;
	Nagios::Plugin::Functions::_use_die($_);
}

# This is NOT the same as N::P::Functions::value_re. We leave that to be the strict
# version. This one allows commas to be part of the numeric value.
my $value = qr/[-+]?[\d\.,]+/;
my $value_re = qr/$value(?:e$value)?/;
my $value_with_negative_infinity = qr/$value_re|~/;
sub _parse {
	my $class = shift;
	my $string = shift;
	$string =~ /^'?([^'=]+)'?=($value_re)([\w%]*);?($value_with_negative_infinity\:?$value_re?)?;?($value_with_negative_infinity\:?$value_re?)?;?($value_re)?;?($value_re)?/o;
	return undef unless ((defined $1 && $1 ne "") && (defined $2 && $2 ne ""));
	my @info = ($1, $2, $3, $4, $5, $6, $7);
	# We convert any commas to periods, in the value fields
	map { defined $info[$_] && $info[$_] =~ s/,/./go } (1, 3, 4, 5, 6);

	# Check that $info[1] is an actual value
	# We do this by returning undef if a warning appears
	my $performance_value;
	{
		my $not_value;
		local $SIG{__WARN__} = sub { $not_value++ };
		$performance_value = $info[1]+0;
		return undef if $not_value;
	}
    my $p = $class->new(
        label => $info[0], value => $performance_value, uom => $info[2], warning => $info[3], critical => $info[4],
        min => $info[5], max => $info[6]
    );
	return $p;
}

# Map undef to ''
sub _nvl {
    my ($self, $value) = @_;
    defined $value ? $value : ''
}

sub perfoutput {
	my $self = shift;
	# Add quotes if label contains a space character
	my $label = $self->label;
	if ($label =~ / /) {
		$label = "'$label'";
	}
    my $out = sprintf "%s=%s%s;%s;%s;%s;%s",
        $label,
        $self->value,
        $self->_nvl($self->uom),
        $self->_nvl($self->warning),
        $self->_nvl($self->critical),
        $self->_nvl($self->min),
        $self->_nvl($self->max);
    # Previous implementation omitted trailing ;; - do we need this?
    $out =~ s/;;$//;
    return $out;
}

sub parse_perfstring {
	my ($class, $perfstring) = @_;
	my @perfs = ();
	my $obj;
	while ($perfstring) {
		$perfstring =~ s/^\s*//;
		# If there is more than 1 equals sign, split it out and parse individually
		if (@{[$perfstring =~ /=/g]} > 1) {
			$perfstring =~ s/^(.*?=.*?)\s//;
			if (defined $1) {
				$obj = $class->_parse($1);
			} else {
				# This could occur if perfdata was soemthing=value=
				# Since this is invalid, we reset the string and continue
				$perfstring = "";
				$obj = $class->_parse($perfstring);
			}
		} else {
			$obj = $class->_parse($perfstring);
			$perfstring = "";
		}
		push @perfs, $obj if $obj;
	}
	return @perfs;
}

sub rrdlabel {
	my $self = shift;
	my $name = $self->clean_label;
	# Shorten
	return substr( $name, 0, 19 );
}

sub clean_label {
	my $self = shift;
	my $name = $self->label;
	if ($name eq "/") {
		$name = "root";
	} elsif ( $name =~ s/^\/// ) {
		$name =~ s/\//_/g;
	}
	# Convert all other characters
	$name =~ s/\W/_/g;
	return $name;
}

# Backward compatibility: create a threshold object on the fly as requested
sub threshold
{
    my $self = shift;
    return Nagios::Plugin::Threshold->set_thresholds(
        warning => $self->warning, critical => $self->critical
    );
}

# Constructor - unpack thresholds, map args to hashref
sub new
{
    my $class = shift;
    my %arg = @_;

    # Convert thresholds
    if (my $threshold = delete $arg{threshold}) {
        $arg{warning}  ||= $threshold->warning  . "";
        $arg{critical} ||= $threshold->critical . "";
    }

    $class->SUPER::new(\%arg);
}

1;

__END__