diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt index 574a63584..73632ddb4 100644 --- a/docs/changelog/7.x.x.txt +++ b/docs/changelog/7.x.x.txt @@ -35,6 +35,7 @@ - added: DataForm can now run a workflow when an entry is added - Fixed #8921: Duplicating templates through conventional methods maintains default template flag - Fixed #8962: Wrong mime-type used for json data + - Added: WebGUI::Pluggable find() and findAndLoad() for easier module loading 7.6.1 - changed: the list of extensions for the export system to pass through diff --git a/lib/WebGUI/Pluggable.pm b/lib/WebGUI/Pluggable.pm index 7fb0c2400..68eb31726 100644 --- a/lib/WebGUI/Pluggable.pm +++ b/lib/WebGUI/Pluggable.pm @@ -15,6 +15,7 @@ package WebGUI::Pluggable; =cut use strict; +use Module::Find; use Carp qw(croak); # Carps should always bypass this package in error reporting @@ -38,12 +39,123 @@ This package provides a standard way of quickly and safely dynamically loading p my $output = eval { WebGUI::Pluggable::run($module, $function, \@params) }; + my @modules + = WebGUI::Pluggable::find( $namespace, + { + exclude => [ $moduleToExclude ], + } + ); + + my @loadedModules + = WebGUI::Pluggable::findAndLoad( $namespace, + { + onLoadFail => sub { warn "Failed to load " . shift . " because " . shift }, + } + ); + =head1 FUNCTIONS These functions are available from this package: =cut +#---------------------------------------------------------------------------- + +=head2 find ( namespace, options ) + +Return an array of all the modules in the given namespace. Will search all +@INC directories. C is a hashref of options with the following keys + + exclude => An arrayref of modules to exclude + onelevel => If true, only find sub modules (children), no deeper + find( "CGI", { onelevel => 1 } ) would match "CGI::Session" but + not "CGI::Session::File" + +=cut + +# TODO: If necessary, use File::Find::Rule instead of Module::Find +sub find { + my $namespace = shift; + my $options = shift; + + # Argument sanity + if ( $options && ref $options ne "HASH" ) { + WebGUI::Error::InvalidParam->throw( + error => "Second argument to find() must be hash reference", + ); + } + if ( $options->{ exclude } && ref $options->{ exclude } ne "ARRAY" ) { + WebGUI::Error::InvalidParam->throw( + error => "'exclude' option must be array reference" + ); + } + + my @modules = (); + + if ( $options->{ onelevel } ) { + @modules = Module::Find::findsubmod $namespace; + } + else { + @modules = Module::Find::findallmod $namespace; + } + + ### Remove hidden files + @modules = grep { !/::[.]/ } @modules; + + ### Exclusions + # Create a hash for quick lookups + if ( $options->{ exclude } ) { + my %modulesHash; + @modulesHash{ @modules } = ( 1 ) x @modules; + delete @modulesHash{ @{ $options->{exclude} } }; + @modules = keys %modulesHash; + } + + return @modules; +} + +#---------------------------------------------------------------------------- + +=head2 findAndLoad ( namespace, options ) + +Find modules and load them into memory. Returns an array of modules that are +loaded. + +Uses L to find the modules, see L for information on arguments. + +Additional options for this method: + + onLoadFail = A subroutine to run when a module fails to load, given + the following arguments: + 1) The module name + 2) The error message from $@ + +=cut + +sub findAndLoad { + my $namespace = shift; + my $options = shift; + + my @modules = find( $namespace, $options ); + my @loadedModules; + + MODULE: + for my $module ( @modules ) { + # Try to load + if (!eval { load( $module ) }) { + if ( $options->{ onLoadFail } ) { + $options->{ onLoadFail }->( $module, $@ ); + } + next MODULE; + } + + # Module loaded successfully + push @loadedModules, $module; + } + + return @loadedModules; +} + #------------------------------------------------------------------- =head2 instanciate ( module, sub, params ) @@ -103,6 +215,8 @@ sub load { if ($moduleError{$module}) { croak "Could not load $module because $moduleError{$module}"; } + + # Try to load the module my $modulePath = $module . ".pm"; $modulePath =~ s{::|'}{/}g; if (eval { require $modulePath; 1 }) { diff --git a/sbin/preload.perl b/sbin/preload.perl index 262939f60..b0f9e7dff 100644 --- a/sbin/preload.perl +++ b/sbin/preload.perl @@ -33,28 +33,18 @@ DBI->install_driver("mysql"); # Change to match your database driver. #---------------------------------------- require WebGUI; require WebGUI::Config; - -require Module::Find; +require WebGUI::Pluggable; # these modules should always be skipped my @excludes = qw(WebGUI::i18n::English::Automated_Information WebGUI::PerformanceProfiler); push @excludes, readLines($webguiRoot."/sbin/preload.exclude"); -my @webguiLibs = Module::Find::findallmod('WebGUI'); - -for my $module ( @webguiLibs ) { - # filter out excludes - next - if grep { $_ eq $module } @excludes; - # filter any files found starting with a period - next - if $module =~ /::\./; - - (my $moduleFile = $module . ".pm") =~ s{::|'}{/}g; - if (!eval { require $moduleFile; 1 }) { - warn "Error loading $module! - $@\n"; +WebGUI::Pluggable::findAndLoad( "WebGUI", + { + exclude => \@excludes, + onLoadFail => sub { warn 'Error loading %s: %s', @_ }, } -} +); require APR::Request::Apache2; require Apache2::Cookie; diff --git a/t/Asset/Wobject/DataForm/diagnose.t b/t/Asset/Wobject/DataForm/diagnose.t index 6d9aed99e..f0cddb866 100644 --- a/t/Asset/Wobject/DataForm/diagnose.t +++ b/t/Asset/Wobject/DataForm/diagnose.t @@ -10,7 +10,7 @@ use FindBin; use strict; -use lib "$FindBin::Bin/../../lib"; +use lib "$FindBin::Bin/../../../lib"; ##The goal of this test is to diagnose problems in DataForms. ## Orphaned DataForms with no Asset table entries diff --git a/t/Pluggable.t b/t/Pluggable.t index a005a449b..237ac7b05 100644 --- a/t/Pluggable.t +++ b/t/Pluggable.t @@ -17,7 +17,20 @@ use strict; use lib "$FindBin::Bin/lib"; use Test::More; use WebGUI::Test; +use File::Find; +use File::Spec; +use Test::Deep; +# Must load some Test::Deep modules before we start modifying @INC +use Test::Deep::Array; +use Test::Deep::ArrayLength; +use Test::Deep::ArrayLengthOnly; +use Test::Deep::ArrayElementsOnly; +use Test::Deep::RefType; +use Test::Deep::Shallow; +use Test::Deep::Blessed; +use Test::Deep::Isa; +use Test::Deep::Set; use WebGUI::Pluggable; @@ -28,7 +41,7 @@ use WebGUI::Pluggable; #---------------------------------------------------------------------------- # Tests -plan tests => 4; # Increment this number for each test you create +plan tests => 7; # Increment this number for each test you create #---------------------------------------------------------------------------- # put your tests here @@ -49,6 +62,47 @@ is($dumper->Dump, q|$VAR1 = { }; |, "Can instanciate an object."); +#---------------------------------------------------------------------------- +# Test find and findAndLoad +{ # Block to localize @INC + my $lib = WebGUI::Test->lib; + local @INC = ( $lib ); + + # Use the i18n files to test + my @testFiles = (); + File::Find::find( + sub { + if ( !/^[.]/ && /[.]pm$/ ) { + my $name = $File::Find::name; + $name =~ s{^$lib[/]}{}; + $name =~ s/[.]pm$//; + $name =~ s{/}{::}g; + push @testFiles, $name; + } + }, + File::Spec->catfile( $lib, 'WebGUI', 'i18n' ), + ); + + cmp_deeply( + [ WebGUI::Pluggable::find( 'WebGUI::i18n' ) ], + bag( @testFiles ), + "find() finds all modules by default", + ); + + cmp_deeply( + [ WebGUI::Pluggable::find( 'WebGUI::i18n', { onelevel => 1 } ) ], + bag( grep { /^WebGUI::i18n::[^:]+$/ } @testFiles ), + "find() with onelevel", + ); + + cmp_deeply( + [ WebGUI::Pluggable::find( 'WebGUI::i18n', { exclude => [ 'WebGUI::i18n::English::WebGUI' ] } ) ], + bag( grep { $_ ne 'WebGUI::i18n::English::WebGUI' } @testFiles ), + "find() with exclude", + ); + +}; + #---------------------------------------------------------------------------- # Cleanup