View | Details | Raw Unified | Return to bug 5911
Collapse All | Expand All

(-)a/C4/Context.pm (+3 lines)
Lines 523-528 with this method. Link Here
523
# flushing the caching mechanism.
523
# flushing the caching mechanism.
524
524
525
my %sysprefs;
525
my %sysprefs;
526
sub _flush_preferences {
527
    %sysprefs = ();
528
}
526
529
527
sub preference {
530
sub preference {
528
    my $self = shift;
531
    my $self = shift;
(-)a/C4/HoldsQueue.pm (+630 lines)
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
        &SetUseTransportCostMatrix
47
        &TransportCostMatrix
48
        &UpdateTransportCostMatrix
49
     );
50
}
51
52
# XXX This is not safe in a persistant environment
53
my $dbh   = C4::Context->dbh;
54
55
=head1 FUNCTIONS
56
57
=head2 SetUseTransportCostMatrix
58
59
  SetUseTransportCostMatrix($true_false);
60
61
Updates UseTransportCostMatrix syspref
62
63
=cut
64
65
sub SetUseTransportCostMatrix {
66
    my ($bool) = @_;
67
68
    $dbh->do("UPDATE systempreferences SET value=? WHERE variable='UseTransportCostMatrix'", undef, $bool ? '1' : '0');
69
}
70
71
=head2 TransportCostMatrix
72
73
  TransportCostMatrix();
74
75
Returns Transport Cost Matrix as a hashref <to branch code> => <from branch code> => cost
76
77
=cut
78
79
sub TransportCostMatrix {
80
    my $transport_costs = $dbh->selectall_arrayref("SELECT * FROM transport_cost",{ Slice => {} });
81
82
    my %transport_cost_matrix;
83
    foreach (@$transport_costs) {
84
        my $from = $_->{frombranch};
85
        my $to = $_->{tobranch};
86
        my $cost = $_->{cost};
87
        my $disabled = $_->{disable_transfer};
88
        $transport_cost_matrix{$to}{$from} = { cost => $cost, disable_transfer => $disabled };
89
    }
90
    return \%transport_cost_matrix;
91
}
92
93
=head2 UpdateTransportCostMatrix
94
95
  UpdateTransportCostMatrix($records);
96
97
Updates full Transport Cost Matrix table. $records is an arrayref of records.
98
Records: { frombranch => <code>, tobranch => <code>, cost => <figure>, disable_transfer => <0,1> }
99
100
=cut
101
102
sub UpdateTransportCostMatrix {
103
    my ($records) = @_;
104
105
    my $sth = $dbh->prepare("INSERT INTO transport_cost (frombranch, tobranch, cost, disable_transfer) VALUES (?, ?, ?, ?)");
106
                 
107
    $dbh->do("TRUNCATE TABLE transport_cost");
108
    foreach (@$records) {
109
        my $cost = $_->{cost};
110
        my $from = $_->{frombranch};
111
        my $to = $_->{tobranch};
112
        if ( !defined ($cost) || ($cost !~ m/0(\.[0.9]*)?|1(.0*)?/o) ) {
113
            warn  "Invalid $from -> $to cost $cost - nust be a decimal number in 0 to 1 range, forcing to 1";
114
            $cost = 1;
115
        }
116
        $sth->execute( $from, $to, $cost, $_->{disable_transfer} ? 1 : 0 );
117
    }
118
}
119
120
=head2 GetHoldsQueueItems
121
122
  GetHoldsQueueItems($branch);
123
124
Returns hold queue for a holding branch. If branch is omitted, then whole queue is returned
125
126
=cut
127
128
sub GetHoldsQueueItems {
129
    my ($branchlimit) = @_;
130
131
    my @bind_params = ();
132
    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
133
                  FROM tmp_holdsqueue
134
                       JOIN biblio      USING (biblionumber)
135
                  LEFT JOIN biblioitems USING (biblionumber)
136
                  LEFT JOIN items       USING (  itemnumber)
137
                /;
138
    if ($branchlimit) {
139
        $query .=" WHERE tmp_holdsqueue.holdingbranch = ?";
140
        push @bind_params, $branchlimit;
141
    }
142
    $query .= " ORDER BY ccode, location, cn_sort, author, title, pickbranch, reservedate";
143
    my $sth = $dbh->prepare($query);
144
    $sth->execute(@bind_params);
145
    my $items = [];
146
    while ( my $row = $sth->fetchrow_hashref ){
147
        $row->{reservedate} = format_date($row->{reservedate});
148
        my $record = GetMarcBiblio($row->{biblionumber});
149
        if ($record){
150
            $row->{subtitle} = GetRecordValue('subtitle',$record,'')->[0]->{subfield};
151
            $row->{parts} = GetRecordValue('parts',$record,'')->[0]->{subfield};
152
            $row->{numbers} = GetRecordValue('numbers',$record,'')->[0]->{subfield};
153
        }
154
        push @$items, $row;
155
    }
156
    return $items;
157
}
158
159
=head2 CreateQueue
160
161
  CreateQueue();
162
163
Top level function that turns reserves into tmp_holdsqueue and hold_fill_targets.
164
165
=cut
166
167
sub CreateQueue {
168
169
    $dbh->do("DELETE FROM tmp_holdsqueue");  # clear the old table for new info
170
    $dbh->do("DELETE FROM hold_fill_targets");
171
172
    my $total_bibs            = 0;
173
    my $total_requests        = 0;
174
    my $total_available_items = 0;
175
    my $num_items_mapped      = 0;
176
177
    my $branches_to_use;
178
    my $transport_cost_matrix;
179
    my $use_transport_cost_matrix = C4::Context->preference("UseTransportCostMatrix");
180
    if ($use_transport_cost_matrix) {
181
        debug( "Using cost matrix" );
182
        $transport_cost_matrix = TransportCostMatrix();
183
        unless (keys %$transport_cost_matrix) {
184
            warn "UseTransportCostMatrix set to yes, but matrix not populated";
185
            undef $transport_cost_matrix;
186
        }
187
    }
188
    unless ($transport_cost_matrix) {
189
        debug( "Not using cost matrix" );
190
        $branches_to_use = load_branches_to_pull_from();
191
    }
192
193
    my $bibs_with_pending_requests = GetBibsWithPendingHoldRequests();
194
    debug( "bibs_with_pending_requests: ".Dumper($bibs_with_pending_requests) );
195
196
    foreach my $biblionumber (@$bibs_with_pending_requests) {
197
        $total_bibs++;
198
        my $hold_requests   = GetPendingHoldRequestsForBib($biblionumber);
199
        my $available_items = GetItemsAvailableToFillHoldRequestsForBib($biblionumber, $branches_to_use);
200
        $total_requests        += scalar(@$hold_requests);
201
        $total_available_items += scalar(@$available_items);
202
203
        my $item_map = MapItemsToHoldRequests($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix);
204
        $item_map  or next;
205
        my $item_map_size = scalar(keys %$item_map)
206
        or next;;
207
208
        $num_items_mapped += $item_map_size;
209
        CreatePicklistFromItemMap($item_map);
210
        AddToHoldTargetMap($item_map);
211
        if (($item_map_size < scalar(@$hold_requests  )) and
212
            ($item_map_size < scalar(@$available_items))) {
213
            # DOUBLE CHECK, but this is probably OK - unfilled item-level requests
214
            # FIXME
215
            #warn "unfilled requests for $biblionumber";
216
            #warn Dumper($hold_requests), Dumper($available_items), Dumper($item_map);
217
        }
218
    }
219
}
220
221
=head2 GetBibsWithPendingHoldRequests
222
223
  my $biblionumber_aref = GetBibsWithPendingHoldRequests();
224
225
Return an arrayref of the biblionumbers of all bibs
226
that have one or more unfilled hold requests.
227
228
=cut
229
230
sub GetBibsWithPendingHoldRequests {
231
    my $dbh = C4::Context->dbh;
232
233
    my $bib_query = "SELECT DISTINCT biblionumber
234
                     FROM reserves
235
                     WHERE found IS NULL
236
                     AND priority > 0
237
                     AND reservedate <= CURRENT_DATE()";
238
    my $sth = $dbh->prepare($bib_query);
239
240
    $sth->execute();
241
    my $biblionumbers = $sth->fetchall_arrayref();
242
243
    return [ map { $_->[0] } @$biblionumbers ];
244
}
245
246
=head2 GetPendingHoldRequestsForBib
247
248
  my $requests = GetPendingHoldRequestsForBib($biblionumber);
249
250
Returns an arrayref of hashrefs to pending, unfilled hold requests
251
on the bib identified by $biblionumber.  The following keys
252
are present in each hashref:
253
254
    biblionumber
255
    borrowernumber
256
    itemnumber
257
    priority
258
    branchcode
259
    reservedate
260
    reservenotes
261
    borrowerbranch
262
263
The arrayref is sorted in order of increasing priority.
264
265
=cut
266
267
sub GetPendingHoldRequestsForBib {
268
    my $biblionumber = shift;
269
270
    my $dbh = C4::Context->dbh;
271
272
    my $request_query = "SELECT biblionumber, borrowernumber, itemnumber, priority, reserves.branchcode, 
273
                                reservedate, reservenotes, borrowers.branchcode AS borrowerbranch
274
                         FROM reserves
275
                         JOIN borrowers USING (borrowernumber)
276
                         WHERE biblionumber = ?
277
                         AND found IS NULL
278
                         AND priority > 0
279
                         AND reservedate <= CURRENT_DATE()
280
                         ORDER BY priority";
281
    my $sth = $dbh->prepare($request_query);
282
    $sth->execute($biblionumber);
283
284
    my $requests = $sth->fetchall_arrayref({});
285
    return $requests;
286
287
}
288
289
=head2 GetItemsAvailableToFillHoldRequestsForBib
290
291
  my $available_items = GetItemsAvailableToFillHoldRequestsForBib($biblionumber, $branches_ar);
292
293
Returns an arrayref of items available to fill hold requests
294
for the bib identified by C<$biblionumber>.  An item is available
295
to fill a hold request if and only if:
296
297
    * it is not on loan
298
    * it is not withdrawn
299
    * it is not marked notforloan
300
    * it is not currently in transit
301
    * it is not lost
302
    * it is not sitting on the hold shelf
303
304
=cut
305
306
sub GetItemsAvailableToFillHoldRequestsForBib {
307
    my ($biblionumber, $branches_to_use) = @_;
308
309
    my $dbh = C4::Context->dbh;
310
    my $items_query = "SELECT itemnumber, homebranch, holdingbranch, itemtypes.itemtype AS itype
311
                       FROM items ";
312
313
    if (C4::Context->preference('item-level_itypes')) {
314
        $items_query .=   "LEFT JOIN itemtypes ON (itemtypes.itemtype = items.itype) ";
315
    } else {
316
        $items_query .=   "JOIN biblioitems USING (biblioitemnumber)
317
                           LEFT JOIN itemtypes USING (itemtype) ";
318
    }
319
    $items_query .=   "WHERE items.notforloan = 0
320
                       AND holdingbranch IS NOT NULL
321
                       AND itemlost = 0
322
                       AND wthdrawn = 0
323
                       AND items.onloan IS NULL
324
                       AND (itemtypes.notforloan IS NULL OR itemtypes.notforloan = 0)
325
                       AND itemnumber NOT IN (
326
                           SELECT itemnumber
327
                           FROM reserves
328
                           WHERE biblionumber = ?
329
                           AND itemnumber IS NOT NULL
330
                           AND (found IS NOT NULL OR priority = 0)
331
                        )
332
                       AND items.biblionumber = ?";
333
    $items_query .=  " AND damaged = 0 "
334
      unless C4::Context->preference('AllowHoldsOnDamagedItems');
335
336
    my @params = ($biblionumber, $biblionumber);
337
    if ($branches_to_use && @$branches_to_use) {
338
        $items_query .= " AND holdingbranch IN (" . join (",", map { "?" } @$branches_to_use) . ")";
339
        push @params, @$branches_to_use;
340
    }
341
    my $sth = $dbh->prepare($items_query);
342
    $sth->execute(@params);
343
344
    my $items = $sth->fetchall_arrayref({});
345
    $items = [ grep { my @transfers = GetTransfers($_->{itemnumber}); $#transfers == -1; } @$items ]; 
346
    map { my $rule = GetBranchItemRule($_->{homebranch}, $_->{itype}); $_->{holdallowed} = $rule->{holdallowed}; $rule->{holdallowed} != 0 } @$items;
347
    return [ grep { $_->{holdallowed} != 0 } @$items ];
348
}
349
350
=head2 MapItemsToHoldRequests
351
352
  MapItemsToHoldRequests($hold_requests, $available_items, $branches, $transport_cost_matrix)
353
354
=cut
355
356
sub MapItemsToHoldRequests {
357
    my ($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix) = @_;
358
359
    # handle trival cases
360
    return unless scalar(@$hold_requests) > 0;
361
    return unless scalar(@$available_items) > 0;
362
363
    debug( "MapItemsToHoldRequests() for ".Dumper($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix) );
364
    my $automatic_return = C4::Context->preference("AutomaticItemReturn");
365
366
    # identify item-level requests
367
    my %specific_items_requested = map { $_->{itemnumber} => 1 } 
368
                                   grep { defined($_->{itemnumber}) }
369
                                   @$hold_requests;
370
371
    # group available items by itemnumber
372
    my %items_by_itemnumber = map { $_->{itemnumber} => $_ } @$available_items;
373
374
    # items already allocated
375
    my %allocated_items = ();
376
377
    # map of items to hold requests
378
    my %item_map = ();
379
 
380
    # figure out which item-level requests can be filled    
381
    my $num_items_remaining = scalar(@$available_items);
382
    foreach my $request (@$hold_requests) {
383
        last if $num_items_remaining == 0;
384
385
        # is this an item-level request?
386
        if (defined($request->{itemnumber})) {
387
            # fill it if possible; if not skip it
388
            if (exists $items_by_itemnumber{$request->{itemnumber}} and
389
                not exists $allocated_items{$request->{itemnumber}}) {
390
                $item_map{$request->{itemnumber}} = { 
391
                    borrowernumber => $request->{borrowernumber},
392
                    biblionumber => $request->{biblionumber},
393
                    holdingbranch =>  $items_by_itemnumber{$request->{itemnumber}}->{holdingbranch},
394
                    pickup_branch => $request->{branchcode} || $request->{borrowerbranch},
395
                    item_level => 1,
396
                    reservedate => $request->{reservedate},
397
                    reservenotes => $request->{reservenotes},
398
                };
399
                $allocated_items{$request->{itemnumber}}++;
400
                $num_items_remaining--;
401
            }
402
        } else {
403
            # it's title-level request that will take up one item
404
            $num_items_remaining--;
405
        }
406
    }
407
408
    # group available items by branch
409
    my %items_by_branch = ();
410
    foreach my $item (@$available_items) {
411
        next unless $item->{holdallowed};
412
413
        push @{ $items_by_branch{  $automatic_return ? $item->{homebranch}
414
                                                     : $item->{holdingbranch} } }, $item
415
          unless exists $allocated_items{ $item->{itemnumber} };
416
    }
417
    return unless keys %items_by_branch;
418
419
    # now handle the title-level requests
420
    $num_items_remaining = scalar(@$available_items) - scalar(keys %allocated_items); 
421
    my $pull_branches;
422
    foreach my $request (@$hold_requests) {
423
        last if $num_items_remaining == 0;
424
        next if defined($request->{itemnumber}); # already handled these
425
426
        # look for local match first
427
        my $pickup_branch = $request->{branchcode} || $request->{borrowerbranch};
428
        my ($itemnumber, $holdingbranch);
429
430
        my $holding_branch_items = $automatic_return ? undef : $items_by_branch{$pickup_branch};
431
        if ( $holding_branch_items ) {
432
            foreach my $item (@$holding_branch_items) {
433
                if ( $request->{borrowerbranch} eq $item->{homebranch} ) {
434
                    $itemnumber = $item->{itemnumber};
435
                    last;
436
                }
437
            }
438
            $holdingbranch = $pickup_branch;
439
            $itemnumber ||= $holding_branch_items->[0]->{itemnumber};
440
        }
441
        elsif ($transport_cost_matrix) {
442
            $pull_branches = [keys %items_by_branch];
443
            $holdingbranch = least_cost_branch( $pickup_branch, $pull_branches, $transport_cost_matrix );
444
            if ( $holdingbranch ) {
445
446
                my $holding_branch_items = $items_by_branch{$holdingbranch};
447
                foreach my $item (@$holding_branch_items) {
448
                    next if $request->{borrowerbranch} ne $item->{homebranch};
449
450
                    $itemnumber = $item->{itemnumber};
451
                    last;
452
                }
453
                $itemnumber ||= $holding_branch_items->[0]->{itemnumber};
454
            }
455
            else {
456
                warn "No transport costs for $pickup_branch";
457
            }
458
        }
459
460
        unless ($itemnumber) {
461
            # not found yet, fall back to basics
462
            if ($branches_to_use) {
463
                $pull_branches = $branches_to_use;
464
            } else {
465
                $pull_branches = [keys %items_by_branch];
466
            }
467
            PULL_BRANCHES:
468
            foreach my $branch (@$pull_branches) {
469
                my $holding_branch_items = $items_by_branch{$branch}
470
                  or next;
471
472
                $holdingbranch ||= $branch;
473
                foreach my $item (@$holding_branch_items) {
474
                    next if $pickup_branch ne $item->{homebranch};
475
476
                    $itemnumber = $item->{itemnumber};
477
                    $holdingbranch = $branch;
478
                    last PULL_BRANCHES;
479
                }
480
            }
481
            $itemnumber ||= $items_by_branch{$holdingbranch}->[0]->{itemnumber}
482
              if $holdingbranch;
483
        }
484
485
        if ($itemnumber) {
486
            my $holding_branch_items = $items_by_branch{$holdingbranch}
487
              or die "Have $itemnumber, $holdingbranch, but no items!";
488
            @$holding_branch_items = grep { $_->{itemnumber} != $itemnumber } @$holding_branch_items;
489
            delete $items_by_branch{$holdingbranch} unless @$holding_branch_items;
490
491
            $item_map{$itemnumber} = {
492
                borrowernumber => $request->{borrowernumber},
493
                biblionumber => $request->{biblionumber},
494
                holdingbranch => $holdingbranch,
495
                pickup_branch => $pickup_branch,
496
                item_level => 0,
497
                reservedate => $request->{reservedate},
498
                reservenotes => $request->{reservenotes},
499
            };
500
            $num_items_remaining--; 
501
        }
502
    }
503
    return \%item_map;
504
}
505
506
=head2 CreatePickListFromItemMap 
507
508
=cut
509
510
sub CreatePicklistFromItemMap {
511
    my $item_map = shift;
512
513
    my $dbh = C4::Context->dbh;
514
515
    my $sth_load=$dbh->prepare("
516
        INSERT INTO tmp_holdsqueue (biblionumber,itemnumber,barcode,surname,firstname,phone,borrowernumber,
517
                                    cardnumber,reservedate,title, itemcallnumber,
518
                                    holdingbranch,pickbranch,notes, item_level_request)
519
        VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
520
    ");
521
522
    foreach my $itemnumber  (sort keys %$item_map) {
523
        my $mapped_item = $item_map->{$itemnumber};
524
        my $biblionumber = $mapped_item->{biblionumber}; 
525
        my $borrowernumber = $mapped_item->{borrowernumber}; 
526
        my $pickbranch = $mapped_item->{pickup_branch};
527
        my $holdingbranch = $mapped_item->{holdingbranch};
528
        my $reservedate = $mapped_item->{reservedate};
529
        my $reservenotes = $mapped_item->{reservenotes};
530
        my $item_level = $mapped_item->{item_level};
531
532
        my $item = GetItem($itemnumber);
533
        my $barcode = $item->{barcode};
534
        my $itemcallnumber = $item->{itemcallnumber};
535
536
        my $borrower = GetMember('borrowernumber'=>$borrowernumber);
537
        my $cardnumber = $borrower->{'cardnumber'};
538
        my $surname = $borrower->{'surname'};
539
        my $firstname = $borrower->{'firstname'};
540
        my $phone = $borrower->{'phone'};
541
   
542
        my $bib = GetBiblioData($biblionumber);
543
        my $title = $bib->{title}; 
544
545
        $sth_load->execute($biblionumber, $itemnumber, $barcode, $surname, $firstname, $phone, $borrowernumber,
546
                           $cardnumber, $reservedate, $title, $itemcallnumber,
547
                           $holdingbranch, $pickbranch, $reservenotes, $item_level);
548
    }
549
}
550
551
=head2 AddToHoldTargetMap
552
553
=cut
554
555
sub AddToHoldTargetMap {
556
    my $item_map = shift;
557
558
    my $dbh = C4::Context->dbh;
559
560
    my $insert_sql = q(
561
        INSERT INTO hold_fill_targets (borrowernumber, biblionumber, itemnumber, source_branchcode, item_level_request)
562
                               VALUES (?, ?, ?, ?, ?)
563
    );
564
    my $sth_insert = $dbh->prepare($insert_sql);
565
566
    foreach my $itemnumber (keys %$item_map) {
567
        my $mapped_item = $item_map->{$itemnumber};
568
        $sth_insert->execute($mapped_item->{borrowernumber}, $mapped_item->{biblionumber}, $itemnumber,
569
                             $mapped_item->{holdingbranch}, $mapped_item->{item_level});
570
    }
571
}
572
573
# Helper functions, not part of any interface
574
575
sub debug {
576
#   warn @_;
577
}
578
579
sub load_branches_to_pull_from {
580
    my $static_branch_list = C4::Context->preference("StaticHoldsQueueWeight")
581
      or return;
582
583
    my @branches_to_use = map { s/^\s+//; s/\s+$//; $_; } split /,/, $static_branch_list;
584
585
    @branches_to_use = shuffle(@branches_to_use) if  C4::Context->preference("RandomizeHoldsQueueWeight");
586
587
    return \@branches_to_use;
588
}
589
590
sub least_cost_branch {
591
592
    #$from - arrayref
593
    my ($to, $from, $transport_cost_matrix) = @_;
594
595
# Nothing really spectacular: supply to branch, a list of potential from branches
596
# and find the minimum from - to value from the transport_cost_matrix
597
    return $from->[0] if @$from == 1;
598
599
    my ($least_cost, @branch);
600
    foreach (@$from) {
601
        my $cell = $transport_cost_matrix->{$to}{$_};
602
        next if $cell->{disable_transfer};
603
604
        my $cost = $cell->{cost};
605
606
        unless (defined $least_cost) {
607
            $least_cost = $cost;
608
            push @branch, $_;
609
            next;
610
        }
611
612
        next if $cost > $least_cost;
613
614
        if ($cost == $least_cost) {
615
            push @branch, $_;
616
            next;
617
        }
618
619
        @branch = ($_);
620
        $least_cost = $cost;
621
    }
622
623
    return $branch[0];
624
625
    # XXX return a random @branch with minimum cost instead of the first one;
626
    # return $branch[0] if @branch == 1;
627
}
628
629
630
1;
(-)a/admin/systempreferences.pl (+1 lines)
Lines 203-208 $tabsysprefs{DisplayClearScreenButton} = "Circulation"; Link Here
203
$tabsysprefs{AllowAllMessageDeletion}        = "Circulation";
203
$tabsysprefs{AllowAllMessageDeletion}        = "Circulation";
204
$tabsysprefs{OverdueNoticeBcc}               = "Circulation";
204
$tabsysprefs{OverdueNoticeBcc}               = "Circulation";
205
$tabsysprefs{OverduesBlockCirc}              = "Circulation";
205
$tabsysprefs{OverduesBlockCirc}              = "Circulation";
206
$tabsysprefs{UseTransportCostMatrix}         = "Circulation";
206
207
207
208
208
# Staff Client
209
# Staff Client
(-)a/admin/transport-cost-matrix.pl (+122 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
# Copyright 2000-2002 Katipo Communications
3
# copyright 2010 BibLibre
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
use strict;
21
use warnings;
22
use CGI;
23
use C4::Context;
24
use C4::Output;
25
use C4::Auth;
26
use C4::Koha;
27
use C4::Debug;
28
use C4::Branch; # GetBranches
29
use C4::HoldsQueue qw(TransportCostMatrix UpdateTransportCostMatrix SetUseTransportCostMatrix);
30
31
use Data::Dumper;
32
33
my $input = new CGI;
34
35
my ($template, $loggedinuser, $cookie)
36
    = get_template_and_user({template_name => "admin/transport-cost-matrix.tmpl",
37
                            query => $input,
38
                            type => "intranet",
39
                            authnotrequired => 0,
40
                            flagsrequired => {parameters => 1},
41
                            debug => 1,
42
                            });
43
44
my $update = $input->param('op') eq 'set-cost-matrix';
45
my $use_transport_cost_matrix = $input->param('UseTransportCostMatrix') || 0;
46
47
my ($cost_matrix, $have_matrix);
48
unless ($update) {
49
    $cost_matrix = TransportCostMatrix();
50
    $have_matrix = keys %$cost_matrix if $cost_matrix;
51
    $use_transport_cost_matrix = C4::Context->preference("UseTransportCostMatrix");
52
}
53
54
my $branches = GetBranches();
55
my @branchloop = map { code => $_,
56
                       name => $branches->{$_}->{'branchname'} },
57
                 sort { $branches->{$a}->{branchname} cmp $branches->{$b}->{branchname} }
58
                 keys %$branches;
59
my (@branchfromloop, @cost, @errors);
60
foreach my $branchfrom ( @branchloop ) {
61
    my $fromcode = $branchfrom->{code};
62
63
    my %from_row = ( code => $fromcode, name => $branchfrom->{name} );
64
    foreach my $branchto ( @branchloop ) {
65
        my $tocode = $branchto->{code};
66
67
        my %from_to_input_def = ( code => $tocode, name => $branchto->{name} );
68
        push @{ $from_row{branchtoloop} }, \%from_to_input_def;
69
70
        if ($fromcode eq $tocode) {
71
            $from_to_input_def{skip} = 1;
72
            next;
73
        }
74
75
        (my $from_to = "${fromcode}_${tocode}") =~ s/\W//go;
76
         $from_to_input_def{id} = $from_to;
77
        my $input_name   = "cost_$from_to";
78
        my $disable_name = "disable_$from_to";
79
80
        if ($update) {
81
            $from_to_input_def{disabled} = 1 if $input->param($disable_name);
82
            my $value = $from_to_input_def{value} = $input->param($input_name);
83
            push @errors, "Invalid value for $from_row{name} -> $from_to_input_def{name}"
84
              unless $value >= 0.0 && $value <= 1.0;
85
        }
86
        else {
87
            if ($have_matrix) {
88
                if ( my $cell = $cost_matrix->{$tocode}{$fromcode} ) {
89
                    $from_to_input_def{value} = $cell->{cost};
90
                    $from_to_input_def{disabled} = 1 if $cell->{disable_transfer};
91
                }
92
            } else {
93
                $from_to_input_def{value} = 0.5;
94
            }
95
        }
96
    }
97
    
98
#              die Dumper(\%from_row);
99
    push @branchfromloop, \%from_row;
100
}
101
102
if ($update && !@errors) {
103
    my @update_recs = map {
104
        my $from = $_->{code};
105
        map { frombranch => $from, tobranch => $_->{code}, cost => $_->{value}, disable_transfer => $_->{disabled} || 0 },
106
            grep { $_->{code} ne $from }
107
            @{ $_->{branchtoloop} };
108
    } @branchfromloop;
109
110
    UpdateTransportCostMatrix(\@update_recs);
111
    SetUseTransportCostMatrix($use_transport_cost_matrix);
112
}
113
   
114
$template->param(
115
    branchloop => \@branchloop,
116
    branchfromloop => \@branchfromloop,
117
    UseTransportCostMatrix => $use_transport_cost_matrix,
118
);
119
output_html_with_http_headers $input, $cookie, $template->output;
120
121
exit 0;
122
(-)a/circ/view_holdsqueue.pl (-32 / +2 lines)
Lines 31-37 use C4::Biblio; Link Here
31
use C4::Items;
31
use C4::Items;
32
use C4::Koha;   # GetItemTypes
32
use C4::Koha;   # GetItemTypes
33
use C4::Branch; # GetBranches
33
use C4::Branch; # GetBranches
34
use C4::Dates qw/format_date/;
34
use C4::HoldsQueue qw(GetHoldsQueueItems);
35
35
36
my $query = new CGI;
36
my $query = new CGI;
37
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
37
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
Lines 51-56 my $branchlimit = $params->{'branchlimit'}; Link Here
51
my $itemtypeslimit = $params->{'itemtypeslimit'};
51
my $itemtypeslimit = $params->{'itemtypeslimit'};
52
52
53
if ( $run_report ) {
53
if ( $run_report ) {
54
    # XXX GetHoldsQueueItems() does not support $itemtypeslimit!
54
    my $items = GetHoldsQueueItems($branchlimit, $itemtypeslimit);
55
    my $items = GetHoldsQueueItems($branchlimit, $itemtypeslimit);
55
    $template->param(
56
    $template->param(
56
        branch     => $branchlimit,
57
        branch     => $branchlimit,
Lines 76-111 $template->param( Link Here
76
   itemtypeloop => \@itemtypesloop,
77
   itemtypeloop => \@itemtypesloop,
77
);
78
);
78
79
79
sub GetHoldsQueueItems {
80
	my ($branchlimit,$itemtypelimit) = @_;
81
	my $dbh = C4::Context->dbh;
82
83
    my @bind_params = ();
84
	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
85
                  FROM tmp_holdsqueue
86
                       JOIN biblio      USING (biblionumber)
87
				  LEFT JOIN biblioitems USING (biblionumber)
88
                  LEFT JOIN items       USING (  itemnumber)
89
                /;
90
    if ($branchlimit) {
91
	    $query .=" WHERE tmp_holdsqueue.holdingbranch = ?";
92
        push @bind_params, $branchlimit;
93
    }
94
    $query .= " ORDER BY ccode, location, cn_sort, author, title, pickbranch, reservedate";
95
	my $sth = $dbh->prepare($query);
96
	$sth->execute(@bind_params);
97
	my $items = [];
98
    while ( my $row = $sth->fetchrow_hashref ){
99
	$row->{reservedate} = format_date($row->{reservedate});
100
	my $record = GetMarcBiblio($row->{biblionumber});
101
    if ($record){
102
        $row->{subtitle} = GetRecordValue('subtitle',$record,'')->[0]->{subfield};
103
	    $row->{parts} = GetRecordValue('parts',$record,'')->[0]->{subfield};
104
	    $row->{numbers} = GetRecordValue('numbers',$record,'')->[0]->{subfield};
105
	}
106
        push @$items, $row;
107
    }
108
    return $items;
109
}
110
# writing the template
80
# writing the template
111
output_html_with_http_headers $query, $cookie, $template->output;
81
output_html_with_http_headers $query, $cookie, $template->output;
(-)a/installer/data/mysql/kohastructure.sql (+17 lines)
Lines 2785-2790 CREATE TABLE `fieldmapping` ( -- koha to keyword mapping Link Here
2785
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
2785
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
2786
2786
2787
--
2787
--
2788
-- Table structure for table `transport_cost`
2789
--
2790
2791
DROP TABLE IF EXISTS `transport_cost`;
2792
CREATE TABLE `transport_cost` (
2793
      `frombranch` varchar(10) NOT NULL,
2794
      `tobranch` varchar(10) NOT NULL,
2795
      `cost` decimal(4,3) NOT NULL,
2796
      `disable_transfer` tinyint(1) NOT NULL DEFAULT 0,
2797
      CHECK ( `frombranch` <> `tobranch` ), -- a dud check, mysql does not support that
2798
      CHECK ( cost >= 0.0 AND cost <= 1.0), -- a dud check, mysql does not support that
2799
      PRIMARY KEY (`frombranch`, `tobranch`),
2800
      CONSTRAINT `transport_cost_ibfk_1` FOREIGN KEY (`frombranch`) REFERENCES `branches` (`branchcode`) ON DELETE CASCADE ON UPDATE CASCADE,
2801
      CONSTRAINT `transport_cost_ibfk_2` FOREIGN KEY (`tobranch`) REFERENCES `branches` (`branchcode`) ON DELETE CASCADE ON UPDATE CASCADE
2802
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
2803
2804
--
2788
-- Table structure for table `biblioimages`
2805
-- Table structure for table `biblioimages`
2789
--
2806
--
2790
2807
(-)a/installer/data/mysql/sysprefs.sql (+1 lines)
Lines 324-329 INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES Link Here
324
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');
324
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');
325
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');
325
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');
326
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');
326
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');
327
INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('UseTransportCostMatrix',0,"Use Transport Cost Matrix when filling holds",'','YesNo');
327
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');
328
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');
328
INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES ('MARCAuthorityControlField008', '|| aca||aabn           | a|a     d', NULL, NULL, 'Textarea');
329
INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES ('MARCAuthorityControlField008', '|| aca||aabn           | a|a     d', NULL, NULL, 'Textarea');
329
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('OpenLibraryCovers',0,'If ON Openlibrary book covers will be show',NULL,'YesNo');
330
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES('OpenLibraryCovers',0,'If ON Openlibrary book covers will be show',NULL,'YesNo');
(-)a/installer/data/mysql/updatedatabase.pl (+20 lines)
Lines 5239-5244 if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) { Link Here
5239
    SetVersion($DBversion);
5239
    SetVersion($DBversion);
5240
}
5240
}
5241
5241
5242
$DBversion = "3.07.00.XXX";
5243
if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
5244
    $dbh->do("INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('UseTransportCostMatrix',0,'Use Transport Cost Matrix when filling holds','','YesNo')");
5245
5246
 $dbh->do("CREATE TABLE `transport_cost` (
5247
              `frombranch` varchar(10) NOT NULL,
5248
              `tobranch` varchar(10) NOT NULL,
5249
              `cost` decimal(4,3) NOT NULL,
5250
              `disable_transfer` tinyint(1) NOT NULL DEFAULT 0,
5251
              CHECK ( `frombranch` <> `tobranch` ), -- a dud check, mysql does not support that
5252
              CHECK ( cost >= 0.0 AND cost <= 1.0), -- a dud check, mysql does not support that
5253
              PRIMARY KEY (`frombranch`, `tobranch`),
5254
              CONSTRAINT `transport_cost_ibfk_1` FOREIGN KEY (`frombranch`) REFERENCES `branches` (`branchcode`) ON DELETE CASCADE ON UPDATE CASCADE,
5255
              CONSTRAINT `transport_cost_ibfk_2` FOREIGN KEY (`tobranch`) REFERENCES `branches` (`branchcode`) ON DELETE CASCADE ON UPDATE CASCADE
5256
          ) ENGINE=InnoDB DEFAULT CHARSET=utf8");
5257
5258
    print "Upgrade to $DBversion done (creating `transport_cost` table; adding UseTransportCostMatrix systempref, in circulation)\n";
5259
    SetVersion ($DBversion);
5260
}
5261
5242
=head1 FUNCTIONS
5262
=head1 FUNCTIONS
5243
5263
5244
=head2 TableExists($table)
5264
=head2 TableExists($table)
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt (+2 lines)
Lines 53-58 Link Here
53
	<dd>Define circulation and fines rules for combinations of libraries, patron categories, and item types</dd>
53
	<dd>Define circulation and fines rules for combinations of libraries, patron categories, and item types</dd>
54
    <dt><a href="/cgi-bin/koha/admin/branch_transfer_limits.pl">Library transfer limits</a></dt>
54
    <dt><a href="/cgi-bin/koha/admin/branch_transfer_limits.pl">Library transfer limits</a></dt>
55
	<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>
55
	<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>
56
    <dt><a href="/cgi-bin/koha/admin/transport-cost-matrix.pl">Transport Cost Matrix</a></dt>
57
	<dd>Define transport costs between branches</dd>
56
    <dt><a href="/cgi-bin/koha/admin/item_circulation_alerts.pl">Item circulation alerts</a></dt>
58
    <dt><a href="/cgi-bin/koha/admin/item_circulation_alerts.pl">Item circulation alerts</a></dt>
57
	<dd>Define rules for check-in and checkout notifications for combinations of libraries, patron categories, and item types</dd>
59
	<dd>Define rules for check-in and checkout notifications for combinations of libraries, patron categories, and item types</dd>
58
</dl>
60
</dl>
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/transport-cost-matrix.tt (+126 lines)
Line 0 Link Here
1
[% INCLUDE 'doc-head-open.inc' %]
2
<title>Koha &rsaquo; Administration &rsaquo; Transport Cost Matrix</title>
3
[% INCLUDE 'doc-head-close.inc' %]
4
5
<script type="text/javascript">
6
//<![CDATA[
7
function check_transport_cost(e) {
8
    var val = e.value;
9
    if (val && !isNaN(val) && val >= 0.0 && val <= 1.0) {
10
        return;
11
    }
12
    alert("Cost must be expressed as a decimal number in 0 to 1 range");
13
}
14
function disable_transport_cost_chg(e, cost_id) {
15
    disable_transport_cost(cost_id, e.checked);
16
}
17
function disable_transport_cost(cost_id, disable) {
18
    if (disable) {
19
        $('#celldiv_'+cost_id).find('input[type=text]').attr("disabled","disabled").addClass('disabled-transfer');
20
    } else {
21
        $('#celldiv_'+cost_id).find('input:disabled').removeAttr("disabled").removeClass('disabled-transfer');
22
    }
23
}
24
function enable_cost_input(cost_id) {
25
    var cell = $('#celldiv_'+cost_id);
26
    var cost = $(cell).text();
27
    var disabled = $(cell).hasClass('disabled-transfer');
28
    $(cell).removeClass('disabled-transfer');
29
30
    $('#celldiv_'+cost_id).html(
31
        '<input name="cost_'+cost_id+'" onchange="check_transport_cost(this);" size="4" value="'+$.trim(cost)+'" />'+
32
        '<br/>No xfr <input name="disable_'+cost_id+'" value="1" onchange="disable_transport_cost_chg(this, \''+cost_id+'\');" type="checkbox" '+(disabled ? 'checked' : '')+' />'
33
    );
34
    disable_transport_cost(cost_id, disabled);
35
}
36
function use_transport_cost_matrix_chg (e) {
37
    show_transport_cost_matrix(e.checked);
38
}
39
function show_transport_cost_matrix(show) {
40
    if (show) {
41
        $('#transport-cost-matrix').show();
42
    } else {
43
        $('#transport-cost-matrix').hide();
44
    }
45
}
46
function form_submit (f) {
47
    $(f).find('input:disabled').removeAttr("disabled");
48
    // XXX check 0 - 1
49
    return true;
50
}
51
52
$(document).ready(function() {
53
    show_transport_cost_matrix([% IF UseTransportCostMatrix %]true[% ELSE %]false[% END %]);
54
});
55
//]]>
56
</script>
57
<style type="text/css">
58
.disabled-transfer {
59
    background-color: red;
60
}
61
</style>
62
63
</head>
64
<body>
65
[% INCLUDE 'header.inc' %]
66
[% INCLUDE 'cat-search.inc' %]
67
68
<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>
69
70
<div id="doc3" class="yui-t1">
71
72
<div id="bd">
73
    <div id="yui-main">
74
    <div class="yui-b">
75
    <h1 class="parameters">
76
            Defining transport costs between libraries
77
    </h1>
78
    <div class="container">
79
        <form method="post" action="?" onSubmit="return form_submit(this);">
80
            <input type="hidden" name="op" value="set-cost-matrix" />
81
            <p> Use Transport Cost Matrix <input type="checkbox" name="UseTransportCostMatrix" value="1" [% IF UseTransportCostMatrix %]checked[% END %] onChange="use_transport_cost_matrix_chg(this);" />
82
            <div id="transport-cost-matrix">
83
                <div class="help">
84
                    <p>Costs are normalised decimal values 0 to 1, 0 being minimum (no) cost, 1 maximum.</p>
85
                    <p>Red cells signify no transfer allowed</p>
86
                    <p>Click on the cell to edit</p>
87
                </div>
88
                <table>
89
                    <tr>
90
                        <th>From \ To</th>
91
                [% FOR b IN branchloop %]
92
                        <th>[% b.name %]</th>
93
                [% END %]
94
                    <tr>
95
                [% FOR bf IN branchfromloop %]
96
                    <tr>
97
                        <th>[% bf.name %]</th>
98
                    [% FOR bt IN bf.branchtoloop %]
99
                        <td>
100
                        [% IF bt.skip %]
101
                            &nbsp;
102
                        [% ELSE %]
103
                            <div id="celldiv_[% bt.id %]"[% IF bt.disabled %] class="disabled-transfer"[% END %]>
104
                            <div onclick="enable_cost_input('[% bt.id %]');">[% bt.value %]</div>
105
                            <input type="hidden" name="cost_[% bt.id %]" value="[% bt.value %]" />
106
                            [% IF bt.disabled %]
107
                            <input type="hidden" name="disable_[% bt.id %]" value="1" />
108
                            [% END %]
109
                            </div>
110
                        [% END %]
111
                        </td>
112
                    [% END %]
113
                    </tr>
114
                [% END %]
115
                </table>
116
            </div>
117
            <input type="submit" value="Save" class="submit" />
118
        </form>
119
    </div>
120
    </div>
121
    </div>
122
<div class="yui-b">
123
[% INCLUDE 'admin-menu.inc' %]
124
</div>
125
</div>
126
[% INCLUDE 'intranet-bottom.inc' %]
(-)a/misc/cronjobs/holds/build_holds_queue.pl (-380 / +2 lines)
Lines 5-11 Link Here
5
#-----------------------------------
5
#-----------------------------------
6
# FIXME: add command-line options for verbosity and summary
6
# FIXME: add command-line options for verbosity and summary
7
# FIXME: expand perldoc, explain intended logic
7
# FIXME: expand perldoc, explain intended logic
8
# FIXME: refactor all subroutines into C4 for testability
9
8
10
use strict;
9
use strict;
11
use warnings;
10
use warnings;
Lines 16-399 BEGIN { Link Here
16
    eval { require "$FindBin::Bin/../kohalib.pl" };
15
    eval { require "$FindBin::Bin/../kohalib.pl" };
17
}
16
}
18
17
19
use C4::Context;
18
use C4::HoldsQueue qw(CreateQueue);
20
use C4::Search;
21
use C4::Items;
22
use C4::Branch;
23
use C4::Circulation;
24
use C4::Members;
25
use C4::Biblio;
26
19
27
use List::Util qw(shuffle);
20
CreateQueue();
28
21
29
my $bibs_with_pending_requests = GetBibsWithPendingHoldRequests();
30
31
my $dbh   = C4::Context->dbh;
32
$dbh->do("DELETE FROM tmp_holdsqueue");  # clear the old table for new info
33
$dbh->do("DELETE FROM hold_fill_targets");
34
35
my $total_bibs            = 0;
36
my $total_requests        = 0;
37
my $total_available_items = 0;
38
my $num_items_mapped      = 0;
39
40
my @branches_to_use = _get_branches_to_pull_from();
41
42
foreach my $biblionumber (@$bibs_with_pending_requests) {
43
    $total_bibs++;
44
    my $hold_requests   = GetPendingHoldRequestsForBib($biblionumber);
45
    my $available_items = GetItemsAvailableToFillHoldRequestsForBib($biblionumber, @branches_to_use);
46
    $total_requests        += scalar(@$hold_requests);
47
    $total_available_items += scalar(@$available_items);
48
    my $item_map = MapItemsToHoldRequests($hold_requests, $available_items, @branches_to_use);
49
50
    (defined($item_map)) or next;
51
52
    my $item_map_size = scalar(keys %$item_map);
53
    $num_items_mapped += $item_map_size;
54
    CreatePicklistFromItemMap($item_map);
55
    AddToHoldTargetMap($item_map);
56
    if (($item_map_size < scalar(@$hold_requests  )) and
57
        ($item_map_size < scalar(@$available_items))) {
58
        # DOUBLE CHECK, but this is probably OK - unfilled item-level requests
59
        # FIXME
60
        #warn "unfilled requests for $biblionumber";
61
        #warn Dumper($hold_requests), Dumper($available_items), Dumper($item_map);
62
    }
63
}
64
65
exit 0;
66
67
=head1 FUNCTIONS
68
69
=head2 GetBibsWithPendingHoldRequests
70
71
  my $biblionumber_aref = GetBibsWithPendingHoldRequests();
72
73
Return an arrayref of the biblionumbers of all bibs
74
that have one or more unfilled hold requests.
75
76
=cut
77
78
sub GetBibsWithPendingHoldRequests {
79
    my $dbh = C4::Context->dbh;
80
81
    my $bib_query = "SELECT DISTINCT biblionumber
82
                     FROM reserves
83
                     WHERE found IS NULL
84
                     AND priority > 0
85
                     AND reservedate <= CURRENT_DATE()";
86
    my $sth = $dbh->prepare($bib_query);
87
88
    $sth->execute();
89
    my $biblionumbers = $sth->fetchall_arrayref();
90
91
    return [ map { $_->[0] } @$biblionumbers ];
92
}
93
94
=head2 GetPendingHoldRequestsForBib
95
96
  my $requests = GetPendingHoldRequestsForBib($biblionumber);
97
98
Returns an arrayref of hashrefs to pending, unfilled hold requests
99
on the bib identified by $biblionumber.  The following keys
100
are present in each hashref:
101
102
    biblionumber
103
    borrowernumber
104
    itemnumber
105
    priority
106
    branchcode
107
    reservedate
108
    reservenotes
109
    borrowerbranch
110
111
The arrayref is sorted in order of increasing priority.
112
113
=cut
114
115
sub GetPendingHoldRequestsForBib {
116
    my $biblionumber = shift;
117
118
    my $dbh = C4::Context->dbh;
119
120
    my $request_query = "SELECT biblionumber, borrowernumber, itemnumber, priority, reserves.branchcode, 
121
                                reservedate, reservenotes, borrowers.branchcode AS borrowerbranch
122
                         FROM reserves
123
                         JOIN borrowers USING (borrowernumber)
124
                         WHERE biblionumber = ?
125
                         AND found IS NULL
126
                         AND priority > 0
127
                         AND reservedate <= CURRENT_DATE()
128
                         ORDER BY priority";
129
    my $sth = $dbh->prepare($request_query);
130
    $sth->execute($biblionumber);
131
132
    my $requests = $sth->fetchall_arrayref({});
133
    return $requests;
134
135
}
136
137
=head2 GetItemsAvailableToFillHoldRequestsForBib
138
139
  my $available_items = GetItemsAvailableToFillHoldRequestsForBib($biblionumber);
140
141
Returns an arrayref of items available to fill hold requests
142
for the bib identified by C<$biblionumber>.  An item is available
143
to fill a hold request if and only if:
144
145
    * it is not on loan
146
    * it is not withdrawn
147
    * it is not marked notforloan
148
    * it is not currently in transit
149
    * it is not lost
150
    * it is not sitting on the hold shelf
151
152
=cut
153
154
sub GetItemsAvailableToFillHoldRequestsForBib {
155
    my $biblionumber = shift;
156
    my @branches_to_use = @_;
157
158
    my $dbh = C4::Context->dbh;
159
    my $items_query = "SELECT itemnumber, homebranch, holdingbranch, itemtypes.itemtype AS itype
160
                       FROM items ";
161
162
    if (C4::Context->preference('item-level_itypes')) {
163
        $items_query .=   "LEFT JOIN itemtypes ON (itemtypes.itemtype = items.itype) ";
164
    } else {
165
        $items_query .=   "JOIN biblioitems USING (biblioitemnumber)
166
                           LEFT JOIN itemtypes USING (itemtype) ";
167
    }
168
    $items_query .=   "WHERE items.notforloan = 0
169
                       AND holdingbranch IS NOT NULL
170
                       AND itemlost = 0
171
                       AND wthdrawn = 0";
172
    $items_query .=   " AND damaged = 0 " unless C4::Context->preference('AllowHoldsOnDamagedItems');
173
    $items_query .=   " AND items.onloan IS NULL
174
                       AND (itemtypes.notforloan IS NULL OR itemtypes.notforloan = 0)
175
                       AND itemnumber NOT IN (
176
                           SELECT itemnumber
177
                           FROM reserves
178
                           WHERE biblionumber = ?
179
                           AND itemnumber IS NOT NULL
180
                           AND (found IS NOT NULL OR priority = 0)
181
                        )
182
                       AND items.biblionumber = ?";
183
    my @params = ($biblionumber, $biblionumber);
184
    if ($#branches_to_use > -1) {
185
        $items_query .= " AND holdingbranch IN (" . join (",", map { "?" } @branches_to_use) . ")";
186
        push @params, @branches_to_use;
187
    }
188
    my $sth = $dbh->prepare($items_query);
189
    $sth->execute(@params);
190
191
    my $items = $sth->fetchall_arrayref({});
192
    $items = [ grep { my @transfers = GetTransfers($_->{itemnumber}); $#transfers == -1; } @$items ]; 
193
    map { my $rule = GetBranchItemRule($_->{homebranch}, $_->{itype}); $_->{holdallowed} = $rule->{holdallowed}; $rule->{holdallowed} != 0 } @$items;
194
    return [ grep { $_->{holdallowed} != 0 } @$items ];
195
}
196
197
=head2 MapItemsToHoldRequests
198
199
  MapItemsToHoldRequests($hold_requests, $available_items);
200
201
=cut
202
203
sub MapItemsToHoldRequests {
204
    my $hold_requests = shift;
205
    my $available_items = shift;
206
    my @branches_to_use = @_;
207
208
    # handle trival cases
209
    return unless scalar(@$hold_requests) > 0;
210
    return unless scalar(@$available_items) > 0;
211
212
    # identify item-level requests
213
    my %specific_items_requested = map { $_->{itemnumber} => 1 } 
214
                                   grep { defined($_->{itemnumber}) }
215
                                   @$hold_requests;
216
217
    # group available items by itemnumber
218
    my %items_by_itemnumber = map { $_->{itemnumber} => $_ } @$available_items;
219
220
    # items already allocated
221
    my %allocated_items = ();
222
223
    # map of items to hold requests
224
    my %item_map = ();
225
 
226
    # figure out which item-level requests can be filled    
227
    my $num_items_remaining = scalar(@$available_items);
228
    foreach my $request (@$hold_requests) {
229
        last if $num_items_remaining == 0;
230
231
        # is this an item-level request?
232
        if (defined($request->{itemnumber})) {
233
            # fill it if possible; if not skip it
234
            if (exists $items_by_itemnumber{$request->{itemnumber}} and
235
                not exists $allocated_items{$request->{itemnumber}}) {
236
                $item_map{$request->{itemnumber}} = { 
237
                    borrowernumber => $request->{borrowernumber},
238
                    biblionumber => $request->{biblionumber},
239
                    holdingbranch =>  $items_by_itemnumber{$request->{itemnumber}}->{holdingbranch},
240
                    pickup_branch => $request->{branchcode},
241
                    item_level => 1,
242
                    reservedate => $request->{reservedate},
243
                    reservenotes => $request->{reservenotes},
244
                };
245
                $allocated_items{$request->{itemnumber}}++;
246
                $num_items_remaining--;
247
            }
248
        } else {
249
            # it's title-level request that will take up one item
250
            $num_items_remaining--;
251
        }
252
    }
253
254
    # group available items by branch
255
    my %items_by_branch = ();
256
    foreach my $item (@$available_items) {
257
        push @{ $items_by_branch{ $item->{holdingbranch} } }, $item unless exists $allocated_items{ $item->{itemnumber} };
258
    }
259
260
    # now handle the title-level requests
261
    $num_items_remaining = scalar(@$available_items) - scalar(keys %allocated_items); 
262
    foreach my $request (@$hold_requests) {
263
        last if $num_items_remaining <= 0;
264
        next if defined($request->{itemnumber}); # already handled these
265
266
        # look for local match first
267
        my $pickup_branch = $request->{branchcode};
268
        if (exists $items_by_branch{$pickup_branch} and 
269
            not ($items_by_branch{$pickup_branch}->[0]->{holdallowed} == 1 and 
270
                 $request->{borrowerbranch} ne $items_by_branch{$pickup_branch}->[0]->{homebranch}) 
271
           ) {
272
            my $item = pop @{ $items_by_branch{$pickup_branch} };
273
            delete $items_by_branch{$pickup_branch} if scalar(@{ $items_by_branch{$pickup_branch} }) == 0;
274
            $item_map{$item->{itemnumber}} = { 
275
                                                borrowernumber => $request->{borrowernumber},
276
                                                biblionumber => $request->{biblionumber},
277
                                                holdingbranch => $pickup_branch,
278
                                                pickup_branch => $pickup_branch,
279
                                                item_level => 0,
280
                                                reservedate => $request->{reservedate},
281
                                                reservenotes => $request->{reservenotes},
282
                                             };
283
            $num_items_remaining--;
284
        } else {
285
            my @pull_branches = ();
286
            if ($#branches_to_use > -1) {
287
                @pull_branches = @branches_to_use;
288
            } else {
289
                @pull_branches = sort keys %items_by_branch;
290
            }
291
            foreach my $branch (@pull_branches) {
292
                next unless exists $items_by_branch{$branch} and
293
                            not ($items_by_branch{$branch}->[0]->{holdallowed} == 1 and 
294
                                $request->{borrowerbranch} ne $items_by_branch{$branch}->[0]->{homebranch});
295
                my $item = pop @{ $items_by_branch{$branch} };
296
                delete $items_by_branch{$branch} if scalar(@{ $items_by_branch{$branch} }) == 0;
297
                $item_map{$item->{itemnumber}} = { 
298
                                                    borrowernumber => $request->{borrowernumber},
299
                                                    biblionumber => $request->{biblionumber},
300
                                                    holdingbranch => $branch,
301
                                                    pickup_branch => $pickup_branch,
302
                                                    item_level => 0,
303
                                                    reservedate => $request->{reservedate},
304
                                                    reservenotes => $request->{reservenotes},
305
                                                 };
306
                $num_items_remaining--; 
307
                last;
308
            }
309
        }
310
    }
311
    return \%item_map;
312
}
313
314
=head2 CreatePickListFromItemMap 
315
316
=cut
317
318
sub CreatePicklistFromItemMap {
319
    my $item_map = shift;
320
321
    my $dbh = C4::Context->dbh;
322
323
    my $sth_load=$dbh->prepare("
324
        INSERT INTO tmp_holdsqueue (biblionumber,itemnumber,barcode,surname,firstname,phone,borrowernumber,
325
                                    cardnumber,reservedate,title, itemcallnumber,
326
                                    holdingbranch,pickbranch,notes, item_level_request)
327
        VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
328
    ");
329
330
    foreach my $itemnumber  (sort keys %$item_map) {
331
        my $mapped_item = $item_map->{$itemnumber};
332
        my $biblionumber = $mapped_item->{biblionumber}; 
333
        my $borrowernumber = $mapped_item->{borrowernumber}; 
334
        my $pickbranch = $mapped_item->{pickup_branch};
335
        my $holdingbranch = $mapped_item->{holdingbranch};
336
        my $reservedate = $mapped_item->{reservedate};
337
        my $reservenotes = $mapped_item->{reservenotes};
338
        my $item_level = $mapped_item->{item_level};
339
340
        my $item = GetItem($itemnumber);
341
        my $barcode = $item->{barcode};
342
        my $itemcallnumber = $item->{itemcallnumber};
343
344
        my $borrower = GetMember('borrowernumber'=>$borrowernumber);
345
        my $cardnumber = $borrower->{'cardnumber'};
346
        my $surname = $borrower->{'surname'};
347
        my $firstname = $borrower->{'firstname'};
348
        my $phone = $borrower->{'phone'};
349
   
350
        my $bib = GetBiblioData($biblionumber);
351
        my $title = $bib->{title}; 
352
353
        $sth_load->execute($biblionumber, $itemnumber, $barcode, $surname, $firstname, $phone, $borrowernumber,
354
                           $cardnumber, $reservedate, $title, $itemcallnumber,
355
                           $holdingbranch, $pickbranch, $reservenotes, $item_level);
356
    }
357
}
358
359
=head2 AddToHoldTargetMap
360
361
=cut
362
363
sub AddToHoldTargetMap {
364
    my $item_map = shift;
365
366
    my $dbh = C4::Context->dbh;
367
368
    my $insert_sql = q(
369
        INSERT INTO hold_fill_targets (borrowernumber, biblionumber, itemnumber, source_branchcode, item_level_request)
370
                               VALUES (?, ?, ?, ?, ?)
371
    );
372
    my $sth_insert = $dbh->prepare($insert_sql);
373
374
    foreach my $itemnumber (keys %$item_map) {
375
        my $mapped_item = $item_map->{$itemnumber};
376
        $sth_insert->execute($mapped_item->{borrowernumber}, $mapped_item->{biblionumber}, $itemnumber,
377
                             $mapped_item->{holdingbranch}, $mapped_item->{item_level});
378
    }
379
}
380
381
=head2 _get_branches_to_pull_from
382
383
Query system preferences to get ordered list of
384
branches to use to fill hold requests.
385
386
=cut
387
388
sub _get_branches_to_pull_from {
389
    my @branches_to_use = ();
390
  
391
    my $static_branch_list = C4::Context->preference("StaticHoldsQueueWeight");
392
    if ($static_branch_list) {
393
        @branches_to_use = map { s/^\s+//; s/\s+$//; $_; } split /,/, $static_branch_list;
394
    }
395
396
    @branches_to_use = shuffle(@branches_to_use) if  C4::Context->preference("RandomizeHoldsQueueWeight");
397
398
    return @branches_to_use;
399
}
(-)a/t/db_dependent/HoldsQueue.t (-1 / +161 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Test C4::HoldsQueue::CreateQueue() for both transport cost matrix
4
# and StaticHoldsQueueWeight array (no RandomizeHoldsQueueWeight, no point)
5
# Wraps tests in transaction that's rolled back, so no data is destroyed
6
# MySQL WARNING: This makes sense only if your tables are InnoDB, otherwise
7
# transactions are not supported and mess is left behind
8
9
use strict;
10
use warnings;
11
use C4::Context;
12
13
use Data::Dumper;
14
15
use Test::More tests => 15;
16
17
BEGIN {
18
	use FindBin;
19
	use lib $FindBin::Bin;
20
	use_ok('C4::Reserves');
21
	use_ok('C4::HoldsQueue');
22
}
23
24
my $TITLE = "Test Holds Queue XXX";
25
# Pick a plausible borrower. Easier than creating one.
26
my $BORROWER_QRY = <<EOQ;
27
select *
28
from borrowers
29
where borrowernumber = (select max(borrowernumber) from issues)
30
EOQ
31
my $dbh = C4::Context->dbh;
32
my $borrower = $dbh->selectrow_hashref($BORROWER_QRY);
33
my $borrowernumber = $borrower->{borrowernumber};
34
# Set special (for this test) branches
35
my $borrower_branchcode = $borrower->{branchcode};
36
my @other_branches = grep { $_ ne $borrower_branchcode } @{ $dbh->selectcol_arrayref("SELECT branchcode FROM branches") };
37
my $least_cost_branch_code = pop @other_branches
38
 or BAIL_OUT("No point testing only one branch...");
39
40
# Start transaction
41
$dbh->{AutoCommit} = 0;
42
$dbh->{RaiseError} = 1;
43
44
#Set up the stage
45
# Sysprefs and cost matrix
46
$dbh->do("UPDATE systempreferences SET value = ? WHERE variable = 'StaticHoldsQueueWeight'", undef,
47
         join( ',', @other_branches, $borrower_branchcode, $least_cost_branch_code));
48
$dbh->do("UPDATE systempreferences SET value = '0' WHERE variable = 'RandomizeHoldsQueueWeight'");
49
50
$dbh->do("DELETE FROM transport_cost");
51
my $transport_cost_insert_sth = $dbh->prepare("insert into transport_cost (frombranch, tobranch, cost) values (?, ?, ?)");
52
# Favour $least_cost_branch_code
53
$transport_cost_insert_sth->execute($borrower_branchcode, $least_cost_branch_code, 0.2);
54
$transport_cost_insert_sth->execute($least_cost_branch_code, $borrower_branchcode, 0.2);
55
my @b = @other_branches;
56
while ( my $b1 = shift @b ) {
57
    foreach my $b2 ($borrower_branchcode, $least_cost_branch_code, @b) {
58
        $transport_cost_insert_sth->execute($b1, $b2, 0.5);
59
        $transport_cost_insert_sth->execute($b2, $b1, 0.5);
60
    }
61
}
62
63
64
# Loanable items - all possible combinations of homebranch and holdingbranch
65
$dbh->do("INSERT INTO biblio (frameworkcode, author, title, datecreated)
66
          VALUES             ('SER', 'Koha test', '$TITLE', '2011-02-01')");
67
my $biblionumber = $dbh->selectrow_array("SELECT biblionumber FROM biblio WHERE title = '$TITLE'")
68
  or BAIL_OUT("Cannot find newly created biblio record");
69
$dbh->do("INSERT INTO biblioitems (biblionumber, marcxml)
70
          VALUES                  ($biblionumber, '')");
71
my $biblioitemnumber = $dbh->selectrow_array("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber = $biblionumber")
72
  or BAIL_OUT("Cannot find newly created biblioitems record");
73
74
my $items_insert_sth = $dbh->prepare("INSERT INTO items (biblionumber, biblioitemnumber, barcode, homebranch, holdingbranch, notforloan, damaged, itemlost, wthdrawn, onloan)
75
                                      VALUES            ($biblionumber, $biblioitemnumber, ?, ?, ?, 0, 0, 0, 0, NULL)"); # CURRENT_DATE - 3)");
76
my $first_barcode = int(rand(1000000000000)); # XXX
77
my $barcode = $first_barcode;
78
foreach ( $borrower_branchcode, $least_cost_branch_code, @other_branches ) {
79
    $items_insert_sth->execute($barcode++, $borrower_branchcode, $_);
80
    $items_insert_sth->execute($barcode++, $_, $_);
81
    $items_insert_sth->execute($barcode++, $_, $borrower_branchcode);
82
}
83
84
# Remove existing reserves, makes debugging easier
85
$dbh->do("DELETE FROM reserves");
86
my $constraint = undef;
87
my $bibitems = undef;
88
my $priority = 1;
89
# Make a reserve
90
AddReserve ( $borrower_branchcode, $borrowernumber, $biblionumber, $constraint, $bibitems,  $priority );
91
#                           $resdate, $expdate, $notes, $title, $checkitem, $found
92
$dbh->do("UPDATE reserves SET reservedate = reservedate - 1");
93
94
# Tests
95
my $use_cost_matrix_sth = $dbh->prepare("UPDATE systempreferences SET value = ? WHERE variable = 'UseTransportCostMatrix'");
96
my $test_sth = $dbh->prepare("SELECT * FROM hold_fill_targets
97
                              JOIN tmp_holdsqueue USING (borrowernumber, biblionumber, itemnumber)
98
                              JOIN items USING (itemnumber)
99
                              WHERE borrowernumber = $borrowernumber");
100
101
# We have a book available homed in borrower branch
102
test_queue ('take from homebranch',  0, $borrower_branchcode, $borrower_branchcode);
103
test_queue ('take from homebranch',  1, $borrower_branchcode, $borrower_branchcode);
104
105
$dbh->do("DELETE FROM tmp_holdsqueue");
106
$dbh->do("DELETE FROM hold_fill_targets");
107
$dbh->do("DELETE FROM issues WHERE itemnumber IN (SELECT itemnumber FROM items WHERE homebranch = '$borrower_branchcode')");
108
$dbh->do("DELETE FROM items WHERE homebranch = '$borrower_branchcode'");
109
# We have a book available held in borrower branch
110
test_queue ('take from holdingbranch', 0, $borrower_branchcode, $borrower_branchcode);
111
test_queue ('take from holdingbranch', 1, $borrower_branchcode, $borrower_branchcode);
112
113
$dbh->do("DELETE FROM tmp_holdsqueue");
114
$dbh->do("DELETE FROM hold_fill_targets");
115
$dbh->do("DELETE FROM issues WHERE itemnumber IN (SELECT itemnumber FROM items WHERE holdingbranch = '$borrower_branchcode')");
116
$dbh->do("DELETE FROM items WHERE holdingbranch = '$borrower_branchcode'");
117
# No book available in borrower branch, pick according to the rules
118
# Frst branch from StaticHoldsQueueWeight
119
test_queue ('take from lowest cost branch', 0, $borrower_branchcode, $other_branches[0]);
120
test_queue ('take from lowest cost branch', 1, $borrower_branchcode, $least_cost_branch_code);
121
my $queue = C4::HoldsQueue::GetHoldsQueueItems($least_cost_branch_code) || [];
122
my $queue_item = $queue->[0];
123
ok( $queue_item
124
 && $queue_item->{pickbranch} eq $borrower_branchcode
125
 && $queue_item->{holdingbranch} eq $least_cost_branch_code, "GetHoldsQueueItems" )
126
  or diag( "Expected item for pick $borrower_branchcode, hold $least_cost_branch_code, got ".Dumper($queue_item) );
127
128
# XXX All this tests are for borrower branch pick-up.
129
# Maybe needs expanding to homebranch or holdingbranch pick-up.
130
131
# Cleanup
132
$dbh->rollback;
133
134
exit;
135
136
sub test_queue {
137
    my ($test_name, $use_cost_matrix, $pick_branch, $hold_branch) = @_;
138
139
    $test_name = "$test_name (".($use_cost_matrix ? "" : "don't")." use cost matrix)";
140
141
    $use_cost_matrix_sth->execute($use_cost_matrix);
142
    C4::Context->_flush_preferences();
143
    C4::HoldsQueue::CreateQueue();
144
145
    my $results = $dbh->selectall_arrayref($test_sth, { Slice => {} }); # should be only one
146
    my $r = $results->[0];
147
148
    my $ok = is( $r->{pickbranch}, $pick_branch, "$test_name pick up branch");
149
    $ok &&=  is( $r->{holdingbranch}, $hold_branch, "$test_name holding branch")
150
      if $hold_branch;
151
152
    diag( "Wrong pick-up/hold: ". Dumper ($pick_branch,, $hold_branch, map dump_records($_), qw(reserves hold_fill_targets tmp_holdsqueue)) )
153
      unless $ok;
154
}
155
156
sub dump_records {
157
    my ($tablename) = @_;
158
    return $dbh->selectall_arrayref("SELECT * from $tablename where borrowernumber = ?", { Slice => {} }, $borrowernumber);
159
}
160
161

Return to bug 5911