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

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

page 3 of 8



								# Suppress warning display.
	local $SIG{__WARN__}			= \&throw_exception ;

								# 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, 256)
			if length($@) > 256 ;

		$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) ;
}
=3=

1|2| < PREV = PAGE 3 = NEXT > |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.0175369 wallclock secs ( 0.01 usr + 0.00 sys = 0.01 CPU)