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::Items;
  29 use Koha::Patrons;
  30 use Koha::Libraries;
  31
  32 use List::Util qw( shuffle );
  33 use List::MoreUtils qw( any );
  34
  35 our (@ISA, @EXPORT_OK);
  36 BEGIN {
  37     require Exporter;
  38     @ISA = qw(Exporter);
  39     @EXPORT_OK = qw(
  40         CreateQueue
  41         GetHoldsQueueItems
  42
  43         TransportCostMatrix
  44         UpdateTransportCostMatrix
  45         GetPendingHoldRequestsForBib
  46         load_branches_to_pull_from
  47         update_queue_for_biblio
  48      );
  49 }
  50
  51
  52 =head1 FUNCTIONS
  53
  54 =head2 TransportCostMatrix
  55
  56   TransportCostMatrix();
  57
  58 Returns Transport Cost Matrix as a hashref <to branch code> => <from branch code> => cost
  59
  60 =cut
  61
  62 sub TransportCostMatrix {
  63     my ( $params ) = @_;
  64
  65     my $dbh   = C4::Context->dbh;
  66     my $transport_costs = $dbh->selectall_arrayref("SELECT * FROM transport_cost",{ Slice => {} });
  67
  68     my $today = dt_from_string();
  69     my %transport_cost_matrix;
  70     foreach (@$transport_costs) {
  71         my $from     = $_->{frombranch};
  72         my $to       = $_->{tobranch};
  73         my $cost     = $_->{cost};
  74         my $disabled = $_->{disable_transfer};
  75         $transport_cost_matrix{$to}{$from} = {
  76             cost             => $cost,
  77             disable_transfer => $disabled
  78         };
  79     }
  80
  81     return \%transport_cost_matrix;
  82 }
  83
  84 =head2 UpdateTransportCostMatrix
  85
  86   UpdateTransportCostMatrix($records);
  87
  88 Updates full Transport Cost Matrix table. $records is an arrayref of records.
  89 Records: { frombranch => <code>, tobranch => <code>, cost => <figure>, disable_transfer => <0,1> }
  90
  91 =cut
  92
  93 sub UpdateTransportCostMatrix {
  94     my ($records) = @_;
  95     my $dbh   = C4::Context->dbh;
  96
  97     my $sth = $dbh->prepare("INSERT INTO transport_cost (frombranch, tobranch, cost, disable_transfer) VALUES (?, ?, ?, ?)");
  98
  99     $dbh->do("DELETE FROM transport_cost");
 100     foreach (@$records) {
 101         my $cost = $_->{cost};
 102         my $from = $_->{frombranch};
 103         my $to = $_->{tobranch};
 104         if ($_->{disable_transfer}) {
 105             $cost ||= 0;
 106         }
 107         elsif ( !defined ($cost) || ($cost !~ m/(0|[1-9][0-9]*)(\.[0-9]*)?/o) ) {
 108             warn  "Invalid $from -> $to cost $cost - must be a number >= 0, disabling";
 109             $cost = 0;
 110             $_->{disable_transfer} = 1;
 111         }
 112         $sth->execute( $from, $to, $cost, $_->{disable_transfer} ? 1 : 0 );
 113     }
 114 }
 115
 116 =head2 GetHoldsQueueItems
 117
 118   GetHoldsQueueItems({ branchlimit => $branch, itemtypeslimit =>  $itype, ccodeslimit => $ccode, locationslimit => $location );
 119
 120 Returns hold queue for a holding branch. If branch is omitted, then whole queue is returned
 121
 122 =cut
 123
 124 sub GetHoldsQueueItems {
 125     my $params = shift;
 126     my $dbh   = C4::Context->dbh;
 127
 128     my @bind_params = ();
 129     my $query = q/SELECT tmp_holdsqueue.*, biblio.author, items.ccode, items.itype, biblioitems.itemtype, items.location,
 130                          items.enumchron, items.cn_sort, biblioitems.publishercode,
 131                          biblio.copyrightdate, biblio.subtitle, biblio.medium,
 132                          biblio.part_number, biblio.part_name,
 133                          biblioitems.publicationyear, biblioitems.pages, biblioitems.size,
 134                          biblioitems.isbn, biblioitems.editionstatement, items.copynumber
 135                   FROM tmp_holdsqueue
 136                        JOIN biblio      USING (biblionumber)
 137                   LEFT JOIN biblioitems USING (biblionumber)
 138                   LEFT JOIN items       USING (  itemnumber)
 139                   WHERE 1=1
 140                 /;
 141     if ($params->{branchlimit}) {
 142         $query .="AND tmp_holdsqueue.holdingbranch = ? ";
 143         push @bind_params, $params->{branchlimit};
 144     }
 145     if( $params->{itemtypeslimit} ) {
 146         $query .=" AND items.itype = ? ";
 147         push @bind_params, $params->{itemtypeslimit};
 148     }
 149     if( $params->{ccodeslimit} ) {
 150         $query .=" AND items.ccode = ? ";
 151         push @bind_params, $params->{ccodeslimit};
 152     }
 153     if( $params->{locationslimit} ) {
 154         $query .=" AND items.location = ? ";
 155         push @bind_params, $params->{locationslimit};
 156     }
 157     $query .= " ORDER BY ccode, location, cn_sort, author, title, pickbranch, reservedate";
 158     my $sth = $dbh->prepare($query);
 159     $sth->execute(@bind_params);
 160     my $items = [];
 161     while ( my $row = $sth->fetchrow_hashref ){
 162         # return the bib-level or item-level itype per syspref
 163         if (!C4::Context->preference('item-level_itypes')) {
 164             $row->{itype} = $row->{itemtype};
 165         }
 166         delete $row->{itemtype};
 167
 168         push @$items, $row;
 169     }
 170     return $items;
 171 }
 172
 173 =head2 CreateQueue
 174
 175   CreateQueue();
 176
 177 Top level function that turns reserves into tmp_holdsqueue and hold_fill_targets.
 178
 179 =cut
 180
 181 sub CreateQueue {
 182     my $dbh   = C4::Context->dbh;
 183
 184     $dbh->do("DELETE FROM tmp_holdsqueue");  # clear the old table for new info
 185     $dbh->do("DELETE FROM hold_fill_targets");
 186
 187     my $total_bibs            = 0;
 188     my $total_requests        = 0;
 189     my $total_available_items = 0;
 190     my $num_items_mapped      = 0;
 191
 192     my $branches_to_use;
 193     my $transport_cost_matrix;
 194     my $use_transport_cost_matrix = C4::Context->preference("UseTransportCostMatrix");
 195     if ($use_transport_cost_matrix) {
 196         $transport_cost_matrix = TransportCostMatrix();
 197         unless (keys %$transport_cost_matrix) {
 198             warn "UseTransportCostMatrix set to yes, but matrix not populated";
 199             undef $transport_cost_matrix;
 200         }
 201     }
 202
 203     $branches_to_use = load_branches_to_pull_from($use_transport_cost_matrix);
 204
 205     my $bibs_with_pending_requests = GetBibsWithPendingHoldRequests();
 206
 207     foreach my $biblionumber (@$bibs_with_pending_requests) {
 208
 209         $total_bibs++;
 210
 211         my $result = update_queue_for_biblio(
 212             {   biblio_id             => $biblionumber,
 213                 branches_to_use       => $branches_to_use,
 214                 transport_cost_matrix => $transport_cost_matrix,
 215             }
 216         );
 217
 218         $total_requests        += $result->{requests};
 219         $total_available_items += $result->{available_items};
 220         $num_items_mapped      += $result->{mapped_items};
 221     }
 222 }
 223
 224 =head2 GetBibsWithPendingHoldRequests
 225
 226   my $biblionumber_aref = GetBibsWithPendingHoldRequests();
 227
 228 Return an arrayref of the biblionumbers of all bibs
 229 that have one or more unfilled hold requests.
 230
 231 =cut
 232
 233 sub GetBibsWithPendingHoldRequests {
 234     my $dbh = C4::Context->dbh;
 235
 236     my $bib_query = "SELECT DISTINCT biblionumber
 237                      FROM reserves
 238                      WHERE found IS NULL
 239                      AND priority > 0
 240                      AND reservedate <= CURRENT_DATE()
 241                      AND suspend = 0
 242                      ";
 243     my $sth = $dbh->prepare($bib_query);
 244
 245     $sth->execute();
 246     my $biblionumbers = $sth->fetchall_arrayref();
 247
 248     return [ map { $_->[0] } @$biblionumbers ];
 249 }
 250
 251 =head2 GetPendingHoldRequestsForBib
 252
 253   my $requests = GetPendingHoldRequestsForBib($biblionumber);
 254
 255 Returns an arrayref of hashrefs to pending, unfilled hold requests
 256 on the bib identified by $biblionumber.  The following keys
 257 are present in each hashref:
 258
 259     biblionumber
 260     borrowernumber
 261     itemnumber
 262     priority
 263     branchcode
 264     reservedate
 265     reservenotes
 266     borrowerbranch
 267
 268 The arrayref is sorted in order of increasing priority.
 269
 270 =cut
 271
 272 sub GetPendingHoldRequestsForBib {
 273     my $biblionumber = shift;
 274
 275     my $dbh = C4::Context->dbh;
 276
 277     my $request_query = "SELECT biblionumber, borrowernumber, itemnumber, priority, reserve_id, reserves.branchcode,
 278                                 reservedate, reservenotes, borrowers.branchcode AS borrowerbranch, itemtype, item_level_hold
 279                          FROM reserves
 280                          JOIN borrowers USING (borrowernumber)
 281                          WHERE biblionumber = ?
 282                          AND found IS NULL
 283                          AND priority > 0
 284                          AND reservedate <= CURRENT_DATE()
 285                          AND suspend = 0
 286                          ORDER BY priority";
 287     my $sth = $dbh->prepare($request_query);
 288     $sth->execute($biblionumber);
 289
 290     my $requests = $sth->fetchall_arrayref({});
 291     return $requests;
 292
 293 }
 294
 295 =head2 GetItemsAvailableToFillHoldRequestsForBib
 296
 297   my $available_items = GetItemsAvailableToFillHoldRequestsForBib($biblionumber, $branches_ar);
 298
 299 Returns an arrayref of items available to fill hold requests
 300 for the bib identified by C<$biblionumber>.  An item is available
 301 to fill a hold request if and only if:
 302
 303     * it is not on loan
 304     * it is not withdrawn
 305     * it is not marked notforloan
 306     * it is not currently in transit
 307     * it is not lost
 308     * it is not sitting on the hold shelf
 309     * it is not damaged (unless AllowHoldsOnDamagedItems is on)
 310
 311 =cut
 312
 313 sub GetItemsAvailableToFillHoldRequestsForBib {
 314     my ($biblionumber, $branches_to_use) = @_;
 315
 316     my $dbh = C4::Context->dbh;
 317     my $items_query = "SELECT items.itemnumber, homebranch, holdingbranch, itemtypes.itemtype AS itype
 318                        FROM items ";
 319
 320     if (C4::Context->preference('item-level_itypes')) {
 321         $items_query .=   "LEFT JOIN itemtypes ON (itemtypes.itemtype = items.itype) ";
 322     } else {
 323         $items_query .=   "JOIN biblioitems USING (biblioitemnumber)
 324                            LEFT JOIN itemtypes USING (itemtype) ";
 325     }
 326     $items_query .=  " LEFT JOIN branchtransfers ON (items.itemnumber = branchtransfers.itemnumber)";
 327     $items_query .=  " WHERE items.notforloan = 0
 328                        AND holdingbranch IS NOT NULL
 329                        AND itemlost = 0
 330                        AND withdrawn = 0";
 331     $items_query .= "  AND branchtransfers.datearrived IS NULL
 332                        AND branchtransfers.datecancelled IS NULL";
 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.biblionumber = ?";
 344
 345     my @params = ($biblionumber, $biblionumber);
 346     if ($branches_to_use && @$branches_to_use) {
 347         $items_query .= " AND holdingbranch IN (" . join (",", map { "?" } @$branches_to_use) . ")";
 348         push @params, @$branches_to_use;
 349     }
 350     my $sth = $dbh->prepare($items_query);
 351     $sth->execute(@params);
 352
 353     my $itm = $sth->fetchall_arrayref({});
 354     return [ grep {
 355         my $rule = C4::Circulation::GetBranchItemRule($_->{homebranch}, $_->{itype});
 356         $_->{holdallowed} = $rule->{holdallowed};
 357         $_->{hold_fulfillment_policy} = $rule->{hold_fulfillment_policy};
 358     } @{$itm} ];
 359 }
 360
 361 =head2 _checkHoldPolicy
 362
 363     _checkHoldPolicy($item, $request)
 364
 365     check if item agrees with hold policies
 366
 367 =cut
 368
 369 sub _checkHoldPolicy {
 370     my ( $item, $request ) = @_;
 371
 372     return 0 unless $item->{holdallowed} ne 'not_allowed';
 373
 374     return 0
 375       if $item->{holdallowed} eq 'from_home_library'
 376       && $item->{homebranch} ne $request->{borrowerbranch};
 377
 378     return 0
 379       if $item->{'holdallowed'} eq 'from_local_hold_group'
 380       && !Koha::Libraries->find( $item->{homebranch} )
 381               ->validate_hold_sibling( { branchcode => $request->{borrowerbranch} } );
 382
 383     my $hold_fulfillment_policy = $item->{hold_fulfillment_policy};
 384
 385     return 0
 386       if $hold_fulfillment_policy eq 'holdgroup'
 387       && !Koha::Libraries->find( $item->{homebranch} )
 388             ->validate_hold_sibling( { branchcode => $request->{branchcode} } );
 389
 390     return 0
 391       if $hold_fulfillment_policy eq 'homebranch'
 392       && $request->{branchcode} ne $item->{$hold_fulfillment_policy};
 393
 394     return 0
 395       if $hold_fulfillment_policy eq 'holdingbranch'
 396       && $request->{branchcode} ne $item->{$hold_fulfillment_policy};
 397
 398     return 0
 399       if $hold_fulfillment_policy eq 'patrongroup'
 400       && !Koha::Libraries->find( $request->{borrowerbranch} )
 401               ->validate_hold_sibling( { branchcode => $request->{branchcode} } );
 402
 403     return 1;
 404
 405 }
 406
 407 =head2 MapItemsToHoldRequests
 408
 409   MapItemsToHoldRequests($hold_requests, $available_items, $branches, $transport_cost_matrix)
 410
 411 =cut
 412
 413 sub MapItemsToHoldRequests {
 414     my ($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix) = @_;
 415
 416     # handle trival cases
 417     return unless scalar(@$hold_requests) > 0;
 418     return unless scalar(@$available_items) > 0;
 419
 420     # identify item-level requests
 421     my %specific_items_requested = map { $_->{itemnumber} => 1 }
 422                                    grep { defined($_->{itemnumber}) }
 423                                    @$hold_requests;
 424
 425     map { $_->{_object} = Koha::Items->find( $_->{itemnumber} ) } @$available_items;
 426     my $libraries = {};
 427     map { $libraries->{$_->id} = $_ } Koha::Libraries->search->as_list;
 428
 429     # group available items by itemnumber
 430     my %items_by_itemnumber = map { $_->{itemnumber} => $_ } @$available_items;
 431
 432     # items already allocated
 433     my %allocated_items = ();
 434
 435     # map of items to hold requests
 436     my %item_map = ();
 437
 438     # figure out which item-level requests can be filled
 439     my $num_items_remaining = scalar(@$available_items);
 440
 441     # Look for Local Holds Priority matches first
 442     if ( C4::Context->preference('LocalHoldsPriority') ) {
 443         my $LocalHoldsPriorityPatronControl =
 444           C4::Context->preference('LocalHoldsPriorityPatronControl');
 445         my $LocalHoldsPriorityItemControl =
 446           C4::Context->preference('LocalHoldsPriorityItemControl');
 447
 448         foreach my $request (@$hold_requests) {
 449             last if $num_items_remaining == 0;
 450             my $patron = Koha::Patrons->find($request->{borrowernumber});
 451             next if $patron->category->exclude_from_local_holds_priority;
 452
 453             my $local_hold_match;
 454             foreach my $item (@$available_items) {
 455                 next if $item->{_object}->exclude_from_local_holds_priority;
 456
 457                 next unless _checkHoldPolicy($item, $request);
 458
 459                 next if $request->{itemnumber} && $request->{itemnumber} != $item->{itemnumber};
 460
 461                 next unless $item->{_object}->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );
 462
 463                 my $local_holds_priority_item_branchcode =
 464                   $item->{$LocalHoldsPriorityItemControl};
 465
 466                 my $local_holds_priority_patron_branchcode =
 467                   ( $LocalHoldsPriorityPatronControl eq 'PickupLibrary' )
 468                   ? $request->{branchcode}
 469                   : ( $LocalHoldsPriorityPatronControl eq 'HomeLibrary' )
 470                   ? $request->{borrowerbranch}
 471                   : undef;
 472
 473                 $local_hold_match =
 474                   $local_holds_priority_item_branchcode eq
 475                   $local_holds_priority_patron_branchcode;
 476
 477                 if ($local_hold_match) {
 478                     if ( exists $items_by_itemnumber{ $item->{itemnumber} }
 479                         and not exists $allocated_items{ $item->{itemnumber} }
 480                         and not $request->{allocated})
 481                     {
 482                         $item_map{ $item->{itemnumber} } = {
 483                             borrowernumber => $request->{borrowernumber},
 484                             biblionumber   => $request->{biblionumber},
 485                             holdingbranch  => $item->{holdingbranch},
 486                             pickup_branch  => $request->{branchcode}
 487                               || $request->{borrowerbranch},
 488                             reserve_id   => $request->{reserve_id},
 489                             item_level   => $request->{item_level_hold},
 490                             reservedate  => $request->{reservedate},
 491                             reservenotes => $request->{reservenotes},
 492                         };
 493                         $allocated_items{ $item->{itemnumber} }++;
 494                         $request->{allocated} = 1;
 495                         $num_items_remaining--;
 496                     }
 497                 }
 498             }
 499         }
 500     }
 501
 502     foreach my $request (@$hold_requests) {
 503         last if $num_items_remaining == 0;
 504         next if $request->{allocated};
 505
 506         # is this an item-level request?
 507         if (defined($request->{itemnumber})) {
 508             # fill it if possible; if not skip it
 509             if (
 510                     exists $items_by_itemnumber{ $request->{itemnumber} }
 511                 and not exists $allocated_items{ $request->{itemnumber} }
 512                 and  _checkHoldPolicy($items_by_itemnumber{ $request->{itemnumber} }, $request) # Don't fill item level holds that contravene the hold pickup policy at this time
 513                 and ( !$request->{itemtype} # If hold itemtype is set, item's itemtype must match
 514                     || $items_by_itemnumber{ $request->{itemnumber} }->{itype} eq $request->{itemtype} )
 515
 516                 and $items_by_itemnumber{ $request->{itemnumber} }->{_object}->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } )
 517
 518               )
 519             {
 520
 521                 $item_map{ $request->{itemnumber} } = {
 522                     borrowernumber => $request->{borrowernumber},
 523                     biblionumber   => $request->{biblionumber},
 524                     holdingbranch  => $items_by_itemnumber{ $request->{itemnumber} }->{holdingbranch},
 525                     pickup_branch  => $request->{branchcode} || $request->{borrowerbranch},
 526                     reserve_id     => $request->{reserve_id},
 527                     item_level     => $request->{item_level_hold},
 528                     reservedate    => $request->{reservedate},
 529                     reservenotes   => $request->{reservenotes},
 530                 };
 531                 $allocated_items{ $request->{itemnumber} }++;
 532                 $num_items_remaining--;
 533             }
 534         } else {
 535             # it's title-level request that will take up one item
 536             $num_items_remaining--;
 537         }
 538     }
 539
 540     # group available items by branch
 541     my %items_by_branch = ();
 542     foreach my $item (@$available_items) {
 543         next unless $item->{holdallowed} ne 'not_allowed';
 544
 545         push @{ $items_by_branch{ $item->{holdingbranch} } }, $item
 546           unless exists $allocated_items{ $item->{itemnumber} };
 547     }
 548     return \%item_map unless keys %items_by_branch;
 549
 550     # now handle the title-level requests
 551     $num_items_remaining = scalar(@$available_items) - scalar(keys %allocated_items);
 552     my $pull_branches;
 553     foreach my $request (@$hold_requests) {
 554         last if $num_items_remaining == 0;
 555         next if $request->{allocated};
 556         next if defined($request->{itemnumber}); # already handled these
 557
 558         # look for local match first
 559         my $pickup_branch = $request->{branchcode} || $request->{borrowerbranch};
 560         my ($itemnumber, $holdingbranch);
 561
 562         my $holding_branch_items = $items_by_branch{$pickup_branch};
 563         if ( $holding_branch_items ) {
 564             foreach my $item (@$holding_branch_items) {
 565                 next unless $items_by_itemnumber{ $item->{itemnumber} }->{_object}->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );
 566
 567                 if (
 568                     $request->{borrowerbranch} eq $item->{homebranch}
 569                     && _checkHoldPolicy($item, $request) # Don't fill item level holds that contravene the hold pickup policy at this time
 570                     && ( !$request->{itemtype} # If hold itemtype is set, item's itemtype must match
 571                         || ( $request->{itemnumber} && ( $items_by_itemnumber{ $request->{itemnumber} }->{itype} eq $request->{itemtype} ) ) )
 572                   )
 573                 {
 574                     $itemnumber = $item->{itemnumber};
 575                     last;
 576                 }
 577             }
 578             $holdingbranch = $pickup_branch;
 579         }
 580         elsif ($transport_cost_matrix) {
 581             $pull_branches = [keys %items_by_branch];
 582             $holdingbranch = least_cost_branch( $pickup_branch, $pull_branches, $transport_cost_matrix );
 583             if ( $holdingbranch ) {
 584
 585                 my $holding_branch_items = $items_by_branch{$holdingbranch};
 586                 foreach my $item (@$holding_branch_items) {
 587                     next if $request->{borrowerbranch} ne $item->{homebranch};
 588                     next unless $items_by_itemnumber{ $item->{itemnumber} }->{_object}->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );
 589
 590                     # Don't fill item level holds that contravene the hold pickup policy at this time
 591                     next unless _checkHoldPolicy($item, $request);
 592
 593                     # If hold itemtype is set, item's itemtype must match
 594                     next unless ( !$request->{itemtype}
 595                         || $item->{itype} eq $request->{itemtype} );
 596
 597                     $itemnumber = $item->{itemnumber};
 598                     last;
 599                 }
 600             }
 601             else {
 602                 next;
 603             }
 604         }
 605
 606         unless ($itemnumber) {
 607             # not found yet, fall back to basics
 608             if ($branches_to_use) {
 609                 $pull_branches = $branches_to_use;
 610             } else {
 611                 $pull_branches = [keys %items_by_branch];
 612             }
 613
 614             # Try picking items where the home and pickup branch match first
 615             PULL_BRANCHES:
 616             foreach my $branch (@$pull_branches) {
 617                 my $holding_branch_items = $items_by_branch{$branch}
 618                   or next;
 619
 620                 $holdingbranch ||= $branch;
 621                 foreach my $item (@$holding_branch_items) {
 622                     next if $pickup_branch ne $item->{homebranch};
 623                     next unless _checkHoldPolicy($item, $request);
 624                     next unless $items_by_itemnumber{ $item->{itemnumber} }->{_object}->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );
 625
 626                     # Don't fill item level holds that contravene the hold pickup policy at this time
 627                     next unless $item->{hold_fulfillment_policy} eq 'any'
 628                         || $request->{branchcode} eq $item->{ $item->{hold_fulfillment_policy} };
 629
 630                     # If hold itemtype is set, item's itemtype must match
 631                     next unless ( !$request->{itemtype}
 632                         || $item->{itype} eq $request->{itemtype} );
 633
 634                     $itemnumber = $item->{itemnumber};
 635                     $holdingbranch = $branch;
 636                     last PULL_BRANCHES;
 637                 }
 638             }
 639
 640             # Now try items from the least cost branch based on the transport cost matrix or StaticHoldsQueueWeight
 641             unless ( $itemnumber || !$holdingbranch) {
 642                 foreach my $current_item ( @{ $items_by_branch{$holdingbranch} } ) {
 643                     next unless _checkHoldPolicy($current_item, $request); # Don't fill item level holds that contravene the hold pickup policy at this time
 644
 645                     # If hold itemtype is set, item's itemtype must match
 646                     next unless ( !$request->{itemtype}
 647                         || $current_item->{itype} eq $request->{itemtype} );
 648
 649                     next unless $items_by_itemnumber{ $current_item->{itemnumber} }->{_object}->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );
 650
 651                     $itemnumber = $current_item->{itemnumber};
 652                     last; # quit this loop as soon as we have a suitable item
 653                 }
 654             }
 655
 656             # Now try for items for any item that can fill this hold
 657             unless ( $itemnumber ) {
 658                 PULL_BRANCHES2:
 659                 foreach my $branch (@$pull_branches) {
 660                     my $holding_branch_items = $items_by_branch{$branch}
 661                       or next;
 662
 663                     foreach my $item (@$holding_branch_items) {
 664                         # Don't fill item level holds that contravene the hold pickup policy at this time
 665                         next unless _checkHoldPolicy($item, $request);
 666
 667                         # If hold itemtype is set, item's itemtype must match
 668                         next unless ( !$request->{itemtype}
 669                             || $item->{itype} eq $request->{itemtype} );
 670
 671                         next unless $items_by_itemnumber{ $item->{itemnumber} }->{_object}->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );
 672
 673                         $itemnumber = $item->{itemnumber};
 674                         $holdingbranch = $branch;
 675                         last PULL_BRANCHES2;
 676                     }
 677                 }
 678             }
 679         }
 680
 681         if ($itemnumber) {
 682             my $holding_branch_items = $items_by_branch{$holdingbranch}
 683               or die "Have $itemnumber, $holdingbranch, but no items!";
 684             @$holding_branch_items = grep { $_->{itemnumber} != $itemnumber } @$holding_branch_items;
 685             delete $items_by_branch{$holdingbranch} unless @$holding_branch_items;
 686
 687             $item_map{$itemnumber} = {
 688                 borrowernumber => $request->{borrowernumber},
 689                 biblionumber => $request->{biblionumber},
 690                 holdingbranch => $holdingbranch,
 691                 pickup_branch => $pickup_branch,
 692                 reserve_id => $request->{reserve_id},
 693                 item_level => $request->{item_level_hold},
 694                 reservedate => $request->{reservedate},
 695                 reservenotes => $request->{reservenotes},
 696             };
 697             $num_items_remaining--;
 698         }
 699     }
 700     return \%item_map;
 701 }
 702
 703 =head2 CreatePickListFromItemMap
 704
 705 =cut
 706
 707 sub CreatePicklistFromItemMap {
 708     my $item_map = shift;
 709
 710     my $dbh = C4::Context->dbh;
 711
 712     my $sth_load=$dbh->prepare("
 713         INSERT INTO tmp_holdsqueue (biblionumber,itemnumber,barcode,surname,firstname,phone,borrowernumber,
 714                                     cardnumber,reservedate,title, itemcallnumber,
 715                                     holdingbranch,pickbranch,notes, item_level_request)
 716         VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
 717     ");
 718
 719     foreach my $itemnumber  (sort keys %$item_map) {
 720         my $mapped_item = $item_map->{$itemnumber};
 721         my $biblionumber = $mapped_item->{biblionumber};
 722         my $borrowernumber = $mapped_item->{borrowernumber};
 723         my $pickbranch = $mapped_item->{pickup_branch};
 724         my $holdingbranch = $mapped_item->{holdingbranch};
 725         my $reservedate = $mapped_item->{reservedate};
 726         my $reservenotes = $mapped_item->{reservenotes};
 727         my $item_level = $mapped_item->{item_level};
 728
 729         my $item = Koha::Items->find($itemnumber);
 730         my $barcode = $item->barcode;
 731         my $itemcallnumber = $item->itemcallnumber;
 732
 733         my $patron = Koha::Patrons->find( $borrowernumber );
 734         my $cardnumber = $patron->cardnumber;
 735         my $surname = $patron->surname;
 736         my $firstname = $patron->firstname;
 737         my $phone = $patron->phone;
 738
 739         my $biblio = Koha::Biblios->find( $biblionumber );
 740         my $title = $biblio->title;
 741
 742         $sth_load->execute($biblionumber, $itemnumber, $barcode, $surname, $firstname, $phone, $borrowernumber,
 743                            $cardnumber, $reservedate, $title, $itemcallnumber,
 744                            $holdingbranch, $pickbranch, $reservenotes, $item_level);
 745     }
 746 }
 747
 748 =head2 AddToHoldTargetMap
 749
 750 =cut
 751
 752 sub AddToHoldTargetMap {
 753     my $item_map = shift;
 754
 755     my $dbh = C4::Context->dbh;
 756
 757     my $insert_sql = q(
 758         INSERT INTO hold_fill_targets (borrowernumber, biblionumber, itemnumber, source_branchcode, item_level_request, reserve_id)
 759                                VALUES (?, ?, ?, ?, ?, ?)
 760     );
 761     my $sth_insert = $dbh->prepare($insert_sql);
 762
 763     foreach my $itemnumber (keys %$item_map) {
 764         my $mapped_item = $item_map->{$itemnumber};
 765         $sth_insert->execute($mapped_item->{borrowernumber}, $mapped_item->{biblionumber}, $itemnumber,
 766                              $mapped_item->{holdingbranch}, $mapped_item->{item_level}, $mapped_item->{reserve_id});
 767     }
 768 }
 769
 770 # Helper functions, not part of any interface
 771
 772 sub _trim {
 773     return $_[0] unless $_[0];
 774     $_[0] =~ s/^\s+//;
 775     $_[0] =~ s/\s+$//;
 776     $_[0];
 777 }
 778
 779 sub load_branches_to_pull_from {
 780     my $use_transport_cost_matrix = shift;
 781
 782     my @branches_to_use;
 783
 784     unless ( $use_transport_cost_matrix ) {
 785         my $static_branch_list = C4::Context->preference("StaticHoldsQueueWeight");
 786         @branches_to_use = map { _trim($_) } split( /,/, $static_branch_list )
 787           if $static_branch_list;
 788     }
 789
 790     @branches_to_use =
 791       Koha::Database->new()->schema()->resultset('Branch')
 792       ->get_column('branchcode')->all()
 793       unless (@branches_to_use);
 794
 795     @branches_to_use = shuffle(@branches_to_use)
 796       if C4::Context->preference("RandomizeHoldsQueueWeight");
 797
 798     my $today = dt_from_string();
 799     if ( C4::Context->preference('HoldsQueueSkipClosed') ) {
 800         @branches_to_use = grep {
 801             !Koha::Calendar->new( branchcode => $_ )
 802               ->is_holiday( $today )
 803         } @branches_to_use;
 804     }
 805
 806     return \@branches_to_use;
 807 }
 808
 809 sub least_cost_branch {
 810
 811     #$from - arrayref
 812     my ($to, $from, $transport_cost_matrix) = @_;
 813
 814     # Nothing really spectacular: supply to branch, a list of potential from branches
 815     # and find the minimum from - to value from the transport_cost_matrix
 816     return $from->[0] if ( @$from == 1 && $transport_cost_matrix->{$to}{$from->[0]}->{disable_transfer} != 1 );
 817
 818     # If the pickup library is in the list of libraries to pull from,
 819     # return that library right away, it is obviously the least costly
 820     return ($to) if any { $_ eq $to } @$from;
 821
 822     my ($least_cost, @branch);
 823     foreach (@$from) {
 824         my $cell = $transport_cost_matrix->{$to}{$_};
 825         next if $cell->{disable_transfer};
 826
 827         my $cost = $cell->{cost};
 828         next unless defined $cost; # XXX should this be reported?
 829
 830         unless (defined $least_cost) {
 831             $least_cost = $cost;
 832             push @branch, $_;
 833             next;
 834         }
 835
 836         next if $cost > $least_cost;
 837
 838         if ($cost == $least_cost) {
 839             push @branch, $_;
 840             next;
 841         }
 842
 843         @branch = ($_);
 844         $least_cost = $cost;
 845     }
 846
 847     return $branch[0];
 848
 849     # XXX return a random @branch with minimum cost instead of the first one;
 850     # return $branch[0] if @branch == 1;
 851 }
 852
 853 =head3 update_queue_for_biblio
 854
 855     my $result = update_queue_for_biblio(
 856         {
 857             biblio_id             => $biblio_id,
 858           [ branches_to_use       => $branches_to_use,
 859             transport_cost_matrix => $transport_cost_matrix,
 860             delete                => $delete, ]
 861         }
 862     );
 863
 864 Given a I<biblio_id>, this method calculates and sets the holds queue entries
 865 for the biblio's holds, and the hold fill targets (items).
 866
 867 =head4 Return value
 868
 869 It return a hashref containing:
 870
 871 =over
 872
 873 =item I<requests>: the pending holds count for the biblio.
 874
 875 =item I<available_items> the count of items that are available to fill holds for the biblio.
 876
 877 =item I<mapped_items> the total items that got mapped.
 878
 879 =back
 880
 881 =head4 Optional parameters
 882
 883 =over
 884
 885 =item I<branches_to_use> a list of branchcodes to be used to restrict which items can be used.
 886
 887 =item I<transport_cost_matrix> is the output of C<TransportCostMatrix>.
 888
 889 =item I<delete> tells the method to delete prior entries on the related tables for the biblio_id.
 890
 891 =back
 892
 893 Note: All the optional parameters will be calculated in the method if omitted. They
 894 are allowed to be passed to avoid calculating them many times inside loops.
 895
 896 =cut
 897
 898 sub update_queue_for_biblio {
 899     my ($args) = @_;
 900
 901     my $biblio_id = $args->{biblio_id};
 902
 903     my $branches_to_use = $args->{branches_to_use} // load_branches_to_pull_from( C4::Context->preference('UseTransportCostMatrix') );
 904     my $transport_cost_matrix;
 905
 906     if ( !exists $args->{transport_cost_matrix}
 907         && C4::Context->preference('UseTransportCostMatrix') ) {
 908         $transport_cost_matrix = TransportCostMatrix();
 909     } else {
 910         $transport_cost_matrix = $args->{transport_cost_matrix};
 911     }
 912
 913     if ( $args->{delete} ) {
 914         my $dbh = C4::Context->dbh;
 915
 916         $dbh->do("DELETE FROM tmp_holdsqueue WHERE biblionumber=$biblio_id");
 917         $dbh->do("DELETE FROM hold_fill_targets WHERE biblionumber=$biblio_id");
 918     }
 919
 920     my $hold_requests   = GetPendingHoldRequestsForBib($biblio_id);
 921     my $available_items = GetItemsAvailableToFillHoldRequestsForBib( $biblio_id, $branches_to_use );
 922
 923     my $result = {
 924         requests        => scalar( @{$hold_requests} ),
 925         available_items => scalar( @{$available_items} ),
 926     };
 927
 928     my $item_map = MapItemsToHoldRequests( $hold_requests, $available_items, $branches_to_use, $transport_cost_matrix );
 929     $result->{mapped_items} = scalar( keys %{$item_map} );
 930
 931     if ($item_map) {
 932         CreatePicklistFromItemMap($item_map);
 933         AddToHoldTargetMap($item_map);
 934     }
 935
 936     return $result;
 937 }
 938
 939 1;