| Line 0
          
      
      
        Link Here | 
            
              |  |  | 1 | package C4::HoldsQueue; | 
            
              | 2 |  | 
            
              | 3 | # Copyright 2011 Catalyst IT | 
            
              | 4 | # | 
            
              | 5 | # This file is part of Koha. | 
            
              | 6 | # | 
            
              | 7 | # Koha is free software; you can redistribute it and/or modify it under the | 
            
              | 8 | # terms of the GNU General Public License as published by the Free Software | 
            
              | 9 | # Foundation; either version 2 of the License, or (at your option) any later | 
            
              | 10 | # version. | 
            
              | 11 | # | 
            
              | 12 | # Koha is distributed in the hope that it will be useful, but WITHOUT ANY | 
            
              | 13 | # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR | 
            
              | 14 | # A PARTICULAR PURPOSE.  See the GNU General Public License for more details. | 
            
              | 15 | # | 
            
              | 16 | # You should have received a copy of the GNU General Public License along | 
            
              | 17 | # with Koha; if not, write to the Free Software Foundation, Inc., | 
            
              | 18 | # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | 
            
              | 19 |  | 
            
              | 20 | # FIXME: expand perldoc, explain intended logic | 
            
              | 21 |  | 
            
              | 22 | use strict; | 
            
              | 23 | use warnings; | 
            
              | 24 |  | 
            
              | 25 | use C4::Context; | 
            
              | 26 | use C4::Search; | 
            
              | 27 | use C4::Items; | 
            
              | 28 | use C4::Branch; | 
            
              | 29 | use C4::Circulation; | 
            
              | 30 | use C4::Members; | 
            
              | 31 | use C4::Biblio; | 
            
              | 32 | use C4::Dates qw/format_date/; | 
            
              | 33 |  | 
            
              | 34 | use List::Util qw(shuffle); | 
            
              | 35 | use Data::Dumper; | 
            
              | 36 |  | 
            
              | 37 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); | 
            
              | 38 | BEGIN { | 
            
              | 39 |     $VERSION = 3.03; | 
            
              | 40 |     require Exporter; | 
            
              | 41 |     @ISA = qw(Exporter); | 
            
              | 42 |     @EXPORT_OK = qw( | 
            
              | 43 |         &CreateQueue | 
            
              | 44 |         &GetHoldsQueueItems | 
            
              | 45 |  | 
            
              | 46 |         &TransportCostMatrix | 
            
              | 47 |         &UpdateTransportCostMatrix | 
            
              | 48 |      ); | 
            
              | 49 | } | 
            
              | 50 |  | 
            
              | 51 | # XXX This is not safe in a persistant environment | 
            
              | 52 | my $dbh   = C4::Context->dbh; | 
            
              | 53 |  | 
            
              | 54 | =head1 FUNCTIONS | 
            
              | 55 |  | 
            
              | 56 | =head2 TransportCostMatrix | 
            
              | 57 |  | 
            
              | 58 |   TransportCostMatrix(); | 
            
              | 59 |  | 
            
              | 60 | Returns Transport Cost Matrix as a hashref <to branch code> => <from branch code> => cost | 
            
              | 61 |  | 
            
              | 62 | =cut | 
            
              | 63 |  | 
            
              | 64 | sub TransportCostMatrix { | 
            
              | 65 |     my $transport_costs = $dbh->selectall_arrayref("SELECT * FROM transport_cost",{ Slice => {} }); | 
            
              | 66 |  | 
            
              | 67 |     my %transport_cost_matrix; | 
            
              | 68 |     foreach (@$transport_costs) { | 
            
              | 69 |         my $from = $_->{frombranch}; | 
            
              | 70 |         my $to = $_->{tobranch}; | 
            
              | 71 |         my $cost = $_->{cost}; | 
            
              | 72 |         my $disabled = $_->{disable_transfer}; | 
            
              | 73 |         $transport_cost_matrix{$to}{$from} = { cost => $cost, disable_transfer => $disabled }; | 
            
              | 74 |     } | 
            
              | 75 |     return \%transport_cost_matrix; | 
            
              | 76 | } | 
            
              | 77 |  | 
            
              | 78 | =head2 UpdateTransportCostMatrix | 
            
              | 79 |  | 
            
              | 80 |   UpdateTransportCostMatrix($records); | 
            
              | 81 |  | 
            
              | 82 | Updates full Transport Cost Matrix table. $records is an arrayref of records. | 
            
              | 83 | Records: { frombranch => <code>, tobranch => <code>, cost => <figure>, disable_transfer => <0,1> } | 
            
              | 84 |  | 
            
              | 85 | =cut | 
            
              | 86 |  | 
            
              | 87 | sub UpdateTransportCostMatrix { | 
            
              | 88 |     my ($records) = @_; | 
            
              | 89 |  | 
            
              | 90 |     my $sth = $dbh->prepare("INSERT INTO transport_cost (frombranch, tobranch, cost, disable_transfer) VALUES (?, ?, ?, ?)"); | 
            
              | 91 |                   | 
            
              | 92 |     $dbh->do("TRUNCATE TABLE transport_cost"); | 
            
              | 93 |     foreach (@$records) { | 
            
              | 94 |         my $cost = $_->{cost}; | 
            
              | 95 |         my $from = $_->{frombranch}; | 
            
              | 96 |         my $to = $_->{tobranch}; | 
            
              | 97 |         if ($_->{disable_transfer}) { | 
            
              | 98 |             $cost ||= 0; | 
            
              | 99 |         } | 
            
              | 100 |         elsif ( !defined ($cost) || ($cost !~ m/(0|[1-9][0-9]*)(\.[0-9]*)?/o) ) { | 
            
              | 101 |             warn  "Invalid $from -> $to cost $cost - must be a number >= 0, disablig"; | 
            
              | 102 |             $cost = 0; | 
            
              | 103 |             $_->{disable_transfer} = 1; | 
            
              | 104 |         } | 
            
              | 105 |         $sth->execute( $from, $to, $cost, $_->{disable_transfer} ? 1 : 0 ); | 
            
              | 106 |     } | 
            
              | 107 | } | 
            
              | 108 |  | 
            
              | 109 | =head2 GetHoldsQueueItems | 
            
              | 110 |  | 
            
              | 111 |   GetHoldsQueueItems($branch); | 
            
              | 112 |  | 
            
              | 113 | Returns hold queue for a holding branch. If branch is omitted, then whole queue is returned | 
            
              | 114 |  | 
            
              | 115 | =cut | 
            
              | 116 |  | 
            
              | 117 | sub GetHoldsQueueItems { | 
            
              | 118 |     my ($branchlimit) = @_; | 
            
              | 119 |  | 
            
              | 120 |     my @bind_params = (); | 
            
              | 121 |     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 | 
            
              | 122 |                   FROM tmp_holdsqueue | 
            
              | 123 |                        JOIN biblio      USING (biblionumber) | 
            
              | 124 |                   LEFT JOIN biblioitems USING (biblionumber) | 
            
              | 125 |                   LEFT JOIN items       USING (  itemnumber) | 
            
              | 126 |                 /; | 
            
              | 127 |     if ($branchlimit) { | 
            
              | 128 |         $query .=" WHERE tmp_holdsqueue.holdingbranch = ?"; | 
            
              | 129 |         push @bind_params, $branchlimit; | 
            
              | 130 |     } | 
            
              | 131 |     $query .= " ORDER BY ccode, location, cn_sort, author, title, pickbranch, reservedate"; | 
            
              | 132 |     my $sth = $dbh->prepare($query); | 
            
              | 133 |     $sth->execute(@bind_params); | 
            
              | 134 |     my $items = []; | 
            
              | 135 |     while ( my $row = $sth->fetchrow_hashref ){ | 
            
              | 136 |         $row->{reservedate} = format_date($row->{reservedate}); | 
            
              | 137 |         my $record = GetMarcBiblio($row->{biblionumber}); | 
            
              | 138 |         if ($record){ | 
            
              | 139 |             $row->{subtitle} = GetRecordValue('subtitle',$record,'')->[0]->{subfield}; | 
            
              | 140 |             $row->{parts} = GetRecordValue('parts',$record,'')->[0]->{subfield}; | 
            
              | 141 |             $row->{numbers} = GetRecordValue('numbers',$record,'')->[0]->{subfield}; | 
            
              | 142 |         } | 
            
              | 143 |         push @$items, $row; | 
            
              | 144 |     } | 
            
              | 145 |     return $items; | 
            
              | 146 | } | 
            
              | 147 |  | 
            
              | 148 | =head2 CreateQueue | 
            
              | 149 |  | 
            
              | 150 |   CreateQueue(); | 
            
              | 151 |  | 
            
              | 152 | Top level function that turns reserves into tmp_holdsqueue and hold_fill_targets. | 
            
              | 153 |  | 
            
              | 154 | =cut | 
            
              | 155 |  | 
            
              | 156 | sub CreateQueue { | 
            
              | 157 |  | 
            
              | 158 |     $dbh->do("DELETE FROM tmp_holdsqueue");  # clear the old table for new info | 
            
              | 159 |     $dbh->do("DELETE FROM hold_fill_targets"); | 
            
              | 160 |  | 
            
              | 161 |     my $total_bibs            = 0; | 
            
              | 162 |     my $total_requests        = 0; | 
            
              | 163 |     my $total_available_items = 0; | 
            
              | 164 |     my $num_items_mapped      = 0; | 
            
              | 165 |  | 
            
              | 166 |     my $branches_to_use; | 
            
              | 167 |     my $transport_cost_matrix; | 
            
              | 168 |     my $use_transport_cost_matrix = C4::Context->preference("UseTransportCostMatrix"); | 
            
              | 169 |     if ($use_transport_cost_matrix) { | 
            
              | 170 |         $transport_cost_matrix = TransportCostMatrix(); | 
            
              | 171 |         unless (keys %$transport_cost_matrix) { | 
            
              | 172 |             warn "UseTransportCostMatrix set to yes, but matrix not populated"; | 
            
              | 173 |             undef $transport_cost_matrix; | 
            
              | 174 |         } | 
            
              | 175 |     } | 
            
              | 176 |     unless ($transport_cost_matrix) { | 
            
              | 177 |         $branches_to_use = load_branches_to_pull_from(); | 
            
              | 178 |     } | 
            
              | 179 |  | 
            
              | 180 |     my $bibs_with_pending_requests = GetBibsWithPendingHoldRequests(); | 
            
              | 181 |  | 
            
              | 182 |     foreach my $biblionumber (@$bibs_with_pending_requests) { | 
            
              | 183 |         $total_bibs++; | 
            
              | 184 |         my $hold_requests   = GetPendingHoldRequestsForBib($biblionumber); | 
            
              | 185 |         my $available_items = GetItemsAvailableToFillHoldRequestsForBib($biblionumber, $branches_to_use); | 
            
              | 186 |         $total_requests        += scalar(@$hold_requests); | 
            
              | 187 |         $total_available_items += scalar(@$available_items); | 
            
              | 188 |  | 
            
              | 189 |         my $item_map = MapItemsToHoldRequests($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix); | 
            
              | 190 |         $item_map  or next; | 
            
              | 191 |         my $item_map_size = scalar(keys %$item_map) | 
            
              | 192 |           or next; | 
            
              | 193 |  | 
            
              | 194 |         $num_items_mapped += $item_map_size; | 
            
              | 195 |         CreatePicklistFromItemMap($item_map); | 
            
              | 196 |         AddToHoldTargetMap($item_map); | 
            
              | 197 |         if (($item_map_size < scalar(@$hold_requests  )) and | 
            
              | 198 |             ($item_map_size < scalar(@$available_items))) { | 
            
              | 199 |             # DOUBLE CHECK, but this is probably OK - unfilled item-level requests | 
            
              | 200 |             # FIXME | 
            
              | 201 |             #warn "unfilled requests for $biblionumber"; | 
            
              | 202 |             #warn Dumper($hold_requests), Dumper($available_items), Dumper($item_map); | 
            
              | 203 |         } | 
            
              | 204 |     } | 
            
              | 205 | } | 
            
              | 206 |  | 
            
              | 207 | =head2 GetBibsWithPendingHoldRequests | 
            
              | 208 |  | 
            
              | 209 |   my $biblionumber_aref = GetBibsWithPendingHoldRequests(); | 
            
              | 210 |  | 
            
              | 211 | Return an arrayref of the biblionumbers of all bibs | 
            
              | 212 | that have one or more unfilled hold requests. | 
            
              | 213 |  | 
            
              | 214 | =cut | 
            
              | 215 |  | 
            
              | 216 | sub GetBibsWithPendingHoldRequests { | 
            
              | 217 |     my $dbh = C4::Context->dbh; | 
            
              | 218 |  | 
            
              | 219 |     my $bib_query = "SELECT DISTINCT biblionumber | 
            
              | 220 |                      FROM reserves | 
            
              | 221 |                      WHERE found IS NULL | 
            
              | 222 |                      AND priority > 0 | 
            
              | 223 |                      AND reservedate <= CURRENT_DATE()"; | 
            
              | 224 |     my $sth = $dbh->prepare($bib_query); | 
            
              | 225 |  | 
            
              | 226 |     $sth->execute(); | 
            
              | 227 |     my $biblionumbers = $sth->fetchall_arrayref(); | 
            
              | 228 |  | 
            
              | 229 |     return [ map { $_->[0] } @$biblionumbers ]; | 
            
              | 230 | } | 
            
              | 231 |  | 
            
              | 232 | =head2 GetPendingHoldRequestsForBib | 
            
              | 233 |  | 
            
              | 234 |   my $requests = GetPendingHoldRequestsForBib($biblionumber); | 
            
              | 235 |  | 
            
              | 236 | Returns an arrayref of hashrefs to pending, unfilled hold requests | 
            
              | 237 | on the bib identified by $biblionumber.  The following keys | 
            
              | 238 | are present in each hashref: | 
            
              | 239 |  | 
            
              | 240 |     biblionumber | 
            
              | 241 |     borrowernumber | 
            
              | 242 |     itemnumber | 
            
              | 243 |     priority | 
            
              | 244 |     branchcode | 
            
              | 245 |     reservedate | 
            
              | 246 |     reservenotes | 
            
              | 247 |     borrowerbranch | 
            
              | 248 |  | 
            
              | 249 | The arrayref is sorted in order of increasing priority. | 
            
              | 250 |  | 
            
              | 251 | =cut | 
            
              | 252 |  | 
            
              | 253 | sub GetPendingHoldRequestsForBib { | 
            
              | 254 |     my $biblionumber = shift; | 
            
              | 255 |  | 
            
              | 256 |     my $dbh = C4::Context->dbh; | 
            
              | 257 |  | 
            
              | 258 |     my $request_query = "SELECT biblionumber, borrowernumber, itemnumber, priority, reserves.branchcode,  | 
            
              | 259 |                                 reservedate, reservenotes, borrowers.branchcode AS borrowerbranch | 
            
              | 260 |                          FROM reserves | 
            
              | 261 |                          JOIN borrowers USING (borrowernumber) | 
            
              | 262 |                          WHERE biblionumber = ? | 
            
              | 263 |                          AND found IS NULL | 
            
              | 264 |                          AND priority > 0 | 
            
              | 265 |                          AND reservedate <= CURRENT_DATE() | 
            
              | 266 |                          ORDER BY priority"; | 
            
              | 267 |     my $sth = $dbh->prepare($request_query); | 
            
              | 268 |     $sth->execute($biblionumber); | 
            
              | 269 |  | 
            
              | 270 |     my $requests = $sth->fetchall_arrayref({}); | 
            
              | 271 |     return $requests; | 
            
              | 272 |  | 
            
              | 273 | } | 
            
              | 274 |  | 
            
              | 275 | =head2 GetItemsAvailableToFillHoldRequestsForBib | 
            
              | 276 |  | 
            
              | 277 |   my $available_items = GetItemsAvailableToFillHoldRequestsForBib($biblionumber, $branches_ar); | 
            
              | 278 |  | 
            
              | 279 | Returns an arrayref of items available to fill hold requests | 
            
              | 280 | for the bib identified by C<$biblionumber>.  An item is available | 
            
              | 281 | to fill a hold request if and only if: | 
            
              | 282 |  | 
            
              | 283 |     * it is not on loan | 
            
              | 284 |     * it is not withdrawn | 
            
              | 285 |     * it is not marked notforloan | 
            
              | 286 |     * it is not currently in transit | 
            
              | 287 |     * it is not lost | 
            
              | 288 |     * it is not sitting on the hold shelf | 
            
              | 289 |  | 
            
              | 290 | =cut | 
            
              | 291 |  | 
            
              | 292 | sub GetItemsAvailableToFillHoldRequestsForBib { | 
            
              | 293 |     my ($biblionumber, $branches_to_use) = @_; | 
            
              | 294 |  | 
            
              | 295 |     my $dbh = C4::Context->dbh; | 
            
              | 296 |     my $items_query = "SELECT itemnumber, homebranch, holdingbranch, itemtypes.itemtype AS itype | 
            
              | 297 |                        FROM items "; | 
            
              | 298 |  | 
            
              | 299 |     if (C4::Context->preference('item-level_itypes')) { | 
            
              | 300 |         $items_query .=   "LEFT JOIN itemtypes ON (itemtypes.itemtype = items.itype) "; | 
            
              | 301 |     } else { | 
            
              | 302 |         $items_query .=   "JOIN biblioitems USING (biblioitemnumber) | 
            
              | 303 |                            LEFT JOIN itemtypes USING (itemtype) "; | 
            
              | 304 |     } | 
            
              | 305 |     $items_query .=   "WHERE items.notforloan = 0 | 
            
              | 306 |                        AND holdingbranch IS NOT NULL | 
            
              | 307 |                        AND itemlost = 0 | 
            
              | 308 |                        AND wthdrawn = 0"; | 
            
              | 309 |     $items_query .= "  AND damaged = 0" unless C4::Context->preference('AllowHoldsOnDamagedItems'); | 
            
              | 310 |     $items_query .= "  AND items.onloan IS NULL | 
            
              | 311 |                        AND (itemtypes.notforloan IS NULL OR itemtypes.notforloan = 0) | 
            
              | 312 |                        AND itemnumber NOT IN ( | 
            
              | 313 |                            SELECT itemnumber | 
            
              | 314 |                            FROM reserves | 
            
              | 315 |                            WHERE biblionumber = ? | 
            
              | 316 |                            AND itemnumber IS NOT NULL | 
            
              | 317 |                            AND (found IS NOT NULL OR priority = 0) | 
            
              | 318 |                         ) | 
            
              | 319 |                        AND items.biblionumber = ?"; | 
            
              | 320 |     $items_query .=  " AND damaged = 0 " | 
            
              | 321 |       unless C4::Context->preference('AllowHoldsOnDamagedItems'); | 
            
              | 322 |  | 
            
              | 323 |     my @params = ($biblionumber, $biblionumber); | 
            
              | 324 |     if ($branches_to_use && @$branches_to_use) { | 
            
              | 325 |         $items_query .= " AND holdingbranch IN (" . join (",", map { "?" } @$branches_to_use) . ")"; | 
            
              | 326 |         push @params, @$branches_to_use; | 
            
              | 327 |     } | 
            
              | 328 |     my $sth = $dbh->prepare($items_query); | 
            
              | 329 |     $sth->execute(@params); | 
            
              | 330 |  | 
            
              | 331 |     my $itm = $sth->fetchall_arrayref({}); | 
            
              | 332 |     my @items = grep { ! scalar GetTransfers($_->{itemnumber}) } @$itm; | 
            
              | 333 |     return [ grep {  | 
            
              | 334 |         my $rule = GetBranchItemRule($_->{homebranch}, $_->{itype}); | 
            
              | 335 |         $_->{holdallowed} = $rule->{holdallowed} != 0 | 
            
              | 336 |     } @items ]; | 
            
              | 337 | } | 
            
              | 338 |  | 
            
              | 339 | =head2 MapItemsToHoldRequests | 
            
              | 340 |  | 
            
              | 341 |   MapItemsToHoldRequests($hold_requests, $available_items, $branches, $transport_cost_matrix) | 
            
              | 342 |  | 
            
              | 343 | =cut | 
            
              | 344 |  | 
            
              | 345 | sub MapItemsToHoldRequests { | 
            
              | 346 |     my ($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix) = @_; | 
            
              | 347 |  | 
            
              | 348 |     # handle trival cases | 
            
              | 349 |     return unless scalar(@$hold_requests) > 0; | 
            
              | 350 |     return unless scalar(@$available_items) > 0; | 
            
              | 351 |  | 
            
              | 352 |     my $automatic_return = C4::Context->preference("AutomaticItemReturn"); | 
            
              | 353 |  | 
            
              | 354 |     # identify item-level requests | 
            
              | 355 |     my %specific_items_requested = map { $_->{itemnumber} => 1 }  | 
            
              | 356 |                                    grep { defined($_->{itemnumber}) } | 
            
              | 357 |                                    @$hold_requests; | 
            
              | 358 |  | 
            
              | 359 |     # group available items by itemnumber | 
            
              | 360 |     my %items_by_itemnumber = map { $_->{itemnumber} => $_ } @$available_items; | 
            
              | 361 |  | 
            
              | 362 |     # items already allocated | 
            
              | 363 |     my %allocated_items = (); | 
            
              | 364 |  | 
            
              | 365 |     # map of items to hold requests | 
            
              | 366 |     my %item_map = (); | 
            
              | 367 |   | 
            
              | 368 |     # figure out which item-level requests can be filled     | 
            
              | 369 |     my $num_items_remaining = scalar(@$available_items); | 
            
              | 370 |     foreach my $request (@$hold_requests) { | 
            
              | 371 |         last if $num_items_remaining == 0; | 
            
              | 372 |  | 
            
              | 373 |         # is this an item-level request? | 
            
              | 374 |         if (defined($request->{itemnumber})) { | 
            
              | 375 |             # fill it if possible; if not skip it | 
            
              | 376 |             if (exists $items_by_itemnumber{$request->{itemnumber}} and | 
            
              | 377 |                 not exists $allocated_items{$request->{itemnumber}}) { | 
            
              | 378 |                 $item_map{$request->{itemnumber}} = {  | 
            
              | 379 |                     borrowernumber => $request->{borrowernumber}, | 
            
              | 380 |                     biblionumber => $request->{biblionumber}, | 
            
              | 381 |                     holdingbranch =>  $items_by_itemnumber{$request->{itemnumber}}->{holdingbranch}, | 
            
              | 382 |                     pickup_branch => $request->{branchcode} || $request->{borrowerbranch}, | 
            
              | 383 |                     item_level => 1, | 
            
              | 384 |                     reservedate => $request->{reservedate}, | 
            
              | 385 |                     reservenotes => $request->{reservenotes}, | 
            
              | 386 |                 }; | 
            
              | 387 |                 $allocated_items{$request->{itemnumber}}++; | 
            
              | 388 |                 $num_items_remaining--; | 
            
              | 389 |             } | 
            
              | 390 |         } else { | 
            
              | 391 |             # it's title-level request that will take up one item | 
            
              | 392 |             $num_items_remaining--; | 
            
              | 393 |         } | 
            
              | 394 |     } | 
            
              | 395 |  | 
            
              | 396 |     # group available items by branch | 
            
              | 397 |     my %items_by_branch = (); | 
            
              | 398 |     foreach my $item (@$available_items) { | 
            
              | 399 |         next unless $item->{holdallowed}; | 
            
              | 400 |  | 
            
              | 401 |         push @{ $items_by_branch{  $automatic_return ? $item->{homebranch} | 
            
              | 402 |                                                      : $item->{holdingbranch} } }, $item | 
            
              | 403 |           unless exists $allocated_items{ $item->{itemnumber} }; | 
            
              | 404 |     } | 
            
              | 405 |     return unless keys %items_by_branch; | 
            
              | 406 |  | 
            
              | 407 |     # now handle the title-level requests | 
            
              | 408 |     $num_items_remaining = scalar(@$available_items) - scalar(keys %allocated_items);  | 
            
              | 409 |     my $pull_branches; | 
            
              | 410 |     foreach my $request (@$hold_requests) { | 
            
              | 411 |         last if $num_items_remaining == 0; | 
            
              | 412 |         next if defined($request->{itemnumber}); # already handled these | 
            
              | 413 |  | 
            
              | 414 |         # look for local match first | 
            
              | 415 |         my $pickup_branch = $request->{branchcode} || $request->{borrowerbranch}; | 
            
              | 416 |         my ($itemnumber, $holdingbranch); | 
            
              | 417 |  | 
            
              | 418 |         my $holding_branch_items = $automatic_return ? undef : $items_by_branch{$pickup_branch}; | 
            
              | 419 |         if ( $holding_branch_items ) { | 
            
              | 420 |             foreach my $item (@$holding_branch_items) { | 
            
              | 421 |                 if ( $request->{borrowerbranch} eq $item->{homebranch} ) { | 
            
              | 422 |                     $itemnumber = $item->{itemnumber}; | 
            
              | 423 |                     last; | 
            
              | 424 |                 } | 
            
              | 425 |             } | 
            
              | 426 |             $holdingbranch = $pickup_branch; | 
            
              | 427 |             $itemnumber ||= $holding_branch_items->[0]->{itemnumber}; | 
            
              | 428 |         } | 
            
              | 429 |         elsif ($transport_cost_matrix) { | 
            
              | 430 |             $pull_branches = [keys %items_by_branch]; | 
            
              | 431 |             $holdingbranch = least_cost_branch( $pickup_branch, $pull_branches, $transport_cost_matrix ); | 
            
              | 432 |             if ( $holdingbranch ) { | 
            
              | 433 |  | 
            
              | 434 |                 my $holding_branch_items = $items_by_branch{$holdingbranch}; | 
            
              | 435 |                 foreach my $item (@$holding_branch_items) { | 
            
              | 436 |                     next if $request->{borrowerbranch} ne $item->{homebranch}; | 
            
              | 437 |  | 
            
              | 438 |                     $itemnumber = $item->{itemnumber}; | 
            
              | 439 |                     last; | 
            
              | 440 |                 } | 
            
              | 441 |                 $itemnumber ||= $holding_branch_items->[0]->{itemnumber}; | 
            
              | 442 |             } | 
            
              | 443 |             else { | 
            
              | 444 |                 warn "No transport costs for $pickup_branch"; | 
            
              | 445 |             } | 
            
              | 446 |         } | 
            
              | 447 |  | 
            
              | 448 |         unless ($itemnumber) { | 
            
              | 449 |             # not found yet, fall back to basics | 
            
              | 450 |             if ($branches_to_use) { | 
            
              | 451 |                 $pull_branches = $branches_to_use; | 
            
              | 452 |             } else { | 
            
              | 453 |                 $pull_branches = [keys %items_by_branch]; | 
            
              | 454 |             } | 
            
              | 455 |             PULL_BRANCHES: | 
            
              | 456 |             foreach my $branch (@$pull_branches) { | 
            
              | 457 |                 my $holding_branch_items = $items_by_branch{$branch} | 
            
              | 458 |                   or next; | 
            
              | 459 |  | 
            
              | 460 |                 $holdingbranch ||= $branch; | 
            
              | 461 |                 foreach my $item (@$holding_branch_items) { | 
            
              | 462 |                     next if $pickup_branch ne $item->{homebranch}; | 
            
              | 463 |  | 
            
              | 464 |                     $itemnumber = $item->{itemnumber}; | 
            
              | 465 |                     $holdingbranch = $branch; | 
            
              | 466 |                     last PULL_BRANCHES; | 
            
              | 467 |                 } | 
            
              | 468 |             } | 
            
              | 469 |             $itemnumber ||= $items_by_branch{$holdingbranch}->[0]->{itemnumber} | 
            
              | 470 |               if $holdingbranch; | 
            
              | 471 |         } | 
            
              | 472 |  | 
            
              | 473 |         if ($itemnumber) { | 
            
              | 474 |             my $holding_branch_items = $items_by_branch{$holdingbranch} | 
            
              | 475 |               or die "Have $itemnumber, $holdingbranch, but no items!"; | 
            
              | 476 |             @$holding_branch_items = grep { $_->{itemnumber} != $itemnumber } @$holding_branch_items; | 
            
              | 477 |             delete $items_by_branch{$holdingbranch} unless @$holding_branch_items; | 
            
              | 478 |  | 
            
              | 479 |             $item_map{$itemnumber} = { | 
            
              | 480 |                 borrowernumber => $request->{borrowernumber}, | 
            
              | 481 |                 biblionumber => $request->{biblionumber}, | 
            
              | 482 |                 holdingbranch => $holdingbranch, | 
            
              | 483 |                 pickup_branch => $pickup_branch, | 
            
              | 484 |                 item_level => 0, | 
            
              | 485 |                 reservedate => $request->{reservedate}, | 
            
              | 486 |                 reservenotes => $request->{reservenotes}, | 
            
              | 487 |             }; | 
            
              | 488 |             $num_items_remaining--;  | 
            
              | 489 |         } | 
            
              | 490 |     } | 
            
              | 491 |     return \%item_map; | 
            
              | 492 | } | 
            
              | 493 |  | 
            
              | 494 | =head2 CreatePickListFromItemMap  | 
            
              | 495 |  | 
            
              | 496 | =cut | 
            
              | 497 |  | 
            
              | 498 | sub CreatePicklistFromItemMap { | 
            
              | 499 |     my $item_map = shift; | 
            
              | 500 |  | 
            
              | 501 |     my $dbh = C4::Context->dbh; | 
            
              | 502 |  | 
            
              | 503 |     my $sth_load=$dbh->prepare(" | 
            
              | 504 |         INSERT INTO tmp_holdsqueue (biblionumber,itemnumber,barcode,surname,firstname,phone,borrowernumber, | 
            
              | 505 |                                     cardnumber,reservedate,title, itemcallnumber, | 
            
              | 506 |                                     holdingbranch,pickbranch,notes, item_level_request) | 
            
              | 507 |         VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) | 
            
              | 508 |     "); | 
            
              | 509 |  | 
            
              | 510 |     foreach my $itemnumber  (sort keys %$item_map) { | 
            
              | 511 |         my $mapped_item = $item_map->{$itemnumber}; | 
            
              | 512 |         my $biblionumber = $mapped_item->{biblionumber};  | 
            
              | 513 |         my $borrowernumber = $mapped_item->{borrowernumber};  | 
            
              | 514 |         my $pickbranch = $mapped_item->{pickup_branch}; | 
            
              | 515 |         my $holdingbranch = $mapped_item->{holdingbranch}; | 
            
              | 516 |         my $reservedate = $mapped_item->{reservedate}; | 
            
              | 517 |         my $reservenotes = $mapped_item->{reservenotes}; | 
            
              | 518 |         my $item_level = $mapped_item->{item_level}; | 
            
              | 519 |  | 
            
              | 520 |         my $item = GetItem($itemnumber); | 
            
              | 521 |         my $barcode = $item->{barcode}; | 
            
              | 522 |         my $itemcallnumber = $item->{itemcallnumber}; | 
            
              | 523 |  | 
            
              | 524 |         my $borrower = GetMember('borrowernumber'=>$borrowernumber); | 
            
              | 525 |         my $cardnumber = $borrower->{'cardnumber'}; | 
            
              | 526 |         my $surname = $borrower->{'surname'}; | 
            
              | 527 |         my $firstname = $borrower->{'firstname'}; | 
            
              | 528 |         my $phone = $borrower->{'phone'}; | 
            
              | 529 |     | 
            
              | 530 |         my $bib = GetBiblioData($biblionumber); | 
            
              | 531 |         my $title = $bib->{title};  | 
            
              | 532 |  | 
            
              | 533 |         $sth_load->execute($biblionumber, $itemnumber, $barcode, $surname, $firstname, $phone, $borrowernumber, | 
            
              | 534 |                            $cardnumber, $reservedate, $title, $itemcallnumber, | 
            
              | 535 |                            $holdingbranch, $pickbranch, $reservenotes, $item_level); | 
            
              | 536 |     } | 
            
              | 537 | } | 
            
              | 538 |  | 
            
              | 539 | =head2 AddToHoldTargetMap | 
            
              | 540 |  | 
            
              | 541 | =cut | 
            
              | 542 |  | 
            
              | 543 | sub AddToHoldTargetMap { | 
            
              | 544 |     my $item_map = shift; | 
            
              | 545 |  | 
            
              | 546 |     my $dbh = C4::Context->dbh; | 
            
              | 547 |  | 
            
              | 548 |     my $insert_sql = q( | 
            
              | 549 |         INSERT INTO hold_fill_targets (borrowernumber, biblionumber, itemnumber, source_branchcode, item_level_request) | 
            
              | 550 |                                VALUES (?, ?, ?, ?, ?) | 
            
              | 551 |     ); | 
            
              | 552 |     my $sth_insert = $dbh->prepare($insert_sql); | 
            
              | 553 |  | 
            
              | 554 |     foreach my $itemnumber (keys %$item_map) { | 
            
              | 555 |         my $mapped_item = $item_map->{$itemnumber}; | 
            
              | 556 |         $sth_insert->execute($mapped_item->{borrowernumber}, $mapped_item->{biblionumber}, $itemnumber, | 
            
              | 557 |                              $mapped_item->{holdingbranch}, $mapped_item->{item_level}); | 
            
              | 558 |     } | 
            
              | 559 | } | 
            
              | 560 |  | 
            
              | 561 | # Helper functions, not part of any interface | 
            
              | 562 |  | 
            
              | 563 | sub _trim { | 
            
              | 564 |     return $_[0] unless $_[0]; | 
            
              | 565 |     $_[0] =~ s/^\s+//; | 
            
              | 566 |     $_[0] =~ s/\s+$//; | 
            
              | 567 |     $_[0]; | 
            
              | 568 | } | 
            
              | 569 |  | 
            
              | 570 | sub load_branches_to_pull_from { | 
            
              | 571 |     my $static_branch_list = C4::Context->preference("StaticHoldsQueueWeight") | 
            
              | 572 |       or return; | 
            
              | 573 |  | 
            
              | 574 |     my @branches_to_use = map _trim($_), split /,/, $static_branch_list; | 
            
              | 575 |  | 
            
              | 576 |     @branches_to_use = shuffle(@branches_to_use) if  C4::Context->preference("RandomizeHoldsQueueWeight"); | 
            
              | 577 |  | 
            
              | 578 |     return \@branches_to_use; | 
            
              | 579 | } | 
            
              | 580 |  | 
            
              | 581 | sub least_cost_branch { | 
            
              | 582 |  | 
            
              | 583 |     #$from - arrayref | 
            
              | 584 |     my ($to, $from, $transport_cost_matrix) = @_; | 
            
              | 585 |  | 
            
              | 586 | # Nothing really spectacular: supply to branch, a list of potential from branches | 
            
              | 587 | # and find the minimum from - to value from the transport_cost_matrix | 
            
              | 588 |     return $from->[0] if @$from == 1; | 
            
              | 589 |  | 
            
              | 590 |     my ($least_cost, @branch); | 
            
              | 591 |     foreach (@$from) { | 
            
              | 592 |         my $cell = $transport_cost_matrix->{$to}{$_}; | 
            
              | 593 |         next if $cell->{disable_transfer}; | 
            
              | 594 |  | 
            
              | 595 |         my $cost = $cell->{cost}; | 
            
              | 596 |         next unless defined $cost; # XXX should this be reported? | 
            
              | 597 |  | 
            
              | 598 |         unless (defined $least_cost) { | 
            
              | 599 |             $least_cost = $cost; | 
            
              | 600 |             push @branch, $_; | 
            
              | 601 |             next; | 
            
              | 602 |         } | 
            
              | 603 |  | 
            
              | 604 |         next if $cost > $least_cost; | 
            
              | 605 |  | 
            
              | 606 |         if ($cost == $least_cost) { | 
            
              | 607 |             push @branch, $_; | 
            
              | 608 |             next; | 
            
              | 609 |         } | 
            
              | 610 |  | 
            
              | 611 |         @branch = ($_); | 
            
              | 612 |         $least_cost = $cost; | 
            
              | 613 |     } | 
            
              | 614 |  | 
            
              | 615 |     return $branch[0]; | 
            
              | 616 |  | 
            
              | 617 |     # XXX return a random @branch with minimum cost instead of the first one; | 
            
              | 618 |     # return $branch[0] if @branch == 1; | 
            
              | 619 | } | 
            
              | 620 |  | 
            
              | 621 |  | 
            
              | 622 | 1; |