From 2de4e993081dedab42024ea2a14a1a01ad9a8f72 Mon Sep 17 00:00:00 2001 From: Kyle M Hall Date: Mon, 22 May 2023 12:52:58 -0400 Subject: [PATCH] Bug 33796: Holds Queue builder should check more than just least cost branch for TCM If for some reason all the items from the least cost branch fail ( can't be transferred, fail the hold policy, non-matching itemtype filter, etc ), Koha does not check the next cheapest branch, but instead moves onto the "fall back to basics" code. We should loop over all the branches from least costly to most costly to find the least costly items that can be used. Test Plan: 1) Set up TCM so it's cheapest to transport item from A to C than from B to C. 2) Place hold for record with items at A and B, for pick at C 3) Disable transfer from A to C 4) Build the holds queue 5) Note the B item was selected over other more costly items, but not the less costly A item ( which cannot be transferred ). --- C4/HoldsQueue.pm | 91 ++++++++++++++++--------------------- t/db_dependent/HoldsQueue.t | 60 ++++++++++++++++++++++-- 2 files changed, 96 insertions(+), 55 deletions(-) diff --git a/C4/HoldsQueue.pm b/C4/HoldsQueue.pm index 84cf407a0b..41d9afce08 100644 --- a/C4/HoldsQueue.pm +++ b/C4/HoldsQueue.pm @@ -591,32 +591,31 @@ sub MapItemsToHoldRequests { } elsif ($transport_cost_matrix) { $pull_branches = [keys %items_by_branch]; - $holdingbranch = least_cost_branch( $pickup_branch, $pull_branches, $transport_cost_matrix ); - if ( $holdingbranch ) { - - my $holding_branch_items = $items_by_branch{$holdingbranch}; - foreach my $item (@$holding_branch_items) { - next if $request->{borrowerbranch} ne $item->{$priority_branch}; - - # If hold itemtype is set, item's itemtype must match - next unless ( !$request->{itemtype} - || $item->{itype} eq $request->{itemtype} ); + my @branches = least_cost_branch( $pickup_branch, $pull_branches, $transport_cost_matrix ); + if ( @branches ) { + foreach my $branch ( @branches ) { + my $holding_branch_items = $items_by_branch{$branch}; + foreach my $item (@$holding_branch_items) { + # If hold itemtype is set, item's itemtype must match + next unless ( !$request->{itemtype} + || $item->{itype} eq $request->{itemtype} ); - # If hold item_group is set, item's item_group must match - next unless ( - !$request->{item_group_id} - || ( $item->{_object}->item_group - && $item->{_object}->item_group->id eq $request->{item_group_id} ) - ); + # If hold item_group is set, item's item_group must match + next unless ( + !$request->{item_group_id} + || ( $item->{_object}->item_group + && $item->{_object}->item_group->id eq $request->{item_group_id} ) + ); - # Don't fill a hold with a non-transferrable item - next unless $items_by_itemnumber{ $item->{itemnumber} }->{_object}->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } ); + # Don't fill a hold with a non-transferrable item + next unless $items_by_itemnumber{ $item->{itemnumber} }->{_object}->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } ); - # Don't fill item level holds that contravene the hold pickup policy at this time - next unless _checkHoldPolicy($item, $request); + # Don't fill item level holds that contravene the hold pickup policy at this time + next unless _checkHoldPolicy($item, $request); - $itemnumber = $item->{itemnumber}; - last; + $itemnumber = $item->{itemnumber}; + last; + } } } else { @@ -719,7 +718,7 @@ sub MapItemsToHoldRequests { if ($itemnumber) { my $holding_branch_items = $items_by_branch{$holdingbranch} - or die "Have $itemnumber, $holdingbranch, but no items!"; + or next; #die "Have $itemnumber, $holdingbranch, but no items!"; @$holding_branch_items = grep { $_->{itemnumber} != $itemnumber } @$holding_branch_items; delete $items_by_branch{$holdingbranch} unless @$holding_branch_items; @@ -846,47 +845,35 @@ sub load_branches_to_pull_from { } sub least_cost_branch { - - #$from - arrayref - my ($to, $from, $transport_cost_matrix) = @_; + my ( $to, $from, $transport_cost_matrix ) = @_; # Nothing really spectacular: supply to branch, a list of potential from branches # and find the minimum from - to value from the transport_cost_matrix - return $from->[0] if ( @$from == 1 && $transport_cost_matrix->{$to}{$from->[0]}->{disable_transfer} != 1 ); - - # If the pickup library is in the list of libraries to pull from, - # return that library right away, it is obviously the least costly - return ($to) if any { $_ eq $to } @$from; - my ($least_cost, @branch); - foreach (@$from) { - my $cell = $transport_cost_matrix->{$to}{$_}; - next if $cell->{disable_transfer}; + return $from->[0] + if ( @$from == 1 + && $transport_cost_matrix->{$to}{ $from->[0] }->{disable_transfer} != + 1 ); - my $cost = $cell->{cost}; - next unless defined $cost; # XXX should this be reported? - - unless (defined $least_cost) { - $least_cost = $cost; - push @branch, $_; - next; + my %costs; + foreach my $f (@$from) { + if ( $f eq $to ) { + $costs{$f} = 0; } + else { + my $cell = $transport_cost_matrix->{$to}{$f}; + next if $cell->{disable_transfer}; - next if $cost > $least_cost; + my $cost = $cell->{cost}; + next unless defined $cost; # XXX should this be reported? - if ($cost == $least_cost) { - push @branch, $_; - next; + $costs{$f} = $cost; } - - @branch = ($_); - $least_cost = $cost; } - return $branch[0]; + my @branches = sort { $costs{$a} <=> $costs{$b} } keys %costs; - # XXX return a random @branch with minimum cost instead of the first one; - # return $branch[0] if @branch == 1; + return @branches; } =head3 update_queue_for_biblio diff --git a/t/db_dependent/HoldsQueue.t b/t/db_dependent/HoldsQueue.t index 7eb78ce2bd..7e9cafb38c 100755 --- a/t/db_dependent/HoldsQueue.t +++ b/t/db_dependent/HoldsQueue.t @@ -8,7 +8,7 @@ use Modern::Perl; -use Test::More tests => 61; +use Test::More tests => 62; use Data::Dumper; use C4::Calendar qw( new insert_single_holiday ); @@ -171,8 +171,8 @@ ok( $queue_item or diag( "Expected item for pick $borrower_branchcode, hold $least_cost_branch_code, got ".Dumper($queue_item) ); ok( exists($queue_item->{itype}), 'item type included in queued items list (bug 5825)' ); -ok( - C4::HoldsQueue::least_cost_branch( 'B', [ 'A', 'B', 'C' ] ) eq 'B', +is_deeply( + C4::HoldsQueue::least_cost_branch( 'B', [ 'A', 'B', 'C' ] ), ['B'], 'C4::HoldsQueue::least_cost_branch returns the local branch if it is in the list of branches to pull from' ); @@ -2090,4 +2090,58 @@ subtest "GetItemsAvailableToFillHoldsRequestsForBib" => sub { is( scalar @$items, 2, "Two items without active transfers correctly retrieved"); is_deeply( [$items->[0]->{itemnumber},$items->[1]->{itemnumber}],[$item_2->itemnumber,$item_3->itemnumber],"Correct two items retrieved"); + $schema->storage->txn_rollback; +}; + +subtest "least_cost_branch" => sub { + plan tests => 2; + + $schema->storage->txn_begin; + + my $libraryA = $builder->build( + { + source => 'Branch', + value => { + branchcode => 'A', + } + } + ); + my $libraryB = $builder->build( + { + source => 'Branch', + value => { + branchcode => 'B', + } + } + ); + my $libraryC = $builder->build( + { + source => 'Branch', + value => { + branchcode => 'C', + } + } + ); + + $dbh->do("DELETE FROM transport_cost"); + my $transport_cost_insert_sth = $dbh->do(" + INSERT INTO transport_cost (frombranch, tobranch, cost ) VALUES + ( 'A', 'B', 6 ), + ( 'A', 'C', 5 ), + ( 'B', 'A', 4 ), + ( 'B', 'C', 3 ), + ( 'C', 'A', 2 ), + ( 'C', 'B', 1 ); + "); + + my $tcm = TransportCostMatrix(); + + my @branches; + @branches = C4::HoldsQueue::least_cost_branch( 'A', [ 'A', 'B', 'C' ], $tcm ); + is_deeply( \@branches, ['A', 'C', 'B'], 'Got correct list for A' ); + + @branches = C4::HoldsQueue::least_cost_branch( 'B', [ 'A', 'B', 'C' ], $tcm ); + is_deeply( \@branches, ['B', 'C', 'A'], 'Got correct list for B' ); + + $schema->storage->txn_rollback; }; -- 2.30.2