Net::Peep::Client - Perl extension for client application module

  perldoc Net::Peep

  --config=[PATH]       Path to the configuration file to use.
  --debug=[NUMBER]      Enable debugging. (Def:  0)
  --nodaemon            Do not run in daemon mode.  (Def:  daemon)
  --pidfile=[PATH]      The file to write the pid out to.  (Daemon only.)
  --output=[PATH]       The file to log output to. (Def: stderr)
  --noautodiscovery     Disables autodiscovery and enables the server and port options.
                        (Default:  autodiscovery)
  --server=[HOST]       The host (or IP address) to connect to.  
  --port=[PORT NO]      The port to use.
  --help                Prints this documentation.

    new() - The constructor

    name($name) - Sets/gets the name of the client.  All clients must
    have a name.

    initialize(%options) - Sets the value (using the setOption method
    of the Net::Peep::Conf object) of all command-line options parsed
    by Getopt::Long for the client.  Additional options may be
    specified using %options.  For more information on the format of
    the %options hash, see Getopt::Long.

    configure() - Returns a configuration object.  To be called after
    a call to initialize().

    parser($coderef) - Specifies a callback, which must be in the form
    of a code reference, to be used to parse the config ... end config
    block of the Peep configuration file for the client.

    callback($coderef) - Specifies a callback, which must be in the
    form of a code reference, to be used in the MainLoop method.

    MainLoop($sleep) - Starts the main loop.  If $sleep returns false,
    the callback is only called once; otherwise, the main loop sleeps
    $sleep seconds between each call to the callback.

    logger() - Returns a Net::Peep::Log object

    getConfigSection($section,@lines) - Retrieves a section by the
    name of $section from the lines of text @lines.  This is a utility
    method to assist with parsing sections from the Peep configuration
    file client config sections (e.g., the events section from the
    logparser definition in peep.conf).

    tempParseDefaults(@lines) - Parses a defaults section in a client
    config block in the Peep configuration file.  Note that this code
    duplicates the parseClientDefault method in Net::Peep::Parser.  It
    will be deprecated after backwards-compatibility of peep.conf is
    dropped, probably with the release of 0.5.0.

    getGroups() - Parses the 'groups' option and returns an array of groups.

    getExcluded() - Parses the 'excluded' option and returns a list of
    excluded groups.

  /etc
  /usr/local/etc
  /usr
  /usr/local
  /opt

  Last major commit before the 0.4.0 release. All of the newly rewritten
clients and libraries are now working and are nicely formatted. The server
installation has been changed a bit so now peep.conf is generated from
the template file during a configure - which brings us closer to having
a work-out-of-the-box system.

  collin.starkweather@colorado.edu

  collin.starkweather@collinstarkweather.com

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__