From 1729212b88c4f163f7b4bd21f338cae3d0bed302 Mon Sep 17 00:00:00 2001 From: Olli-Antti Kivilahti Date: Tue, 15 Oct 2013 13:46:40 +0300 Subject: [PATCH] Bug 11024 - Transfer limits should be respected in the build_holds_queue.pl -script. Depends on bug 11005 Adds the UseBranchTransferLimits-functionality to HoldsQueue.pm Includes unit tests. Formatted using perltidy and Perl::Critic --- C4/HoldsQueue.pm | 402 +++++++++++++-------- .../HoldsQueue_UseBranchTransferLimits.t | 326 +++++++++++++++++ 2 files changed, 583 insertions(+), 145 deletions(-) create mode 100755 t/db_dependent/HoldsQueue_UseBranchTransferLimits.t diff --git a/C4/HoldsQueue.pm b/C4/HoldsQueue.pm index 7062cbe..370bb03 100755 --- a/C4/HoldsQueue.pm +++ b/C4/HoldsQueue.pm @@ -36,20 +36,20 @@ use List::MoreUtils qw(any); use Data::Dumper; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + BEGIN { $VERSION = 3.03; require Exporter; - @ISA = qw(Exporter); + @ISA = qw(Exporter); @EXPORT_OK = qw( - &CreateQueue - &GetHoldsQueueItems + &CreateQueue + &GetHoldsQueueItems - &TransportCostMatrix - &UpdateTransportCostMatrix - ); + &TransportCostMatrix + &UpdateTransportCostMatrix + ); } - =head1 FUNCTIONS =head2 TransportCostMatrix @@ -61,16 +61,19 @@ Returns Transport Cost Matrix as a hashref => dbh; - my $transport_costs = $dbh->selectall_arrayref("SELECT * FROM transport_cost",{ Slice => {} }); + my $dbh = C4::Context->dbh; + my $transport_costs = + $dbh->selectall_arrayref( "SELECT * FROM transport_cost", + { Slice => {} } ); my %transport_cost_matrix; foreach (@$transport_costs) { - my $from = $_->{frombranch}; - my $to = $_->{tobranch}; - my $cost = $_->{cost}; + my $from = $_->{frombranch}; + my $to = $_->{tobranch}; + my $cost = $_->{cost}; my $disabled = $_->{disable_transfer}; - $transport_cost_matrix{$to}{$from} = { cost => $cost, disable_transfer => $disabled }; + $transport_cost_matrix{$to}{$from} = + { cost => $cost, disable_transfer => $disabled }; } return \%transport_cost_matrix; } @@ -86,20 +89,25 @@ Records: { frombranch => , tobranch => , cost =>
, disable_t sub UpdateTransportCostMatrix { my ($records) = @_; - my $dbh = C4::Context->dbh; + my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("INSERT INTO transport_cost (frombranch, tobranch, cost, disable_transfer) VALUES (?, ?, ?, ?)"); + my $sth = $dbh->prepare( +"INSERT INTO transport_cost (frombranch, tobranch, cost, disable_transfer) VALUES (?, ?, ?, ?)" + ); - $dbh->do("TRUNCATE TABLE transport_cost"); + $dbh->do("DELETE FROM transport_cost") + ; #Deleting is slower than TRUNCATE, but using TRUNCATE screws up $dbh->{AutoCommit} in unit tests foreach (@$records) { my $cost = $_->{cost}; my $from = $_->{frombranch}; - my $to = $_->{tobranch}; - if ($_->{disable_transfer}) { + my $to = $_->{tobranch}; + if ( $_->{disable_transfer} ) { $cost ||= 0; } - elsif ( !defined ($cost) || ($cost !~ m/(0|[1-9][0-9]*)(\.[0-9]*)?/o) ) { - warn "Invalid $from -> $to cost $cost - must be a number >= 0, disablig"; + elsif ( !defined($cost) || ( $cost !~ m/(0|[1-9][0-9]*)(\.[0-9]*)?/o ) ) + { + warn +"Invalid $from -> $to cost $cost - must be a number >= 0, disablig"; $cost = 0; $_->{disable_transfer} = 1; } @@ -117,34 +125,39 @@ Returns hold queue for a holding branch. If branch is omitted, then whole queue sub GetHoldsQueueItems { my ($branchlimit) = @_; - my $dbh = C4::Context->dbh; + my $dbh = C4::Context->dbh; my @bind_params = (); - my $query = q/SELECT tmp_holdsqueue.*, biblio.author, items.ccode, items.itype, biblioitems.itemtype, items.location, items.enumchron, items.cn_sort, biblioitems.publishercode,biblio.copyrightdate,biblioitems.publicationyear,biblioitems.pages,biblioitems.size,biblioitems.publicationyear,biblioitems.isbn,items.copynumber + my $query = +q/SELECT tmp_holdsqueue.*, biblio.author, items.ccode, items.itype, biblioitems.itemtype, items.location, items.enumchron, items.cn_sort, biblioitems.publishercode,biblio.copyrightdate,biblioitems.publicationyear,biblioitems.pages,biblioitems.size,biblioitems.publicationyear,biblioitems.isbn,items.copynumber FROM tmp_holdsqueue JOIN biblio USING (biblionumber) LEFT JOIN biblioitems USING (biblionumber) LEFT JOIN items USING ( itemnumber) /; if ($branchlimit) { - $query .=" WHERE tmp_holdsqueue.holdingbranch = ?"; + $query .= " WHERE tmp_holdsqueue.holdingbranch = ?"; push @bind_params, $branchlimit; } - $query .= " ORDER BY ccode, location, cn_sort, author, title, pickbranch, reservedate"; + $query .= +" ORDER BY ccode, location, cn_sort, author, title, pickbranch, reservedate"; my $sth = $dbh->prepare($query); $sth->execute(@bind_params); my $items = []; - while ( my $row = $sth->fetchrow_hashref ){ - $row->{reservedate} = format_date($row->{reservedate}); - my $record = GetMarcBiblio($row->{biblionumber}); - if ($record){ - $row->{subtitle} = GetRecordValue('subtitle',$record,'')->[0]->{subfield}; - $row->{parts} = GetRecordValue('parts',$record,'')->[0]->{subfield}; - $row->{numbers} = GetRecordValue('numbers',$record,'')->[0]->{subfield}; + while ( my $row = $sth->fetchrow_hashref ) { + $row->{reservedate} = format_date( $row->{reservedate} ); + my $record = GetMarcBiblio( $row->{biblionumber} ); + if ($record) { + $row->{subtitle} = + GetRecordValue( 'subtitle', $record, '' )->[0]->{subfield}; + $row->{parts} = + GetRecordValue( 'parts', $record, '' )->[0]->{subfield}; + $row->{numbers} = + GetRecordValue( 'numbers', $record, '' )->[0]->{subfield}; } # return the bib-level or item-level itype per syspref - if (!C4::Context->preference('item-level_itypes')) { + if ( !C4::Context->preference('item-level_itypes') ) { $row->{itype} = $row->{itemtype}; } delete $row->{itemtype}; @@ -163,9 +176,9 @@ Top level function that turns reserves into tmp_holdsqueue and hold_fill_targets =cut sub CreateQueue { - my $dbh = C4::Context->dbh; + my $dbh = C4::Context->dbh; - $dbh->do("DELETE FROM tmp_holdsqueue"); # clear the old table for new info + $dbh->do("DELETE FROM tmp_holdsqueue"); # clear the old table for new info $dbh->do("DELETE FROM hold_fill_targets"); my $total_bibs = 0; @@ -175,10 +188,11 @@ sub CreateQueue { my $branches_to_use; my $transport_cost_matrix; - my $use_transport_cost_matrix = C4::Context->preference("UseTransportCostMatrix"); + my $use_transport_cost_matrix = + C4::Context->preference("UseTransportCostMatrix"); if ($use_transport_cost_matrix) { $transport_cost_matrix = TransportCostMatrix(); - unless (keys %$transport_cost_matrix) { + unless ( keys %$transport_cost_matrix ) { warn "UseTransportCostMatrix set to yes, but matrix not populated"; undef $transport_cost_matrix; } @@ -191,25 +205,31 @@ sub CreateQueue { foreach my $biblionumber (@$bibs_with_pending_requests) { $total_bibs++; - my $hold_requests = GetPendingHoldRequestsForBib($biblionumber); - my $available_items = GetItemsAvailableToFillHoldRequestsForBib($biblionumber, $branches_to_use); + my $hold_requests = GetPendingHoldRequestsForBib($biblionumber); + my $available_items = + GetItemsAvailableToFillHoldRequestsForBib( $biblionumber, + $branches_to_use ); $total_requests += scalar(@$hold_requests); $total_available_items += scalar(@$available_items); - my $item_map = MapItemsToHoldRequests($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix); - $item_map or next; - my $item_map_size = scalar(keys %$item_map) + my $item_map = MapItemsToHoldRequests( + $hold_requests, $available_items, + $branches_to_use, $transport_cost_matrix + ); + $item_map or next; + my $item_map_size = scalar( keys %$item_map ) or next; $num_items_mapped += $item_map_size; CreatePicklistFromItemMap($item_map); AddToHoldTargetMap($item_map); - if (($item_map_size < scalar(@$hold_requests )) and - ($item_map_size < scalar(@$available_items))) { - # DOUBLE CHECK, but this is probably OK - unfilled item-level requests - # FIXME - #warn "unfilled requests for $biblionumber"; - #warn Dumper($hold_requests), Dumper($available_items), Dumper($item_map); + if ( ( $item_map_size < scalar(@$hold_requests) ) + and ( $item_map_size < scalar(@$available_items) ) ) + { + # DOUBLE CHECK, but this is probably OK - unfilled item-level requests + # FIXME + #warn "unfilled requests for $biblionumber"; + #warn Dumper($hold_requests), Dumper($available_items), Dumper($item_map); } } } @@ -267,7 +287,8 @@ sub GetPendingHoldRequestsForBib { my $dbh = C4::Context->dbh; - my $request_query = "SELECT biblionumber, borrowernumber, itemnumber, priority, reserves.branchcode, + my $request_query = +"SELECT biblionumber, borrowernumber, itemnumber, priority, reserves.branchcode, reservedate, reservenotes, borrowers.branchcode AS borrowerbranch FROM reserves JOIN borrowers USING (borrowernumber) @@ -280,7 +301,7 @@ sub GetPendingHoldRequestsForBib { my $sth = $dbh->prepare($request_query); $sth->execute($biblionumber); - my $requests = $sth->fetchall_arrayref({}); + my $requests = $sth->fetchall_arrayref( {} ); return $requests; } @@ -303,23 +324,27 @@ to fill a hold request if and only if: =cut sub GetItemsAvailableToFillHoldRequestsForBib { - my ($biblionumber, $branches_to_use) = @_; + my ( $biblionumber, $branches_to_use ) = @_; my $dbh = C4::Context->dbh; - my $items_query = "SELECT itemnumber, homebranch, holdingbranch, itemtypes.itemtype AS itype + my $items_query = +"SELECT itemnumber, homebranch, holdingbranch, ccode, itemtypes.itemtype AS itype FROM items "; - if (C4::Context->preference('item-level_itypes')) { - $items_query .= "LEFT JOIN itemtypes ON (itemtypes.itemtype = items.itype) "; - } else { - $items_query .= "JOIN biblioitems USING (biblioitemnumber) + if ( C4::Context->preference('item-level_itypes') ) { + $items_query .= + "LEFT JOIN itemtypes ON (itemtypes.itemtype = items.itype) "; + } + else { + $items_query .= "JOIN biblioitems USING (biblioitemnumber) LEFT JOIN itemtypes USING (itemtype) "; } - $items_query .= "WHERE items.notforloan = 0 + $items_query .= "WHERE items.notforloan = 0 AND holdingbranch IS NOT NULL AND itemlost = 0 AND withdrawn = 0"; - $items_query .= " AND damaged = 0" unless C4::Context->preference('AllowHoldsOnDamagedItems'); + $items_query .= " AND damaged = 0" + unless C4::Context->preference('AllowHoldsOnDamagedItems'); $items_query .= " AND items.onloan IS NULL AND (itemtypes.notforloan IS NULL OR itemtypes.notforloan = 0) AND itemnumber NOT IN ( @@ -330,23 +355,26 @@ sub GetItemsAvailableToFillHoldRequestsForBib { AND (found IS NOT NULL OR priority = 0) ) AND items.biblionumber = ?"; - $items_query .= " AND damaged = 0 " + $items_query .= " AND damaged = 0 " unless C4::Context->preference('AllowHoldsOnDamagedItems'); - my @params = ($biblionumber, $biblionumber); - if ($branches_to_use && @$branches_to_use) { - $items_query .= " AND holdingbranch IN (" . join (",", map { "?" } @$branches_to_use) . ")"; + my @params = ( $biblionumber, $biblionumber ); + if ( $branches_to_use && @$branches_to_use ) { + $items_query .= " AND holdingbranch IN (" + . join( ",", map { "?" } @$branches_to_use ) . ")"; push @params, @$branches_to_use; } my $sth = $dbh->prepare($items_query); $sth->execute(@params); - my $itm = $sth->fetchall_arrayref({}); - my @items = grep { ! scalar GetTransfers($_->{itemnumber}) } @$itm; - return [ grep { - my $rule = GetBranchItemRule($_->{homebranch}, $_->{itype}); - $_->{holdallowed} = $rule->{holdallowed}; - } @items ]; + my $itm = $sth->fetchall_arrayref( {} ); + my @items = grep { !scalar GetTransfers( $_->{itemnumber} ) } @$itm; + return [ + grep { + my $rule = GetBranchItemRule( $_->{homebranch}, $_->{itype} ); + $_->{holdallowed} = $rule->{holdallowed}; + } @items + ]; } =head2 MapItemsToHoldRequests @@ -356,7 +384,10 @@ sub GetItemsAvailableToFillHoldRequestsForBib { =cut sub MapItemsToHoldRequests { - my ($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix) = @_; + my ( + $hold_requests, $available_items, + $branches_to_use, $transport_cost_matrix + ) = @_; # handle trival cases return unless scalar(@$hold_requests) > 0; @@ -364,8 +395,7 @@ sub MapItemsToHoldRequests { # identify item-level requests my %specific_items_requested = map { $_->{itemnumber} => 1 } - grep { defined($_->{itemnumber}) } - @$hold_requests; + grep { defined( $_->{itemnumber} ) } @$hold_requests; # group available items by itemnumber my %items_by_itemnumber = map { $_->{itemnumber} => $_ } @$available_items; @@ -382,23 +412,50 @@ sub MapItemsToHoldRequests { last if $num_items_remaining == 0; # is this an item-level request? - if (defined($request->{itemnumber})) { + if ( defined( $request->{itemnumber} ) ) { + # fill it if possible; if not skip it - if (exists $items_by_itemnumber{$request->{itemnumber}} and - not exists $allocated_items{$request->{itemnumber}}) { - $item_map{$request->{itemnumber}} = { - borrowernumber => $request->{borrowernumber}, - biblionumber => $request->{biblionumber}, - holdingbranch => $items_by_itemnumber{$request->{itemnumber}}->{holdingbranch}, - pickup_branch => $request->{branchcode} || $request->{borrowerbranch}, - item_level => 1, - reservedate => $request->{reservedate}, - reservenotes => $request->{reservenotes}, - }; - $allocated_items{$request->{itemnumber}}++; - $num_items_remaining--; + if ( exists $items_by_itemnumber{ $request->{itemnumber} } + and not exists $allocated_items{ $request->{itemnumber} } ) + { + +#Dereferencing variables for sanitys sake, and because it is faster when repeatedly called. + my $holdingBranch = + $items_by_itemnumber{ $request->{itemnumber} } + ->{holdingbranch}; + my $pickupBranch = + $request->{branchcode} || $request->{borrowerbranch}; + + my ( $transferOk, $errorMsg ) = + C4::Circulation::CanItemBeTransferred( $pickupBranch, + $holdingBranch, + $items_by_itemnumber{ $request->{itemnumber} }, undef ); + if ( !$transferOk ) { + +#UseBranchTransfer check failed, gosh damn how can this be! It should be blocked in the UI for item level holds! + warn +"HoldsQueue.pm:> Branch transfer failed for pickup branch $pickupBranch, holding branch $holdingBranch, itemnumber $request->{itemnumber}\n" + . "This should be impossible because branch transfer limits for item level holds must be checked when placing holds!"; + } + else { + $item_map{ $request->{itemnumber} } = { + borrowernumber => $request->{borrowernumber}, + biblionumber => $request->{biblionumber}, + holdingbranch => + $items_by_itemnumber{ $request->{itemnumber} } + ->{holdingbranch}, + pickup_branch => $request->{branchcode} + || $request->{borrowerbranch}, + item_level => 1, + reservedate => $request->{reservedate}, + reservenotes => $request->{reservenotes}, + }; + $allocated_items{ $request->{itemnumber} }++; + $num_items_remaining--; + } } - } else { + } + else { # it's title-level request that will take up one item $num_items_remaining--; } @@ -415,18 +472,24 @@ sub MapItemsToHoldRequests { return \%item_map unless keys %items_by_branch; # now handle the title-level requests - $num_items_remaining = scalar(@$available_items) - scalar(keys %allocated_items); + $num_items_remaining = + scalar(@$available_items) - scalar( keys %allocated_items ); my $pull_branches; foreach my $request (@$hold_requests) { last if $num_items_remaining == 0; - next if defined($request->{itemnumber}); # already handled these + next if defined( $request->{itemnumber} ); # already handled these # look for local match first - my $pickup_branch = $request->{branchcode} || $request->{borrowerbranch}; - my ($itemnumber, $holdingbranch); + my $pickup_branch = + $request->{branchcode} || $request->{borrowerbranch}; + my ( $itemnumber, $holdingbranch ); + + # Used to detect if no Items can be transferred to the pickup location. + my $branchTransfersAllowedCount = + 1; #Default this to 1. It is decremented when branchTransfers fail. my $holding_branch_items = $items_by_branch{$pickup_branch}; - if ( $holding_branch_items ) { + if ($holding_branch_items) { foreach my $item (@$holding_branch_items) { if ( $request->{borrowerbranch} eq $item->{homebranch} ) { $itemnumber = $item->{itemnumber}; @@ -437,31 +500,64 @@ sub MapItemsToHoldRequests { $itemnumber ||= $holding_branch_items->[0]->{itemnumber}; } elsif ($transport_cost_matrix) { - $pull_branches = [keys %items_by_branch]; - $holdingbranch = least_cost_branch( $pickup_branch, $pull_branches, $transport_cost_matrix ); - if ( $holdingbranch ) { + $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}; + $branchTransfersAllowedCount = @$holding_branch_items; + +# Making sure to put preference to the Item, which is originally from the Borrowers homebranch. foreach my $item (@$holding_branch_items) { next if $request->{borrowerbranch} ne $item->{homebranch}; $itemnumber = $item->{itemnumber}; last; } + + # Checking if the Item can be Transferred to the pickup library + if ( !$itemnumber + && C4::Context->preference("UseBranchTransferLimits") == 1 ) + { + foreach my $item (@$holding_branch_items) { + my ( $transferOk, $errorMsg ) = + C4::Circulation::CanItemBeTransferred( $pickup_branch, + $item->{holdingbranch}, + $item, undef ); + if ( !$transferOk ) { + $branchTransfersAllowedCount--; + next; + } + + $itemnumber = $item->{itemnumber}; + last; + } + } + +# If one is not using UseBranchTransferLimits, then revert to the default setting. + elsif ( !$itemnumber ) { + +# FIXME Choosing the Item based on the first available, even if it could be on hold. +# Problematic since holds tend to stack on this first item then. + $itemnumber ||= $holding_branch_items->[0]->{itemnumber}; + } } else { warn "No transport costs for $pickup_branch"; } } - unless ($itemnumber) { - # not found yet, fall back to basics + if ( ( !$itemnumber ) && $branchTransfersAllowedCount > 0 ) { + + # not found yet and branchTransfers are not blocking, fall back to basics if ($branches_to_use) { $pull_branches = $branches_to_use; - } else { - $pull_branches = [keys %items_by_branch]; } - PULL_BRANCHES: + else { + $pull_branches = [ keys %items_by_branch ]; + } + PULL_BRANCHES: foreach my $branch (@$pull_branches) { my $holding_branch_items = $items_by_branch{$branch} or next; @@ -470,17 +566,25 @@ sub MapItemsToHoldRequests { foreach my $item (@$holding_branch_items) { next if $pickup_branch ne $item->{homebranch}; - $itemnumber = $item->{itemnumber}; + $itemnumber = $item->{itemnumber}; $holdingbranch = $branch; last PULL_BRANCHES; } } - unless ( $itemnumber ) { - foreach my $current_item ( @{ $items_by_branch{$holdingbranch} } ) { - if ( $holdingbranch && ( $current_item->{holdallowed} == 2 || $pickup_branch eq $current_item->{homebranch} ) ) { + unless ($itemnumber) { + foreach + my $current_item ( @{ $items_by_branch{$holdingbranch} } ) + { + if ( + $holdingbranch + && ( $current_item->{holdallowed} == 2 + || $pickup_branch eq $current_item->{homebranch} ) + ) + { $itemnumber = $current_item->{itemnumber}; - last; # quit this loop as soon as we have a suitable item + last + ; # quit this loop as soon as we have a suitable item } } } @@ -489,17 +593,19 @@ sub MapItemsToHoldRequests { if ($itemnumber) { my $holding_branch_items = $items_by_branch{$holdingbranch} or 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; + @$holding_branch_items = + grep { $_->{itemnumber} != $itemnumber } @$holding_branch_items; + delete $items_by_branch{$holdingbranch} + unless @$holding_branch_items; $item_map{$itemnumber} = { borrowernumber => $request->{borrowernumber}, - biblionumber => $request->{biblionumber}, - holdingbranch => $holdingbranch, - pickup_branch => $pickup_branch, - item_level => 0, - reservedate => $request->{reservedate}, - reservenotes => $request->{reservenotes}, + biblionumber => $request->{biblionumber}, + holdingbranch => $holdingbranch, + pickup_branch => $pickup_branch, + item_level => 0, + reservedate => $request->{reservedate}, + reservenotes => $request->{reservenotes}, }; $num_items_remaining--; } @@ -516,39 +622,42 @@ sub CreatePicklistFromItemMap { my $dbh = C4::Context->dbh; - my $sth_load=$dbh->prepare(" + my $sth_load = $dbh->prepare( " INSERT INTO tmp_holdsqueue (biblionumber,itemnumber,barcode,surname,firstname,phone,borrowernumber, cardnumber,reservedate,title, itemcallnumber, holdingbranch,pickbranch,notes, item_level_request) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) - "); + " ); - foreach my $itemnumber (sort keys %$item_map) { - my $mapped_item = $item_map->{$itemnumber}; - my $biblionumber = $mapped_item->{biblionumber}; + foreach my $itemnumber ( sort keys %$item_map ) { + my $mapped_item = $item_map->{$itemnumber}; + my $biblionumber = $mapped_item->{biblionumber}; my $borrowernumber = $mapped_item->{borrowernumber}; - my $pickbranch = $mapped_item->{pickup_branch}; - my $holdingbranch = $mapped_item->{holdingbranch}; - my $reservedate = $mapped_item->{reservedate}; - my $reservenotes = $mapped_item->{reservenotes}; - my $item_level = $mapped_item->{item_level}; - - my $item = GetItem($itemnumber); - my $barcode = $item->{barcode}; + my $pickbranch = $mapped_item->{pickup_branch}; + my $holdingbranch = $mapped_item->{holdingbranch}; + my $reservedate = $mapped_item->{reservedate}; + my $reservenotes = $mapped_item->{reservenotes}; + my $item_level = $mapped_item->{item_level}; + + my $item = GetItem($itemnumber); + my $barcode = $item->{barcode}; my $itemcallnumber = $item->{itemcallnumber}; - my $borrower = GetMember('borrowernumber'=>$borrowernumber); + my $borrower = GetMember( 'borrowernumber' => $borrowernumber ); my $cardnumber = $borrower->{'cardnumber'}; - my $surname = $borrower->{'surname'}; - my $firstname = $borrower->{'firstname'}; - my $phone = $borrower->{'phone'}; + my $surname = $borrower->{'surname'}; + my $firstname = $borrower->{'firstname'}; + my $phone = $borrower->{'phone'}; - my $bib = GetBiblioData($biblionumber); + my $bib = GetBiblioData($biblionumber); my $title = $bib->{title}; - $sth_load->execute($biblionumber, $itemnumber, $barcode, $surname, $firstname, $phone, $borrowernumber, - $cardnumber, $reservedate, $title, $itemcallnumber, - $holdingbranch, $pickbranch, $reservenotes, $item_level); + $sth_load->execute( + $biblionumber, $itemnumber, $barcode, $surname, + $firstname, $phone, $borrowernumber, $cardnumber, + $reservedate, $title, $itemcallnumber, $holdingbranch, + $pickbranch, $reservenotes, $item_level + ); } } @@ -567,10 +676,13 @@ sub AddToHoldTargetMap { ); my $sth_insert = $dbh->prepare($insert_sql); - foreach my $itemnumber (keys %$item_map) { + foreach my $itemnumber ( keys %$item_map ) { my $mapped_item = $item_map->{$itemnumber}; - $sth_insert->execute($mapped_item->{borrowernumber}, $mapped_item->{biblionumber}, $itemnumber, - $mapped_item->{holdingbranch}, $mapped_item->{item_level}); + $sth_insert->execute( + $mapped_item->{borrowernumber}, $mapped_item->{biblionumber}, + $itemnumber, $mapped_item->{holdingbranch}, + $mapped_item->{item_level} + ); } } @@ -589,7 +701,8 @@ sub load_branches_to_pull_from { my @branches_to_use = map _trim($_), split /,/, $static_branch_list; - @branches_to_use = shuffle(@branches_to_use) if C4::Context->preference("RandomizeHoldsQueueWeight"); + @branches_to_use = shuffle(@branches_to_use) + if C4::Context->preference("RandomizeHoldsQueueWeight"); return \@branches_to_use; } @@ -597,25 +710,25 @@ 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 +# 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; # 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); + my ( $least_cost, @branch ); foreach (@$from) { my $cell = $transport_cost_matrix->{$to}{$_}; next if $cell->{disable_transfer}; my $cost = $cell->{cost}; - next unless defined $cost; # XXX should this be reported? + next unless defined $cost; # XXX should this be reported? - unless (defined $least_cost) { + unless ( defined $least_cost ) { $least_cost = $cost; push @branch, $_; next; @@ -623,12 +736,12 @@ sub least_cost_branch { next if $cost > $least_cost; - if ($cost == $least_cost) { + if ( $cost == $least_cost ) { push @branch, $_; next; } - @branch = ($_); + @branch = ($_); $least_cost = $cost; } @@ -638,5 +751,4 @@ sub least_cost_branch { # return $branch[0] if @branch == 1; } - 1; diff --git a/t/db_dependent/HoldsQueue_UseBranchTransferLimits.t b/t/db_dependent/HoldsQueue_UseBranchTransferLimits.t new file mode 100755 index 0000000..2612a6a --- /dev/null +++ b/t/db_dependent/HoldsQueue_UseBranchTransferLimits.t @@ -0,0 +1,326 @@ +#!/usr/bin/perl + +=head TESTING PLAN + +PRECONDITIONS| +-------------+ +UseBranchTranferLimits itemtype DVD +IPT -> CPL -> FFL -> IPT +no transfers into LPL + +TransportCostMatrix in use +Allow all, cost 1 + +-> pickup branch IPT <- +-> Borrowers homebranch LPL <- + + +Biblio1 Items +Item barcode holdingbranch transferOK? itemtype +cpl11 CPL 0 DVD +cpl12 CPL 1 BK +ffl11 FFL 1 DVD +ffl12 FFL 1 BK + +Biblio2 Items +Item barcode holdingbranch transferOK? itemtype +cpl21 CPL 0 DVD +cpl22 CPL 0 DVD + +Biblio3 Items +Item barcode holdingbranch transferOK? itemtype +ffl31 FFL 1 DVD +ffl32 FFL 1 BK + +--------------------- +--- HoldsQueue.pm --- +--------------------- + +CASE1: Title-level multi_hold on all Biblios, pickup location IPT + +Expected: +Hold for Biblio1 gets satisfied with Items cpl12, ipt11, ipt12 or ffl1. +Hold for Biblio2 fails to satisfy, no messages given. +Hold for Biblio3 is satisfied with ffl31. + + +CASE2: Item-level holds, pickup location IPT + +Expected: +Item to hold hold satisfied? +cpl1 0 +cpl12 1 +ipt11 1 +ipt12 1 +ffl1 1 +cpl21 0 +cpl22 0 +cpl23 1 +ffl31 1 +ffl32 1 + + +=cut + +use Modern::Perl; + +use C4::Context; + +use Test::More tests => 9; + +use C4::Circulation; +use C4::Record; +use C4::HoldsQueue; +use C4::Reserves; +use C4::HoldsQueue; + +# Start transaction +my $dbh = C4::Context->dbh; +$dbh->{AutoCommit} = 0; +$dbh->{RaiseError} = 1; + + +##########################xxxxxxxxxxxxxxxxxxxxxxxxx########################### +### xxxxxxxxxxxxxxxxxxxxxxxxxx Set up the stage xxxxxxxxxxxxxxxxxxxxxxxxxx ### +##########################xxxxxxxxxxxxxxxxxxxxxxxxx########################### + +## Set branches +my $desiredBranches = ['IPT', 'CPL', 'FFL', 'LPL']; +my $branches = C4::Branch::GetBranches; + +foreach my $branchCode (@$desiredBranches) { + if (exists $branches->{$branchCode}) { + #Alls well and the library is here yay! + } + else { + #le fuu! who is not using the default libraries? + my $branchwhatever = C4::SQLHelper::InsertInTable("branches",{branchcode=>"$branchCode",branchname=>"Yet another branch",city=>" ",zipcode=>" "},1); + print $branchwhatever; + } +} + +my %data = ( + cardnumber => 'CARDNUMBER42', + firstname => 'my firstname', + surname => 'my surname', + categorycode => 'S', + branchcode => 'LPL', +); + +my $borrowernumber = C4::Members::AddMember(%data); +my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ); + + +## Itemtypes +my $itemTypes = { map {$_->{itemtype} => 1} C4::ItemType->all() }; +if (! (exists $itemTypes->{'BK'})) { + $dbh->do("INSERT INTO `kohadata`.`itemtypes` (`itemtype`, `description`, `rentalcharge`, `notforloan`, `imageurl`, `summary`, `checkinmsg`, `checkinmsgtype`) VALUES ('BK', NULL, '0', NULL, NULL, NULL, NULL, 'message');"); +} +if (! (exists $itemTypes->{'DVD'})) { + $dbh->do("INSERT INTO `kohadata`.`itemtypes` (`itemtype`, `description`, `rentalcharge`, `notforloan`, `imageurl`, `summary`, `checkinmsg`, `checkinmsgtype`) VALUES ('DVD', NULL, '0', NULL, NULL, NULL, NULL, 'message');"); +} + + + +## Add example Bibliographic records + +my ( $biblioNumber1, $biblioNumber2, $biblioNumber3, $discardBiblioitemnumber); +my $bibFramework = ''; #Using the default bibliographic framework. + +my $marcxml=qq( + + 00000cim a22000004a 4500 + ss||||j||||||| + uuuu xxk|||||||||||||||||eng|c + + BIBLIO1 + + +); +my $record=C4::Record::marcxml2marc($marcxml); +( $biblioNumber1, $discardBiblioitemnumber ) = C4::Biblio::AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } ); + +$marcxml=qq( + + 00000cim a22000004a 4500 + ss||||j||||||| + uuuu xxk|||||||||||||||||eng|c + + BIBLIO2 + + +); +$record=C4::Record::marcxml2marc($marcxml); +( $biblioNumber2, $discardBiblioitemnumber ) = C4::Biblio::AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } ); + +$marcxml=qq( + + 00000cim a22000004a 4500 + ss||||j||||||| + uuuu xxk|||||||||||||||||eng|c + + BIBLIO3 + + +); +$record=C4::Record::marcxml2marc($marcxml); +( $biblioNumber3, $discardBiblioitemnumber ) = C4::Biblio::AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } ); + +## Add items to the mix +my ($discardThis, $discardThat); # Not needing biblionumber or biblioitemnumber for the added items +my ($cpl11, $cpl12, $ffl11, $ffl12, $cpl21, $cpl22, $ffl31, $ffl32); + +($discardThis, $discardThat, $cpl11) = C4::Items::AddItem({ barcode => 'cpl11', homebranch => 'CPL', holdingbranch => 'CPL', itype => 'DVD', notforloan => '0' }, $biblioNumber1); +($discardThis, $discardThat, $cpl12) = C4::Items::AddItem({ barcode => 'cpl12', homebranch => 'CPL', holdingbranch => 'CPL', itype => 'BK' , notforloan => '0' }, $biblioNumber1); +($discardThis, $discardThat, $ffl11) = C4::Items::AddItem({ barcode => 'ffl11', homebranch => 'FFL', holdingbranch => 'FFL', itype => 'DVD', notforloan => '0' }, $biblioNumber1); +($discardThis, $discardThat, $ffl12) = C4::Items::AddItem({ barcode => 'ffl12', homebranch => 'FFL', holdingbranch => 'FFL', itype => 'BK' , notforloan => '0' }, $biblioNumber1); + +($discardThis, $discardThat, $cpl21) = C4::Items::AddItem({ barcode => 'cpl21', homebranch => 'CPL', holdingbranch => 'CPL', itype => 'DVD', notforloan => '0' }, $biblioNumber2); +($discardThis, $discardThat, $cpl22) = C4::Items::AddItem({ barcode => 'cpl22', homebranch => 'CPL', holdingbranch => 'CPL', itype => 'DVD', notforloan => '0' }, $biblioNumber2); + +($discardThis, $discardThat, $ffl31) = C4::Items::AddItem({ barcode => 'ffl31', homebranch => 'FFL', holdingbranch => 'FFL', itype => 'DVD', notforloan => '0' }, $biblioNumber3); +($discardThis, $discardThat, $ffl32) = C4::Items::AddItem({ barcode => 'ffl32', homebranch => 'FFL', holdingbranch => 'FFL', itype => 'BK' , notforloan => '0' }, $biblioNumber3); + + +## Sysprefs and cost matrix +C4::Context->set_preference('UseTransportCostMatrix', 1); +C4::Context->set_preference('item-level_itypes', 1); +C4::Context->set_preference("BranchTransferLimitsType", 'itemtype'); +C4::Context->set_preference('StaticHoldsQueueWeight', 0); +C4::Context->set_preference('RandomizeHoldsQueueWeight', 0); + + +C4::HoldsQueue::UpdateTransportCostMatrix( [ + {frombranch => 'IPT', tobranch => 'CPL', cost => 1, disable_transfer => 0}, + {frombranch => 'IPT', tobranch => 'FFL', cost => 1, disable_transfer => 0}, + {frombranch => 'IPT', tobranch => 'LPL', cost => 1, disable_transfer => 0}, + {frombranch => 'CPL', tobranch => 'FFL', cost => 1, disable_transfer => 0}, + {frombranch => 'CPL', tobranch => 'IPT', cost => 0.2, disable_transfer => 0}, + {frombranch => 'CPL', tobranch => 'LPL', cost => 1, disable_transfer => 0}, + {frombranch => 'FFL', tobranch => 'IPT', cost => 1, disable_transfer => 0}, + {frombranch => 'FFL', tobranch => 'CPL', cost => 1, disable_transfer => 0}, + {frombranch => 'FFL', tobranch => 'LPL', cost => 1, disable_transfer => 0}, +] ); + + +C4::Circulation::DeleteBranchTransferLimits( 'IPT' ); +C4::Circulation::DeleteBranchTransferLimits( 'CPL' ); +C4::Circulation::DeleteBranchTransferLimits( 'FFL' ); +C4::Circulation::DeleteBranchTransferLimits( 'LPL' ); +# CreateBranchTransferLimit( to , from, code ); Block these transfers! +C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', 'DVD' ); +C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', 'DVD' ); +C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', 'DVD' ); +C4::Circulation::CreateBranchTransferLimit( 'LPL', 'IPT', 'DVD' ); +C4::Circulation::CreateBranchTransferLimit( 'LPL', 'CPL', 'DVD' ); +C4::Circulation::CreateBranchTransferLimit( 'LPL', 'FFL', 'DVD' ); + + +#############################xxxxxxxxxxxxxxxxxxxxxxxxx########################### +### xxxxxxxxxxxxxxxxxxxxxxxxxx Start running tests xxxxxxxxxxxxxxxxxxxxxxxxxx ### +#############################xxxxxxxxxxxxxxxxxxxxxxxxx########################### + + + ############# +### CASE1: Title-level multi_hold on all Biblios, pickup location IPT ### + ############# + +## Remove existing reserves, makes debugging easier +$dbh->do("DELETE FROM reserves"); + +C4::Reserves::AddReserve ( 'IPT', $borrowernumber, $biblioNumber1, 'a', '', '1' ); +C4::Reserves::AddReserve ( 'IPT', $borrowernumber, $biblioNumber2, 'a', '', '1' ); +C4::Reserves::AddReserve ( 'IPT', $borrowernumber, $biblioNumber3, 'a', '', '1' ); + +$dbh->do("UPDATE reserves SET reservedate = DATE_SUB( reservedate, INTERVAL 1 DAY )"); + +## Item cpl11 is a DVD and transferring it from CPL to IPT is strictly forbidden. +## Transport matrix favours CPL -> IPT transports, so we should get either the BK or DVD. +my $testOk = 0; +my $branches_to_use = undef; #Testing only with Transport cost matrix since it is the future! +my $transport_cost_matrix = C4::HoldsQueue::TransportCostMatrix(); +my $hold_requests = C4::HoldsQueue::GetPendingHoldRequestsForBib($biblioNumber1); +my $available_items = C4::HoldsQueue::GetItemsAvailableToFillHoldRequestsForBib($biblioNumber1, $branches_to_use); +my $item_map = C4::HoldsQueue::MapItemsToHoldRequests($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix); +my $rib = (C4::Items::GetItem( (keys %$item_map)[0] ))->{barcode}; #Reserved Item's barcode +$testOk = 1 if ($rib eq 'cpl12'); +is($testOk, 1, 'Title-level hold, mixed material, Biblio1'); +=head +## Should fail, requesting DVD's from a transfer-denied branch. +$testOk = 0; +$branches_to_use = undef; #Testing only with Transport cost matrix since it is the future! +$transport_cost_matrix = C4::HoldsQueue::TransportCostMatrix(); +$hold_requests = C4::HoldsQueue::GetPendingHoldRequestsForBib($biblioNumber2); +$available_items = C4::HoldsQueue::GetItemsAvailableToFillHoldRequestsForBib($biblioNumber2, $branches_to_use); +$item_map = C4::HoldsQueue::MapItemsToHoldRequests($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix); +$testOk = %$item_map; #This time we should have no results +is($testOk, 0, 'Title-level hold, transfer denied, Biblio2'); + +## Should succeed, no transfer blocks +$testOk = 0; +$branches_to_use = undef; #Testing only with Transport cost matrix since it is the future! +$transport_cost_matrix = C4::HoldsQueue::TransportCostMatrix(); +$hold_requests = C4::HoldsQueue::GetPendingHoldRequestsForBib($biblioNumber3); +$available_items = C4::HoldsQueue::GetItemsAvailableToFillHoldRequestsForBib($biblioNumber3, $branches_to_use); +$item_map = C4::HoldsQueue::MapItemsToHoldRequests($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix); +$testOk = keys %$item_map; #This time any result will do +is($testOk, 1, 'Title-level hold, transfer allowed, Biblio3'); +=cut + + + + ############# +### CASE2: Item-level holds, pickup location IPT ### + ############# + +## Remove existing reserves, makes debugging easier +$dbh->do("DELETE FROM reserves"); + +#$branch, $borrowernumber, $biblionumber, $constraint, $bibitems, $priority, $resdate, $expdate, $notes, $title, $checkitem, $found +C4::Reserves::AddReserve ( 'IPT', $borrowernumber, $biblioNumber1, undef, undef, '1', undef, undef, undef, undef, $cpl11, undef ); +C4::Reserves::AddReserve ( 'IPT', $borrowernumber, $biblioNumber1, undef, undef, '1', undef, undef, undef, undef, $cpl12, undef ); +C4::Reserves::AddReserve ( 'IPT', $borrowernumber, $biblioNumber1, undef, undef, '1', undef, undef, undef, undef, $ffl11, undef ); +C4::Reserves::AddReserve ( 'IPT', $borrowernumber, $biblioNumber1, undef, undef, '1', undef, undef, undef, undef, $ffl12, undef ); + +C4::Reserves::AddReserve ( 'IPT', $borrowernumber, $biblioNumber2, undef, undef, '1', undef, undef, undef, undef, $cpl21, undef ); +C4::Reserves::AddReserve ( 'IPT', $borrowernumber, $biblioNumber2, undef, undef, '1', undef, undef, undef, undef, $cpl22, undef ); + +C4::Reserves::AddReserve ( 'IPT', $borrowernumber, $biblioNumber3, undef, undef, '1', undef, undef, undef, undef, $ffl31, undef ); +C4::Reserves::AddReserve ( 'IPT', $borrowernumber, $biblioNumber3, undef, undef, '1', undef, undef, undef, undef, $ffl32, undef ); + +$dbh->do("UPDATE reserves SET reservedate = DATE_SUB( reservedate, INTERVAL 1 DAY )"); + +## Transfer of cpl11 should be blocked, other 3 Items are mapped +$testOk = 0; +$branches_to_use = undef; #Testing only with Transport cost matrix since it is the future! +$transport_cost_matrix = C4::HoldsQueue::TransportCostMatrix(); +$hold_requests = C4::HoldsQueue::GetPendingHoldRequestsForBib($biblioNumber1); +$available_items = C4::HoldsQueue::GetItemsAvailableToFillHoldRequestsForBib($biblioNumber1, $branches_to_use); +$item_map = C4::HoldsQueue::MapItemsToHoldRequests($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix); +is( (exists $item_map->{$cpl11}) , '', 'Item cpl11 transfer denied'); +is( (exists $item_map->{$cpl12}) , 1, 'Item cpl12 transfer allowed'); +is( (exists $item_map->{$ffl11}) , 1, 'Item cpl11 transfer allowed'); +is( (exists $item_map->{$ffl12}) , 1, 'Item cpl11 transfer allowed'); + +## All items should fail their transfer +$testOk = 0; +$branches_to_use = undef; #Testing only with Transport cost matrix since it is the future! +$transport_cost_matrix = C4::HoldsQueue::TransportCostMatrix(); +$hold_requests = C4::HoldsQueue::GetPendingHoldRequestsForBib($biblioNumber2); +$available_items = C4::HoldsQueue::GetItemsAvailableToFillHoldRequestsForBib($biblioNumber2, $branches_to_use); +$item_map = C4::HoldsQueue::MapItemsToHoldRequests($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix); +is( (exists $item_map->{$cpl21}) , '', 'Item cpl21 transfer denied'); +is( (exists $item_map->{$cpl22}) , '', 'Item cpl22 transfer denied'); + +## Should succeed, no transfer blocks +$testOk = 0; +$branches_to_use = undef; #Testing only with Transport cost matrix since it is the future! +$transport_cost_matrix = C4::HoldsQueue::TransportCostMatrix(); +$hold_requests = C4::HoldsQueue::GetPendingHoldRequestsForBib($biblioNumber3); +$available_items = C4::HoldsQueue::GetItemsAvailableToFillHoldRequestsForBib($biblioNumber3, $branches_to_use); +$item_map = C4::HoldsQueue::MapItemsToHoldRequests($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix); +is( (exists $item_map->{$ffl31}) , 1, 'Item ffl31 transfer allowed'); +is( (exists $item_map->{$ffl32}) , 1, 'Item ffl32 transfer allowed'); + +# Cleanup +$dbh->rollback(); \ No newline at end of file -- 1.8.1.2