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