@@ -, +, @@ Koha::IssuingRules->guess_article_requestable_itemtypes --- Koha/Biblio.pm | 26 +++++++++ Koha/IssuingRules.pm | 59 +++++++++++++++++++ t/db_dependent/ArticleRequests.t | 35 ++++++++++- .../guess_article_requestable_itemtypes.t | 67 ++++++++++++++++++++++ 4 files changed, 184 insertions(+), 3 deletions(-) create mode 100644 t/db_dependent/Koha/IssuingRules/guess_article_requestable_itemtypes.t --- a/Koha/Biblio.pm +++ a/Koha/Biblio.pm @@ -99,6 +99,32 @@ sub can_article_request { return q{}; } +=head3 may_article_request + + Returns true if it is likely possible to make an article request for + a given item type (or the default item type from biblioitems). + + # As class method: + my $boolean = Koha::Biblio->may_article_request({ itemtype => 'BK' }); + # As instance method: + my $boolean = Koha::Biblios->find($biblionumber)->may_article_request; + +=cut + +sub may_article_request { + my ( $class_or_self, $params ) = @_; + return q{} if !C4::Context->preference('ArticleRequests'); + my $itemtype = ref($class_or_self) + ? $class_or_self->itemtype + : $params->{itemtype}; + my $category = $params->{categorycode}; + + my $guess = Koha::IssuingRules->guess_article_requestable_itemtypes({ + $category ? ( categorycode => $category ) : (), + }); + return ( $guess->{ $itemtype } || $guess->{ '*' } ) ? 1 : q{}; +} + =head3 article_request_type my $type = $biblio->article_request_type( $borrower ); --- a/Koha/IssuingRules.pm +++ a/Koha/IssuingRules.pm @@ -121,6 +121,65 @@ sub get_onshelfholds_policy { return $issuing_rule ? $issuing_rule->onshelfholds : undef; } +=head3 article_requestable_rules + + Return rules that allow article requests, optionally filtered by + patron categorycode. + + Use with care; see guess_article_requestable_itemtypes. + +=cut + +sub article_requestable_rules { + my ( $class_or_self, $params ) = @_; + my $category = $params->{categorycode}; + + return if !C4::Context->preference('ArticleRequests'); + return $class_or_self->search({ + $category ? ( categorycode => [ $category, '*' ] ) : (), + article_requests => { '!=' => 'no' }, + }); +} + +=head3 guess_article_requestable_itemtypes + + Return item types in a hashref that are likely possible to be + 'article requested'. Constructed by an intelligent guess in the + issuing rules (see article_requestable_rules). + + Optional parameters: categorycode. + + Note: the routine is used in opac-search to obtain a reasonable + estimate within performance borders (not looking at all items but + just using default itemtype). Also we are not looking at the + branchcode here, since home or holding branch of the item is + leading and branch may be unknown too (anonymous opac session). + +=cut + +our $last_article_requestable_guesses; # used during Plack life time + +sub guess_article_requestable_itemtypes { + my ( $class_or_self, $params ) = @_; + my $category = $params->{categorycode}; + return {} if !C4::Context->preference('ArticleRequests'); + + my $key = $category || '*'; + return $last_article_requestable_guesses->{$key} + if $last_article_requestable_guesses && exists $last_article_requestable_guesses->{$key}; + + my $res = {}; + my $rules = $class_or_self->article_requestable_rules({ + $category ? ( categorycode => $category ) : (), + }); + return $res if !$rules; + foreach my $rule ( $rules->as_list ) { + $res->{ $rule->itemtype } = 1; + } + $last_article_requestable_guesses->{$key} = $res; + return $res; +} + =head3 type =cut --- a/t/db_dependent/ArticleRequests.t +++ a/t/db_dependent/ArticleRequests.t @@ -19,16 +19,17 @@ use Modern::Perl; use POSIX qw(strftime); -use Test::More tests => 55; +use Test::More tests => 56; use t::lib::TestBuilder; +use t::lib::Mocks; use Koha::Database; use Koha::Biblio; use Koha::Notice::Messages; use Koha::Patron; - -use t::lib::TestBuilder; +use Koha::Library::Group; +use Koha::IssuingRules; BEGIN { use_ok('Koha::ArticleRequest'); @@ -219,6 +220,34 @@ subtest 'search_limited' => sub { is( Koha::ArticleRequests->search_limited->count, $nb_article_requests, 'Koha::ArticleRequests->search_limited should not return all article requests for restricted patron' ); }; +subtest 'may_article_request' => sub { + plan tests => 6; + + # mocking + t::lib::Mocks::mock_preference('ArticleRequests', 1); + $Koha::IssuingRules::last_article_requestable_guesses = { + '*' => { 'CR' => 1 }, + 'S' => { '*' => 1 }, + 'PT' => { 'BK' => 1 }, + }; + + # tests for class method call + is( Koha::Biblio->may_article_request({ itemtype => 'CR' }), 1, 'SER/* should be true' ); + is( Koha::Biblio->may_article_request({ itemtype => 'CR', categorycode => 'S' }), 1, 'SER/S should be true' ); + is( Koha::Biblio->may_article_request({ itemtype => 'CR', categorycode => 'PT' }), '', 'SER/PT should be false' ); + + # tests for instance method call + my $builder = t::lib::TestBuilder->new; + my $biblio = $builder->build_object({ class => 'Koha::Biblios' }); + my $biblioitem = $builder->build_object({ class => 'Koha::Biblioitems', value => { biblionumber => $biblio->biblionumber, itemtype => 'BK' }}); + is( $biblio->may_article_request, '', 'BK/* false' ); + is( $biblio->may_article_request({ categorycode => 'S' }), 1, 'BK/S true' ); + is( $biblio->may_article_request({ categorycode => 'PT' }), 1, 'BK/PT true' ); + + # Cleanup + $Koha::IssuingRules::last_article_requestable_guesses = undef; +}; + $schema->storage->txn_rollback(); sub set_logged_in_user { --- a/t/db_dependent/Koha/IssuingRules/guess_article_requestable_itemtypes.t +++ a/t/db_dependent/Koha/IssuingRules/guess_article_requestable_itemtypes.t @@ -0,0 +1,67 @@ +#!/usr/bin/perl + +use Modern::Perl; +use Test::More tests => 1; + +use t::lib::Mocks; +use t::lib::TestBuilder; +use Koha::Database; +use Koha::IssuingRules; + +my $schema = Koha::Database->new->schema; +$schema->storage->txn_begin; +our $builder = t::lib::TestBuilder->new; + +subtest 'guess_article_requestable_itemtypes' => sub { + plan tests => 12; + + t::lib::Mocks::mock_preference('ArticleRequests', 1); + Koha::IssuingRules->delete; + my $itype1 = $builder->build_object({ class => 'Koha::ItemTypes' }); + my $itype2 = $builder->build_object({ class => 'Koha::ItemTypes' }); + my $catg1 = $builder->build_object({ class => 'Koha::Patron::Categories' }); + my $catg2 = $builder->build_object({ class => 'Koha::Patron::Categories' }); + my $rule1 = $builder->build_object({ + class => 'Koha::IssuingRules', + value => { + branchcode => 'MPL', # no worries: no FK + categorycode => '*', + itemtype => $itype1->itemtype, + article_requests => 'bib_only', + }, + }); + my $rule2 = $builder->build_object({ + class => 'Koha::IssuingRules', + value => { + branchcode => '*', + categorycode => $catg1->categorycode, + itemtype => $itype2->itemtype, + article_requests => 'yes', + }, + }); + + my $res = Koha::IssuingRules->guess_article_requestable_itemtypes; + is( $res->{'*'}, undef, 'Item type * seems not permitted' ); + is( $res->{$itype1->itemtype}, 1, 'Item type 1 seems permitted' ); + is( $res->{$itype2->itemtype}, 1, 'Item type 2 seems permitted' ); + $res = Koha::IssuingRules->guess_article_requestable_itemtypes({ categorycode => $catg2->categorycode }); + is( $res->{'*'}, undef, 'Item type * seems not permitted' ); + is( $res->{$itype1->itemtype}, 1, 'Item type 1 seems permitted' ); + is( $res->{$itype2->itemtype}, undef, 'Item type 2 seems not permitted' ); + + # Change the rules + $rule2->itemtype('*')->store; + $Koha::IssuingRules::last_article_requestable_guesses = {}; + $res = Koha::IssuingRules->guess_article_requestable_itemtypes; + is( $res->{'*'}, 1, 'Item type * seems permitted' ); + is( $res->{$itype1->itemtype}, 1, 'Item type 1 seems permitted' ); + is( $res->{$itype2->itemtype}, undef, 'Item type 2 seems not permitted' ); + $res = Koha::IssuingRules->guess_article_requestable_itemtypes({ categorycode => $catg2->categorycode }); + is( $res->{'*'}, undef, 'Item type * seems not permitted' ); + is( $res->{$itype1->itemtype}, 1, 'Item type 1 seems permitted' ); + is( $res->{$itype2->itemtype}, undef, 'Item type 2 seems not permitted' ); + + $Koha::IssuingRules::last_article_requestable_guesses = {}; +}; + +$schema->storage->txn_rollback; --