Nagios::Plugin::OverHTTP::Middleware::PerformanceData - Modifies responses

  #TODO: Write this

package Nagios::Plugin::OverHTTP::Middleware::PerformanceData;

use 5.008001;
use strict;
use warnings 'all';

###########################################################################
# METADATA
our $AUTHORITY = 'cpan:DOUGDUDE';
our $VERSION   = '0.14';

###########################################################################
# MOOSE
use Moose 0.74;
use MooseX::StrictConstructor 0.08;

###########################################################################
# MOOSE ROLES
with 'Nagios::Plugin::OverHTTP::Middleware';

###########################################################################
# MOOSE TYPES
use Nagios::Plugin::OverHTTP::Library qw(Status);

###########################################################################
# MODULE IMPORTS
use Nagios::Plugin::OverHTTP::Library 0.14;
use Nagios::Plugin::OverHTTP::PerformanceData;
use Try::Tiny;

###########################################################################
# ALL IMPORTS BEFORE THIS WILL BE ERASED
use namespace::clean 0.04 -except => [qw(meta)];

###########################################################################
# ATTRIBUTES
has 'critical_override' => (
	is            => 'rw',
	isa           => 'HashRef[Str]',
	documentation => q{Specifies performance levels that result in a }
	                .q{critical status},
	default       => sub { {} },
);
has 'honor_remote_thresholds' => (
	is            => 'rw',
	isa           => 'Bool',
	documentation => q{Specifies if thresholds from the remote plugin }
	                .q{should be used to change the status},
	default       => 0,
);
has 'rewrite_in_overrides' => (
	is            => 'rw',
	isa           => 'Bool',
	documentation => q{Specifies if the given override thresholds should }
	                .q{be rewritten into the respose},
	default       => 1,
);
has 'warning_override' => (
	is            => 'rw',
	isa           => 'HashRef[Str]',
	documentation => q{Specifies performance levels that result in a }
	                .q{warning status},
	default       => sub { {} },
);

###########################################################################
# METHODS
sub rewrite {
	my ($self, $response) = @_;

	if (!$response->has_performance_data) {
		# This response has no performance data
		return $response;
	}

	# Parse the performance data, keeping the line order
	my @performance_data = map {
		# Create array of data for each line to keep line order
		[ _parse_data($_) ]
	} split m{\n}msx, $response->performance_data;

	# Set the new status to the current status
	my $new_status = $response->status;

	# Set the new performance data to the current performance data
	my $new_performance_data = $response->performance_data;

	# Get a list of data objects
	my @data_objects = grep { ref ne q{} } map { @{$_} } @performance_data;

	if ($new_status != $Nagios::Plugin::OverHTTP::Library::STATUS_CRITICAL) {
		# Get the number of critical performance data
		my $critical = _matching_performance_data(
			\@data_objects => q{critical},
			check_original => $self->honor_remote_thresholds,
			override       => $self->critical_override,
		);

		if ($critical > 0) {
			# Set the new status to critical
			$new_status = $Nagios::Plugin::OverHTTP::Library::STATUS_CRITICAL;
		}
	}

	if ($new_status != $Nagios::Plugin::OverHTTP::Library::STATUS_CRITICAL
		&& $new_status != $Nagios::Plugin::OverHTTP::Library::STATUS_WARNING) {
		# Get the number of warning performance data
		my $warning = _matching_performance_data(
			\@data_objects => q{warning},
			check_original => $self->honor_remote_thresholds,
			override       => $self->warning_override,
		);

		if ($warning > 0) {
			# Set the new status to warning
			$new_status = $Nagios::Plugin::OverHTTP::Library::STATUS_WARNING;
		}
	}

	if ($self->rewrite_in_overrides) {
		# Update the performance data with the new overrides
		_update_performance_data(\@data_objects,
			critical => $self->critical_override,
			warning  => $self->warning_override,
		);

		foreach my $line (@performance_data) {
			# Update the performance data lines
			$line = [ map { ref($_) && $_ == $data_objects[0] ? shift(@data_objects) : $_ } @{$line} ];
		}

		# Create the new performance data line
		$new_performance_data = join qq{\n}, map { join q{ },map { ref($_) ? $_->to_string : $_ } @{$_} } @performance_data;
	}

	# Return the modified response
	return $response->clone(
		performance_data => $new_performance_data,
		status           => $new_status,
	);
}

###########################################################################
# PRIVATE FUNCTIONS
sub _matching_performance_data {
	my ($data_r, $type, %args) = @_;

	# Get the override arguments
	my $override = $args{override} || {};

	# Should the original be checked?
	my $check_original = $args{check_original} || 0;

	# Make the check method name
	my $check_method = sprintf q{is_%s}, $type;

	# Make closure for grep
	my $does_match = sub {
		my ($data) = @_;
		my $label  = $data->label; # Cache value

		# Return result of check
		return ($check_original && $data->$check_method)
			|| (exists $override->{$label} && $data->is_within_range($override->{$label}));
	};

	# Return the objects that match
	return grep { $does_match->($_) } @{$data_r};
}
sub _parse_data {
	my ($string) = @_;

	# Split the data
	my @split_data = Nagios::Plugin::OverHTTP::PerformanceData
		->split_performance_string($string);

	# Return the parsed pieces
	return map { _parse_data_piece_lax($_) } @split_data;
}
sub _parse_data_piece_lax {
	my ($data_string) = @_;

	my $data = try {
		# Make a new data object
		Nagios::Plugin::OverHTTP::PerformanceData->new($data_string);
	}
	catch {
		# On error, just revert back to the string, as this is lax
		$data_string;
	};

	# Return the new data
	return $data;
}
sub _update_performance_data {
	my ($data_r, %args) = @_;

	# Get the override arguments
	my $critical_override = $args{critical} || {};
	my $warning_override  = $args{warning } || {};

	foreach my $data (@{$data_r}) {
		my $label = $data->label; # Cache label

		if (exists $critical_override->{$label}) {
			# Update the critical threshold
			$data->critical_threshold($critical_override->{$label});
		}

		if (exists $warning_override->{$label}) {
			# Update the warning threshold
			$data->warning_threshold($warning_override->{$label});
		}
	}

	return;
}

###########################################################################
# MAKE MOOSE OBJECT IMMUTABLE
__PACKAGE__->meta->make_immutable;

1;

__END__