@@ -, +, @@ --- C4/Circulation.pm | 2 +- Koha/Plugins.pm | 35 ++++++++++++++++++++++ t/db_dependent/Koha/Plugins/Plugins.t | 34 +++++++++++++++++++-- t/lib/Koha/Plugin/TestBarcodes.pm | 43 +++++++++++++++++++++++++++ t/lib/Koha/Plugin/TestBarcodes2.pm | 43 +++++++++++++++++++++++++++ 5 files changed, 154 insertions(+), 3 deletions(-) create mode 100644 t/lib/Koha/Plugin/TestBarcodes.pm create mode 100644 t/lib/Koha/Plugin/TestBarcodes2.pm --- a/C4/Circulation.pm +++ a/C4/Circulation.pm @@ -178,7 +178,7 @@ sub barcodedecode { my ($barcode, $filter) = @_; my $branch = C4::Context::mybranch(); $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter; - ($barcode) = Koha::Plugins->call('item_barcode_transform', $barcode ) || $barcode; + ($barcode) = Koha::Plugins->call_recursive('item_barcode_transform', $barcode ); $filter or return $barcode; # ensure filter is defined, else return untouched barcode if ($filter eq 'whitespace') { $barcode =~ s/\s//g; --- a/Koha/Plugins.pm +++ a/Koha/Plugins.pm @@ -82,6 +82,41 @@ sub call { return @responses; } +=head2 call_recursive + +Calls a plugin method for all enabled plugins, +passing the return value from the previous plugin +to the next one. + + @response = Koha::Plugins->call_recursive($method, @args) + +=cut + +sub call_recursive { + my ( $class, $method, @args ) = @_; + + my @responses; + if ( C4::Context->config('enable_plugins') ) { + + my @plugins = $class->new( { enable_plugins => 1 } )->GetPlugins( { method => $method } ); + @plugins = grep { $_->can($method) } @plugins; + + foreach my $plugin (@plugins) { + my @response = eval { $plugin->$method(@args) }; + + if ($@) { + warn sprintf( "Plugin error (%s): %s", $plugin->get_metadata->{name}, $@ ); + next; + } else { + @args = @response; + } + } + + } + + return @args; +} + =head2 GetPlugins This will return a list of all available plugins, optionally limited by --- a/t/db_dependent/Koha/Plugins/Plugins.t +++ a/t/db_dependent/Koha/Plugins/Plugins.t @@ -25,7 +25,7 @@ use File::Temp qw( tempdir tempfile ); use FindBin qw($Bin); use Module::Load::Conditional qw(can_load); use Test::MockModule; -use Test::More tests => 54; +use Test::More tests => 55; use C4::Context; use Koha::Database; @@ -78,6 +78,36 @@ subtest 'call() tests' => sub { $schema->storage->txn_rollback; }; +subtest 'call_recursive() tests' => sub { + plan tests => 6; + + $schema->storage->txn_begin; + # Temporarily remove any installed plugins data + Koha::Plugins::Methods->delete; + + t::lib::Mocks::mock_config('enable_plugins', 1); + my $plugins = Koha::Plugins->new({ enable_plugins => 1 }); + my @plugins = $plugins->InstallPlugins; + foreach my $plugin (@plugins) { + $plugin->enable(); + } + + my (@responses) = Koha::Plugins->call_recursive('item_barcode_transform', 1); + is( scalar @responses, 1, "Got back one element" ); + is( $responses[0], 4, "Got expected response" ); + + (@responses) = Koha::Plugins->call_recursive('item_barcode_transform', 'abcd'); + is( scalar @responses, 1, "Got back one element" ); + is( $responses[0], 'abcd', "Got expected response" ); + + t::lib::Mocks::mock_config('enable_plugins', 0); + (@responses) = Koha::Plugins->call_recursive('item_barcode_transform', 1); + is( scalar @responses, 1, "Got back one element" ); + is( $responses[0], 1, "call_recursive should return the original arguments if plugins are disabled" ); + + $schema->storage->txn_rollback; +}; + subtest 'GetPlugins() tests' => sub { plan tests => 2; @@ -96,7 +126,7 @@ subtest 'GetPlugins() tests' => sub { @plugins = $plugins->GetPlugins({ metadata => { my_example_tag => 'find_me' }, all => 1 }); @names = map { $_->get_metadata()->{'name'} } @plugins; - is( scalar @names, 2, "Only two plugins found via a metadata tag" ); + is( scalar @names, 4, "Only four plugins found via a metadata tag" ); $schema->storage->txn_rollback; }; --- a/t/lib/Koha/Plugin/TestBarcodes.pm +++ a/t/lib/Koha/Plugin/TestBarcodes.pm @@ -0,0 +1,43 @@ +package Koha::Plugin::TestBarcodes; + +use Scalar::Util qw( looks_like_number ); + +## It's good practice to use Modern::Perl +use Modern::Perl; + +## Required for all plugins +use base qw(Koha::Plugins::Base); + +our $VERSION = 1.01; +our $metadata = { + name => 'TestBarcodes Plugin', + author => 'Kyle M Hall', + description => 'TestBarcodes plugin', + date_authored => '2013-01-14', + date_updated => '2013-01-14', + minimum_version => '3.11', + maximum_version => undef, + version => $VERSION, + my_example_tag => 'find_me', +}; + +sub new { + my ( $class, $args ) = @_; + $args->{'metadata'} = $metadata; + my $self = $class->SUPER::new($args); + return $self; +} + +sub item_barcode_transform { + my ( $self, $barcode ) = @_; + return $barcode unless looks_like_number( $barcode ); + return $barcode + 1; +} + +sub patron_barcode_transform { + my ( $self, $barcode ) = @_; + return $barcode unless looks_like_number( $barcode ); + return $barcode + 1; +} + +1; --- a/t/lib/Koha/Plugin/TestBarcodes2.pm +++ a/t/lib/Koha/Plugin/TestBarcodes2.pm @@ -0,0 +1,43 @@ +package Koha::Plugin::TestBarcodes2; + +use Scalar::Util qw( looks_like_number ); + +## It's good practice to use Modern::Perl +use Modern::Perl; + +## Required for all plugins +use base qw(Koha::Plugins::Base); + +our $VERSION = 1.01; +our $metadata = { + name => 'TestBarcodes2 Plugin', + author => 'Kyle M Hall', + description => 'TestBarcodes2 plugin', + date_authored => '2013-01-14', + date_updated => '2013-01-14', + minimum_version => '3.11', + maximum_version => undef, + version => $VERSION, + my_example_tag => 'find_me', +}; + +sub new { + my ( $class, $args ) = @_; + $args->{'metadata'} = $metadata; + my $self = $class->SUPER::new($args); + return $self; +} + +sub item_barcode_transform { + my ( $self, $barcode ) = @_; + return $barcode unless looks_like_number( $barcode ); + return $barcode + 2; +} + +sub patron_barcode_transform { + my ( $self, $barcode ) = @_; + return $barcode unless looks_like_number( $barcode ); + return $barcode + 2; +} + +1; --