package # hidden from cpan
    Monitoring::Generator::TestConfig::P1Data;

use strict;
use warnings;

########################################

=over 4

=item get_p1_script

    returns the p1 script source

    adapted from the nagios debian package

=back

=cut

sub get_p1_script {
    my $self      = shift;
    our $scriptsource;
    if(!defined $scriptsource) {
       while(my $line = <DATA>) { $scriptsource .= $line; }
    }

    return($scriptsource);
}

1;

__DATA__
package Embed::Persistent;

# p1.pl

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		=> '/tmp/p1/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 4KB 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, 4096) ;
}

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

sub READLINE {
	my $self = shift;

# CHANGED 12/26/07 EG Following two statements didn't allow for multi-line output or output > 256 chars
								# 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" ;

	return $$self;
}

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

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

package Embed::Persistent;

sub valid_package_name {
	local $_ = shift ;
	s|([^A-Za-z0-9\/])|sprintf("_%2x",unpack("C",$1))|eg;
								# second pass only for words starting with a digit
	s|/(\d)|sprintf("/_%2x",unpack("C",$1))|eg;

								# Dress it up as a real package name
	s|/|::|g;
	return /^::/ ? "Embed$_" : "Embed::$_" ;
 }

# Perl 5.005_03 only traps warnings for errors classed by perldiag
# as Fatal (eg 'Global symbol """"%s"""" requires explicit package name').
# Therefore treat all warnings as fatal.

sub throw_exception {
	die shift ;
}

sub eval_file {
	my ($filename, $delete, undef, $plugin_args) = @_ ;

	my $mtime 	= -M $filename ;
	my $ts 		= localtime(time())
				if DEBUG_LEVEL ;


	if (
		exists($Cache{$filename})	&&
		$Cache{$filename}[MTIME]	&&
	   	$Cache{$filename}[MTIME] <= $mtime
	   )  {
								# We have compiled this plugin before and
								# it has not changed on disk; nothing to do except
								# 1 parse the plugin arguments and cache them (to save
								#   repeated parsing of the same args) - the same
								#   plugin could be called with different args.
								# 2 return the error from a former compilation
								#   if there was one.

			$Cache{$filename}[PLUGIN_ARGS]{$plugin_args} ||= [ parse_line('\s+', 0, $plugin_args) ]
				if $plugin_args ;

			if ( $Cache{$filename}[PLUGIN_ERROR] ) {
				print LH qq($ts eval_file: $filename failed compilation formerly and file has not changed; skipping compilation.\n)
					if DEBUG_LEVEL & LEAVE_MSG ;
				die qq(**ePN failed to compile $filename: "$Cache{$filename}[PLUGIN_ERROR]") ;
			} else {
				print LH qq($ts eval_file: $filename already successfully compiled and file has not changed; skipping compilation.\n)
					if DEBUG_LEVEL & LEAVE_MSG ;
				return $Cache{$filename}[PLUGIN_HNDLR] ;
			}
	}

	my $package	= valid_package_name($filename) ;

	$Cache{$filename}[PLUGIN_ARGS]{$plugin_args} ||= [ parse_line('\s+', 0, $plugin_args) ]
		if $plugin_args ;

	local *FH;
								# die will be trapped by caller (checking ERRSV)
	open FH, $filename
		or die qq(**ePN failed to open "$filename": "$!") ;

	my $sub ;
	sysread FH, $sub, -s FH ;
	close FH;
								# Cater for scripts that have embedded EOF symbols (__END__)
								# XXXX
								# Doesn't make sense to me.

	# $sub		=~ s/__END__/\;}\n__END__/;
								# Wrap the code into a subroutine inside our unique package
								# (using $_ here [to save a lexical] is not a good idea since
								# the definition of the package is visible to any other Perl
								# code that uses [non localised] $_).
	my $hndlr	= <<EOSUB ;
package $package;

sub hndlr {
	\@ARGV = \@_ ;
	local \$^W = 1 ;
 	\$ENV{NAGIOS_PLUGIN} = '$filename' ;

								# <<< START of PLUGIN (first line of plugin is line 8 in the text) >>>
$sub
								# <<< END of PLUGIN >>>
}
EOSUB

	$Cache{$filename}[MTIME]		= $mtime
							unless $delete ;
								# Suppress warning display.
	local $SIG{__WARN__}			= \&throw_exception ;


                                                                # Following 3 lines added 10/18/07 by Larry Low to fix problem where
                                                                # modified Perl plugins didn't get recached by the epn
        no strict 'refs';
        undef %{$package.'::'};
        use strict 'refs';

								# Compile &$package::hndlr. Since non executable code is being eval'd
								# there is no need to protect lexicals in this scope.
	eval $hndlr;

								# $@ is set for any warning and error.
								# This guarantees that the plugin will not be run.
	if ($@) {
								# Report error line number wrt to original plugin text (7 lines added by eval_file).
								# Error text looks like
								# 'Use of uninitialized ..' at (eval 23) line 186, <DATA> line 218
								# The error line number is 'line 186'
		chomp($@) ;
		$@ =~ s/line (\d+)[\.,]/'line ' . ($1 - 7) . ','/e ;

		print LH qq($ts eval_file: syntax error in $filename: "$@".\n)
			if DEBUG_LEVEL & LEAVE_MSG ;

	 	if ( DEBUG_LEVEL & PLUGIN_DUMP ) {
			my $i = 1 ;
			$_ = $hndlr ;
			s/^/sprintf('%10d  ', $i++)/meg ;
								# Will only get here once (when a faulty plugin is compiled).
								# Therefore only _faulty_ plugins are dumped once each time the text changes.

			print PH qq($ts eval_file: transformed plugin "$filename" to ==>\n$_\n) ;
		}

		$@ = substr($@, 0, 4096)
			if length($@) > 4096 ;

		$Cache{$filename}[PLUGIN_ERROR] = $@ ;
								# If the compilation fails, leave nothing behind that may affect subsequent
								# compilations. This will be trapped by caller (checking ERRSV).
		die qq(**ePN failed to compile $filename: "$@") ;

	} else {
		$Cache{$filename}[PLUGIN_ERROR] = '' ;
	}

	print LH qq($ts eval_file: successfully compiled "$filename $plugin_args".\n)
		if DEBUG_LEVEL & LEAVE_MSG ;

	print CH qq($ts eval_file: after $Current_Run compilations \%Cache =>\n), Data::Dumper->Dump([\%Cache], [qw(*Cache)]), "\n"
		if ( (DEBUG_LEVEL & CACHE_DUMP) && (++$Current_Run % Cache_Dump_Interval == 0) ) ;

	no strict 'refs' ;
	return $Cache{$filename}[PLUGIN_HNDLR] = *{ $package . '::hndlr' }{CODE} ;

}

sub run_package {
	my ($filename, undef, $plugin_hndlr_cr, $plugin_args) = @_;
								# Second parm (after $filename) _may_ be used to wallop stashes.

	my $res		= 3 ;
	my $ts		= localtime(time())
				if DEBUG_LEVEL ;

	local $SIG{__WARN__}	= \&throw_exception ;
	my $stdout		= tie (*STDOUT, 'OutputTrap');
	my @plugin_args		= $plugin_args ? @{ $Cache{$filename}[PLUGIN_ARGS]{$plugin_args} } : () ;

								# If the plugin has args, they have been cached by eval_file.
								# ( cannot cache @plugin_args here because run_package() is
								#   called by child processes so cannot update %Cache.)

	eval { $plugin_hndlr_cr->(@plugin_args) } ;

	if ($@) {
								# Error => normal plugin termination (exit) || run time error.
		$_			= $@ ;
		/^ExitTrap: (-?\d+)/	? $res = $1 :
								# For normal plugin exit, $@ will  always match /^ExitTrap: (-?\d+)/
		/^ExitTrap:  /		? $res = 0  :	do {
								# Run time error/abnormal plugin termination.

								chomp ;
								# Report error line number wrt to original plugin text (7 lines added by eval_file).
								s/line (\d+)[\.,]/'line ' . ($1 - 7) . ','/e ;
								print STDOUT qq(**ePN $filename: "$_".\n) ;
							} ;

		($@, $_)		= ('', '') ;
	}
								# ! Error => Perl code is not a plugin (fell off the end; no exit)

								# !! (read any output from the tied file handle.)
	my $plugin_output	= <STDOUT> ;

	undef $stdout ;
	untie *STDOUT;

	print LH qq($ts run_package: "$filename $plugin_args" returning ($res, "$plugin_output").\n)
		if DEBUG_LEVEL & LEAVE_MSG ;

	return ($res, $plugin_output) ;
}

1;
