fixed DataForm/diagnose.t

Added find() and findAndLoad() to WebGUI::Pluggable and updated sbin/preload.perl

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

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<options> 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<find> to find the modules, see L<find> 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 }) {

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;

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

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