Bug 28026: Add call_recursive() as a supplement for call()
[koha.git] / Koha / Plugins.pm
1 package Koha::Plugins;
2
3 # Copyright 2012 Kyle Hall
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
11 #
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20 use Modern::Perl;
21
22 use Array::Utils qw( array_minus );
23 use Class::Inspector;
24 use List::MoreUtils qw( any );
25 use Module::Load::Conditional qw( can_load );
26 use Module::Load;
27 use Module::Pluggable search_path => ['Koha::Plugin'], except => qr/::Edifact(|::Line|::Message|::Order|::Segment|::Transport)$/;
28 use Try::Tiny;
29
30 use C4::Context;
31 use C4::Output;
32
33 use Koha::Exceptions::Plugin;
34 use Koha::Plugins::Methods;
35
36 BEGIN {
37     my $pluginsdir = C4::Context->config("pluginsdir");
38     my @pluginsdir = ref($pluginsdir) eq 'ARRAY' ? @$pluginsdir : $pluginsdir;
39     push @INC, array_minus(@pluginsdir, @INC) ;
40     pop @INC if $INC[-1] eq '.';
41 }
42
43 =head1 NAME
44
45 Koha::Plugins - Module for loading and managing plugins.
46
47 =cut
48
49 sub new {
50     my ( $class, $args ) = @_;
51
52     return unless ( C4::Context->config("enable_plugins") || $args->{'enable_plugins'} );
53
54     $args->{'pluginsdir'} = C4::Context->config("pluginsdir");
55
56     return bless( $args, $class );
57 }
58
59 =head2 call
60
61 Calls a plugin method for all enabled plugins
62
63     @responses = Koha::Plugins->call($method, @args)
64
65 =cut
66
67 sub call {
68     my ($class, $method, @args) = @_;
69
70     my @responses;
71     if (C4::Context->config('enable_plugins')) {
72         my @plugins = $class->new({ enable_plugins => 1 })->GetPlugins({ method => $method });
73         @plugins = grep { $_->can($method) } @plugins;
74         foreach my $plugin (@plugins) {
75             my $response = eval { $plugin->$method(@args) };
76             if ($@) {
77                 warn sprintf("Plugin error (%s): %s", $plugin->get_metadata->{name}, $@);
78                 next;
79             }
80
81             push @responses, $response;
82         }
83
84     }
85     return @responses;
86 }
87
88 =head2 call_recursive
89
90 Calls a plugin method for all enabled plugins,
91 passing the return value from the previous plugin
92 to the next one.
93
94     @response = Koha::Plugins->call_recursive($method, @args)
95
96 =cut
97
98 sub call_recursive {
99     my ( $class, $method, @args ) = @_;
100
101     my @responses;
102     if ( C4::Context->config('enable_plugins') ) {
103
104         my @plugins = $class->new( { enable_plugins => 1 } )->GetPlugins( { method => $method } );
105         @plugins = grep { $_->can($method) } @plugins;
106
107         foreach my $plugin (@plugins) {
108             my @response = eval { $plugin->$method(@args) };
109
110             if ($@) {
111                 warn sprintf( "Plugin error (%s): %s", $plugin->get_metadata->{name}, $@ );
112                 next;
113             } else {
114                 @args = @response;
115             }
116         }
117
118     }
119
120     return @args;
121 }
122
123 =head2 GetPlugins
124
125 This will return a list of all available plugins, optionally limited by
126 method or metadata value.
127
128     my @plugins = Koha::Plugins::GetPlugins({
129         method => 'some_method',
130         metadata => { some_key => 'some_value' },
131     });
132
133 The method and metadata parameters are optional.
134 Available methods currently are: 'report', 'tool', 'to_marc', 'edifact'.
135 If you pass multiple keys in the metadata hash, all keys must match.
136
137 =cut
138
139 sub GetPlugins {
140     my ( $self, $params ) = @_;
141
142     my $method       = $params->{method};
143     my $req_metadata = $params->{metadata} // {};
144
145     my $filter = ( $method ) ? { plugin_method => $method } : undef;
146
147     my $plugin_classes = Koha::Plugins::Methods->search(
148         $filter,
149         {   columns  => 'plugin_class',
150             distinct => 1
151         }
152     )->_resultset->get_column('plugin_class');
153
154     my @plugins;
155
156     # Loop through all plugins that implement at least a method
157     while ( my $plugin_class = $plugin_classes->next ) {
158
159         if ( can_load( modules => { $plugin_class => undef }, nocache => 1 ) ) {
160
161             my $plugin;
162             my $failed_instantiation;
163
164             try {
165                 $plugin = $plugin_class->new({
166                     enable_plugins => $self->{'enable_plugins'}
167                         # loads even if plugins are disabled
168                         # FIXME: is this for testing without bothering to mock config?
169                 });
170             }
171             catch {
172                 warn "$_";
173                 $failed_instantiation = 1;
174             };
175
176             next if $failed_instantiation;
177
178             next unless $plugin->is_enabled or
179                         defined($params->{all}) && $params->{all};
180
181             # filter the plugin out by metadata
182             my $plugin_metadata = $plugin->get_metadata;
183             next
184                 if $plugin_metadata
185                 and %$req_metadata
186                 and any { !$plugin_metadata->{$_} || $plugin_metadata->{$_} ne $req_metadata->{$_} } keys %$req_metadata;
187
188             push @plugins, $plugin;
189         } elsif ( defined($params->{errors}) && $params->{errors} ){
190             push @plugins, { error => 'cannot_load', name => $plugin_class };
191         }
192
193     }
194
195     return @plugins;
196 }
197
198 =head2 InstallPlugins
199
200 Koha::Plugins::InstallPlugins()
201
202 This method iterates through all plugins physically present on a system.
203 For each plugin module found, it will test that the plugin can be loaded,
204 and if it can, will store its available methods in the plugin_methods table.
205
206 NOTE: We re-load all plugins here as a protective measure in case someone
207 has removed a plugin directly from the system without using the UI
208
209 =cut
210
211 sub InstallPlugins {
212     my ( $self, $params ) = @_;
213
214     my @plugin_classes = $self->plugins();
215     my @plugins;
216
217     foreach my $plugin_class (@plugin_classes) {
218         if ( can_load( modules => { $plugin_class => undef }, nocache => 1 ) ) {
219             next unless $plugin_class->isa('Koha::Plugins::Base');
220
221             my $plugin;
222             my $failed_instantiation;
223
224             try {
225                 $plugin = $plugin_class->new({ enable_plugins => $self->{'enable_plugins'} });
226             }
227             catch {
228                 warn "$_";
229                 $failed_instantiation = 1;
230             };
231
232             next if $failed_instantiation;
233
234             Koha::Plugins::Methods->search({ plugin_class => $plugin_class })->delete();
235
236             foreach my $method ( @{ Class::Inspector->methods( $plugin_class, 'public' ) } ) {
237                 Koha::Plugins::Method->new(
238                     {
239                         plugin_class  => $plugin_class,
240                         plugin_method => $method,
241                     }
242                 )->store();
243             }
244
245             push @plugins, $plugin;
246         } else {
247             my $error = $Module::Load::Conditional::ERROR;
248             # Do not warn the error if the plugin has been uninstalled
249             warn $error unless $error =~ m|^Could not find or check module '$plugin_class'|;
250         }
251     }
252     return @plugins;
253 }
254
255 1;
256 __END__
257
258 =head1 AVAILABLE HOOKS
259
260 =head2 after_hold_create
261
262 =head3 Parameters
263
264 =over
265
266 =item * C<$hold> - A Koha::Hold object that has just been inserted in database
267
268 =back
269
270 =head3 Return value
271
272 None
273
274 =head3 Example
275
276     sub after_hold_create {
277         my ($self, $hold) = @_;
278
279         warn "New hold for borrower " . $hold->borrower->borrowernumber;
280     }
281
282 =head1 AUTHOR
283
284 Kyle M Hall <kyle.m.hall@gmail.com>
285
286 =cut