Bug 17530: Add Koha::IssuingRules->guess_article_requestable_itemtypes

This routine looks at the issuingrules and makes a fast 'intelligent
guess' if article requests may be allowed for item types while
branch code and patron category may not be available.

We also add Koha::Biblio->may_article_request using the routine based
on default item type or parameter. Implemented as both class and instance
method. Added a few tests.

Test plan:
[1] Run t/db_dependent/Koha/IssuingRules/guess_article_requestable_itemtypes.t
[2] Run t/db_dependent/ArticleRequests.t to test Koha::Biblio changes.

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>

Signed-off-by: Brendan Gallagher <brendan@bywatersolutions.com>
Signed-off-by: Chris Cormack <chrisc@catalyst.net.nz>

Signed-off-by: Nick Clemens <nick@bywatersolutions.com>

diff --git a/Koha/Biblio.pm b/Koha/Biblio.pm
index 1dca4d9..7a60b41 100644 (file)
--- a/Koha/Biblio.pm
+++ b/Koha/Biblio.pm
@@ -169,6 +169,32 @@ sub can_be_transferred {
     return 0;
 }
 
+=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 // q{} } || $guess->{ '*' } ) ? 1 : q{};
+}
+
 =head3 article_request_type
 
 my $type = $biblio->article_request_type( $borrower );

diff --git a/Koha/IssuingRules.pm b/Koha/IssuingRules.pm
index e0fffd1..642c55d 100644 (file)
--- a/Koha/IssuingRules.pm
+++ b/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

diff --git a/t/db_dependent/ArticleRequests.t b/t/db_dependent/ArticleRequests.t
index ab2145f..d38bf02 100755 (executable)
--- a/t/db_dependent/ArticleRequests.t
+++ b/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');
@@ -217,6 +218,34 @@ subtest 'search_limited' => sub {
     is( Koha::ArticleRequests->search_limited->count, 0, '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 {

diff --git a/t/db_dependent/Koha/IssuingRules/guess_article_requestable_itemtypes.t b/t/db_dependent/Koha/IssuingRules/guess_article_requestable_itemtypes.t
new file mode 100644 (file)
index 0000000..71c6c66
--- /dev/null
+++ b/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;