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