Probe::MachineInfo::SimpleMetric - Simple Metric Collector


Probe-MachineInfo documentation Contained in the Probe-MachineInfo distribution.

Index


Code Index:

NAME

Top

Probe::MachineInfo::SimpleMetric - Simple Metric Collector

SYNOPSIS

Top

blah

DESCRIPTION

Top

blah

PUBLIC INTERFACE

Top

get

 get()

get_via_cmd

 get_via_cmd()

get_via_file

 get_via_file()

filter_through_regex

  filter_through_regex($value)

command

 command()

linenumber

 linenumber()

regex

 regex()

AUTHOR

Top

Sagar R. Shah


Probe-MachineInfo documentation Contained in the Probe-MachineInfo distribution.
package Probe::MachineInfo::SimpleMetric;


# pragmata
use base qw(Probe::MachineInfo::Metric);
use strict;
use warnings;


# Standard Perl Library and CPAN modules
use English;
use Proc::Reliable;

#
# CLASS ATTRIBUTES
#

#
# CONSTRUCTOR
#


sub get {
	my($self) = @_;

	return $self->get_via_cmd() if($self->command());
	return $self->get_via_file() if($self->filename());

}

sub get_via_cmd {
	my ($self) = @_;

	my $cmd = $self->command();
	return unless $cmd;

	my($executable) = $cmd =~ m/^(\S+)/;

	if(not -r $executable) {
		$self->log->warn("$executable is not readable\n");
		return;
	}
	elsif(not -x _) {
		$self->log->warn("$executable is not executable\n");
		return;
	}

	my $proc = Proc::Reliable->new();

	my $output = $proc->run($cmd);

	if($proc->status()) {
		my $err = $proc->stderr();
		$self->log->warn("$cmd exited with non zero exit status $err\n");
		return;
	}

	unless($output) {
		$self->log->warn("$cmd returned no output\n");
		return;
	}

	if($self->linenumber()) {
		my $n = $self->linenumber();
		my @lines = split("\n", $output);
		$output = $lines[$n];
	}

	return $self->filter_through_regex($output);
}

sub get_via_file {
	my($self) = @_;

	my $file = $self->filename();
	return unless $file;

	if(! -r $file) {
		$self->log->warn("$file is not readable\n");
		return;
	}

	open (my $fh, '<', $file) or return;
	my @contents = <$fh>;
	close $fh;

	if(my $n = $self->linenumber()) {
		return->filter_through_regex($contents[$n])
	}
	else {
		return->filter_through_regex(join("\n", @contents))
	}	
}

sub filter_through_regex {
	my($self, $value) = @_;


	chomp $value;

	if(my $regex = $self->regex()) {
		my($value) = $value =~ m/$regex/;
		return $value;
	}

	return $value;
}

sub command {
	my($self) = @_;

	return;
}


sub linenumber {
	my($self) = @_;

	return;
}

sub regex {
	my($self) = @_;

	return;
}

1;