PROXY  WHOIS  RQUOTE  TEXTS  SOFT  FOREX  BBOARD
 Music  Philosophy  Code  Literature  Russian

= ROOT|Technical|Code_Examples|C|nagios-2.9|p1.pl =

page 2 of 8




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 ;
=2=

1| < PREV = PAGE 2 = NEXT > |3|4|5|6|7|8

UP TO ROOT | UP TO DIR | TO FIRST PAGE

Google
 


E-mail Facebook Google Digg del.icio.us BlinkList Fark Furl Ma.gnolia Netscape NewsVine Reddit Slashdot Spurl StumbleUpon Technorati YahooMyWeb LiveJournal Blogmarks TwitThis Live News2.ru BobrDobr.ru Memori.ru MoeMesto.ru

0.00540709 wallclock secs ( 0.01 usr + 0.00 sys = 0.01 CPU)