package Embed::Persistent;

# $Id: p1.pl,v 1.1 2005/01/20 02:12:13 egalstad Exp $

# $Log: p1.pl,v $
# Revision 1.1  2005/01/20 02:12:13  egalstad
# Core dump fixes, embedded Perl changes, new mini_epn
#
# Revision 1.5  2005-01-18 13:52:15+11  anwsmh
# 1 Set log level back to RETICENT and log file name to a placeholder for dist.
#
# Revision 1.4  2005-01-18 13:26:12+11  anwsmh
# 1 Major changes for Perl >= 5.6
#   1.1 tieing STDERR to ErrorTrap caused a SEGV in libperl because of
#       misuse of the open statement.
#   1.2 STDERR is now aliased to the handle associated with a log file
#       opened if logging is enabled.
#


# p1.pl for Nagios 2.0

# Only major changes are that STDOUT is redirected to a scalar
# by means of a tied filehandle so that it can be returned to Nagios
# without the need for a syscall to read()
#

use strict ;
use vars '%Cache' ;
use Text::ParseWords qw(parse_line) ;

use constant RETICENT	=> 1 ;
use constant GARRULOUS	=> 0 ;
use constant DEBUG		=> 0 ;

use constant EPN_STDERR_LOG => '/Path/to/embedded/Perl/Nagios/Logfile' ;

use constant TEXT_RETICENT	=> <<'RETICENT' ;

package OutputTrap;

#
# Methods for use by tied STDOUT in embedded PERL module.
#
# Simply ties STDOUT to a scalar and emulates serial semantics.
#
 
sub TIEHANDLE {
	my ($class) = @_;
        my $me ;
	bless \$me, $class;
}

sub PRINT {
	my $self = shift;
	$$self .= join("",@_);
}

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

sub READLINE {
	my $self = shift;
	# Perl code other than plugins may print nothing; in this case return "(No output!)\n".
	return(defined $$self ? $$self : "(No output!)\n");
}

sub CLOSE {
	my $self = shift;
}

package Embed::Persistent;

sub valid_package_name {
	my($string) = @_;
	$string =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg;
	# second pass only for words starting with a digit
	$string =~ s|/(\d)|sprintf("/_%2x",unpack("C",$1))|eg;
	
	# Dress it up as a real package name
	$string =~ s|/|::|g;
	return "Embed::" . $string;
 }

# 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 {
	my $warn = shift ;
	return if $warn =~ /^Subroutine CORE::GLOBAL::exit redefined/ ;
	die $warn ;
}

sub eval_file {
	my $filename = shift;
	my $delete = shift;