package PBS::Plugin;
use 5.006 ;
use strict ;
use warnings ;
use Carp ;
require Exporter ;
use AutoLoader qw(AUTOLOAD) ;
our @ISA = qw(Exporter) ;
our %EXPORT_TAGS = ('all' => [ qw() ]) ;
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ) ;
our @EXPORT = qw(ScanForPlugins RunPluginSubs RunUniquePluginSub) ;
our $VERSION = '0.04' ;
use File::Basename ;
use Getopt::Long ;
use Cwd ;
use PBS::Constants ;
use PBS::PBSConfig ;
use PBS::Output ;
#-------------------------------------------------------------------------------
my $plugin_load_package = 0 ;
my %loaded_plugins ;
if($^O eq "MSWin32")
{
# remove an annoying warning
local $SIG{'__WARN__'} = sub {print STDERR $_[0] unless $_[0] =~ /^Subroutine CORE::GLOBAL::glob/} ;
# the normal 'glob' handles ~ as the home directory even if it is not at the begining of the path
eval "use File::DosGlob 'GLOBAL_glob';" ;
die $@ if $@ ;
}
#-------------------------------------------------------------------------------
sub GetLoadedPlugins
{
return(keys %loaded_plugins) ;
}
#-------------------------------------------------------------------------------
sub LoadPlugin
{
my ($config, $plugin) = @_;
if(exists $loaded_plugins{$plugin})
{
PrintInfo " Ignoring Already loaded '$plugin'.\n" if $config->{DISPLAY_PLUGIN_LOAD_INFO} ;
return ;
}
if($config->{DISPLAY_PLUGIN_LOAD_INFO})
{
my ($basename, $path, $ext) = File::Basename::fileparse($plugin, ('\..*')) ;
PrintInfo " $basename$ext\n" ;
}
$loaded_plugins{$plugin} = $plugin_load_package ;
eval
{
PBS::PBS::LoadFileInPackage
(
''
, $plugin
, "PBS::PLUGIN_$plugin_load_package"
, {}
, "use strict ;\nuse warnings ;\n"
. "use PBS::Output ;\n"
) ;
} ;
die ERROR("Couldn't load plugin from '$plugin':\n $@") if $@ ;
$plugin_load_package++ ;
}
#-------------------------------------------------------------------------------
sub LoadPluginFromSubRefs
{
my ($config, $plugin, %subs) = @_;
my ($package, $file_name, $line) = caller() ;
if(exists $loaded_plugins{$plugin})
{
PrintInfo "Plugin '$plugin' from '$file_name:$line' already loaded, Ignoring!\n" if $config->{DISPLAY_PLUGIN_LOAD_INFO} ;
}
else
{
PrintInfo "Plugin '$plugin' from '$file_name:$line':\n" if $config->{DISPLAY_PLUGIN_LOAD_INFO} ;
$loaded_plugins{$plugin} = $plugin_load_package ;
while (my($sub_name, $sub_ref) = each %subs)
{
if($config->{DISPLAY_PLUGIN_LOAD_INFO})
{
PrintInfo " sub ref '$sub_name'\n" ;
}
eval "* PBS::PLUGIN_${plugin_load_package}::$sub_name = \$sub_ref ;" ;
}
$plugin_load_package++ ;
}
}
#-------------------------------------------------------------------------------
sub ScanForPlugins
{
my ($config, $plugin_paths) = @_ ;
for my $plugin_path (@$plugin_paths)
{
PrintInfo "Plugin directory '$plugin_path':\n" if $config->{DISPLAY_PLUGIN_LOAD_INFO} ;
for my $plugin (glob("$plugin_path/*.pm"))
{
LoadPlugin($config, $plugin) ;
}
}
}
#-------------------------------------------------------------------------------
sub RunPluginSubs
{
# run multiple subs, don't return anything
my ($config, $plugin_sub_name, @plugin_arguments) = @_ ;
my ($package, $file_name, $line) = caller() ;
$file_name =~ s/^'// ;
$file_name =~ s/'$// ;
PrintInfo "Calling '$plugin_sub_name' from '$file_name:$line':\n" if $config->{DISPLAY_PLUGIN_RUNS} ;
for my $plugin_path (sort keys %loaded_plugins)
{
no warnings ;
my $plugin_load_package = $loaded_plugins{$plugin_path} ;
my $plugin_sub ;
eval "\$plugin_sub = *PBS::PLUGIN_${plugin_load_package}::${plugin_sub_name}{CODE} ;" ;
if($plugin_sub)
{
PrintInfo "Running '$plugin_sub_name' in plugin '$plugin_path'\n" if $config->{DISPLAY_PLUGIN_RUNS} ;
eval {$plugin_sub->(@plugin_arguments)} ;
die ERROR "Error Running plugin sub '$plugin_sub_name':\n$@" if $@ ;
}
else
{
PrintWarning "Couldn't find '$plugin_sub_name' in plugin '$plugin_path'\n" if $config->{DISPLAY_PLUGIN_RUNS} ;
}
}
}
#-------------------------------------------------------------------------------
sub RunUniquePluginSub
{
# run a single sub and returns
my ($config, $plugin_sub_name, @plugin_arguments) = @_ ;
my ($package, $file_name, $line) = caller() ;
$file_name =~ s/^'// ;
$file_name =~ s/'$// ;
PrintInfo "Calling unique '$plugin_sub_name' from '$file_name:$line':\n" if $config->{DISPLAY_PLUGIN_RUNS} ;
my (@found_plugin, $plugin_path, $plugin_sub) ;
my ($plugin_sub_to_run, $plugin_to_run_path) ;
for $plugin_path (sort keys %loaded_plugins)
{
no warnings ;
my $plugin_load_package = $loaded_plugins{$plugin_path} ;
eval "\$plugin_sub = *PBS::PLUGIN_${plugin_load_package}::${plugin_sub_name}{CODE} ;" ;
push @found_plugin, $plugin_path if($plugin_sub) ;
if($plugin_sub)
{
$plugin_sub_to_run = $plugin_sub ;
$plugin_to_run_path = $plugin_path ;
PrintInfo "Found unique '$plugin_sub_name' in plugin '$plugin_path'\n" if $config->{DISPLAY_PLUGIN_RUNS} ;
}
else
{
PrintWarning "Couldn't find unique '$plugin_sub_name' in plugin '$plugin_path'\n" if $config->{DISPLAY_PLUGIN_RUNS} ;
}
}
if(@found_plugin > 1)
{
die ERROR "Error: Found more than one plugin for unique '$plugin_sub_name'\n" . join("\n", @found_plugin) . "\n" ;
}
if($plugin_sub_to_run)
{
PrintInfo "Running unique '$plugin_sub_name' in plugin '$plugin_to_run_path'\n" if $config->{DISPLAY_PLUGIN_RUNS} ;
if(! defined wantarray)
{
eval {$plugin_sub_to_run->(@plugin_arguments)} ;
die ERROR "Error Running unique plugin sub '$plugin_sub_name':\n$@" if $@ ;
}
else
{
if(wantarray)
{
my @results ;
eval {@results = $plugin_sub_to_run->(@plugin_arguments)} ;
die ERROR "Error Running unique plugin sub '$plugin_sub_name':\n$@" if $@ ;
return(@results) ;
}
else
{
my $result ;
eval {$result = $plugin_sub_to_run->(@plugin_arguments)} ;
die ERROR "Error Running unique plugin sub '$plugin_sub_name':\n$@" if $@ ;
return($result) ;
}
}
}
else
{
PrintWarning "Couldn't find unique Plugin '$plugin_sub_name'.\n" if $config->{DISPLAY_PLUGIN_RUNS} ;
return ;
}
}
#-------------------------------------------------------------------------------
1 ;
__END__
=head1 NAME
PBS::Plugin - Handle Plugins in PBS
=head1 SYNOPSIS
=head1 DESCRIPTION
=head2 LIMITATIONS
plugins can't hadle the same switch (switch registred by a plugin, pbs switches OK when passed to plugin)
=head2 EXPORT
=head1 AUTHOR
Khemir Nadim ibn Hamouda. nadim@khemir.net
=head1 SEE ALSO
B<PBS> reference manual.
=cut