package Embed::Persistent;

# p1.pl for Nagios 2.0

use strict ;

use Text::ParseWords qw(parse_line) ;

use constant	LEAVE_MSG		=> 1 ;
use constant	CACHE_DUMP		=> 2 ;
use constant	PLUGIN_DUMP		=> 4 ;

use constant	DEBUG_LEVEL		=> 0 ;
# use constant	DEBUG_LEVEL		=> CACHE_DUMP ;
# use constant	DEBUG_LEVEL		=> LEAVE_MSG ;
# use constant	DEBUG_LEVEL		=> LEAVE_MSG | CACHE_DUMP ;
# use constant	DEBUG_LEVEL		=> LEAVE_MSG | CACHE_DUMP | PLUGIN_DUMP ;

use constant	DEBUG_LOG_PATH		=> '/usr/local/nagios/var/' ;
# use constant	DEBUG_LOG_PATH		=> './' ;
use constant	LEAVE_MSG_STREAM	=> DEBUG_LOG_PATH . 'epn_leave-msgs.log' ;
use constant	CACHE_DUMP_STREAM	=> DEBUG_LOG_PATH . 'epn_cache-dump.log' ;
use constant	PLUGIN_DUMP_STREAM	=> DEBUG_LOG_PATH . 'epn_plugin-dump.log' ;

use constant	NUMBER_OF_PERL_PLUGINS	=> 60 ;

use constant	Cache_Dump_Interval	=> 20 ;
								# Cache will be dumped every Cache_Dump_Interval plugin compilations

(DEBUG_LEVEL & LEAVE_MSG)	&& do 	{
							open LH, '>> ' . LEAVE_MSG_STREAM
								or die "Can't open " . LEAVE_MSG_STREAM . ": $!" ;

								# Unbuffer LH since this will be written by child processes.

							select( (select(LH), $| = 1)[0] ) ;
					} ;
(DEBUG_LEVEL & CACHE_DUMP)	&& do	{
							 (open CH, '>> ' . CACHE_DUMP_STREAM
								or die "Can't open " . CACHE_DUMP_STREAM . ": $!") ;
							select( (select(CH), $| = 1)[0] ) ;
					} ;
(DEBUG_LEVEL & PLUGIN_DUMP)	&& (open PH, '>> ' . PLUGIN_DUMP_STREAM
								or die "Can't open " . PLUGIN_DUMP_STREAM . ": $!") ;

require Data::Dumper
	if DEBUG_LEVEL & CACHE_DUMP ;

my (%Cache, $Current_Run) ;
keys %Cache	= NUMBER_OF_PERL_PLUGINS ;
								# Offsets in %Cache{$filename}
use constant	MTIME			=> 0 ;
use constant	PLUGIN_ARGS		=> 1 ;
use constant	PLUGIN_ERROR		=> 2 ;
use constant	PLUGIN_HNDLR		=> 3 ;

package main;

use subs 'CORE::GLOBAL::exit';

sub CORE::GLOBAL::exit { die "ExitTrap: $_[0] (Redefine exit to trap plugin exit with eval BLOCK)" }


package OutputTrap;

								# Methods for use by tied STDOUT in embedded PERL module.
								# Simply ties STDOUT to a scalar and caches values written to it.
								# NB No more than 256 characters per line are kept.
 
sub TIEHANDLE {
	my ($class) = @_;
	my $me = '';
	bless \$me, $class;
}

sub PRINT {
	my $self = shift;
	# $$self = substr(join('',@_), 0, 256) ;
	$$self .= substr(join('',@_), 0, 256) ;
}

sub PRINTF {
	my $self = shift;
	my $fmt = shift;
	# $$self = substr(sprintf($fmt,@_), 0, 256) ;
	$$self .= substr(sprintf($fmt,@_), 0, 256) ;
}

sub READLINE {
	my $self = shift;
								# Omit all lines after the first, per the nagios plugin guidelines
        $$self = (split /\n/, $$self)[0];
								# Perl code other than plugins may print nothing; in this case return "(No output!)\n".
	return $$self ? substr($$self, 0, 256) : "(No output!)\n" ;
}

sub CLOSE {
	my $self = shift;
	undef $self ;
}