Bug 10859: Alert if a borrower already has an issue for the same biblio

This patch adds a new system preference, AllowMultipleIssuesOnABiblio.

If this system preference is OFF, an alert is raised if a patron
tries to check out an item even when they already have a different
item checked out from that bib.

The librarian can force the checkout anyway.

It doesn't alert the librarian if the biblio is a subscription

Test plan:
1. Create a biblio with at least 2 items
2. Checkout the first item for a borrower
3. Set syspref AllowMultipleIssuesOnABiblio to OFF.
4. Try to checkout the second item with the same borrower. A message
should appear telling you that this borrower already borrowed an item
from this biblio.
If you have the permission 'force_checkout' You should also see two
buttons to confirm (or not) the checkout
5. Click on 'No'. The checkout is not done
6. Repeat step 4 and click 'Yes', the checkout is done.
7. Return the second item.
8. Set syspref AllowMultipleIssuesOnABiblio to ON
9. Try to checkout the second item with the same borrower. This time
the checkout is done without warnings.

Followed test plan. Works as expected.
Signed-off-by: Marc Véron <veron@veron.ch>

Signed-off-by: Katrin Fischer <Katrin.Fischer.83@web.de>
All tests and QA script pass, works well. Tested:

* Permission to override
  * check out a second item from a record with subscriptions works
  * check out a second item from a 'normal' record is warned about,
  but can be done

* No permission to override
  * subscription item: can be checked out
  * normal item: can't be checked out

* Feature turned off
  * Check out never warns/blocks

Signed-off-by: Galen Charlton <gmc@esilibrary.com>

C4/Circulation.pm

@@ -1015,6 +1015,25 @@ sub CanBookBeIssued {
         }
     }
 
+    if (not C4::Context->preference('AllowMultipleIssuesOnABiblio')) {
+        # Check if borrower has already issued an item from the same biblio
+        # Only if it's not a subscription
+        my $biblionumber = $item->{biblionumber};
+        require C4::Serials;
+        my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
+        unless ($is_a_subscription) {
+            my $issues = GetIssues( {
+                borrowernumber => $borrower->{borrowernumber},
+                biblionumber   => $biblionumber,
+            } );
+            my @issues = $issues ? @$issues : ();
+            # If there is at least one issue on another item than the item we want to checkout
+            if (scalar @issues > 0 and $issues[0]->{itemnumber} != $item->{itemnumber}) {
+                $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
+            }
+        }
+    }
+
     return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
 }
 
@@ -2296,6 +2315,73 @@ sub GetOpenIssue {
 
 }
 
+=head2 GetIssues
+
+    $issues = GetIssues({});    # return all issues!
+    $issues = GetIssues({ borrowernumber => $borrowernumber, biblionumber => $biblionumber });
+
+Returns all pending issues that match given criteria.
+Returns a arrayref or undef if an error occurs.
+
+Allowed criteria are:
+
+=over 2
+
+=item * borrowernumber
+
+=item * biblionumber
+
+=item * itemnumber
+
+=back
+
+=cut
+
+sub GetIssues {
+    my ($criteria) = @_;
+
+    # Build filters
+    my @filters;
+    my @allowed = qw(borrowernumber biblionumber itemnumber);
+    foreach (@allowed) {
+        if (defined $criteria->{$_}) {
+            push @filters, {
+                field => $_,
+                value => $criteria->{$_},
+            };
+        }
+    }
+
+    # Do we need to join other tables ?
+    my %join;
+    if (defined $criteria->{biblionumber}) {
+        $join{items} = 1;
+    }
+
+    # Build SQL query
+    my $where = '';
+    if (@filters) {
+        $where = "WHERE " . join(' AND ', map { "$_->{field} = ?" } @filters);
+    }
+    my $query = q{
+        SELECT issues.*
+        FROM issues
+    };
+    if (defined $join{items}) {
+        $query .= q{
+            LEFT JOIN items ON (issues.itemnumber = items.itemnumber)
+        };
+    }
+    $query .= $where;
+
+    # Execute SQL query
+    my $dbh = C4::Context->dbh;
+    my $sth = $dbh->prepare($query);
+    my $rv = $sth->execute(map { $_->{value} } @filters);
+
+    return $rv ? $sth->fetchall_arrayref({}) : undef;
+}
+
 =head2 GetItemIssues
 
   $issues = &GetItemIssues($itemnumber, $history);

installer/data/mysql/sysprefs.sql

@@ -18,6 +18,7 @@ INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, `
 ('AllowHoldsOnDamagedItems','1','','Allow hold requests to be placed on damaged items','YesNo'),
 ('AllowHoldsOnPatronsPossessions','1',NULL,'Allow holds on records that patron have items of it','YesNo'),
 ('AllowItemsOnHoldCheckout','0','','Do not generate RESERVE_WAITING and RESERVED warning when checking out items reserved to someone else. This allows self checkouts for those items.','YesNo'),
+('AllowMultipleIssuesOnABiblio',1,'Allow/Don\'t allow patrons to check out multiple items from one biblio','','YesNo'),
 ('AllowMultipleCovers','0','1','Allow multiple cover images to be attached to each bibliographic record.','YesNo'),
 ('AllowNotForLoanOverride','0','','If ON, Koha will allow the librarian to loan a not for loan item.','YesNo'),
 ('AllowOfflineCirculation','0','','If on, enables HTML5 offline circulation functionality.','YesNo'),

installer/data/mysql/updatedatabase.pl

@@ -8191,6 +8191,17 @@ Your library.'
     SetVersion($DBversion);
 }
 
+$DBversion = "3.15.00.XXX";
+if ( CheckVersion($DBversion) ) {
+    $dbh->do(q{
+        INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type)
+        VALUES('AllowMultipleIssuesOnABiblio',1,'Allow/Don\'t allow patrons to check out multiple items from one biblio','','YesNo')
+    });
+
+    print "Upgrade to $DBversion done (Bug 10859 - Add system preference AllowMultipleIssuesOnABiblio)\n";
+    SetVersion($DBversion);
+}
+
 =head1 FUNCTIONS
 
 =head2 TableExists($table)

koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref

@@ -337,6 +337,12 @@ Circulation:
                   alert: "display a message"
                   nothing : "do nothing"
             - .
+        -
+            - pref: AllowMultipleIssuesOnABiblio
+              choices:
+                  yes: Allow
+                  no: "Don't allow"
+            - patrons to check out multiple items from the same biblio.
     Checkin Policy:
         -
             - pref: BlockReturnOfWithdrawnItems

koha-tmpl/intranet-tmpl/prog/en/modules/circ/circulation.tt

@@ -271,6 +271,15 @@ var MSG_EXPORT_SELECT_CHECKOUTS = _("You must select checkout(s) to export");
 [% IF  HIGHHOLDS %]
     <li>High demand item. Loan period shortened to [% HIGHHOLDS.duration %] days (due [% HIGHHOLDS.returndate %]). Check out anyway?</li>
 [% END %]
+
+[% IF BIBLIO_ALREADY_ISSUED %]
+  <li>
+    Borrower has already an issue on another item from this biblio.
+    [% IF CAN_user_circulate_force_checkout %]
+      Check out anyway?
+    [% END %]
+  </li>
+[% END %]
 </ul>
 
 [% IF HIGHHOLDS %]

t/db_dependent/Circulation/GetIssues.t

@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+
+use Modern::Perl;
+
+use Test::More;
+use Test::MockModule;
+use C4::Biblio;
+use C4::Items;
+use C4::Members;
+use C4::Branch;
+use C4::Category;
+use C4::Circulation;
+use MARC::Record;
+
+my $branchcode;
+my $branch_created;
+my @branches = keys %{ GetBranches() };
+if (@branches) {
+    $branchcode = $branches[0];
+} else {
+    $branchcode = 'B';
+    ModBranch({ add => 1, branchcode => $branchcode, branchname => 'Branch' });
+    $branch_created = 1;
+}
+
+my %item_branch_infos = (
+    homebranch => $branchcode,
+    holdingbranch => $branchcode,
+);
+
+my ($biblionumber1) = AddBiblio(MARC::Record->new, '');
+my $itemnumber1 = AddItem({ barcode => '0101', %item_branch_infos }, $biblionumber1);
+my $itemnumber2 = AddItem({ barcode => '0102', %item_branch_infos }, $biblionumber1);
+
+my ($biblionumber2) = AddBiblio(MARC::Record->new, '');
+my $itemnumber3 = AddItem({ barcode => '0203', %item_branch_infos }, $biblionumber2);
+
+my $categorycode;
+my $category_created;
+my @categories = C4::Category->all;
+if (@categories) {
+    $categorycode = $categories[0]->{categorycode}
+} else {
+    $categorycode = 'C';
+    C4::Context->dbh->do(
+        "INSERT INTO categories(categorycode) VALUES(?)", undef, $categorycode);
+    $category_created = 1;
+}
+
+my $borrowernumber = AddMember(categorycode => $categorycode, branchcode => $branchcode);
+my $borrower = GetMember(borrowernumber => $borrowernumber);
+
+# Need to mock userenv for AddIssue
+my $module = new Test::MockModule('C4::Context');
+$module->mock('userenv', sub { { branch => $branchcode } });
+AddIssue($borrower, '0101');
+AddIssue($borrower, '0203');
+
+# Begin tests...
+my $issues;
+$issues = GetIssues({biblionumber => $biblionumber1});
+is(scalar @$issues, 1, "Biblio $biblionumber1 has 1 item issued");
+is($issues->[0]->{itemnumber}, $itemnumber1, "First item of biblio $biblionumber1 is issued");
+
+$issues = GetIssues({biblionumber => $biblionumber2});
+is(scalar @$issues, 1, "Biblio $biblionumber2 has 1 item issued");
+is($issues->[0]->{itemnumber}, $itemnumber3, "First item of biblio $biblionumber2 is issued");
+
+$issues = GetIssues({borrowernumber => $borrowernumber});
+is(scalar @$issues, 2, "Borrower $borrowernumber checked out 2 items");
+
+$issues = GetIssues({borrowernumber => $borrowernumber, biblionumber => $biblionumber1});
+is(scalar @$issues, 1, "One of those is an item from biblio $biblionumber1");
+
+$issues = GetIssues({borrowernumber => $borrowernumber, biblionumber => $biblionumber2});
+is(scalar @$issues, 1, "The other is an item from biblio $biblionumber2");
+
+$issues = GetIssues({itemnumber => $itemnumber2});
+is(scalar @$issues, 0, "No one has issued the second item of biblio $biblionumber2");
+
+END {
+    AddReturn('0101', $branchcode);
+    AddReturn('0203', $branchcode);
+    DelMember($borrowernumber);
+    if ($category_created) {
+        C4::Context->dbh->do(
+            "DELETE FROM categories WHERE categorycode = ?", undef, $categorycode);
+    }
+    my $dbh = C4::Context->dbh;
+    C4::Items::DelItem($dbh, $biblionumber1, $itemnumber1);
+    C4::Items::DelItem($dbh, $biblionumber1, $itemnumber2);
+    C4::Items::DelItem($dbh, $biblionumber2, $itemnumber3);
+    C4::Biblio::DelBiblio($biblionumber1);
+    C4::Biblio::DelBiblio($biblionumber2);
+
+    if ($branch_created) {
+        DelBranch($branchcode);
+    }
+};
+
+done_testing;