From 86c2c4626d4f60b70531bd0ab358b9bd4faa8f08 Mon Sep 17 00:00:00 2001
From: Srdjan <srdjan@catalyst.net.nz>
Date: Wed, 5 Sep 2012 12:47:21 +1200
Subject: [PATCH] bug_5911: Transport Cost Matrix

Create transport_cost table,  added UseTransportCostMatrix syspref.
transport_cost table contains branch to branch transfer
costs. These are used for filling inter-branch hold transfers.

Moved GetHoldsQueueItems() from .pl to HoldsQueue.pm

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Paul Poulain <paul.poulain@biblibre.com>
---
 C4/Circulation.pm                             |   3 +-
 C4/HoldsQueue.pm                              | 622 ++++++++++++++++++
 admin/systempreferences.pl                    |   1 +
 admin/transport-cost-matrix.pl                | 124 ++++
 circ/view_holdsqueue.pl                       |  34 +-
 installer/data/mysql/kohastructure.sql        |  16 +
 installer/data/mysql/sysprefs.sql             |   1 +
 installer/data/mysql/updatedatabase.pl        |  22 +
 .../prog/en/modules/admin/admin-home.tt       |   2 +
 .../admin/preferences/circulation.pref        |   6 +
 .../en/modules/admin/transport-cost-matrix.tt | 131 ++++
 misc/cronjobs/holds/build_holds_queue.pl      | 385 +----------
 t/db_dependent/HoldsQueue.t                   | 173 +++++
 13 files changed, 1104 insertions(+), 416 deletions(-)
 create mode 100755 C4/HoldsQueue.pm
 create mode 100755 admin/transport-cost-matrix.pl
 create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/admin/transport-cost-matrix.tt
 create mode 100755 t/db_dependent/HoldsQueue.t

diff --git a/C4/Circulation.pm b/C4/Circulation.pm
index 8bd53b9f54..d33dd96be1 100644
--- a/C4/Circulation.pm
+++ b/C4/Circulation.pm
@@ -1477,7 +1477,8 @@ sub GetBranchItemRule {
 
     foreach my $attempt (@attempts) {
         my ($query, @bind_params) = @{$attempt};
-        my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params );
+        my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
+          or next;
 
         # Since branch/category and branch/itemtype use the same per-branch
         # defaults tables, we have to check that the key we want is set, not
diff --git a/C4/HoldsQueue.pm b/C4/HoldsQueue.pm
new file mode 100755
index 0000000000..608732f2dc
--- /dev/null
+++ b/C4/HoldsQueue.pm
@@ -0,0 +1,622 @@
+package C4::HoldsQueue;
+
+# Copyright 2011 Catalyst IT
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+# FIXME: expand perldoc, explain intended logic
+
+use strict;
+use warnings;
+
+use C4::Context;
+use C4::Search;
+use C4::Items;
+use C4::Branch;
+use C4::Circulation;
+use C4::Members;
+use C4::Biblio;
+use C4::Dates qw/format_date/;
+
+use List::Util qw(shuffle);
+use Data::Dumper;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+BEGIN {
+    $VERSION = 3.03;
+    require Exporter;
+    @ISA = qw(Exporter);
+    @EXPORT_OK = qw(
+        &CreateQueue
+        &GetHoldsQueueItems
+
+        &TransportCostMatrix
+        &UpdateTransportCostMatrix
+     );
+}
+
+# XXX This is not safe in a persistant environment
+my $dbh   = C4::Context->dbh;
+
+=head1 FUNCTIONS
+
+=head2 TransportCostMatrix
+
+  TransportCostMatrix();
+
+Returns Transport Cost Matrix as a hashref <to branch code> => <from branch code> => cost
+
+=cut
+
+sub TransportCostMatrix {
+    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 $disabled = $_->{disable_transfer};
+        $transport_cost_matrix{$to}{$from} = { cost => $cost, disable_transfer => $disabled };
+    }
+    return \%transport_cost_matrix;
+}
+
+=head2 UpdateTransportCostMatrix
+
+  UpdateTransportCostMatrix($records);
+
+Updates full Transport Cost Matrix table. $records is an arrayref of records.
+Records: { frombranch => <code>, tobranch => <code>, cost => <figure>, disable_transfer => <0,1> }
+
+=cut
+
+sub UpdateTransportCostMatrix {
+    my ($records) = @_;
+
+    my $sth = $dbh->prepare("INSERT INTO transport_cost (frombranch, tobranch, cost, disable_transfer) VALUES (?, ?, ?, ?)");
+
+    $dbh->do("TRUNCATE TABLE transport_cost");
+    foreach (@$records) {
+        my $cost = $_->{cost};
+        my $from = $_->{frombranch};
+        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";
+            $cost = 0;
+            $_->{disable_transfer} = 1;
+        }
+        $sth->execute( $from, $to, $cost, $_->{disable_transfer} ? 1 : 0 );
+    }
+}
+
+=head2 GetHoldsQueueItems
+
+  GetHoldsQueueItems($branch);
+
+Returns hold queue for a holding branch. If branch is omitted, then whole queue is returned
+
+=cut
+
+sub GetHoldsQueueItems {
+    my ($branchlimit) = @_;
+
+    my @bind_params = ();
+    my $query = q/SELECT tmp_holdsqueue.*, biblio.author, items.ccode, 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 = ?";
+        push @bind_params, $branchlimit;
+    }
+    $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};
+        }
+        push @$items, $row;
+    }
+    return $items;
+}
+
+=head2 CreateQueue
+
+  CreateQueue();
+
+Top level function that turns reserves into tmp_holdsqueue and hold_fill_targets.
+
+=cut
+
+sub CreateQueue {
+
+    $dbh->do("DELETE FROM tmp_holdsqueue");  # clear the old table for new info
+    $dbh->do("DELETE FROM hold_fill_targets");
+
+    my $total_bibs            = 0;
+    my $total_requests        = 0;
+    my $total_available_items = 0;
+    my $num_items_mapped      = 0;
+
+    my $branches_to_use;
+    my $transport_cost_matrix;
+    my $use_transport_cost_matrix = C4::Context->preference("UseTransportCostMatrix");
+    if ($use_transport_cost_matrix) {
+        $transport_cost_matrix = TransportCostMatrix();
+        unless (keys %$transport_cost_matrix) {
+            warn "UseTransportCostMatrix set to yes, but matrix not populated";
+            undef $transport_cost_matrix;
+        }
+    }
+    unless ($transport_cost_matrix) {
+        $branches_to_use = load_branches_to_pull_from();
+    }
+
+    my $bibs_with_pending_requests = GetBibsWithPendingHoldRequests();
+
+    foreach my $biblionumber (@$bibs_with_pending_requests) {
+        $total_bibs++;
+        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)
+          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);
+        }
+    }
+}
+
+=head2 GetBibsWithPendingHoldRequests
+
+  my $biblionumber_aref = GetBibsWithPendingHoldRequests();
+
+Return an arrayref of the biblionumbers of all bibs
+that have one or more unfilled hold requests.
+
+=cut
+
+sub GetBibsWithPendingHoldRequests {
+    my $dbh = C4::Context->dbh;
+
+    my $bib_query = "SELECT DISTINCT biblionumber
+                     FROM reserves
+                     WHERE found IS NULL
+                     AND priority > 0
+                     AND reservedate <= CURRENT_DATE()";
+    my $sth = $dbh->prepare($bib_query);
+
+    $sth->execute();
+    my $biblionumbers = $sth->fetchall_arrayref();
+
+    return [ map { $_->[0] } @$biblionumbers ];
+}
+
+=head2 GetPendingHoldRequestsForBib
+
+  my $requests = GetPendingHoldRequestsForBib($biblionumber);
+
+Returns an arrayref of hashrefs to pending, unfilled hold requests
+on the bib identified by $biblionumber.  The following keys
+are present in each hashref:
+
+    biblionumber
+    borrowernumber
+    itemnumber
+    priority
+    branchcode
+    reservedate
+    reservenotes
+    borrowerbranch
+
+The arrayref is sorted in order of increasing priority.
+
+=cut
+
+sub GetPendingHoldRequestsForBib {
+    my $biblionumber = shift;
+
+    my $dbh = C4::Context->dbh;
+
+    my $request_query = "SELECT biblionumber, borrowernumber, itemnumber, priority, reserves.branchcode,
+                                reservedate, reservenotes, borrowers.branchcode AS borrowerbranch
+                         FROM reserves
+                         JOIN borrowers USING (borrowernumber)
+                         WHERE biblionumber = ?
+                         AND found IS NULL
+                         AND priority > 0
+                         AND reservedate <= CURRENT_DATE()
+                         ORDER BY priority";
+    my $sth = $dbh->prepare($request_query);
+    $sth->execute($biblionumber);
+
+    my $requests = $sth->fetchall_arrayref({});
+    return $requests;
+
+}
+
+=head2 GetItemsAvailableToFillHoldRequestsForBib
+
+  my $available_items = GetItemsAvailableToFillHoldRequestsForBib($biblionumber, $branches_ar);
+
+Returns an arrayref of items available to fill hold requests
+for the bib identified by C<$biblionumber>.  An item is available
+to fill a hold request if and only if:
+
+    * it is not on loan
+    * it is not withdrawn
+    * it is not marked notforloan
+    * it is not currently in transit
+    * it is not lost
+    * it is not sitting on the hold shelf
+
+=cut
+
+sub GetItemsAvailableToFillHoldRequestsForBib {
+    my ($biblionumber, $branches_to_use) = @_;
+
+    my $dbh = C4::Context->dbh;
+    my $items_query = "SELECT itemnumber, homebranch, holdingbranch, 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)
+                           LEFT JOIN itemtypes USING (itemtype) ";
+    }
+    $items_query .=   "WHERE items.notforloan = 0
+                       AND holdingbranch IS NOT NULL
+                       AND itemlost = 0
+                       AND wthdrawn = 0";
+    $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 (
+                           SELECT itemnumber
+                           FROM reserves
+                           WHERE biblionumber = ?
+                           AND itemnumber IS NOT NULL
+                           AND (found IS NOT NULL OR priority = 0)
+                        )
+                       AND items.biblionumber = ?";
+    $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) . ")";
+        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} != 0
+    } @items ];
+}
+
+=head2 MapItemsToHoldRequests
+
+  MapItemsToHoldRequests($hold_requests, $available_items, $branches, $transport_cost_matrix)
+
+=cut
+
+sub MapItemsToHoldRequests {
+    my ($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix) = @_;
+
+    # handle trival cases
+    return unless scalar(@$hold_requests) > 0;
+    return unless scalar(@$available_items) > 0;
+
+    my $automatic_return = C4::Context->preference("AutomaticItemReturn");
+
+    # identify item-level requests
+    my %specific_items_requested = map { $_->{itemnumber} => 1 }
+                                   grep { defined($_->{itemnumber}) }
+                                   @$hold_requests;
+
+    # group available items by itemnumber
+    my %items_by_itemnumber = map { $_->{itemnumber} => $_ } @$available_items;
+
+    # items already allocated
+    my %allocated_items = ();
+
+    # map of items to hold requests
+    my %item_map = ();
+
+    # figure out which item-level requests can be filled
+    my $num_items_remaining = scalar(@$available_items);
+    foreach my $request (@$hold_requests) {
+        last if $num_items_remaining == 0;
+
+        # is this an item-level request?
+        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--;
+            }
+        } else {
+            # it's title-level request that will take up one item
+            $num_items_remaining--;
+        }
+    }
+
+    # group available items by branch
+    my %items_by_branch = ();
+    foreach my $item (@$available_items) {
+        next unless $item->{holdallowed};
+
+        push @{ $items_by_branch{  $automatic_return ? $item->{homebranch}
+                                                     : $item->{holdingbranch} } }, $item
+          unless exists $allocated_items{ $item->{itemnumber} };
+    }
+    return unless keys %items_by_branch;
+
+    # now handle the title-level requests
+    $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
+
+        # look for local match first
+        my $pickup_branch = $request->{branchcode} || $request->{borrowerbranch};
+        my ($itemnumber, $holdingbranch);
+
+        my $holding_branch_items = $automatic_return ? undef : $items_by_branch{$pickup_branch};
+        if ( $holding_branch_items ) {
+            foreach my $item (@$holding_branch_items) {
+                if ( $request->{borrowerbranch} eq $item->{homebranch} ) {
+                    $itemnumber = $item->{itemnumber};
+                    last;
+                }
+            }
+            $holdingbranch = $pickup_branch;
+            $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 ) {
+
+                my $holding_branch_items = $items_by_branch{$holdingbranch};
+                foreach my $item (@$holding_branch_items) {
+                    next if $request->{borrowerbranch} ne $item->{homebranch};
+
+                    $itemnumber = $item->{itemnumber};
+                    last;
+                }
+                $itemnumber ||= $holding_branch_items->[0]->{itemnumber};
+            }
+            else {
+                warn "No transport costs for $pickup_branch";
+            }
+        }
+
+        unless ($itemnumber) {
+            # not found yet, fall back to basics
+            if ($branches_to_use) {
+                $pull_branches = $branches_to_use;
+            } else {
+                $pull_branches = [keys %items_by_branch];
+            }
+            PULL_BRANCHES:
+            foreach my $branch (@$pull_branches) {
+                my $holding_branch_items = $items_by_branch{$branch}
+                  or next;
+
+                $holdingbranch ||= $branch;
+                foreach my $item (@$holding_branch_items) {
+                    next if $pickup_branch ne $item->{homebranch};
+
+                    $itemnumber = $item->{itemnumber};
+                    $holdingbranch = $branch;
+                    last PULL_BRANCHES;
+                }
+            }
+            $itemnumber ||= $items_by_branch{$holdingbranch}->[0]->{itemnumber}
+              if $holdingbranch;
+        }
+
+        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;
+
+            $item_map{$itemnumber} = {
+                borrowernumber => $request->{borrowernumber},
+                biblionumber => $request->{biblionumber},
+                holdingbranch => $holdingbranch,
+                pickup_branch => $pickup_branch,
+                item_level => 0,
+                reservedate => $request->{reservedate},
+                reservenotes => $request->{reservenotes},
+            };
+            $num_items_remaining--;
+        }
+    }
+    return \%item_map;
+}
+
+=head2 CreatePickListFromItemMap
+
+=cut
+
+sub CreatePicklistFromItemMap {
+    my $item_map = shift;
+
+    my $dbh = C4::Context->dbh;
+
+    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};
+        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 $itemcallnumber = $item->{itemcallnumber};
+
+        my $borrower = GetMember('borrowernumber'=>$borrowernumber);
+        my $cardnumber = $borrower->{'cardnumber'};
+        my $surname = $borrower->{'surname'};
+        my $firstname = $borrower->{'firstname'};
+        my $phone = $borrower->{'phone'};
+
+        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);
+    }
+}
+
+=head2 AddToHoldTargetMap
+
+=cut
+
+sub AddToHoldTargetMap {
+    my $item_map = shift;
+
+    my $dbh = C4::Context->dbh;
+
+    my $insert_sql = q(
+        INSERT INTO hold_fill_targets (borrowernumber, biblionumber, itemnumber, source_branchcode, item_level_request)
+                               VALUES (?, ?, ?, ?, ?)
+    );
+    my $sth_insert = $dbh->prepare($insert_sql);
+
+    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});
+    }
+}
+
+# Helper functions, not part of any interface
+
+sub _trim {
+    return $_[0] unless $_[0];
+    $_[0] =~ s/^\s+//;
+    $_[0] =~ s/\s+$//;
+    $_[0];
+}
+
+sub load_branches_to_pull_from {
+    my $static_branch_list = C4::Context->preference("StaticHoldsQueueWeight")
+      or return;
+
+    my @branches_to_use = map _trim($_), split /,/, $static_branch_list;
+
+    @branches_to_use = shuffle(@branches_to_use) if  C4::Context->preference("RandomizeHoldsQueueWeight");
+
+    return \@branches_to_use;
+}
+
+sub least_cost_branch {
+
+    #$from - arrayref
+    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;
+
+    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?
+
+        unless (defined $least_cost) {
+            $least_cost = $cost;
+            push @branch, $_;
+            next;
+        }
+
+        next if $cost > $least_cost;
+
+        if ($cost == $least_cost) {
+            push @branch, $_;
+            next;
+        }
+
+        @branch = ($_);
+        $least_cost = $cost;
+    }
+
+    return $branch[0];
+
+    # XXX return a random @branch with minimum cost instead of the first one;
+    # return $branch[0] if @branch == 1;
+}
+
+
+1;
diff --git a/admin/systempreferences.pl b/admin/systempreferences.pl
index f7a7d05838..8b3791933e 100755
--- a/admin/systempreferences.pl
+++ b/admin/systempreferences.pl
@@ -203,6 +203,7 @@ $tabsysprefs{DisplayClearScreenButton}       = "Circulation";
 $tabsysprefs{AllowAllMessageDeletion}        = "Circulation";
 $tabsysprefs{OverdueNoticeBcc}               = "Circulation";
 $tabsysprefs{OverduesBlockCirc}              = "Circulation";
+$tabsysprefs{UseTransportCostMatrix}         = "Circulation";
 
 
 # Staff Client
diff --git a/admin/transport-cost-matrix.pl b/admin/transport-cost-matrix.pl
new file mode 100755
index 0000000000..25d39118d9
--- /dev/null
+++ b/admin/transport-cost-matrix.pl
@@ -0,0 +1,124 @@
+#!/usr/bin/perl
+# Copyright 2000-2002 Katipo Communications
+# copyright 2010 BibLibre
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+use strict;
+use warnings;
+use CGI;
+use C4::Context;
+use C4::Output;
+use C4::Auth;
+use C4::Koha;
+use C4::Debug;
+use C4::Branch; # GetBranches
+use C4::HoldsQueue qw(TransportCostMatrix UpdateTransportCostMatrix);
+
+use Data::Dumper;
+
+my $input = new CGI;
+
+my ($template, $loggedinuser, $cookie)
+    = get_template_and_user({template_name => "admin/transport-cost-matrix.tmpl",
+                            query => $input,
+                            type => "intranet",
+                            authnotrequired => 0,
+                            flagsrequired => {parameters => 1},
+                            debug => 1,
+                            });
+my $use_transport_cost_matrix = C4::Context->preference("UseTransportCostMatrix");
+
+my $update = $input->param('op') eq 'set-cost-matrix';
+
+my ($cost_matrix, $have_matrix);
+unless ($update) {
+    $cost_matrix = TransportCostMatrix();
+    $have_matrix = keys %$cost_matrix if $cost_matrix;
+}
+
+my $branches = GetBranches();
+my @branchloop = map { code => $_,
+                       name => $branches->{$_}->{'branchname'} },
+                 sort { $branches->{$a}->{branchname} cmp $branches->{$b}->{branchname} }
+                 keys %$branches;
+my (@branchfromloop, @cost, @errors);
+foreach my $branchfrom ( @branchloop ) {
+    my $fromcode = $branchfrom->{code};
+
+    my %from_row = ( code => $fromcode, name => $branchfrom->{name} );
+    foreach my $branchto ( @branchloop ) {
+        my $tocode = $branchto->{code};
+
+        my %from_to_input_def = ( code => $tocode, name => $branchto->{name} );
+        push @{ $from_row{branchtoloop} }, \%from_to_input_def;
+
+        if ($fromcode eq $tocode) {
+            $from_to_input_def{skip} = 1;
+            next;
+        }
+
+        (my $from_to = "${fromcode}_${tocode}") =~ s/\W//go;
+         $from_to_input_def{id} = $from_to;
+        my $input_name   = "cost_$from_to";
+        my $disable_name = "disable_$from_to";
+
+        if ($update) {
+            my $value = $from_to_input_def{value} = $input->param($input_name);
+            if ( $input->param($disable_name) ) {
+                $from_to_input_def{disabled} = 1;
+            }
+            else {
+                push @errors, "Invalid value for $from_row{name} -> $from_to_input_def{name}"
+                  unless $value =~ /\d/o && $value >= 0.0;
+            }
+        }
+        else {
+            if ($have_matrix) {
+                if ( my $cell = $cost_matrix->{$tocode}{$fromcode} ) {
+                    $from_to_input_def{value} = $cell->{cost};
+                    $from_to_input_def{disabled} = 1 if $cell->{disable_transfer};
+                }
+            } else {
+                $from_to_input_def{disabled} = 1;
+            }
+        }
+    }
+
+#              die Dumper(\%from_row);
+    push @branchfromloop, \%from_row;
+}
+
+if ($update && !@errors) {
+    my @update_recs = map {
+        my $from = $_->{code};
+        map { frombranch => $from, tobranch => $_->{code}, cost => $_->{value}, disable_transfer => $_->{disabled} || 0 },
+            grep { $_->{code} ne $from }
+            @{ $_->{branchtoloop} };
+    } @branchfromloop;
+
+    UpdateTransportCostMatrix(\@update_recs);
+}
+
+$template->param(
+    branchloop => \@branchloop,
+    branchfromloop => \@branchfromloop,
+    WARNING_transport_cost_matrix_off => !$use_transport_cost_matrix,
+    errors => \@errors,
+);
+output_html_with_http_headers $input, $cookie, $template->output;
+
+exit 0;
diff --git a/circ/view_holdsqueue.pl b/circ/view_holdsqueue.pl
index 4b514239a4..cf529f04aa 100755
--- a/circ/view_holdsqueue.pl
+++ b/circ/view_holdsqueue.pl
@@ -31,7 +31,7 @@ use C4::Biblio;
 use C4::Items;
 use C4::Koha;   # GetItemTypes
 use C4::Branch; # GetBranches
-use C4::Dates qw/format_date/;
+use C4::HoldsQueue qw(GetHoldsQueueItems);
 
 my $query = new CGI;
 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
@@ -51,6 +51,7 @@ my $branchlimit    = $params->{'branchlimit'};
 my $itemtypeslimit = $params->{'itemtypeslimit'};
 
 if ( $run_report ) {
+    # XXX GetHoldsQueueItems() does not support $itemtypeslimit!
     my $items = GetHoldsQueueItems($branchlimit, $itemtypeslimit);
     $template->param(
         branch     => $branchlimit,
@@ -76,36 +77,5 @@ $template->param(
    itemtypeloop => \@itemtypesloop,
 );
 
-sub GetHoldsQueueItems {
-	my ($branchlimit,$itemtypelimit) = @_;
-	my $dbh = C4::Context->dbh;
-
-    my @bind_params = ();
-	my $query = q/SELECT tmp_holdsqueue.*, biblio.author, items.ccode, 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 = ?";
-        push @bind_params, $branchlimit;
-    }
-    $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};
-	}
-        push @$items, $row;
-    }
-    return $items;
-}
 # writing the template
 output_html_with_http_headers $query, $cookie, $template->output;
diff --git a/installer/data/mysql/kohastructure.sql b/installer/data/mysql/kohastructure.sql
index 91d42a29fb..a5939411f1 100644
--- a/installer/data/mysql/kohastructure.sql
+++ b/installer/data/mysql/kohastructure.sql
@@ -2809,6 +2809,22 @@ CREATE TABLE `fieldmapping` ( -- koha to keyword mapping
   PRIMARY KEY  (`id`)
 ) ENGINE=InnoDB DEFAULT CHARSET=utf8;
 
+--
+-- Table structure for table `transport_cost`
+--
+
+DROP TABLE IF EXISTS transport_cost;
+CREATE TABLE transport_cost (
+      frombranch varchar(10) NOT NULL,
+      tobranch varchar(10) NOT NULL,
+      cost decimal(6,2) NOT NULL,
+      disable_transfer tinyint(1) NOT NULL DEFAULT 0,
+      CHECK ( frombranch <> tobranch ), -- a dud check, mysql does not support that
+      PRIMARY KEY (frombranch, tobranch),
+      CONSTRAINT transport_cost_ibfk_1 FOREIGN KEY (frombranch) REFERENCES branches (branchcode) ON DELETE CASCADE ON UPDATE CASCADE,
+      CONSTRAINT transport_cost_ibfk_2 FOREIGN KEY (tobranch) REFERENCES branches (`branchcode`) ON DELETE CASCADE ON UPDATE CASCADE
+) ENGINE=InnoDB DEFAULT CHARSET=utf8;
+
 --
 -- Table structure for table `biblioimages`
 --
diff --git a/installer/data/mysql/sysprefs.sql b/installer/data/mysql/sysprefs.sql
index 35f92cccc7..3990d978c3 100644
--- a/installer/data/mysql/sysprefs.sql
+++ b/installer/data/mysql/sysprefs.sql
@@ -317,6 +317,7 @@ INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES
 INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('OpacHiddenItems','','This syspref allows to define custom rules for hiding specific items at opac. See docs/opac/OpacHiddenItems.txt for more informations.','','Textarea');
 INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('numSearchRSSResults',50,'Specify the maximum number of results to display on a RSS page of results',NULL,'Integer');
 INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES ('OpacRenewalBranch','checkoutbranch','Choose how the branch for an OPAC renewal is recorded in statistics','itemhomebranch|patronhomebranch|checkoutbranch|null','Choice');
+INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('UseTransportCostMatrix',0,"Use Transport Cost Matrix when filling holds",'','YesNo');
 INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES ('BasketConfirmations', '1', 'When closing or reopening a basket,', 'always ask for confirmation.|do not ask for confirmation.', 'Choice');
 INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES ('MARCAuthorityControlField008', '|| aca||aabn           | a|a     d', NULL, NULL, 'Textarea');
 INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('OpenLibraryCovers',0,'If ON Openlibrary book covers will be show',NULL,'YesNo');
diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl
index 25cd3676ce..7ca3ae4d4f 100755
--- a/installer/data/mysql/updatedatabase.pl
+++ b/installer/data/mysql/updatedatabase.pl
@@ -5696,6 +5696,28 @@ if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
     SetVersion($DBversion);
 }
 
+
+
+
+$DBversion = "3.09.00.XXX";
+if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
+    $dbh->do("INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('UseTransportCostMatrix',0,'Use Transport Cost Matrix when filling holds','','YesNo')");
+
+ $dbh->do("CREATE TABLE `transport_cost` (
+              `frombranch` varchar(10) NOT NULL,
+              `tobranch` varchar(10) NOT NULL,
+              `cost` decimal(6,2) NOT NULL,
+              `disable_transfer` tinyint(1) NOT NULL DEFAULT 0,
+              CHECK ( `frombranch` <> `tobranch` ), -- a dud check, mysql does not support that
+              PRIMARY KEY (`frombranch`, `tobranch`),
+              CONSTRAINT `transport_cost_ibfk_1` FOREIGN KEY (`frombranch`) REFERENCES `branches` (`branchcode`) ON DELETE CASCADE ON UPDATE CASCADE,
+              CONSTRAINT `transport_cost_ibfk_2` FOREIGN KEY (`tobranch`) REFERENCES `branches` (`branchcode`) ON DELETE CASCADE ON UPDATE CASCADE
+          ) ENGINE=InnoDB DEFAULT CHARSET=utf8");
+
+    print "Upgrade to $DBversion done (creating `transport_cost` table; adding UseTransportCostMatrix systempref, in circulation)\n";
+    SetVersion ($DBversion);
+}
+
 =head1 FUNCTIONS
 
 =head2 TableExists($table)
diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt
index 3906c46657..88fabe9ee7 100644
--- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt
+++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt
@@ -50,6 +50,8 @@
     <dd>Define extended attributes (identifiers and statistical categories) for patron records</dd>
     <dt><a href="/cgi-bin/koha/admin/branch_transfer_limits.pl">Library transfer limits</a></dt>
 	<dd>Limit the ability to transfer items between libraries based on the library sending, the library receiving, and the item type involved. These rules only go into effect if the preference UseBranchTransferLimits is set to ON.</dd>
+    <dt><a href="/cgi-bin/koha/admin/transport-cost-matrix.pl">Transport Cost Matrix</a></dt>
+    <dd>Define transport costs between branches</dd>
     <dt><a href="/cgi-bin/koha/admin/item_circulation_alerts.pl">Item circulation alerts</a></dt>
 	<dd>Define rules for check-in and checkout notifications for combinations of libraries, patron categories, and item types</dd>
     <dt><a href="/cgi-bin/koha/admin/cities.pl">Cities and towns</a></dt>
diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref
index a9ed6f7a72..1d25de6a61 100644
--- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref
+++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref
@@ -170,6 +170,12 @@ Circulation:
                   ccode: collection code
                   itemtype: item type
             - .
+        -
+            - pref: UseTransportCostMatrix
+              choices:
+                  yes: Use
+                  no: "Don't use"
+            - Transport Cost Matrix for calculating optimal holds filling between branches.
         -
             - Use the checkout and fines rules of
             - pref: CircControl
diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/transport-cost-matrix.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/transport-cost-matrix.tt
new file mode 100644
index 0000000000..8d12419a9f
--- /dev/null
+++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/transport-cost-matrix.tt
@@ -0,0 +1,131 @@
+[% INCLUDE 'doc-head-open.inc' %]
+<title>Koha &rsaquo; Administration &rsaquo; Transport Cost Matrix</title>
+[% INCLUDE 'doc-head-close.inc' %]
+
+<script type="text/javascript">
+//<![CDATA[
+function check_transport_cost(e) {
+    var val = e.value;
+    if (val && val != '' && !isNaN(parseFloat(val)) && val >= 0.0) {
+        return;
+    }
+    alert("Cost must be expressed as a decimal number >= 0");
+}
+function disable_transport_cost_chg(e, cost_id) {
+    disable_transport_cost(cost_id, e.checked);
+}
+function disable_transport_cost(cost_id, disable) {
+    if (disable) {
+        $('#celldiv_'+cost_id).find('input[type=text]').attr("disabled","disabled").addClass('disabled-transfer');
+    } else {
+        $('#celldiv_'+cost_id).find('input:disabled').removeAttr("disabled").removeClass('disabled-transfer');
+    }
+}
+function enable_cost_input(cost_id) {
+    var cell = $('#celldiv_'+cost_id);
+    var cost = $(cell).text();
+    var disabled = $(cell).hasClass('disabled-transfer');
+    $(cell).removeClass('disabled-transfer');
+
+    $('#celldiv_'+cost_id).html(
+        '<input type="text" name="cost_'+cost_id+'" onblur="check_transport_cost(this);" size="4" value="'+$.trim(cost)+'" />'+
+        '<br/>Disable <input name="disable_'+cost_id+'" value="1" onchange="disable_transport_cost_chg(this, \''+cost_id+'\');" type="checkbox" '+(disabled ? 'checked' : '')+' />'
+    );
+    disable_transport_cost(cost_id, disabled);
+}
+
+function form_submit (f) {
+    $(f).find('input:disabled').removeAttr("disabled");
+    return true;
+}
+
+$(document).ready(function() {
+    show_transport_cost_matrix([% IF UseTransportCostMatrix %]true[% ELSE %]false[% END %]);
+});
+//]]>
+</script>
+<style type="text/css">
+.disabled-transfer {
+    background-color: red;
+}
+.errors {
+    color: red;
+}
+</style>
+
+</head>
+<body>
+[% INCLUDE 'header.inc' %]
+[% INCLUDE 'cat-search.inc' %]
+
+<div id="breadcrumbs"><a href="/cgi-bin/koha/mainpage.pl">Home</a> &rsaquo; <a href="/cgi-bin/koha/admin/admin-home.pl">Administration</a> &rsaquo; Transport Cost Matrix</div>
+
+<div id="doc3" class="yui-t1">
+
+<div id="bd">
+    <div id="yui-main">
+    <div class="yui-b">
+    <h1 class="parameters">
+            Defining transport costs between libraries
+    </h1>
+[% IF ( WARNING_transport_cost_matrix_off ) %]
+<div class="dialog message">Because the "UseTransportCostMatrix" system preference is currently not enabled, Transport Cost Matrix is not being used.  Go <a href="/cgi-bin/koha/admin/preferences.pl?op=search&amp;searchfield=UseTransportCostMatrix">here</a> if you wish to enable this feature.</div>
+[% END %]
+
+    <div class="container">
+        <form method="post" action="?" onSubmit="return form_submit(this);">
+            <input type="hidden" name="op" value="set-cost-matrix" />
+            <div id="transport-cost-matrix">
+                <div class="help">
+                    <p>Costs are decimal values 0 to some arbitrarymax value (1 or 100), 0 being minimum (no) cost.</p>
+                    <p>Red cells signify no transfer allowed</p>
+                    <p>Click on the cell to edit</p>
+                </div>
+                <ul class="errors" %]>
+                [% FOR e IN errors %]
+                    <li>[% e %]</li>
+                [% END %]
+                </ul>
+                <table>
+                    <tr>
+                        <th>From \ To</th>
+                [% FOR b IN branchloop %]
+                        <th>[% b.name %]</th>
+                [% END %]
+                    <tr>
+                [% FOR bf IN branchfromloop %]
+                    <tr>
+                        <th>[% bf.name %]</th>
+                    [% FOR bt IN bf.branchtoloop %]
+                        <td>
+                        [% IF bt.skip %]
+                            &nbsp;
+                        [% ELSE %]
+                            [% IF bt.disabled %]
+                            <div id="celldiv_[% bt.id %]" class="disabled-transfer">
+                            [% ELSE %]
+                            <div id="celldiv_[% bt.id %]">
+                            [% END %]
+                            <div onclick="enable_cost_input('[% bt.id %]');">[% bt.disabled ? '&nbsp;' : bt.value %]</div>
+                            <input type="hidden" name="cost_[% bt.id %]" value="[% bt.value %]" />
+                            [% IF bt.disabled %]
+                            <input type="hidden" name="disable_[% bt.id %]" value="1" />
+                            [% END %]
+                            </div>
+                        [% END %]
+                        </td>
+                    [% END %]
+                    </tr>
+                [% END %]
+                </table>
+            </div>
+            <input type="submit" value="Save" class="submit" />
+        </form>
+    </div>
+    </div>
+    </div>
+<div class="yui-b">
+[% INCLUDE 'admin-menu.inc' %]
+</div>
+</div>
+[% INCLUDE 'intranet-bottom.inc' %]
diff --git a/misc/cronjobs/holds/build_holds_queue.pl b/misc/cronjobs/holds/build_holds_queue.pl
index d920c042a4..9ec9825ea9 100755
--- a/misc/cronjobs/holds/build_holds_queue.pl
+++ b/misc/cronjobs/holds/build_holds_queue.pl
@@ -5,7 +5,6 @@
 #-----------------------------------
 # FIXME: add command-line options for verbosity and summary
 # FIXME: expand perldoc, explain intended logic
-# FIXME: refactor all subroutines into C4 for testability
 
 use strict;
 use warnings;
@@ -16,387 +15,7 @@ BEGIN {
     eval { require "$FindBin::Bin/../kohalib.pl" };
 }
 
-use C4::Context;
-use C4::Search;
-use C4::Items;
-use C4::Branch;
-use C4::Circulation;
-use C4::Members;
-use C4::Biblio;
+use C4::HoldsQueue qw(CreateQueue);
 
-use List::Util qw(shuffle);
+CreateQueue();
 
-my $bibs_with_pending_requests = GetBibsWithPendingHoldRequests();
-
-my $dbh   = C4::Context->dbh;
-$dbh->do("DELETE FROM tmp_holdsqueue");  # clear the old table for new info
-$dbh->do("DELETE FROM hold_fill_targets");
-
-my $total_bibs            = 0;
-my $total_requests        = 0;
-my $total_available_items = 0;
-my $num_items_mapped      = 0;
-
-my @branches_to_use = _get_branches_to_pull_from();
-
-foreach my $biblionumber (@$bibs_with_pending_requests) {
-    $total_bibs++;
-    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);
-
-    (defined($item_map)) or next;
-
-    my $item_map_size = scalar(keys %$item_map);
-    $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);
-    }
-}
-
-exit 0;
-
-=head1 FUNCTIONS
-
-=head2 GetBibsWithPendingHoldRequests
-
-  my $biblionumber_aref = GetBibsWithPendingHoldRequests();
-
-Return an arrayref of the biblionumbers of all bibs
-that have one or more unfilled hold requests.
-
-=cut
-
-sub GetBibsWithPendingHoldRequests {
-    my $dbh = C4::Context->dbh;
-
-    my $bib_query = "SELECT DISTINCT biblionumber
-                     FROM reserves
-                     WHERE found IS NULL
-                     AND priority > 0
-                     AND reservedate <= CURRENT_DATE()
-                     AND suspend = 0
-                     ";
-    my $sth = $dbh->prepare($bib_query);
-
-    $sth->execute();
-    my $biblionumbers = $sth->fetchall_arrayref();
-
-    return [ map { $_->[0] } @$biblionumbers ];
-}
-
-=head2 GetPendingHoldRequestsForBib
-
-  my $requests = GetPendingHoldRequestsForBib($biblionumber);
-
-Returns an arrayref of hashrefs to pending, unfilled hold requests
-on the bib identified by $biblionumber.  The following keys
-are present in each hashref:
-
-    biblionumber
-    borrowernumber
-    itemnumber
-    priority
-    branchcode
-    reservedate
-    reservenotes
-    borrowerbranch
-
-The arrayref is sorted in order of increasing priority.
-
-=cut
-
-sub GetPendingHoldRequestsForBib {
-    my $biblionumber = shift;
-
-    my $dbh = C4::Context->dbh;
-
-    my $request_query = "SELECT biblionumber, borrowernumber, itemnumber, priority, reserves.branchcode, 
-                                reservedate, reservenotes, borrowers.branchcode AS borrowerbranch
-                         FROM reserves
-                         JOIN borrowers USING (borrowernumber)
-                         WHERE biblionumber = ?
-                         AND found IS NULL
-                         AND priority > 0
-                         AND reservedate <= CURRENT_DATE()
-                         AND suspend = 0
-                         ORDER BY priority";
-    my $sth = $dbh->prepare($request_query);
-    $sth->execute($biblionumber);
-
-    my $requests = $sth->fetchall_arrayref({});
-    return $requests;
-
-}
-
-=head2 GetItemsAvailableToFillHoldRequestsForBib
-
-  my $available_items = GetItemsAvailableToFillHoldRequestsForBib($biblionumber);
-
-Returns an arrayref of items available to fill hold requests
-for the bib identified by C<$biblionumber>.  An item is available
-to fill a hold request if and only if:
-
-    * it is not on loan
-    * it is not withdrawn
-    * it is not marked notforloan
-    * it is not currently in transit
-    * it is not lost
-    * it is not sitting on the hold shelf
-
-=cut
-
-sub GetItemsAvailableToFillHoldRequestsForBib {
-    my $biblionumber = shift;
-    my @branches_to_use = @_;
-
-    my $dbh = C4::Context->dbh;
-    my $items_query = "SELECT itemnumber, homebranch, holdingbranch, 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)
-                           LEFT JOIN itemtypes USING (itemtype) ";
-    }
-    $items_query .=   "WHERE items.notforloan = 0
-                       AND holdingbranch IS NOT NULL
-                       AND itemlost = 0
-                       AND wthdrawn = 0";
-    $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 (
-                           SELECT itemnumber
-                           FROM reserves
-                           WHERE biblionumber = ?
-                           AND itemnumber IS NOT NULL
-                           AND (found IS NOT NULL OR priority = 0)
-                        )
-                       AND items.biblionumber = ?";
-    my @params = ($biblionumber, $biblionumber);
-    if ($#branches_to_use > -1) {
-        $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 $items = $sth->fetchall_arrayref({});
-    $items = [ grep { my @transfers = GetTransfers($_->{itemnumber}); $#transfers == -1; } @$items ]; 
-    map { my $rule = GetBranchItemRule($_->{homebranch}, $_->{itype}); $_->{holdallowed} = $rule->{holdallowed}; $rule->{holdallowed} != 0 } @$items;
-    return [ grep { $_->{holdallowed} != 0 } @$items ];
-}
-
-=head2 MapItemsToHoldRequests
-
-  MapItemsToHoldRequests($hold_requests, $available_items);
-
-=cut
-
-sub MapItemsToHoldRequests {
-    my $hold_requests = shift;
-    my $available_items = shift;
-    my @branches_to_use = @_;
-
-    # handle trival cases
-    return unless scalar(@$hold_requests) > 0;
-    return unless scalar(@$available_items) > 0;
-
-    # identify item-level requests
-    my %specific_items_requested = map { $_->{itemnumber} => 1 } 
-                                   grep { defined($_->{itemnumber}) }
-                                   @$hold_requests;
-
-    # group available items by itemnumber
-    my %items_by_itemnumber = map { $_->{itemnumber} => $_ } @$available_items;
-
-    # items already allocated
-    my %allocated_items = ();
-
-    # map of items to hold requests
-    my %item_map = ();
- 
-    # figure out which item-level requests can be filled    
-    my $num_items_remaining = scalar(@$available_items);
-    foreach my $request (@$hold_requests) {
-        last if $num_items_remaining == 0;
-
-        # is this an item-level request?
-        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},
-                    item_level => 1,
-                    reservedate => $request->{reservedate},
-                    reservenotes => $request->{reservenotes},
-                };
-                $allocated_items{$request->{itemnumber}}++;
-                $num_items_remaining--;
-            }
-        } else {
-            # it's title-level request that will take up one item
-            $num_items_remaining--;
-        }
-    }
-
-    # group available items by branch
-    my %items_by_branch = ();
-    foreach my $item (@$available_items) {
-        push @{ $items_by_branch{ $item->{holdingbranch} } }, $item unless exists $allocated_items{ $item->{itemnumber} };
-    }
-
-    # now handle the title-level requests
-    $num_items_remaining = scalar(@$available_items) - scalar(keys %allocated_items); 
-    foreach my $request (@$hold_requests) {
-        last if $num_items_remaining <= 0;
-        next if defined($request->{itemnumber}); # already handled these
-
-        # look for local match first
-        my $pickup_branch = $request->{branchcode};
-        if (exists $items_by_branch{$pickup_branch} and 
-            not ($items_by_branch{$pickup_branch}->[0]->{holdallowed} == 1 and 
-                 $request->{borrowerbranch} ne $items_by_branch{$pickup_branch}->[0]->{homebranch}) 
-           ) {
-            my $item = pop @{ $items_by_branch{$pickup_branch} };
-            delete $items_by_branch{$pickup_branch} if scalar(@{ $items_by_branch{$pickup_branch} }) == 0;
-            $item_map{$item->{itemnumber}} = { 
-                                                borrowernumber => $request->{borrowernumber},
-                                                biblionumber => $request->{biblionumber},
-                                                holdingbranch => $pickup_branch,
-                                                pickup_branch => $pickup_branch,
-                                                item_level => 0,
-                                                reservedate => $request->{reservedate},
-                                                reservenotes => $request->{reservenotes},
-                                             };
-            $num_items_remaining--;
-        } else {
-            my @pull_branches = ();
-            if ($#branches_to_use > -1) {
-                @pull_branches = @branches_to_use;
-            } else {
-                @pull_branches = sort keys %items_by_branch;
-            }
-            foreach my $branch (@pull_branches) {
-                next unless exists $items_by_branch{$branch} and
-                            not ($items_by_branch{$branch}->[0]->{holdallowed} == 1 and 
-                                $request->{borrowerbranch} ne $items_by_branch{$branch}->[0]->{homebranch});
-                my $item = pop @{ $items_by_branch{$branch} };
-                delete $items_by_branch{$branch} if scalar(@{ $items_by_branch{$branch} }) == 0;
-                $item_map{$item->{itemnumber}} = { 
-                                                    borrowernumber => $request->{borrowernumber},
-                                                    biblionumber => $request->{biblionumber},
-                                                    holdingbranch => $branch,
-                                                    pickup_branch => $pickup_branch,
-                                                    item_level => 0,
-                                                    reservedate => $request->{reservedate},
-                                                    reservenotes => $request->{reservenotes},
-                                                 };
-                $num_items_remaining--; 
-                last;
-            }
-        }
-    }
-    return \%item_map;
-}
-
-=head2 CreatePickListFromItemMap 
-
-=cut
-
-sub CreatePicklistFromItemMap {
-    my $item_map = shift;
-
-    my $dbh = C4::Context->dbh;
-
-    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}; 
-        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 $itemcallnumber = $item->{itemcallnumber};
-
-        my $borrower = GetMember('borrowernumber'=>$borrowernumber);
-        my $cardnumber = $borrower->{'cardnumber'};
-        my $surname = $borrower->{'surname'};
-        my $firstname = $borrower->{'firstname'};
-        my $phone = $borrower->{'phone'};
-   
-        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);
-    }
-}
-
-=head2 AddToHoldTargetMap
-
-=cut
-
-sub AddToHoldTargetMap {
-    my $item_map = shift;
-
-    my $dbh = C4::Context->dbh;
-
-    my $insert_sql = q(
-        INSERT INTO hold_fill_targets (borrowernumber, biblionumber, itemnumber, source_branchcode, item_level_request)
-                               VALUES (?, ?, ?, ?, ?)
-    );
-    my $sth_insert = $dbh->prepare($insert_sql);
-
-    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});
-    }
-}
-
-=head2 _get_branches_to_pull_from
-
-Query system preferences to get ordered list of
-branches to use to fill hold requests.
-
-=cut
-
-sub _get_branches_to_pull_from {
-    my @branches_to_use = ();
-  
-    my $static_branch_list = C4::Context->preference("StaticHoldsQueueWeight");
-    if ($static_branch_list) {
-        @branches_to_use = map { s/^\s+//; s/\s+$//; $_; } split /,/, $static_branch_list;
-    }
-
-    @branches_to_use = shuffle(@branches_to_use) if  C4::Context->preference("RandomizeHoldsQueueWeight");
-
-    return @branches_to_use;
-}
diff --git a/t/db_dependent/HoldsQueue.t b/t/db_dependent/HoldsQueue.t
new file mode 100755
index 0000000000..7fb459a6e9
--- /dev/null
+++ b/t/db_dependent/HoldsQueue.t
@@ -0,0 +1,173 @@
+#!/usr/bin/perl
+
+# Test C4::HoldsQueue::CreateQueue() for both transport cost matrix
+# and StaticHoldsQueueWeight array (no RandomizeHoldsQueueWeight, no point)
+# Wraps tests in transaction that's rolled back, so no data is destroyed
+# MySQL WARNING: This makes sense only if your tables are InnoDB, otherwise
+# transactions are not supported and mess is left behind
+
+use strict;
+use warnings;
+use C4::Context;
+
+use Data::Dumper;
+
+use Test::More tests => 18;
+
+BEGIN {
+    use FindBin;
+    use lib $FindBin::Bin;
+    use_ok('C4::Reserves');
+    use_ok('C4::HoldsQueue');
+}
+
+my $TITLE = "Test Holds Queue XXX";
+# Pick a plausible borrower. Easier than creating one.
+my $BORROWER_QRY = <<EOQ;
+select *
+from borrowers
+where borrowernumber = (select max(borrowernumber) from issues)
+EOQ
+my $dbh = C4::Context->dbh;
+my $borrower = $dbh->selectrow_hashref($BORROWER_QRY);
+my $borrowernumber = $borrower->{borrowernumber};
+# Set special (for this test) branches
+my $borrower_branchcode = $borrower->{branchcode};
+my @other_branches = grep { $_ ne $borrower_branchcode } @{ $dbh->selectcol_arrayref("SELECT branchcode FROM branches") };
+my $least_cost_branch_code = pop @other_branches
+  or BAIL_OUT("No point testing only one branch...");
+my $itemtype = $dbh->selectrow_array("SELECT min(itemtype) FROM itemtypes WHERE notforloan = 0")
+  or BAIL_OUT("No adequate itemtype");
+
+# Start transaction
+$dbh->{AutoCommit} = 0;
+$dbh->{RaiseError} = 1;
+
+#Set up the stage
+# Sysprefs and cost matrix
+$dbh->do("UPDATE systempreferences SET value = ? WHERE variable = 'StaticHoldsQueueWeight'", undef,
+         join( ',', @other_branches, $borrower_branchcode, $least_cost_branch_code));
+$dbh->do("UPDATE systempreferences SET value = '0' WHERE variable = 'RandomizeHoldsQueueWeight'");
+
+$dbh->do("DELETE FROM transport_cost");
+my $transport_cost_insert_sth = $dbh->prepare("insert into transport_cost (frombranch, tobranch, cost) values (?, ?, ?)");
+# Favour $least_cost_branch_code
+$transport_cost_insert_sth->execute($borrower_branchcode, $least_cost_branch_code, 0.2);
+$transport_cost_insert_sth->execute($least_cost_branch_code, $borrower_branchcode, 0.2);
+my @b = @other_branches;
+while ( my $b1 = shift @b ) {
+    foreach my $b2 ($borrower_branchcode, $least_cost_branch_code, @b) {
+        $transport_cost_insert_sth->execute($b1, $b2, 0.5);
+        $transport_cost_insert_sth->execute($b2, $b1, 0.5);
+    }
+}
+
+
+# Loanable items - all possible combinations of homebranch and holdingbranch
+$dbh->do("INSERT INTO biblio (frameworkcode, author, title, datecreated)
+          VALUES             ('SER', 'Koha test', '$TITLE', '2011-02-01')");
+my $biblionumber = $dbh->selectrow_array("SELECT biblionumber FROM biblio WHERE title = '$TITLE'")
+  or BAIL_OUT("Cannot find newly created biblio record");
+$dbh->do("INSERT INTO biblioitems (biblionumber, marcxml, itemtype)
+          VALUES                  ($biblionumber, '', '$itemtype')");
+my $biblioitemnumber = $dbh->selectrow_array("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber = $biblionumber")
+  or BAIL_OUT("Cannot find newly created biblioitems record");
+
+my $items_insert_sth = $dbh->prepare("INSERT INTO items (biblionumber, biblioitemnumber, barcode, homebranch, holdingbranch, notforloan, damaged, itemlost, wthdrawn, onloan, itype)
+                                      VALUES            ($biblionumber, $biblioitemnumber, ?, ?, ?, 0, 0, 0, 0, NULL, '$itemtype')"); # CURRENT_DATE - 3)");
+my $first_barcode = int(rand(1000000000000)); # XXX
+my $barcode = $first_barcode;
+foreach ( $borrower_branchcode, $least_cost_branch_code, @other_branches ) {
+    $items_insert_sth->execute($barcode++, $borrower_branchcode, $_);
+    $items_insert_sth->execute($barcode++, $_, $_);
+    $items_insert_sth->execute($barcode++, $_, $borrower_branchcode);
+}
+
+# Remove existing reserves, makes debugging easier
+$dbh->do("DELETE FROM reserves");
+my $constraint = undef;
+my $bibitems = undef;
+my $priority = 1;
+# Make a reserve
+AddReserve ( $borrower_branchcode, $borrowernumber, $biblionumber, $constraint, $bibitems,  $priority );
+#                           $resdate, $expdate, $notes, $title, $checkitem, $found
+$dbh->do("UPDATE reserves SET reservedate = reservedate - 1");
+
+# Tests
+my $use_cost_matrix_sth = $dbh->prepare("UPDATE systempreferences SET value = ? WHERE variable = 'UseTransportCostMatrix'");
+my $test_sth = $dbh->prepare("SELECT * FROM hold_fill_targets
+                              JOIN tmp_holdsqueue USING (borrowernumber, biblionumber, itemnumber)
+                              JOIN items USING (itemnumber)
+                              WHERE borrowernumber = $borrowernumber");
+
+# We have a book available homed in borrower branch, no point fiddling with AutomaticItemReturn
+test_queue ('take from homebranch',  0, $borrower_branchcode, $borrower_branchcode);
+test_queue ('take from homebranch',  1, $borrower_branchcode, $borrower_branchcode);
+
+$dbh->do("DELETE FROM tmp_holdsqueue");
+$dbh->do("DELETE FROM hold_fill_targets");
+$dbh->do("DELETE FROM issues WHERE itemnumber IN (SELECT itemnumber FROM items WHERE homebranch = '$borrower_branchcode' AND holdingbranch = '$borrower_branchcode')");
+$dbh->do("DELETE FROM items WHERE homebranch = '$borrower_branchcode' AND holdingbranch = '$borrower_branchcode'");
+# test_queue will flush
+$dbh->do("UPDATE systempreferences SET value = 1 WHERE variable = 'AutomaticItemReturn'");
+# Not sure how to make this test more difficult - holding branch does not matter
+test_queue ('take from holdingbranch AutomaticItemReturn on', 0, $borrower_branchcode, undef);
+test_queue ('take from holdingbranch AutomaticItemReturn on', 1, $borrower_branchcode, $least_cost_branch_code);
+
+$dbh->do("DELETE FROM tmp_holdsqueue");
+$dbh->do("DELETE FROM hold_fill_targets");
+$dbh->do("DELETE FROM issues WHERE itemnumber IN (SELECT itemnumber FROM items WHERE homebranch = '$borrower_branchcode')");
+$dbh->do("DELETE FROM items WHERE homebranch = '$borrower_branchcode'");
+$dbh->do("UPDATE systempreferences SET value = 0 WHERE variable = 'AutomaticItemReturn'");
+# We have a book available held in borrower branch
+test_queue ('take from holdingbranch', 0, $borrower_branchcode, $borrower_branchcode);
+test_queue ('take from holdingbranch', 1, $borrower_branchcode, $borrower_branchcode);
+
+$dbh->do("DELETE FROM tmp_holdsqueue");
+$dbh->do("DELETE FROM hold_fill_targets");
+$dbh->do("DELETE FROM issues WHERE itemnumber IN (SELECT itemnumber FROM items WHERE holdingbranch = '$borrower_branchcode')");
+$dbh->do("DELETE FROM items WHERE holdingbranch = '$borrower_branchcode'");
+# No book available in borrower branch, pick according to the rules
+# Frst branch from StaticHoldsQueueWeight
+test_queue ('take from lowest cost branch', 0, $borrower_branchcode, $other_branches[0]);
+test_queue ('take from lowest cost branch', 1, $borrower_branchcode, $least_cost_branch_code);
+my $queue = C4::HoldsQueue::GetHoldsQueueItems($least_cost_branch_code) || [];
+my $queue_item = $queue->[0];
+ok( $queue_item
+ && $queue_item->{pickbranch} eq $borrower_branchcode
+ && $queue_item->{holdingbranch} eq $least_cost_branch_code, "GetHoldsQueueItems" )
+  or diag( "Expected item for pick $borrower_branchcode, hold $least_cost_branch_code, got ".Dumper($queue_item) );
+
+# XXX All this tests are for borrower branch pick-up.
+# Maybe needs expanding to homebranch or holdingbranch pick-up.
+
+# Cleanup
+$dbh->rollback;
+
+exit;
+
+sub test_queue {
+    my ($test_name, $use_cost_matrix, $pick_branch, $hold_branch) = @_;
+
+    $test_name = "$test_name (".($use_cost_matrix ? "" : "don't ")."use cost matrix)";
+
+    $use_cost_matrix_sth->execute($use_cost_matrix);
+    C4::Context->clear_syspref_cache();
+    C4::HoldsQueue::CreateQueue();
+
+    my $results = $dbh->selectall_arrayref($test_sth, { Slice => {} }); # should be only one
+    my $r = $results->[0];
+
+    my $ok = is( $r->{pickbranch}, $pick_branch, "$test_name pick up branch");
+    $ok &&=  is( $r->{holdingbranch}, $hold_branch, "$test_name holding branch")
+      if $hold_branch;
+
+    diag( "Wrong pick-up/hold for first target (pick_branch, hold_branch, reserves, hold_fill_targets, tmp_holdsqueue): "
+        . Dumper ($pick_branch, $hold_branch, map dump_records($_), qw(reserves hold_fill_targets tmp_holdsqueue)) )
+      unless $ok;
+}
+
+sub dump_records {
+    my ($tablename) = @_;
+    return $dbh->selectall_arrayref("SELECT * from $tablename where borrowernumber = ?", { Slice => {} }, $borrowernumber);
+}
-- 
2.39.5