File Coverage

blib/lib/Net/Peep/Client.pm

Criterion	Covered	Total	%
statement	148	273	54.2
branch	35	110	31.8
condition	7	42	16.6
subroutine	27	36	75.0
pod	0	21	0.0
total	217	482	45.0

package Net::Peep::Client;

require 5.00503;
use strict;
# use warnings; # commented out for 5.005 compatibility
use Carp;
use Data::Dumper;
use Socket;
use Getopt::Long;
use File::Tail;
use Pod::Text;
use Net::Peep::BC;
use Net::Peep::Log;
use Net::Peep::Parser;
use Net::Peep::Notifier;

require Exporter;

use vars qw{ @ISA %EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION };

@ISA = qw(Exporter);
%EXPORT_TAGS = ( 'all' => [ qw( INTERVAL MAX_INTERVAL ADJUST_AFTER ) ] );
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@EXPORT = qw( );
$VERSION = do { my @r = (q$Revision: 1.12 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };

# These are in seconds and are the parameters for File::Tail

# File Tail uses the idea of intervals and predictions to try to keep
# blocking time at a maximum. These three parameters are the ones that
# people will want to tune for performance vs. load. The smaller the
# interval, the higher the load but faster events are picked up.

# The interval that File::Tail waits before checking the log
use constant INTERVAL => 0.1;
# The maximum interval that File::Tail will wait before checking the
# log
use constant MAX_INTERVAL => 1;
# The time after which File::Tail adjusts its predictions
use constant ADJUST_AFTER => 2;

sub new {

	my $self = shift;
	my $class = ref($self) || $self;
	my $this = {};
	bless $this, $class;

} # end sub new

sub name {

    my $self = shift;
    if (@_) { $self->{'NAME'} = shift; }
    return $self->{'NAME'};

} # end sub name

sub callback {

	my $self = shift;
	my $callback = shift;
	confess "Cannot register callback:  Expecting a code reference.  (Got [$callback].)"
		unless ref($callback) eq 'CODE';
	$self->{"__CALLBACK"} = $callback;
	return 1;

} # end sub callback

sub getCallback {

	my $self = shift;
	confess "Cannot get callback:  A callback has not been set yet."
		unless exists $self->{"__CALLBACK"};
	return $self->{"__CALLBACK"};

} # end sub getCallback

sub parser {

	my $self = shift;
	my $parser = shift;
	confess "Cannot register parser:  Expecting a code reference.  (Got [$parser].)"
		unless ref($parser) eq 'CODE';
	$self->{"__PARSER"} = $parser;
	return 1;

} # end sub parser

sub getParser {

	my $self = shift;
	confess "Cannot get parser:  A parser has not been set yet."
		unless exists $self->{"__PARSER"};
	return $self->{"__PARSER"};

} # end sub getParser

sub runParser {

    my $self = shift;
    my @text = @_;

    my $parser = $self->getParser();
    &$parser(@text);

} # end sub runParser

sub loop {

	my $self = shift;
	if (@_) { $self->{"__LOOP"} = shift; }
	return $self->{"__LOOP"};

} # end sub loop

sub peck {

	my $self = shift;
	my $conf = $self->conf();

	unless (exists $self->{"__PEEP"}) {
		if ($conf->getOptions()) {
			$self->{"__PEEP"} = Net::Peep::BC->new( $self->name(), $conf );
		} else {
			confess "Error:  Expecting options to have been parsed by now.";
		}
	}
	return $self->{"__PEEP"};

} # end sub peck

sub initialize {

	my $self = shift;
	my %options = @_;

	my $conf = $self->conf();

	$conf->client($self);

	my (
		$config,
		$logfile,
		$debug,
		$daemon,
		$output,
		$pidfile,
		$autodiscovery,
		$server,
		$port,
		$silent,
		$help) = ('/etc/peep.conf','',0,1,'','',1,'','',0,0);

	my %standardOptions = (
		'config=s' => \$config,
		'logfile=s' => \$logfile,
		'debug=s' => \$debug,
		'daemon!' => \$daemon,
		'output=s' => \$output,
		'pidfile=s' => \$pidfile,
		'autodiscovery!' => \$autodiscovery,
		'server=s' => \$server,
		'port=s' => \$port,
		'silent' => \$silent,
		'help' => \$help
	);

	for my $option (keys %standardOptions) {
		if (exists $options{$option}) {
			delete $standardOptions{$option};
		}
	}

	my %allOptions = (%options,%standardOptions);

	GetOptions(%allOptions);

	# set the debug level first so we can start printing debugging
	# messages
	$Net::Peep::Log::logfile = $output if $output;
	$Net::Peep::Log::debug = $debug if $debug;

	my $found;

	if (-f ${$allOptions{'config=s'}}) {
		$found = ${$allOptions{'config=s'}};
	} else {
		for my $dir ('.','/usr/local/etc','/usr','/usr/local','/opt') {
			if (-f "$dir/peep.conf") {
				$found = "$dir/peep.conf";
				last;
			}
		}
	}

	if ($found) {
		$self->logger()->debug(1,"The Peep configuration file has been identified as [$found]");
	} else {
		$self->logger()->log("No peep configuration file could be found.  Exiting gracefully ....");
		exit 2;
	}

	$conf->setOption('config',$found);
	$conf->setOption('logfile',${$allOptions{'logfile=s'}}) if ${$allOptions{'logfile=s'}} ne '';
	$conf->setOption('debug',${$allOptions{'debug=s'}});
	$conf->setOption('daemon',${$allOptions{'daemon!'}});
	$conf->setOption('output',${$allOptions{'output=s'}});
	$conf->setOption('pidfile',${$allOptions{'pidfile=s'}}) if ${$allOptions{'pidfile=s'}} ne '';
	$conf->setOption('autodiscovery',${$allOptions{'autodiscovery!'}});
	$conf->setOption('server',${$allOptions{'server=s'}}) if ${$allOptions{'server=s'}} ne '';
	$conf->setOption('port',${$allOptions{'port=s'}}) if ${$allOptions{'port=s'}} ne '';
	$conf->setOption('silent',${$allOptions{'silent'}});
	$conf->setOption('help',${$allOptions{'help'}});

	return $help ? 0 : 1;

} # end sub initialize

sub MainLoop {

	my $self = shift;
	my $sleep = shift;

	my $client = $self->name() || confess "Cannot begin main loop:  Client name not specified.";
	my $conf = $self->conf() || confess "Cannot begin main loop:  Configuration object not found.";

	my $fork = $conf->getOption('daemon');

	if ($fork) {

		$self->logger()->debug(7,"Running in daemon mode.  Forking ...");

		if (fork()) {
			# If we're here, then we're the parent
			close (STDIN);
			close (STDOUT);
			close (STDERR);
			exit(0);
		}

		$self->logger()->debug(7,"\tForked.");

		# Else we're the child. Let's write out our pid
		my $pid = 0;
		if ($conf->optionExists('pidfile')) {
			my $pidfile = $conf->getOption('pidfile') || confess "Cannot fork:  Pidfile not found.";
			if (open PIDFILE, ">$pidfile") {
				select (PIDFILE); $| = 1;  # autoflush
				select (STDERR);
				print PIDFILE "$$\n";
				close PIDFILE;
				$pid = 1;
			} else {
				$self->logger()->log("Warning:  Couldn't open pid file:  No pidfile option.");
				$self->logger()->log("\tContinuing anyway ...");
			}
		} else {
			$self->logger()->log("Warning:  Couldn't open pid file: Pidfile option not specified.");
			$self->logger()->log("\tContinuing anyway ...");
		}

	}

	my $sub = $self->getCallback();
	if ($sleep) {
		while (1) {
			$self->logger()->debug(9,"Executing callback from within infinite loop ...");
			&$sub();
			$self->logger()->debug(9,"\tSleeping [$sleep] seconds ...");
			sleep($sleep);
		}
	} else {
		$self->logger()->debug(9,"Executing callback ...");
		&$sub();
	}

} # end sub MainLoop

sub configure {

	my $self = shift;
	my $conf = $self->conf()
	    || confess "Cannot parse configuration object:  Configuration object not found";
	Net::Peep::Parser->new()->load($conf);

	my @version = $self->conf()->versionExists()
		? split /\./, $self->conf()->getVersion()
			: ();

	my $config = $conf->getOption('config');
	unless (@version && $version[0] >= 0 && $version[1] >= 4 && $version[2] > 3) {

		print STDERR <<"eop";

[$0] Warning:  The configuration file

  $config

appears to use an old configuration file syntax.  You may want to
update your configuration to be consistent with the 0.4.4 release.
The older syntax may not be supported as of the 0.5.0 release.

eop

		;

	}

	return $conf;

} # end sub configure

sub conf {

	my $self = shift;
	$self->{"__CONF"} = Net::Peep::Conf->new() unless exists $self->{"__CONF"};
	return $self->{"__CONF"};

} # end sub conf

sub pods {

	my $self = shift;
	my $message = shift;

	print "\n$message\n\n" if $message;

	open(POD,$0) || die "Cannot print help text for $0:  $!";
	Pod::Text->new()->parse_from_filehandle(\*POD);
	close POD;

	exit 0;

} # end sub pods

# returns a logging object
sub logger {

	my $self = shift;
	if ( ! exists $self->{'__LOGGER'} ) { $self->{'__LOGGER'} = new Net::Peep::Log }
	return $self->{'__LOGGER'};

} # end sub logger

# Remove our pidfile with garbage collection (if it exists) The client
# needs to call this function explicitly upon receipt of a signal with
# the appropriate reference.
sub shutdown {
	my $self = shift;
	print STDERR "Shutting down ...\n";
	my $notifier = new Net::Peep::Notifier;
	print STDERR "\tFlushing notification buffers ...\n";
	my $n = $notifier->force();
	my $string = $n ?
	    "\t$n notifications were flushed from the buffers.\n" :
		"\tNo notifications were flushed from the buffers:  The buffers were empty.\n";
	print STDERR $string;
	my $conf = $self->conf();
	my $pidfile = defined $conf && $conf->optionExists('pidfile') && -f $conf->getOption('pidfile')
	    ? $conf->getOption('pidfile') : '';
	if ($pidfile) {
		print STDERR "\tUnlinking pidfile ", $pidfile, " ...\n";
		unlink $pidfile;
	}
	print STDERR "Done.\n";
}

sub getConfigSection {

    my $self = shift;
    my $section = shift;
    my @text = @_;

    my @return;
    my $read = 0;
    for my $line (@text) {
	if ($line =~ /^\s*$section/) {
	    $read = 1;
	} elsif ($line =~ /^\s*end events/) {
	    $read = 0;
	} elsif ($read) {
	    next if $line =~ /^\s*#/ || $line =~ /^\s*$/;
	    push @return, $line;
	} else {
	    # do nothing
	}
    }
    return wantarray ? @return : \@return;

} # end sub getConfigSection

sub tempParseDefaults {

    my $self = shift;
    my @text = @_;

    my $conf = $self->conf();

    for my $line ($self->getConfigSection('default',@text)) {

	    if ($line =~ /^\s*([\w\-]+)\s+(\S+)\s*$/) {
		my ($option,$value) = ($1,$2);
		if ($conf->optionExists($option)) {
		    $self->logger()->debug(6,"\t\tNot setting option [$option]:  It has already been set (possibly from the command-line).");
		} else {
		    $self->logger()->debug(6,"\t\tSetting option [$option] to value [$value].");
		    $conf->setOption($option,$value) unless $conf->optionExists($option);
		}
	    }

    }

} # sub tempParseDefaults

sub getGroups {

    my $self = shift;
    my $conf = $self->conf();
    unless (exists $self->{'GROUPS'}) {
	my $groups = $conf->optionExists('groups') ? $conf->getOption('groups') : '';
	my @groups = split /,/, $groups;
	$self->{'GROUPS'} = \@groups;
    }
    return wantarray ? @{$self->{'GROUPS'}} : $self->{'GROUPS'};

} # end sub getGroups

sub getExcluded {

    my $self = shift;
    my $conf = $self->conf();
    unless (exists $self->{'EXCLUDED'}) {
	my $excluded = $conf->optionExists('excluded') ? $conf->getOption('excluded') : '';
	my @excluded = split /,/, $excluded;
	$self->{'EXCLUDED'} = \@excluded;
    }
    return wantarray ? @{$self->{'EXCLUDED'}} : $self->{'EXCLUDED'};

} # end sub getExcluded

sub filter {

    my $self = shift;
    my $object = shift || confess "Object not found";
    my $nogrp = shift;

    my $conf = $self->conf();

    my $return = 0;

    my $name = $object->name();

    unless ($nogrp) {

	$self->logger()->debug(9,"Checking group [$name] against group and excluded group lists ...");

	my $group = $object->group();

	my @groups = ();
	my @exclude = ();

	@groups = $self->getGroups('groups');
	@exclude = $self->getExcluded('exclude');

	if (grep /^all$/, @groups) {
	    $return = 1;
	} else {
	    for my $group_option (@groups) {
		$return = 1 if $group eq $group_option;
	    }
	}

	for my $exclude_option (@exclude) {
	    $return = 0 if $group eq $exclude_option;
	}

	$self->logger()->debug(8,"[$name] will be ignored:  The group [$group] is either not in the group ".
			       "list [@groups] or it is in the excluded list [@exclude].") if $return == 0;
    }

    my $hosts = $object->hosts();
    my @version = $conf->versionExists() ? split /\./, $conf->getVersion() : ();

    if (@version && $version[0] >= 0 && $version[1] >= 4 && $version[2] > 3) {
	if ($object->pool()->isInHostPool($Net::Peep::Notifier::HOSTNAME)) {
	    $return = 1;
	} else {
	    $return = 0;
	    $self->logger()->debug(8,"[$name] will be ignored:  Host [$Net::Peep::Notifier::HOSTNAME] ".
				   "is not in the host pool [$hosts].");
	}
    }

    return $return;

} # end sub filter

1;

__END__