C4/HoldsQueue.pm

   1 package C4::HoldsQueue;
   2
   3 # Copyright 2011 Catalyst IT
   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 # FIXME: expand perldoc, explain intended logic
  21
  22 use strict;
  23 use warnings;
  24
  25 use C4::Context;
  26 use C4::Circulation qw( GetBranchItemRule );
  27 use Koha::DateUtils qw( dt_from_string );
  28 use Koha::Hold::HoldsQueueItems;
  29 use Koha::Items;
  30 use Koha::Libraries;
  31 use Koha::Logger;
  32 use Koha::Patrons;
  33
  34 use List::Util qw( shuffle );
  35 use List::MoreUtils qw( any );
  36 use Algorithm::Munkres qw();
  37
  38 our (@ISA, @EXPORT_OK);
  39 BEGIN {
  40     require Exporter;
  41     @ISA = qw(Exporter);
  42     @EXPORT_OK = qw(
  43         CreateQueue
  44         GetHoldsQueueItems
  45
  46         TransportCostMatrix
  47         UpdateTransportCostMatrix
  48         GetPendingHoldRequestsForBib
  49         load_branches_to_pull_from
  50         update_queue_for_biblio
  51      );
  52 }
  53
  54
  55 =head1 FUNCTIONS
  56
  57 =head2 TransportCostMatrix
  58
  59   TransportCostMatrix();
  60
  61 Returns Transport Cost Matrix as a hashref <to branch code> => <from branch code> => cost
  62
  63 =cut
  64
  65 sub TransportCostMatrix {
  66     my ( $params ) = @_;
  67
  68     my $dbh   = C4::Context->dbh;
  69     my $transport_costs = $dbh->selectall_arrayref("SELECT * FROM transport_cost",{ Slice => {} });
  70
  71     my $today = dt_from_string();
  72     my %transport_cost_matrix;
  73     foreach (@$transport_costs) {
  74         my $from     = $_->{frombranch};
  75         my $to       = $_->{tobranch};
  76         my $cost     = $_->{cost};
  77         my $disabled = $_->{disable_transfer};
  78         $transport_cost_matrix{$to}{$from} = {
  79             cost             => $cost,
  80             disable_transfer => $disabled
  81         };
  82     }
  83
  84     return \%transport_cost_matrix;
  85 }
  86
  87 =head2 UpdateTransportCostMatrix
  88
  89   UpdateTransportCostMatrix($records);
  90
  91 Updates full Transport Cost Matrix table. $records is an arrayref of records.
  92 Records: { frombranch => <code>, tobranch => <code>, cost => <figure>, disable_transfer => <0,1> }
  93
  94 =cut
  95
  96 sub UpdateTransportCostMatrix {
  97     my ($records) = @_;
  98     my $dbh   = C4::Context->dbh;
  99
 100     my $sth = $dbh->prepare("INSERT INTO transport_cost (frombranch, tobranch, cost, disable_transfer) VALUES (?, ?, ?, ?)");
 101
 102     $dbh->do("DELETE FROM transport_cost");
 103     foreach (@$records) {
 104         my $cost = $_->{cost};
 105         my $from = $_->{frombranch};
 106         my $to = $_->{tobranch};
 107         if ($_->{disable_transfer}) {
 108             $cost ||= 0;
 109         }
 110         elsif ( !defined ($cost) || ($cost !~ m/(0|[1-9][0-9]*)(\.[0-9]*)?/o) ) {
 111             warn  "Invalid $from -> $to cost $cost - must be a number >= 0, disabling";
 112             $cost = 0;
 113             $_->{disable_transfer} = 1;
 114         }
 115         $sth->execute( $from, $to, $cost, $_->{disable_transfer} ? 1 : 0 );
 116     }
 117 }
 118
 119 =head2 GetHoldsQueueItems
 120
 121   GetHoldsQueueItems({ branchlimit => $branch, itemtypeslimit =>  $itype, ccodeslimit => $ccode, locationslimit => $location );
 122
 123 Returns hold queue for a holding branch. If branch is omitted, then whole queue is returned
 124
 125 =cut
 126
 127 sub GetHoldsQueueItems {
 128     my $params = shift;
 129     my $dbh   = C4::Context->dbh;
 130
 131     my $search_params;
 132     $search_params->{'me.holdingbranch'} = $params->{branchlimit} if $params->{branchlimit};
 133     $search_params->{'itype'} = $params->{itemtypeslimit} if $params->{itemtypeslimit};
 134     $search_params->{'ccode'} = $params->{ccodeslimit} if $params->{ccodeslimit};
 135     $search_params->{'location'} = $params->{locationslimit} if $params->{locationslimit};
 136
 137     my $results = Koha::Hold::HoldsQueueItems->search(
 138         $search_params,
 139         {
 140             join => [
 141                 'borrower',
 142             ],
 143             prefetch => [
 144                 'biblio',
 145                 'biblioitem',
 146                 {
 147                     'item' => {
 148                         'item_group_item' => 'item_group'
 149                     }
 150                 }
 151             ],
 152             order_by => [
 153                 'ccode',        'location',   'item.cn_sort', 'author',
 154                 'biblio.title', 'pickbranch', 'reservedate'
 155             ],
 156         }
 157     );
 158
 159     return $results;
 160 }
 161
 162 =head2 CreateQueue
 163
 164   CreateQueue();
 165
 166 Top level function that turns reserves into tmp_holdsqueue and hold_fill_targets.
 167
 168 =cut
 169
 170 sub CreateQueue {
 171     my $params      = shift;
 172     my $unallocated = $params->{unallocated};
 173     my $dbh         = C4::Context->dbh;
 174
 175     unless ($unallocated) {
 176         $dbh->do("DELETE FROM tmp_holdsqueue");    # clear the old table for new info
 177         $dbh->do("DELETE FROM hold_fill_targets");
 178     }
 179
 180     my $total_bibs            = 0;
 181     my $total_requests        = 0;
 182     my $total_available_items = 0;
 183     my $num_items_mapped      = 0;
 184
 185     my $branches_to_use;
 186     my $transport_cost_matrix;
 187     my $use_transport_cost_matrix = C4::Context->preference("UseTransportCostMatrix");
 188     if ($use_transport_cost_matrix) {
 189         $transport_cost_matrix = TransportCostMatrix();
 190         unless (keys %$transport_cost_matrix) {
 191             warn "UseTransportCostMatrix set to yes, but matrix not populated";
 192             undef $transport_cost_matrix;
 193         }
 194     }
 195
 196     $branches_to_use = load_branches_to_pull_from($use_transport_cost_matrix);
 197
 198     my $bibs_with_pending_requests = GetBibsWithPendingHoldRequests();
 199
 200     foreach my $biblionumber (@$bibs_with_pending_requests) {
 201
 202         $total_bibs++;
 203
 204         my $result = update_queue_for_biblio(
 205             {
 206                 biblio_id             => $biblionumber,
 207                 branches_to_use       => $branches_to_use,
 208                 transport_cost_matrix => $transport_cost_matrix,
 209                 unallocated           => $unallocated
 210             }
 211         );
 212
 213         $total_requests        += $result->{requests};
 214         $total_available_items += $result->{available_items};
 215         $num_items_mapped      += $result->{mapped_items};
 216     }
 217 }
 218
 219 =head2 GetBibsWithPendingHoldRequests
 220
 221   my $biblionumber_aref = GetBibsWithPendingHoldRequests();
 222
 223 Return an arrayref of the biblionumbers of all bibs
 224 that have one or more unfilled hold requests.
 225
 226 =cut
 227
 228 sub GetBibsWithPendingHoldRequests {
 229     my $dbh = C4::Context->dbh;
 230
 231     my $bib_query = "SELECT DISTINCT biblionumber
 232                      FROM reserves
 233                      WHERE found IS NULL
 234                      AND priority > 0
 235                      AND reservedate <= CURRENT_DATE()
 236                      AND suspend = 0
 237                      AND reserve_id NOT IN (SELECT reserve_id FROM hold_fill_targets)
 238                      ";
 239     my $sth = $dbh->prepare($bib_query);
 240
 241     $sth->execute();
 242     my $biblionumbers = $sth->fetchall_arrayref();
 243
 244     return [ map { $_->[0] } @$biblionumbers ];
 245 }
 246
 247 =head2 GetPendingHoldRequestsForBib
 248
 249     my $requests = GetPendingHoldRequestsForBib( { biblionumber => $biblionumber, unallocated => $unallocated } );
 250
 251 Returns an arrayref of hashrefs to pending, unfilled hold requests
 252 on the bib identified by $biblionumber. Optionally returns only unallocated holds.  The following keys
 253 are present in each hashref:
 254
 255     biblionumber
 256     borrowernumber
 257     itemnumber
 258     priority
 259     branchcode
 260     reservedate
 261     reservenotes
 262     borrowerbranch
 263
 264 The arrayref is sorted in order of increasing priority.
 265
 266 =cut
 267
 268 sub GetPendingHoldRequestsForBib {
 269     my $params       = shift;
 270     my $biblionumber = $params->{biblionumber};
 271     my $unallocated  = $params->{unallocated};
 272
 273     my $dbh = C4::Context->dbh;
 274
 275     my $request_query = "SELECT biblionumber, borrowernumber, itemnumber, priority, reserve_id, reserves.branchcode,
 276                                 reservedate, reservenotes, borrowers.branchcode AS borrowerbranch, itemtype, item_level_hold, item_group_id
 277                          FROM reserves
 278                          JOIN borrowers USING (borrowernumber)
 279                          WHERE biblionumber = ?
 280                          AND found IS NULL
 281                          AND priority > 0
 282                          AND reservedate <= CURRENT_DATE()
 283                          AND suspend = 0 ";
 284     $request_query .= "AND reserve_id NOT IN (SELECT reserve_id FROM hold_fill_targets) " if $unallocated;
 285     $request_query .= "ORDER BY priority";
 286     my $sth = $dbh->prepare($request_query);
 287     $sth->execute($biblionumber);
 288
 289     my $requests = $sth->fetchall_arrayref({});
 290     return $requests;
 291
 292 }
 293
 294 =head2 GetItemsAvailableToFillHoldRequestsForBib
 295
 296   my $available_items = GetItemsAvailableToFillHoldRequestsForBib($biblionumber, $branches_ar);
 297
 298 Returns an arrayref of items available to fill hold requests
 299 for the bib identified by C<$biblionumber>.  An item is available
 300 to fill a hold request if and only if:
 301
 302     * it is not on loan
 303     * it is not withdrawn
 304     * it is not marked notforloan
 305     * it is not currently in transit
 306     * it is not lost
 307     * it is not sitting on the hold shelf
 308     * it is not damaged (unless AllowHoldsOnDamagedItems is on)
 309
 310 =cut
 311
 312 sub GetItemsAvailableToFillHoldRequestsForBib {
 313     my ($biblionumber, $branches_to_use) = @_;
 314
 315     my $dbh = C4::Context->dbh;
 316     my $items_query = "SELECT items.itemnumber, homebranch, holdingbranch, itemtypes.itemtype AS itype
 317                        FROM items ";
 318
 319     if ( C4::Context->preference('item-level_itypes') ) {
 320         $items_query .= "LEFT JOIN itemtypes ON (itemtypes.itemtype = items.itype) ";
 321     } else {
 322         $items_query .= "JOIN biblioitems USING (biblioitemnumber)
 323                            LEFT JOIN itemtypes USING (itemtype) ";
 324     }
 325     $items_query .= " LEFT JOIN branchtransfers ON (
 326                            items.itemnumber = branchtransfers.itemnumber
 327                            AND branchtransfers.datearrived IS NULL AND branchtransfers.datecancelled IS NULL
 328                      )";
 329     $items_query .= " WHERE items.notforloan = 0
 330                        AND holdingbranch IS NOT NULL
 331                        AND itemlost = 0
 332                        AND withdrawn = 0";
 333     $items_query .= "  AND damaged = 0" unless C4::Context->preference('AllowHoldsOnDamagedItems');
 334     $items_query .= "  AND items.onloan IS NULL
 335                        AND (itemtypes.notforloan IS NULL OR itemtypes.notforloan = 0)
 336                        AND items.itemnumber NOT IN (
 337                            SELECT itemnumber
 338                            FROM reserves
 339                            WHERE biblionumber = ?
 340                            AND itemnumber IS NOT NULL
 341                            AND (found IS NOT NULL OR priority = 0)
 342                         )
 343                         AND items.itemnumber NOT IN (
 344                            SELECT itemnumber
 345                            FROM tmp_holdsqueue
 346                            WHERE biblionumber = ?
 347                         )
 348                        AND items.biblionumber = ?
 349                        AND branchtransfers.itemnumber IS NULL";
 350
 351     my @params = ($biblionumber, $biblionumber, $biblionumber);
 352     if ($branches_to_use && @$branches_to_use) {
 353         $items_query .= " AND holdingbranch IN (" . join (",", map { "?" } @$branches_to_use) . ")";
 354         push @params, @$branches_to_use;
 355     }
 356     my $sth = $dbh->prepare($items_query);
 357     $sth->execute(@params);
 358
 359     my $itm = $sth->fetchall_arrayref({});
 360     return [ grep {
 361         my $rule = C4::Circulation::GetBranchItemRule($_->{homebranch}, $_->{itype});
 362         $_->{holdallowed} = $rule->{holdallowed};
 363         $_->{hold_fulfillment_policy} = $rule->{hold_fulfillment_policy};
 364     } @{$itm} ];
 365 }
 366
 367 =head2 _checkHoldPolicy
 368
 369     _checkHoldPolicy($item, $request)
 370
 371     check if item agrees with hold policies
 372
 373 =cut
 374
 375 sub _checkHoldPolicy {
 376     my ( $item, $request ) = @_;
 377
 378     return 0 unless $item->{holdallowed} ne 'not_allowed';
 379
 380     return 0
 381         if $item->{holdallowed} eq 'from_home_library'
 382         && $item->{homebranch} ne $request->{borrowerbranch};
 383
 384     return 0
 385         if $item->{'holdallowed'} eq 'from_local_hold_group'
 386         && !Koha::Libraries->find( $item->{homebranch} )
 387         ->validate_hold_sibling( { branchcode => $request->{borrowerbranch} } );
 388
 389     my $hold_fulfillment_policy = $item->{hold_fulfillment_policy};
 390
 391     return 0
 392         if $hold_fulfillment_policy eq 'holdgroup'
 393         && !Koha::Libraries->find( $item->{homebranch} )
 394         ->validate_hold_sibling( { branchcode => $request->{branchcode} } );
 395
 396     return 0
 397         if $hold_fulfillment_policy eq 'homebranch'
 398         && $request->{branchcode} ne $item->{$hold_fulfillment_policy};
 399
 400     return 0
 401         if $hold_fulfillment_policy eq 'holdingbranch'
 402         && $request->{branchcode} ne $item->{$hold_fulfillment_policy};
 403
 404     return 0
 405         if $hold_fulfillment_policy eq 'patrongroup'
 406         && !Koha::Libraries->find( $request->{borrowerbranch} )
 407         ->validate_hold_sibling( { branchcode => $request->{branchcode} } );
 408
 409     return 1;
 410
 411 }
 412
 413 sub _allocateWithTransportCostMatrix {
 414     my (
 415         $hold_requests, $available_items, $branches_to_use, $libraries, $transport_cost_matrix, $allocated_items,
 416         $items_by_itemnumber
 417     ) = @_;
 418
 419     my @allocated;
 420
 421     my @remaining_items = grep { !exists $allocated_items->{ $_->{itemnumber} } && $_->{holdallowed} ne 'not_allowed'; }
 422         @$available_items;
 423
 424     my @requests  = grep { !defined $_->{itemnumber} } @$hold_requests;
 425     my @remaining = ();
 426
 427     my $num_agents = scalar(@remaining_items);
 428     my $num_tasks  = scalar(@requests);
 429
 430     return [] if $num_agents == 0 || $num_tasks == 0;
 431
 432     if ( $num_tasks > $num_agents ) {
 433         @remaining = @requests[ $num_agents .. $num_tasks - 1 ];
 434         @requests  = @requests[ 0 .. $num_agents - 1 ];
 435         $num_tasks = $num_agents;
 436     }
 437
 438     my @m = map { [ (undef) x $num_tasks ] } ( 1 .. $num_agents );
 439
 440     my $inf = -1;    # Initially represent infinity with a negative value.
 441     my $max = 0;
 442
 443     # If some candidate holds requests cannot be filled and there are
 444     # hold requests remaining, we will try again a limited number of
 445     # times.
 446     #
 447     # The limit is chosen arbitrarily and only servers to keep the
 448     # asymptotic worst case to O(num_tasks³).
 449     my $RETRIES          = 8;
 450     my $retries          = $RETRIES;
 451     my $r                = 0;
 452     my @candidate_tasks  = ( (0) x $num_tasks );
 453     my @candidate_agents = ( (0) x $num_agents );
 454
 455 RETRY:
 456     while (1) {
 457         return [] if $num_agents == 0 || $num_tasks == 0;
 458
 459         if ( $num_tasks < $num_agents && @remaining ) {
 460
 461             # On retry, move tasks from @remaining to @requests up to
 462             # the number of agents.
 463             my $nr = scalar(@remaining);
 464             my $na = $num_agents - $num_tasks;
 465             my $nm = $nr < $na ? $nr : $na;
 466             push @requests, ( splice @remaining, 0, $nm );
 467             $num_tasks += $nm;
 468             for ( my $t = scalar(@candidate_tasks) ; $t < $num_tasks ; $t++ ) {
 469                 push @candidate_tasks, 0;
 470             }
 471         }
 472
 473         for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
 474             for ( my $j = $r ; $j < $num_tasks ; $j++ ) {
 475                 my $item    = $remaining_items[$i];
 476                 my $request = $requests[$j];
 477
 478                 my $pickup_branch = $request->{branchcode} || $request->{borrowerbranch};
 479                 my $srcbranch     = $item->{holdingbranch};
 480
 481                 $m[$i][$j] = $inf
 482                     and next
 483                     unless _checkHoldPolicy( $item, $request );
 484                 $m[$i][$j] = $inf
 485                     and next
 486                     unless $items_by_itemnumber->{ $item->{itemnumber} }->{_object}
 487                     ->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );
 488
 489                 # If hold itemtype is set, item's itemtype must match
 490                 $m[$i][$j] = $inf
 491                     and next
 492                     unless ( !$request->{itemtype}
 493                     || $item->{itype} eq $request->{itemtype} );
 494
 495                 # If hold item_group is set, item's item_group must match
 496                 $m[$i][$j] = $inf
 497                     and next
 498                     unless (
 499                     !$request->{item_group_id}
 500                     || (   $item->{_object}->item_group
 501                         && $item->{_object}->item_group->id eq $request->{item_group_id} )
 502                     );
 503
 504                 my $cell = $transport_cost_matrix->{$pickup_branch}{$srcbranch};
 505                 my $cost;
 506
 507                 if ( !defined $cell && $pickup_branch eq $srcbranch ) {
 508                     $cost = 0;
 509                 } elsif ( !defined $cell || $cell->{disable_transfer} ) {
 510                     $cost = $inf;
 511                 } else {
 512                     if ( defined $cell->{cost} ) {
 513                         $cost = $cell->{cost};
 514                     } else {
 515                         $cost = $inf;
 516                     }
 517                 }
 518
 519                 $m[$i][$j] = $cost;
 520
 521                 if ( $cost != $inf ) {
 522
 523                     # There is at least one possible item in row $i and column $j
 524                     $candidate_tasks[$j]  = 1;
 525                     $candidate_agents[$i] = 1;
 526                 }
 527
 528                 if ( $cost > $max ) {
 529                     $max = $cost;
 530                 }
 531             }
 532         }
 533
 534         # Remove any hold request for which there is no finite transport cost item available.
 535         my $removed_something = 0;
 536
 537         for ( my $j = 0, my $j0 = 0 ; $j < $num_tasks ; $j++ ) {
 538             if ( !$candidate_tasks[$j] ) {
 539                 for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
 540                     splice @{ $m[$i] }, $j - $j0, 1;
 541                 }
 542                 splice @requests, $j - $j0, 1;
 543                 $j0++;
 544                 $removed_something = 1;
 545             }
 546         }
 547
 548         $num_tasks = scalar(@requests);
 549
 550         if ( $num_agents > $num_tasks && @remaining ) {
 551
 552             $r                = $num_tasks;
 553             @candidate_tasks  = ( (1) x $num_tasks );
 554             @candidate_agents = ( (1) x $num_agents );
 555             next RETRY;
 556         }
 557
 558         if ( $num_tasks > $num_agents ) {
 559
 560             return [] if $num_agents == 0;
 561             unshift @remaining, ( splice @requests, $num_agents );
 562             $num_tasks = $num_agents;
 563         }
 564
 565         return [] if $num_agents == 0 || $num_tasks == 0;
 566
 567         # Substitute infinity with a cost that is higher than the total of
 568         # any possible assignment.  This ensures that any possible
 569         # assignment will be selected before any assignment of infinite
 570         # cost.  Infinite cost assignments can be be filtered out at the
 571         # end.
 572         $inf = $max * $num_tasks + 1;
 573
 574         my @m0 = map {[(undef) x  $num_tasks]} (1..$num_agents);
 575         for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
 576             for ( my $j = 0 ; $j < $num_tasks ; $j++ ) {
 577                 if ( $m[$i][$j] < 0 ) {
 578                     # Bias towards not allocating items to holds closer to
 579                     # the end of the queue in the queue if not all holds
 580                     # can be filled by representing infinity with
 581                     # different values.
 582                     $m0[$i][$j] = $inf + ( $num_tasks - $j );
 583                 } else {
 584                     $m0[$i][$j] = $m[$i][$j];
 585                 }
 586             }
 587         }
 588
 589         my $res = [ (undef) x $num_agents ];
 590
 591         Algorithm::Munkres::assign( \@m0, $res );
 592
 593         my @unallocated = ();
 594         @allocated = ();
 595         for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
 596             my $j = $res->[$i];
 597             if ( !defined $j || $j >= $num_tasks ) {
 598
 599                 # If the algorithm zero-pads the matrix
 600                 # (Algorithm::Munkres version 0.08) holds may be
 601                 # allocated to nonexisting items ($j >= 0).  We just ignore these.
 602                 next;
 603             }
 604             if ( $m0[$i][$j] > $max ) {
 605
 606                 # No finite cost item was assigned to this hold.
 607                 push @unallocated, $j;
 608             } else {
 609
 610                 my $request = $requests[$j];
 611                 my $item    = $remaining_items[$i];
 612                 push @allocated, [
 613                     $item->{itemnumber},
 614                     {
 615                         borrowernumber => $request->{borrowernumber},
 616                         biblionumber   => $request->{biblionumber},
 617                         holdingbranch  => $item->{holdingbranch},
 618                         pickup_branch  => $request->{branchcode}
 619                             || $request->{borrowerbranch},
 620                         reserve_id   => $request->{reserve_id},
 621                         item_level   => $request->{item_level_hold},
 622                         reservedate  => $request->{reservedate},
 623                         reservenotes => $request->{reservenotes},
 624                     }
 625                 ];
 626             }
 627         }
 628
 629         if ( $retries-- > 0 && @unallocated && @remaining ) {
 630
 631             # Remove the transport cost of unfilled holds and compact the matrix.
 632             # Also remove the hold request from the array.
 633             for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
 634                 my $u = 0;
 635                 for ( my $j = 0 ; $j < $num_tasks ; $j++ ) {
 636                     if ( $u < scalar(@unallocated) && $unallocated[$u] == $j ) {
 637                         $u++;
 638                     } elsif ( $u > 0 ) {
 639                         $m[$i][ $j - $u ] = $m[$i][$j];
 640                     }
 641                 }
 642             }
 643             for ( my $u = 0 ; $u < scalar(@unallocated) ; $u++ ) {
 644                 splice @requests, $unallocated[$u], 1;
 645             }
 646             $num_tasks = scalar(@requests);
 647
 648             $r = $num_tasks;
 649         } else {
 650             if ( $retries == 0 && @unallocated && @remaining ) {
 651                 Koha::Logger->get->warn(
 652                     "There are available items that have not been allocated and remaining holds, but we abort trying to fill these after $RETRIES retries."
 653                 );
 654             }
 655             last RETRY;
 656         }
 657     }
 658
 659     return \@allocated;
 660 }
 661
 662 =head2 MapItemsToHoldRequests
 663
 664   my $item_map = MapItemsToHoldRequests($hold_requests, $available_items, $branches, $transport_cost_matrix)
 665
 666   Parameters:
 667   $hold_requests is a hash containing hold information built by GetPendingHoldRequestsForBib
 668   $available_items is a hash containing item information built by GetItemsAvailableToFillHoldRequestsForBib
 669   $branches is an arrayref to a list of branches filled by load_branches_to_pull_from
 670   $transport_cost_matrix is a hash of hashes with branchcodes as keys, listing the cost to transfer from that branch to another
 671
 672   Returns a hash of hashes with itemnumbers as keys, each itemnumber containing a hash with the information
 673   about the hold it has been mapped to.
 674
 675   This routine attempts to match the holds in the following priority
 676   1 - If local holds priority is enabled we check all requests to see if local matches can be found
 677   2 - We check for item level matches and fill those
 678   3 - We now loop the remaining requests in priority order attempting to fill with
 679       a - Items where HoldsQueuePrioritizeBranch matches either from items held at the pickup branch, or at the least cost branch (if Transport Cost Matrix is being used)
 680       b - Items where the homebranch of the item and the pickup library match
 681       c - Items from the least cost branch (or items at the pickup location if available)
 682       d - Any item that can fill the hold
 683
 684 =cut
 685
 686 sub MapItemsToHoldRequests {
 687     my ($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix) = @_;
 688
 689     # handle trival cases
 690     return unless scalar(@$hold_requests) > 0;
 691     return unless scalar(@$available_items) > 0;
 692
 693     map { $_->{_object} = Koha::Items->find( $_->{itemnumber} ) } @$available_items;
 694     my $libraries = {};
 695     map { $libraries->{$_->id} = $_ } Koha::Libraries->search->as_list;
 696
 697     # group available items by itemnumber
 698     my %items_by_itemnumber = map { $_->{itemnumber} => $_ } @$available_items;
 699
 700     # items already allocated
 701     my %allocated_items = ();
 702
 703     # map of items to hold requests
 704     my %item_map = ();
 705
 706     # figure out which item-level requests can be filled
 707     my $num_items_remaining = scalar(@$available_items);
 708
 709     # Look for Local Holds Priority matches first
 710     if ( C4::Context->preference('LocalHoldsPriority') ) {
 711         my $LocalHoldsPriorityPatronControl =
 712           C4::Context->preference('LocalHoldsPriorityPatronControl');
 713         my $LocalHoldsPriorityItemControl =
 714           C4::Context->preference('LocalHoldsPriorityItemControl');
 715
 716         foreach my $request (@$hold_requests) {
 717             last if $num_items_remaining == 0;
 718             my $patron = Koha::Patrons->find($request->{borrowernumber});
 719             next if $patron->category->exclude_from_local_holds_priority;
 720
 721             my $local_hold_match;
 722             foreach my $item (@$available_items) {
 723                 next if $item->{_object}->exclude_from_local_holds_priority;
 724
 725                 next unless _can_item_fill_request( $item, $request, $libraries );
 726
 727                 next if $request->{itemnumber} && $request->{itemnumber} != $item->{itemnumber};
 728
 729                 my $local_holds_priority_item_branchcode =
 730                   $item->{$LocalHoldsPriorityItemControl};
 731
 732                 my $local_holds_priority_patron_branchcode =
 733                   ( $LocalHoldsPriorityPatronControl eq 'PickupLibrary' )
 734                   ? $request->{branchcode}
 735                   : ( $LocalHoldsPriorityPatronControl eq 'HomeLibrary' )
 736                   ? $request->{borrowerbranch}
 737                   : undef;
 738
 739                 $local_hold_match =
 740                   $local_holds_priority_item_branchcode eq
 741                   $local_holds_priority_patron_branchcode;
 742
 743                 if ($local_hold_match) {
 744                     if ( exists $items_by_itemnumber{ $item->{itemnumber} }
 745                         and not exists $allocated_items{ $item->{itemnumber} }
 746                         and not $request->{allocated})
 747                     {
 748                         $item_map{ $item->{itemnumber} } = {
 749                             borrowernumber => $request->{borrowernumber},
 750                             biblionumber   => $request->{biblionumber},
 751                             holdingbranch  => $item->{holdingbranch},
 752                             pickup_branch  => $request->{branchcode}
 753                               || $request->{borrowerbranch},
 754                             reserve_id   => $request->{reserve_id},
 755                             item_level   => $request->{item_level_hold},
 756                             reservedate  => $request->{reservedate},
 757                             reservenotes => $request->{reservenotes},
 758                         };
 759                         $allocated_items{ $item->{itemnumber} }++;
 760                         $request->{allocated} = 1;
 761                         $num_items_remaining--;
 762                     }
 763                 }
 764             }
 765         }
 766     }
 767
 768     # Handle item level requests
 769     # Note that we loop the requests in priority order reserving an item for each title level hold
 770     # So we will only fill item level requests if there are enough items to fill higher priority
 771     # title level holds.
 772     foreach my $request (@$hold_requests) {
 773         last if $num_items_remaining == 0;
 774         next if $request->{allocated};
 775
 776         # is this an item-level request?
 777         if (defined($request->{itemnumber})) {
 778             # fill it if possible; if not skip it
 779             if (    exists $items_by_itemnumber{ $request->{itemnumber} }
 780                 and not exists $allocated_items{ $request->{itemnumber} }
 781                 and _can_item_fill_request( $items_by_itemnumber{ $request->{itemnumber} }, $request, $libraries ) )
 782             {
 783
 784                 $item_map{ $request->{itemnumber} } = {
 785                     borrowernumber => $request->{borrowernumber},
 786                     biblionumber   => $request->{biblionumber},
 787                     holdingbranch  => $items_by_itemnumber{ $request->{itemnumber} }->{holdingbranch},
 788                     pickup_branch  => $request->{branchcode} || $request->{borrowerbranch},
 789                     reserve_id     => $request->{reserve_id},
 790                     item_level     => $request->{item_level_hold},
 791                     reservedate    => $request->{reservedate},
 792                     reservenotes   => $request->{reservenotes},
 793                 };
 794                 $allocated_items{ $request->{itemnumber} }++;
 795                 $num_items_remaining--;
 796             }
 797         } else {
 798             # it's title-level request that will take up one item
 799             $num_items_remaining--;
 800         }
 801     }
 802
 803     if ( defined $transport_cost_matrix ) {
 804         my $allocations = _allocateWithTransportCostMatrix(
 805             $hold_requests,         $available_items,  $branches_to_use, $libraries,
 806             $transport_cost_matrix, \%allocated_items, \%items_by_itemnumber
 807         );
 808         for my $allocation (@$allocations) {
 809             $item_map{ $allocation->[0] } = $allocation->[1];
 810             $num_items_remaining--;
 811         }
 812         return \%item_map;
 813     }
 814
 815     # group available items by branch
 816     my %items_by_branch = ();
 817     foreach my $item (@$available_items) {
 818         next unless $item->{holdallowed} ne 'not_allowed';
 819
 820         push @{ $items_by_branch{ $item->{holdingbranch} } }, $item
 821           unless exists $allocated_items{ $item->{itemnumber} };
 822     }
 823     return \%item_map unless keys %items_by_branch;
 824
 825     # now handle the title-level requests
 826     $num_items_remaining = scalar(@$available_items) - scalar(keys %allocated_items);
 827     my $pull_branches;
 828     foreach my $request (@$hold_requests) {
 829         last if $num_items_remaining == 0;
 830         next if $request->{allocated};
 831         next if defined($request->{itemnumber}); # already handled these
 832
 833         # HoldsQueuePrioritizeBranch check
 834         # ********************************
 835         my $pickup_branch = $request->{branchcode} || $request->{borrowerbranch};
 836         my ( $itemnumber, $holdingbranch );    # These variables are used for tracking the filling of the hold
 837                                                # $itemnumber, when set, is the item that has been chosen for the hold
 838             # $holdingbranch gets set to the pickup branch of the request if there are items held at that branch
 839             # otherwise it gets set to the least cost branch of the transport cost matrix
 840             # otherwise it gets sets to the first branch from the list of branches to pull from
 841
 842         my $holding_branch_items = $items_by_branch{$pickup_branch};
 843         if ($holding_branch_items) {
 844             $holdingbranch = $pickup_branch;
 845         }
 846
 847         my $priority_branch = C4::Context->preference('HoldsQueuePrioritizeBranch') // 'homebranch';
 848         foreach my $item (@$holding_branch_items) {
 849             if ( _can_item_fill_request( $item, $request, $libraries )
 850                 && $request->{borrowerbranch} eq $item->{$priority_branch} )
 851             {
 852                 $itemnumber = $item->{itemnumber};
 853                 last;
 854             }
 855         }
 856         # End HoldsQueuePrioritizeBranch check
 857         # ********************************
 858
 859
 860         # Not found yet, fall back to basics
 861         unless ($itemnumber) {
 862             if ($branches_to_use) {
 863                 $pull_branches = $branches_to_use;
 864             } else {
 865                 $pull_branches = [keys %items_by_branch];
 866             }
 867             $holdingbranch ||= $pull_branches->[0];    # We set this as the first from the list of pull branches
 868                  # unless we set it above to the pickupbranch or the least cost branch
 869                  # FIXME: The intention is to follow StaticHoldsQueueWeight, but we don't check that pref
 870
 871             # Try picking items where the home and pickup branch match first
 872             foreach my $branch (@$pull_branches) {
 873                 my $holding_branch_items = $items_by_branch{$branch}
 874                     or next;
 875
 876                 foreach my $item (@$holding_branch_items) {
 877                     if ( $pickup_branch eq $item->{homebranch}
 878                         && _can_item_fill_request( $item, $request, $libraries ) )
 879                     {
 880                         $itemnumber    = $item->{itemnumber};
 881                         $holdingbranch = $branch;
 882                         last;
 883                     }
 884                 }
 885                 last if $itemnumber;
 886             }
 887
 888             # Now try items from the least cost branch based on the transport cost matrix or StaticHoldsQueueWeight
 889             unless ( $itemnumber || !$holdingbranch) {
 890                 foreach my $current_item ( @{ $items_by_branch{$holdingbranch} } ) {
 891                     next unless _can_item_fill_request( $current_item, $request, $libraries );
 892
 893                     $itemnumber = $current_item->{itemnumber};
 894                     last; # quit this loop as soon as we have a suitable item
 895                 }
 896             }
 897
 898             # Now try for items for any item that can fill this hold
 899             unless ( $itemnumber ) {
 900                 foreach my $branch (@$pull_branches) {
 901                     my $holding_branch_items = $items_by_branch{$branch}
 902                       or next;
 903
 904                     foreach my $item (@$holding_branch_items) {
 905                         if( _can_item_fill_request( $item, $request, $libraries ) ){
 906                             $itemnumber = $item->{itemnumber};
 907                             $holdingbranch = $branch;
 908                             last;
 909                         }
 910                     }
 911                     last if $itemnumber;
 912                 }
 913             }
 914         }
 915
 916         if ($itemnumber) {
 917             my $holding_branch_items = $items_by_branch{$holdingbranch}
 918               or die "Have $itemnumber, $holdingbranch, but no items!";
 919             @$holding_branch_items = grep { $_->{itemnumber} != $itemnumber } @$holding_branch_items;
 920             delete $items_by_branch{$holdingbranch} unless @$holding_branch_items;
 921
 922             $item_map{$itemnumber} = {
 923                 borrowernumber => $request->{borrowernumber},
 924                 biblionumber => $request->{biblionumber},
 925                 holdingbranch => $holdingbranch,
 926                 pickup_branch => $pickup_branch,
 927                 reserve_id => $request->{reserve_id},
 928                 item_level => $request->{item_level_hold},
 929                 reservedate => $request->{reservedate},
 930                 reservenotes => $request->{reservenotes},
 931             };
 932             $num_items_remaining--;
 933         }
 934     }
 935     return \%item_map;
 936 }
 937
 938
 939 =head2 _can_item_fill_request
 940
 941   my $bool = _can_item_fill_request( $item, $request, $libraries );
 942
 943   This is an internal function of MapItemsToHoldRequests for checking an item against a hold. It uses the custom hashes for item and hold information
 944   used by that routine
 945
 946 =cut
 947
 948 sub _can_item_fill_request {
 949     my ( $item, $request, $libraries ) = @_;
 950
 951     # Don't fill item level holds that contravene the hold pickup policy at this time
 952     return unless _checkHoldPolicy( $item, $request );
 953
 954     # If hold itemtype is set, item's itemtype must match
 955     return unless ( !$request->{itemtype}
 956         || $item->{itype} eq $request->{itemtype} );
 957
 958     # If hold item_group is set, item's item_group must match
 959     return
 960         unless (
 961         !$request->{item_group_id}
 962         || (   $item->{_object}->item_group
 963             && $item->{_object}->item_group->id eq $request->{item_group_id} )
 964         );
 965
 966     return
 967         unless $item->{_object}->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );
 968
 969     return 1;
 970 }
 971
 972
 973
 974 =head2 CreatePickListFromItemMap
 975
 976 =cut
 977
 978 sub CreatePicklistFromItemMap {
 979     my $item_map = shift;
 980
 981     my $dbh = C4::Context->dbh;
 982
 983     my $sth_load=$dbh->prepare("
 984         INSERT INTO tmp_holdsqueue (biblionumber,itemnumber,barcode,surname,firstname,phone,borrowernumber,
 985                                     cardnumber,reservedate,title, itemcallnumber,
 986                                     holdingbranch,pickbranch,notes, item_level_request)
 987         VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
 988     ");
 989
 990     foreach my $itemnumber  (sort keys %$item_map) {
 991         my $mapped_item = $item_map->{$itemnumber};
 992         my $biblionumber = $mapped_item->{biblionumber};
 993         my $borrowernumber = $mapped_item->{borrowernumber};
 994         my $pickbranch = $mapped_item->{pickup_branch};
 995         my $holdingbranch = $mapped_item->{holdingbranch};
 996         my $reservedate = $mapped_item->{reservedate};
 997         my $reservenotes = $mapped_item->{reservenotes};
 998         my $item_level = $mapped_item->{item_level};
 999
1000         my $item = Koha::Items->find($itemnumber);
1001         my $barcode = $item->barcode;
1002         my $itemcallnumber = $item->itemcallnumber;
1003
1004         my $patron = Koha::Patrons->find( $borrowernumber );
1005         my $cardnumber = $patron->cardnumber;
1006         my $surname = $patron->surname;
1007         my $firstname = $patron->firstname;
1008         my $phone = $patron->phone;
1009
1010         my $biblio = Koha::Biblios->find( $biblionumber );
1011         my $title = $biblio->title;
1012
1013         $sth_load->execute($biblionumber, $itemnumber, $barcode, $surname, $firstname, $phone, $borrowernumber,
1014                            $cardnumber, $reservedate, $title, $itemcallnumber,
1015                            $holdingbranch, $pickbranch, $reservenotes, $item_level);
1016     }
1017 }
1018
1019 =head2 AddToHoldTargetMap
1020
1021 =cut
1022
1023 sub AddToHoldTargetMap {
1024     my $item_map = shift;
1025
1026     my $dbh    = C4::Context->dbh;
1027     my $schema = Koha::Database->new->schema;
1028
1029     my $insert_sql = q(
1030         INSERT INTO hold_fill_targets (borrowernumber, biblionumber, itemnumber, source_branchcode, item_level_request, reserve_id) VALUES (?, ?, ?, ?, ?, ?)
1031     );
1032     my $sth_insert = $dbh->prepare($insert_sql);
1033
1034     foreach my $itemnumber ( keys %$item_map ) {
1035         my $mapped_item = $item_map->{$itemnumber};
1036         $schema->txn_do(
1037             sub {
1038                 $dbh->do( 'DELETE FROM hold_fill_targets WHERE itemnumber = ?', {}, $itemnumber );
1039                 $sth_insert->execute(
1040                     $mapped_item->{borrowernumber}, $mapped_item->{biblionumber}, $itemnumber,
1041                     $mapped_item->{holdingbranch},  $mapped_item->{item_level},   $mapped_item->{reserve_id}
1042                 );
1043             }
1044         );
1045     }
1046 }
1047
1048 # Helper functions, not part of any interface
1049
1050 sub _trim {
1051     return $_[0] unless $_[0];
1052     $_[0] =~ s/^\s+//;
1053     $_[0] =~ s/\s+$//;
1054     $_[0];
1055 }
1056
1057 sub load_branches_to_pull_from {
1058     my $use_transport_cost_matrix = shift;
1059
1060     my @branches_to_use;
1061
1062     unless ( $use_transport_cost_matrix ) {
1063         my $static_branch_list = C4::Context->preference("StaticHoldsQueueWeight");
1064         @branches_to_use = map { _trim($_) } split( /,/, $static_branch_list )
1065           if $static_branch_list;
1066     }
1067
1068     @branches_to_use =
1069       Koha::Database->new()->schema()->resultset('Branch')
1070       ->get_column('branchcode')->all()
1071       unless (@branches_to_use);
1072
1073     @branches_to_use = shuffle(@branches_to_use)
1074       if C4::Context->preference("RandomizeHoldsQueueWeight");
1075
1076     my $today = dt_from_string();
1077     if ( C4::Context->preference('HoldsQueueSkipClosed') ) {
1078         @branches_to_use = grep {
1079             !Koha::Calendar->new( branchcode => $_ )
1080               ->is_holiday( $today )
1081         } @branches_to_use;
1082     }
1083
1084     return \@branches_to_use;
1085 }
1086
1087 sub least_cost_branch {
1088
1089     #$from - arrayref
1090     my ($to, $from, $transport_cost_matrix) = @_;
1091
1092     # Nothing really spectacular: supply to branch, a list of potential from branches
1093     # and find the minimum from - to value from the transport_cost_matrix
1094     return $from->[0] if ( @$from == 1 && $transport_cost_matrix->{$to}{$from->[0]}->{disable_transfer} != 1 );
1095
1096     # If the pickup library is in the list of libraries to pull from,
1097     # return that library right away, it is obviously the least costly
1098     return ($to) if any { $_ eq $to } @$from;
1099
1100     my ($least_cost, @branch);
1101     foreach (@$from) {
1102         my $cell = $transport_cost_matrix->{$to}{$_};
1103         next if $cell->{disable_transfer};
1104
1105         my $cost = $cell->{cost};
1106         next unless defined $cost; # XXX should this be reported?
1107
1108         unless (defined $least_cost) {
1109             $least_cost = $cost;
1110             push @branch, $_;
1111             next;
1112         }
1113
1114         next if $cost > $least_cost;
1115
1116         if ($cost == $least_cost) {
1117             push @branch, $_;
1118             next;
1119         }
1120
1121         @branch = ($_);
1122         $least_cost = $cost;
1123     }
1124
1125     return $branch[0];
1126
1127     # XXX return a random @branch with minimum cost instead of the first one;
1128     # return $branch[0] if @branch == 1;
1129 }
1130
1131 =head3 update_queue_for_biblio
1132
1133     my $result = update_queue_for_biblio(
1134         {
1135             biblio_id             => $biblio_id,
1136           [ branches_to_use       => $branches_to_use,
1137             transport_cost_matrix => $transport_cost_matrix,
1138             delete                => $delete,
1139             unallocated           => $unallocated, ]
1140         }
1141     );
1142
1143 Given a I<biblio_id>, this method calculates and sets the holds queue entries
1144 for the biblio's holds, and the hold fill targets (items).
1145
1146 =head4 Return value
1147
1148 It return a hashref containing:
1149
1150 =over
1151
1152 =item I<requests>: the pending holds count for the biblio.
1153
1154 =item I<available_items> the count of items that are available to fill holds for the biblio.
1155
1156 =item I<mapped_items> the total items that got mapped.
1157
1158 =back
1159
1160 =head4 Optional parameters
1161
1162 =over
1163
1164 =item I<branches_to_use> a list of branchcodes to be used to restrict which items can be used.
1165
1166 =item I<transport_cost_matrix> is the output of C<TransportCostMatrix>.
1167
1168 =item I<delete> tells the method to delete prior entries on the related tables for the biblio_id.
1169
1170 =item I<unallocated> tells the method to limit the holds to those not in the holds queue, should not
1171     be passed at the same time as delete.
1172
1173 =back
1174
1175 Note: All the optional parameters will be calculated in the method if omitted. They
1176 are allowed to be passed to avoid calculating them many times inside loops.
1177
1178 =cut
1179
1180 sub update_queue_for_biblio {
1181     my ($args) = @_;
1182     my $biblio_id = $args->{biblio_id};
1183     my $result;
1184
1185     # We need to empty the queue for this biblio unless CreateQueue has emptied the entire queue for rebuilding
1186     if ( $args->{delete} ) {
1187         my $dbh = C4::Context->dbh;
1188
1189         $dbh->do("DELETE FROM tmp_holdsqueue WHERE biblionumber=$biblio_id");
1190         $dbh->do("DELETE FROM hold_fill_targets WHERE biblionumber=$biblio_id");
1191     }
1192
1193     my $hold_requests   = GetPendingHoldRequestsForBib({ biblionumber => $biblio_id, unallocated => $args->{unallocated} });
1194     $result->{requests} = scalar( @{$hold_requests} );
1195     # No need to check anything else if there are no holds to fill
1196     return $result unless $result->{requests};
1197
1198     my $branches_to_use = $args->{branches_to_use} // load_branches_to_pull_from( C4::Context->preference('UseTransportCostMatrix') );
1199     my $transport_cost_matrix;
1200
1201     if ( !exists $args->{transport_cost_matrix}
1202         && C4::Context->preference('UseTransportCostMatrix') ) {
1203         $transport_cost_matrix = TransportCostMatrix();
1204     } else {
1205         $transport_cost_matrix = $args->{transport_cost_matrix};
1206     }
1207
1208     my $available_items = GetItemsAvailableToFillHoldRequestsForBib( $biblio_id, $branches_to_use );
1209
1210     $result->{available_items}  = scalar( @{$available_items} );
1211
1212     my $item_map = MapItemsToHoldRequests( $hold_requests, $available_items, $branches_to_use, $transport_cost_matrix );
1213     $result->{mapped_items} = scalar( keys %{$item_map} );
1214
1215     if ($item_map) {
1216         CreatePicklistFromItemMap($item_map);
1217         AddToHoldTargetMap($item_map);
1218     }
1219
1220     return $result;
1221 }
1222
1223 1;