Bug 21073: Improve plugin performance

Right now, to check if a plugin is functional and what methods it exposes we load the module and test for a given method at run time. This is highly inefficient. It makes far more sense to do this at install time and store the data in the db. I believe we should store a table of methods that each plugin exposes and check that instead. Then, at install time we can test that a) the plugin can be loaded and b) add the available methods to the plugin_methods table.

Test Plan:
1) Apply this patch
2) Restart all the things
3) Run updatedatabase.pl
4) Verify you can use existing plugins
5) Verify you can install new plugins

Signed-off-by: Agustin Moyano <agustinmoyano@theke.io>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>

Koha/Plugins.pm

@@ -19,12 +19,15 @@ package Koha::Plugins;
 
 use Modern::Perl;
 
-use Module::Load::Conditional qw(can_load);
-use Module::Pluggable search_path => ['Koha::Plugin'], except => qr/::Edifact(|::Line|::Message|::Order|::Segment|::Transport)$/;
+use Class::Inspector;
 use List::MoreUtils qw( any );
+use Module::Load::Conditional qw(can_load);
+use Module::Load qw(load);
+use Module::Pluggable search_path => ['Koha::Plugin'], except => qr/::Edifact(|::Line|::Message|::Order|::Segment|::Transport)$/;
 
 use C4::Context;
 use C4::Output;
+use Koha::Plugins::Methods;
 
 BEGIN {
     my $pluginsdir = C4::Context->config("pluginsdir");
@@ -70,6 +73,43 @@ sub GetPlugins {
     my $method = $params->{method};
     my $req_metadata = $params->{metadata} // {};
 
+    my $dbh = C4::Context->dbh;
+    my $plugin_classes = $dbh->selectcol_arrayref('SELECT DISTINCT(plugin_class) FROM plugin_methods');
+    my @plugins;
+
+    foreach my $plugin_class (@$plugin_classes) {
+        next if $method && !Koha::Plugins::Methods->search({ plugin_class => $plugin_class, plugin_method => $method })->count;
+        load $plugin_class;
+        my $plugin = $plugin_class->new({ enable_plugins => $self->{'enable_plugins'} });
+
+        my $plugin_enabled = $plugin->retrieve_data('__ENABLED__');
+        $plugin->{enabled} = $plugin_enabled;
+
+        # Want all plugins. Not only enabled ones.
+        if ( defined($params->{all}) && $params->{all} ) {
+            $plugin_enabled = 1;
+        }
+
+        next unless $plugin_enabled;
+
+        push @plugins, $plugin;
+    }
+    return @plugins;
+}
+
+=head2
+
+Koha::Plugins::InstallPlugins()
+
+This method iterates through all plugins physically present on a system.
+For each plugin module found, it will test that the plugin can be loaded,
+and if it can, will store its available methods in the plugin_methods table.
+
+=cut
+
+sub InstallPlugins {
+    my ( $self, $params ) = @_;
+
     my @plugin_classes = $self->plugins();
     my @plugins;
 
@@ -79,22 +119,17 @@ sub GetPlugins {
 
             my $plugin = $plugin_class->new({ enable_plugins => $self->{'enable_plugins'} });
 
-            my $plugin_enabled = $plugin->retrieve_data('__ENABLED__');
-            $plugin->{enabled} = $plugin_enabled;
+            Koha::Plugins::Methods->search({ plugin_class => $plugin_class })->delete();
 
-            # Want all plugins. Not only enabled ones.
-            if ( defined($params->{all}) && $params->{all} ) {
-                $plugin_enabled = 1;
+            foreach my $method ( @{ Class::Inspector->methods($plugin_class) } ) {
+                Koha::Plugins::Method->new(
+                    {
+                        plugin_class  => $plugin_class,
+                        plugin_method => $method,
+                    }
+                )->store();
             }
 
-            next unless $plugin_enabled;
-
-            # Limit results by method or metadata
-            next if $method && !$plugin->can($method);
-            my $plugin_metadata = $plugin->get_metadata;
-            next if $plugin_metadata
-                and %$req_metadata
-                and any { !$plugin_metadata->{$_} || $plugin_metadata->{$_} ne $req_metadata->{$_} } keys %$req_metadata;
             push @plugins, $plugin;
         } else {
             my $error = $Module::Load::Conditional::ERROR;

Koha/Plugins/Handler.pm

@@ -21,9 +21,10 @@ use Modern::Perl;
 
 use File::Path qw(remove_tree);
 
-use Module::Load::Conditional qw(can_load);
+use Module::Load qw(load);
 
 use C4::Context;
+use Koha::Plugins::Methods;
 
 BEGIN {
     my $pluginsdir = C4::Context->config("pluginsdir");
@@ -61,15 +62,15 @@ sub run {
     my $cgi           = $args->{'cgi'};
     my $params        = $args->{'params'};
 
-    if ( can_load( modules => { $plugin_class => undef } ) ) {
+    my $has_method = Koha::Plugins::Methods->search({ plugin_class => $plugin_class, plugin_method => $plugin_method })->count();
+    if ( $has_method ) {
+        load $plugin_class;
         my $plugin = $plugin_class->new( { cgi => $cgi, enable_plugins => $args->{'enable_plugins'} } );
-        if ( $plugin->can($plugin_method) ) {
-            return $plugin->$plugin_method( $params );
-        } else {
-            warn "Plugin does not have method $plugin_method";
-        }
+        my @return = $plugin->$plugin_method( $params );
+        return $plugin->$plugin_method( $params );
     } else {
-        warn "Plugin $plugin_class cannot be loaded";
+        warn "Plugin does not have method $plugin_method";
+        return undef;
     }
 }
 
@@ -101,6 +102,7 @@ sub delete {
     });
 
     C4::Context->dbh->do( "DELETE FROM plugin_data WHERE plugin_class = ?", undef, ($plugin_class) );
+    Koha::Plugins::Methods->search({ plugin_class => $plugin_class })->delete();
 
     unlink "$plugin_path.pm" or warn "Could not unlink $plugin_path.pm: $!";
     remove_tree($plugin_path);

Koha/Plugins/Methods.pm

@@ -21,7 +21,7 @@ use Carp;
 
 use Koha::Database;
 
-use Koha::City;
+use Koha::Plugins::Method;
 
 use base qw(Koha::Objects);
 

koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt

@@ -98,13 +98,11 @@
                 </dl>
             [% END %]
 
-            [% IF CAN_user_plugins && plugins_enabled %]
                 <h3>Plugins</h3>
                 <dl>
                     <dt><a href="/cgi-bin/koha/plugins/plugins-home.pl">Manage plugins</a></dt>
                     <dd>View, manage, configure and run plugins.</dd>
                 </dl>
-            [% END %]
             </div>
 
             <div class="col-md-6 sysprefs">

plugins/plugins-upload.pl

@@ -19,9 +19,10 @@
 use Modern::Perl;
 
 use Archive::Extract;
-use File::Temp;
-use File::Copy;
 use CGI qw ( -utf8 );
+use Class::Inspector;
+use File::Copy;
+use File::Temp;
 
 use C4::Context;
 use C4::Auth;
@@ -86,6 +87,8 @@ if ($plugins_enabled) {
                 $template->param( ERRORS => [ \%errors ] );
                 output_html_with_http_headers $input, $cookie, $template->output;
                 exit;
+            } else {
+                Koha::Plugins->new()->InstallPlugins();
             }
         }
     } elsif ( ( $op eq 'Upload' ) && !$uploadfile ) {

t/db_dependent/Plugins.t

@@ -13,6 +13,7 @@ use Test::More tests => 47;
 
 use C4::Context;
 use Koha::Database;
+use Koha::Plugins::Methods;
 
 use t::lib::Mocks;
 
@@ -27,6 +28,10 @@ BEGIN {
 
 my $schema = Koha::Database->new->schema;
 
+Koha::Plugins->new( { enable_plugins => 1 } )->InstallPlugins();
+
+ok( Koha::Plugins::Methods->search( { plugin_class => 'Koha::Plugin::Test' } )->count, 'Test plugin methods added to database' );
+
 my $mock_plugin = Test::MockModule->new( 'Koha::Plugin::Test' );
 $mock_plugin->mock( 'test_template', sub {
     my ( $self, $file ) = @_;
@@ -93,12 +98,6 @@ is( scalar grep( /^Test Plugin$/, @names), 1, "Koha::Plugins::GetPlugins functio
 
 @names = map { $_->get_metadata()->{'name'} } @plugins;
 is( scalar grep( /^Test Plugin$/, @names), 1, "GetPlugins also found Test Plugin via a metadata tag" );
-# Test two metadata conditions; one does not exist for Test.pm
-# Since it is a required key, we should not find the same results
-my @plugins2 = Koha::Plugins->new({ enable_plugins => 1 })->GetPlugins({
-    metadata => { my_example_tag  => 'find_me', not_there => '1' },
-});
-isnt( scalar @plugins2, scalar @plugins, 'GetPlugins with two metadata conditions' );
 
 $result = $plugin->disable;
 is( ref($result), 'Koha::Plugin::Test' );
@@ -141,6 +140,7 @@ for my $pass ( 1 .. 2 ) {
 
     ok( -f $plugins_dir . "/Koha/Plugin/Com/ByWaterSolutions/KitchenSink.pm", "KitchenSink plugin installed successfully" );
     $INC{$pm_path} = $full_pm_path; # FIXME I do not really know why, but if this is moved before the $plugin constructor, it will fail with Can't locate object method "new" via package "Koha::Plugin::Com::ByWaterSolutions::KitchenSink"
+    Koha::Plugins->new( { enable_plugins => 1 } )->InstallPlugins();
     Koha::Plugins::Handler->delete({ class => "Koha::Plugin::Com::ByWaterSolutions::KitchenSink", enable_plugins => 1 });
     my $sth = C4::Context->dbh->table_info( undef, undef, $table, 'TABLE' );
     my $info = $sth->fetchall_arrayref;