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

(-)a/C4/Context.pm (+3 lines)
Lines 459-464 with this method. Link Here
459
# flushing the caching mechanism.
459
# flushing the caching mechanism.
460
460
461
my %sysprefs;
461
my %sysprefs;
462
sub _flush_preferences {
463
    %sysprefs = ();
464
}
462
465
463
sub preference {
466
sub preference {
464
    my $self = shift;
467
    my $self = shift;
(-)a/C4/HoldsQueue.pm (+626 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
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
    my @params = ($biblionumber, $biblionumber);
334
    if ($branches_to_use && @$branches_to_use) {
335
        $items_query .= " AND holdingbranch IN (" . join (",", map { "?" } @$branches_to_use) . ")";
336
        push @params, @$branches_to_use;
337
    }
338
    my $sth = $dbh->prepare($items_query);
339
    $sth->execute(@params);
340
341
    my $items = $sth->fetchall_arrayref({});
342
    $items = [ grep { my @transfers = GetTransfers($_->{itemnumber}); $#transfers == -1; } @$items ]; 
343
    map { my $rule = GetBranchItemRule($_->{homebranch}, $_->{itype}); $_->{holdallowed} = $rule->{holdallowed}; $rule->{holdallowed} != 0 } @$items;
344
    return [ grep { $_->{holdallowed} != 0 } @$items ];
345
}
346
347
=head2 MapItemsToHoldRequests
348
349
  MapItemsToHoldRequests($hold_requests, $available_items);
350
351
=cut
352
353
sub MapItemsToHoldRequests {
354
    my ($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix) = @_;
355
356
    # handle trival cases
357
    return unless scalar(@$hold_requests) > 0;
358
    return unless scalar(@$available_items) > 0;
359
360
    debug( "MapItemsToHoldRequests() for ".Dumper($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix) );
361
    my $automatic_return = C4::Context->preference("AutomaticItemReturn");
362
363
    # identify item-level requests
364
    my %specific_items_requested = map { $_->{itemnumber} => 1 } 
365
                                   grep { defined($_->{itemnumber}) }
366
                                   @$hold_requests;
367
368
    # group available items by itemnumber
369
    my %items_by_itemnumber = map { $_->{itemnumber} => $_ } @$available_items;
370
371
    # items already allocated
372
    my %allocated_items = ();
373
374
    # map of items to hold requests
375
    my %item_map = ();
376
 
377
    # figure out which item-level requests can be filled    
378
    my $num_items_remaining = scalar(@$available_items);
379
    foreach my $request (@$hold_requests) {
380
        last if $num_items_remaining == 0;
381
382
        # is this an item-level request?
383
        if (defined($request->{itemnumber})) {
384
            # fill it if possible; if not skip it
385
            if (exists $items_by_itemnumber{$request->{itemnumber}} and
386
                not exists $allocated_items{$request->{itemnumber}}) {
387
                $item_map{$request->{itemnumber}} = { 
388
                    borrowernumber => $request->{borrowernumber},
389
                    biblionumber => $request->{biblionumber},
390
                    holdingbranch =>  $items_by_itemnumber{$request->{itemnumber}}->{holdingbranch},
391
                    pickup_branch => $request->{branchcode} || $request->{borrowerbranch},
392
                    item_level => 1,
393
                    reservedate => $request->{reservedate},
394
                    reservenotes => $request->{reservenotes},
395
                };
396
                $allocated_items{$request->{itemnumber}}++;
397
                $num_items_remaining--;
398
            }
399
        } else {
400
            # it's title-level request that will take up one item
401
            $num_items_remaining--;
402
        }
403
    }
404
405
    # group available items by branch
406
    my %items_by_branch = ();
407
    foreach my $item (@$available_items) {
408
        next unless $item->{holdallowed};
409
410
        push @{ $items_by_branch{  $automatic_return ? $item->{homebranch}
411
                                                     : $item->{holdingbranch} } }, $item
412
          unless exists $allocated_items{ $item->{itemnumber} };
413
    }
414
    return unless keys %items_by_branch;
415
416
    # now handle the title-level requests
417
    $num_items_remaining = scalar(@$available_items) - scalar(keys %allocated_items); 
418
    my $pull_branches;
419
    foreach my $request (@$hold_requests) {
420
        last if $num_items_remaining == 0;
421
        next if defined($request->{itemnumber}); # already handled these
422
423
        # look for local match first
424
        my $pickup_branch = $request->{branchcode} || $request->{borrowerbranch};
425
        my ($itemnumber, $holdingbranch);
426
427
        my $holding_branch_items = $automatic_return ? undef : $items_by_branch{$pickup_branch};
428
        if ( $holding_branch_items ) {
429
            foreach my $item (@$holding_branch_items) {
430
                if ( $request->{borrowerbranch} eq $item->{homebranch} ) {
431
                    $itemnumber = $item->{itemnumber};
432
                    last;
433
                }
434
            }
435
            $holdingbranch = $pickup_branch;
436
            $itemnumber ||= $holding_branch_items->[0]->{itemnumber};
437
        }
438
        elsif ($transport_cost_matrix) {
439
            $pull_branches = [keys %items_by_branch];
440
            $holdingbranch = least_cost_branch( $pickup_branch, $pull_branches, $transport_cost_matrix );
441
            if ( $holdingbranch ) {
442
443
                my $holding_branch_items = $items_by_branch{$holdingbranch};
444
                foreach my $item (@$holding_branch_items) {
445
                    next if $request->{borrowerbranch} ne $item->{homebranch};
446
447
                    $itemnumber = $item->{itemnumber};
448
                    last;
449
                }
450
                $itemnumber ||= $holding_branch_items->[0]->{itemnumber};
451
            }
452
            else {
453
                warn "No transport costs for $pickup_branch";
454
            }
455
        }
456
457
        unless ($itemnumber) {
458
            # not found yet, fall back to basics
459
            if ($branches_to_use) {
460
                $pull_branches = $branches_to_use;
461
            } else {
462
                $pull_branches = [keys %items_by_branch];
463
            }
464
            PULL_BRANCHES:
465
            foreach my $branch (@$pull_branches) {
466
                my $holding_branch_items = $items_by_branch{$branch}
467
                  or next;
468
469
                $holdingbranch ||= $branch;
470
                foreach my $item (@$holding_branch_items) {
471
                    next if $pickup_branch ne $item->{homebranch};
472
473
                    $itemnumber = $item->{itemnumber};
474
                    $holdingbranch = $branch;
475
                    last PULL_BRANCHES;
476
                }
477
            }
478
            $itemnumber ||= $items_by_branch{$holdingbranch}->[0]->{itemnumber}
479
              if $holdingbranch;
480
        }
481
482
        if ($itemnumber) {
483
            my $holding_branch_items = $items_by_branch{$holdingbranch}
484
              or die "Have $itemnumber, $holdingbranch, but no items!";
485
            @$holding_branch_items = grep { $_->{itemnumber} != $itemnumber } @$holding_branch_items;
486
            delete $items_by_branch{$holdingbranch} unless @$holding_branch_items;
487
488
            $item_map{$itemnumber} = {
489
                borrowernumber => $request->{borrowernumber},
490
                biblionumber => $request->{biblionumber},
491
                holdingbranch => $holdingbranch,
492
                pickup_branch => $pickup_branch,
493
                item_level => 0,
494
                reservedate => $request->{reservedate},
495
                reservenotes => $request->{reservenotes},
496
            };
497
            $num_items_remaining--; 
498
        }
499
    }
500
    return \%item_map;
501
}
502
503
=head2 CreatePickListFromItemMap 
504
505
=cut
506
507
sub CreatePicklistFromItemMap {
508
    my $item_map = shift;
509
510
    my $dbh = C4::Context->dbh;
511
512
    my $sth_load=$dbh->prepare("
513
        INSERT INTO tmp_holdsqueue (biblionumber,itemnumber,barcode,surname,firstname,phone,borrowernumber,
514
                                    cardnumber,reservedate,title, itemcallnumber,
515
                                    holdingbranch,pickbranch,notes, item_level_request)
516
        VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
517
    ");
518
519
    foreach my $itemnumber  (sort keys %$item_map) {
520
        my $mapped_item = $item_map->{$itemnumber};
521
        my $biblionumber = $mapped_item->{biblionumber}; 
522
        my $borrowernumber = $mapped_item->{borrowernumber}; 
523
        my $pickbranch = $mapped_item->{pickup_branch};
524
        my $holdingbranch = $mapped_item->{holdingbranch};
525
        my $reservedate = $mapped_item->{reservedate};
526
        my $reservenotes = $mapped_item->{reservenotes};
527
        my $item_level = $mapped_item->{item_level};
528
529
        my $item = GetItem($itemnumber);
530
        my $barcode = $item->{barcode};
531
        my $itemcallnumber = $item->{itemcallnumber};
532
533
        my $borrower = GetMember('borrowernumber'=>$borrowernumber);
534
        my $cardnumber = $borrower->{'cardnumber'};
535
        my $surname = $borrower->{'surname'};
536
        my $firstname = $borrower->{'firstname'};
537
        my $phone = $borrower->{'phone'};
538
   
539
        my $bib = GetBiblioData($biblionumber);
540
        my $title = $bib->{title}; 
541
542
        $sth_load->execute($biblionumber, $itemnumber, $barcode, $surname, $firstname, $phone, $borrowernumber,
543
                           $cardnumber, $reservedate, $title, $itemcallnumber,
544
                           $holdingbranch, $pickbranch, $reservenotes, $item_level);
545
    }
546
}
547
548
=head2 AddToHoldTargetMap
549
550
=cut
551
552
sub AddToHoldTargetMap {
553
    my $item_map = shift;
554
555
    my $dbh = C4::Context->dbh;
556
557
    my $insert_sql = q(
558
        INSERT INTO hold_fill_targets (borrowernumber, biblionumber, itemnumber, source_branchcode, item_level_request)
559
                               VALUES (?, ?, ?, ?, ?)
560
    );
561
    my $sth_insert = $dbh->prepare($insert_sql);
562
563
    foreach my $itemnumber (keys %$item_map) {
564
        my $mapped_item = $item_map->{$itemnumber};
565
        $sth_insert->execute($mapped_item->{borrowernumber}, $mapped_item->{biblionumber}, $itemnumber,
566
                             $mapped_item->{holdingbranch}, $mapped_item->{item_level});
567
    }
568
}
569
570
# Helper functions, not part of any interface
571
572
sub debug {
573
#   warn @_;
574
}
575
576
sub load_branches_to_pull_from {
577
    my $static_branch_list = C4::Context->preference("StaticHoldsQueueWeight")
578
      or return;
579
580
    my @branches_to_use = map { s/^\s+//; s/\s+$//; $_; } split /,/, $static_branch_list;
581
582
    @branches_to_use = shuffle(@branches_to_use) if  C4::Context->preference("RandomizeHoldsQueueWeight");
583
584
    return \@branches_to_use;
585
}
586
587
sub least_cost_branch {
588
589
    #$from - arrayref
590
    my ($to, $from, $transport_cost_matrix) = @_;
591
592
# Nothing really spectacular: supply to branch, a list of potential from branches
593
# and find the minimum from - to value from the transport_cost_matrix
594
    return $from->[0] if @$from == 1;
595
596
    my ($least_cost, @branch);
597
    foreach (@$from) {
598
        my $cell = $transport_cost_matrix->{$to}{$_};
599
        next if $cell->{disable_transfer};
600
601
        my $cost = $cell->{cost};
602
603
        unless (defined $least_cost) {
604
            $least_cost = $cost;
605
            push @branch, $_;
606
            next;
607
        }
608
609
        next if $cost > $least_cost;
610
611
        if ($cost == $least_cost) {
612
            push @branch, $_;
613
            next;
614
        }
615
616
        @branch = ($_);
617
        $least_cost = $cost;
618
    }
619
620
    return $branch[0];
621
622
    # XXX return a random @branch with minimum cost instead of the first one;
623
    # return $branch[0] if @branch == 1;
624
}
625
626
(-)a/admin/systempreferences.pl (+1 lines)
Lines 202-207 $tabsysprefs{DisplayClearScreenButton} = "Circulation"; Link Here
202
$tabsysprefs{AllowAllMessageDeletion}        = "Circulation";
202
$tabsysprefs{AllowAllMessageDeletion}        = "Circulation";
203
$tabsysprefs{OverdueNoticeBcc}               = "Circulation";
203
$tabsysprefs{OverdueNoticeBcc}               = "Circulation";
204
$tabsysprefs{OverduesBlockCirc}              = "Circulation";
204
$tabsysprefs{OverduesBlockCirc}              = "Circulation";
205
$tabsysprefs{UseTransportCostMatrix}         = "Circulation";
205
206
206
207
207
# Staff Client
208
# 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 / +1 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 76-111 $template->param( Link Here
76
   itemtypeloop => \@itemtypesloop,
76
   itemtypeloop => \@itemtypesloop,
77
);
77
);
78
78
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
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
79
# writing the template
111
output_html_with_http_headers $query, $cookie, $template->output;
80
output_html_with_http_headers $query, $cookie, $template->output;
(-)a/installer/data/mysql/en/mandatory/sysprefs.sql (+1 lines)
Lines 291-296 INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES Link Here
291
INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES ('TraceCompleteSubfields','0','Force subject tracings to only match complete subfields.','0','YesNo');
291
INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES ('TraceCompleteSubfields','0','Force subject tracings to only match complete subfields.','0','YesNo');
292
INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES ('UseAuthoritiesForTracings','1','Use authority record numbers for subject tracings instead of heading strings.','0','YesNo');
292
INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES ('UseAuthoritiesForTracings','1','Use authority record numbers for subject tracings instead of heading strings.','0','YesNo');
293
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES ('OPACAllowUserToChooseBranch', 1,       'Allow the user to choose the branch they want to pickup their hold from','1','YesNo');
293
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES ('OPACAllowUserToChooseBranch', 1,       'Allow the user to choose the branch they want to pickup their hold from','1','YesNo');
294
INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('UseTransportCostMatrix',0,"Use Transport Cost Matrix when filling holds",'','YesNo');
294
INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('displayFacetCount', '0', NULL, NULL, 'YesNo');
295
INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('displayFacetCount', '0', NULL, NULL, 'YesNo');
295
INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('maxRecordsForFacets', '20', NULL, NULL, 'Integer');
296
INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('maxRecordsForFacets', '20', NULL, NULL, 'Integer');
296
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES ('AllowPurchaseSuggestionBranchChoice', 0, 'Allow user to choose branch when making a purchase suggestion','1','YesNo');
297
INSERT INTO systempreferences (variable,value,explanation,options,type) VALUES ('AllowPurchaseSuggestionBranchChoice', 0, 'Allow user to choose branch when making a purchase suggestion','1','YesNo');
(-)a/installer/data/mysql/kohastructure.sql (+16 lines)
Lines 2600-2605 CREATE TABLE `fieldmapping` ( Link Here
2600
  PRIMARY KEY  (`id`)
2600
  PRIMARY KEY  (`id`)
2601
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
2601
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
2602
2602
2603
--
2604
-- Table structure for table `transport_cost`
2605
--
2606
2607
DROP TABLE IF EXISTS `transport_cost`;
2608
CREATE TABLE `transport_cost` (
2609
      `frombranch` varchar(10) NOT NULL,
2610
      `tobranch` varchar(10) NOT NULL,
2611
      `cost` decimal(4,3) NOT NULL,
2612
      `disable_transfer` tinyint(1) NOT NULL DEFAULT 0,
2613
      CHECK ( `frombranch` <> `tobranch` ), -- a dud check, mysql does not support that
2614
      CHECK ( cost >= 0.0 AND cost <= 1.0), -- a dud check, mysql does not support that
2615
      PRIMARY KEY (`frombranch`, `tobranch`),
2616
      CONSTRAINT `transport_cost_ibfk_1` FOREIGN KEY (`frombranch`) REFERENCES `branches` (`branchcode`) ON DELETE CASCADE ON UPDATE CASCADE,
2617
      CONSTRAINT `transport_cost_ibfk_2` FOREIGN KEY (`tobranch`) REFERENCES `branches` (`branchcode`) ON DELETE CASCADE ON UPDATE CASCADE
2618
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
2603
2619
2604
/*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
2620
/*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
2605
/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
2621
/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
(-)a/installer/data/mysql/updatedatabase.pl (+20 lines)
Lines 4166-4171 if (C4::Context->preference("Version") < TransformToNum($DBversion)) { Link Here
4166
    SetVersion ($DBversion);
4166
    SetVersion ($DBversion);
4167
}
4167
}
4168
4168
4169
$DBversion = "3.03.00.XXX";
4170
if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
4171
    $dbh->do("INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('UseTransportCostMatrix',0,'Use Transport Cost Matrix when filling holds','','YesNo')");
4172
4173
    $dbh->do("CREATE TABLE `transport_cost` (
4174
              `frombranch` varchar(10) NOT NULL,
4175
              `tobranch` varchar(10) NOT NULL,
4176
              `cost` decimal(4,3) NOT NULL,
4177
              `disable_transfer` tinyint(1) NOT NULL DEFAULT 0,
4178
              CHECK ( `frombranch` <> `tobranch` ), -- a dud check, mysql does not support that
4179
              CHECK ( cost >= 0.0 AND cost <= 1.0), -- a dud check, mysql does not support that
4180
              PRIMARY KEY (`frombranch`, `tobranch`),
4181
              CONSTRAINT `transport_cost_ibfk_1` FOREIGN KEY (`frombranch`) REFERENCES `branches` (`branchcode`) ON DELETE CASCADE ON UPDATE CASCADE,
4182
              CONSTRAINT `transport_cost_ibfk_2` FOREIGN KEY (`tobranch`) REFERENCES `branches` (`branchcode`) ON DELETE CASCADE ON UPDATE CASCADE
4183
          ) ENGINE=InnoDB DEFAULT CHARSET=utf8");
4184
4185
    print "Upgrade to $DBversion done (creating `transport_cost` table; adding UseTransportCostMatrix systempref, in circulation)\n";
4186
    SetVersion ($DBversion);
4187
}
4188
4169
=head1 FUNCTIONS
4189
=head1 FUNCTIONS
4170
4190
4171
=head2 DropAllForeignKeys($table)
4191
=head2 DropAllForeignKeys($table)
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tmpl (+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.tmpl (+126 lines)
Line 0 Link Here
1
<!-- TMPL_INCLUDE NAME="doc-head-open.inc" -->
2
<title>Koha &rsaquo; Administration &rsaquo; Transport Cost Matrix</title>
3
<!-- TMPL_INCLUDE NAME="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(<!-- TMPL_IF NAME="UseTransportCostMatrix" -->true<!-- TMPL_ELSE -->false<!-- /TMPL_IF -->);
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
<!-- TMPL_INCLUDE NAME="header.inc" -->
66
<!-- TMPL_INCLUDE NAME="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" <!-- TMPL_IF NAME="UseTransportCostMatrix" -->checked<!-- /TMPL_IF --> 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
                <!-- TMPL_LOOP NAME="branchloop" -->
92
                        <th><!-- TMPL_VAR NAME="name" --></th>
93
                <!-- /TMPL_LOOP -->
94
                    <tr>
95
                <!-- TMPL_LOOP NAME="branchfromloop" -->
96
                    <tr>
97
                        <th><!-- TMPL_VAR NAME="name" --></th>
98
                    <!-- TMPL_LOOP NAME="branchtoloop" -->
99
                        <td>
100
                        <!-- TMPL_IF NAME="skip"  -->
101
                            &nbsp;
102
                        <!-- TMPL_ELSE -->
103
                            <div id="celldiv_<!-- TMPL_VAR NAME="id" -->"<!-- TMPL_IF NAME="disabled"  -->class="disabled-transfer"<!-- /TMPL_IF -->>
104
                            <div onclick="enable_cost_input('<!-- TMPL_VAR NAME="id" -->');"><!-- TMPL_VAR NAME="value" --></div>
105
                            <input type="hidden" name="cost_<!-- TMPL_VAR NAME="id" -->" value="<!-- TMPL_VAR NAME="value" -->" />
106
                            <!-- TMPL_IF NAME="disabled"  -->
107
                            <input type="hidden" name="disable_<!-- TMPL_VAR NAME="id" -->" value="1" />
108
                            <!-- /TMPL_IF -->
109
                            </div>
110
                        <!-- /TMPL_IF -->
111
                        </td>
112
                    <!-- /TMPL_LOOP -->
113
                    </tr>
114
                <!-- /TMPL_LOOP -->
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
<!-- TMPL_INCLUDE NAME="admin-menu.inc" -->
124
</div>
125
</div>
126
<!-- TMPL_INCLUDE NAME="intranet-bottom.inc" -->
(-)a/misc/cronjobs/holds/build_holds_queue.pl (-379 / +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-398 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
                       AND items.onloan IS NULL
173
                       AND (itemtypes.notforloan IS NULL OR itemtypes.notforloan = 0)
174
                       AND itemnumber NOT IN (
175
                           SELECT itemnumber
176
                           FROM reserves
177
                           WHERE biblionumber = ?
178
                           AND itemnumber IS NOT NULL
179
                           AND (found IS NOT NULL OR priority = 0)
180
                        )
181
                       AND items.biblionumber = ?";
182
    my @params = ($biblionumber, $biblionumber);
183
    if ($#branches_to_use > -1) {
184
        $items_query .= " AND holdingbranch IN (" . join (",", map { "?" } @branches_to_use) . ")";
185
        push @params, @branches_to_use;
186
    }
187
    my $sth = $dbh->prepare($items_query);
188
    $sth->execute(@params);
189
190
    my $items = $sth->fetchall_arrayref({});
191
    $items = [ grep { my @transfers = GetTransfers($_->{itemnumber}); $#transfers == -1; } @$items ]; 
192
    map { my $rule = GetBranchItemRule($_->{homebranch}, $_->{itype}); $_->{holdallowed} = $rule->{holdallowed}; $rule->{holdallowed} != 0 } @$items;
193
    return [ grep { $_->{holdallowed} != 0 } @$items ];
194
}
195
196
=head2 MapItemsToHoldRequests
197
198
  MapItemsToHoldRequests($hold_requests, $available_items);
199
200
=cut
201
202
sub MapItemsToHoldRequests {
203
    my $hold_requests = shift;
204
    my $available_items = shift;
205
    my @branches_to_use = @_;
206
207
    # handle trival cases
208
    return unless scalar(@$hold_requests) > 0;
209
    return unless scalar(@$available_items) > 0;
210
211
    # identify item-level requests
212
    my %specific_items_requested = map { $_->{itemnumber} => 1 } 
213
                                   grep { defined($_->{itemnumber}) }
214
                                   @$hold_requests;
215
216
    # group available items by itemnumber
217
    my %items_by_itemnumber = map { $_->{itemnumber} => $_ } @$available_items;
218
219
    # items already allocated
220
    my %allocated_items = ();
221
222
    # map of items to hold requests
223
    my %item_map = ();
224
 
225
    # figure out which item-level requests can be filled    
226
    my $num_items_remaining = scalar(@$available_items);
227
    foreach my $request (@$hold_requests) {
228
        last if $num_items_remaining == 0;
229
230
        # is this an item-level request?
231
        if (defined($request->{itemnumber})) {
232
            # fill it if possible; if not skip it
233
            if (exists $items_by_itemnumber{$request->{itemnumber}} and
234
                not exists $allocated_items{$request->{itemnumber}}) {
235
                $item_map{$request->{itemnumber}} = { 
236
                    borrowernumber => $request->{borrowernumber},
237
                    biblionumber => $request->{biblionumber},
238
                    holdingbranch =>  $items_by_itemnumber{$request->{itemnumber}}->{holdingbranch},
239
                    pickup_branch => $request->{branchcode},
240
                    item_level => 1,
241
                    reservedate => $request->{reservedate},
242
                    reservenotes => $request->{reservenotes},
243
                };
244
                $allocated_items{$request->{itemnumber}}++;
245
                $num_items_remaining--;
246
            }
247
        } else {
248
            # it's title-level request that will take up one item
249
            $num_items_remaining--;
250
        }
251
    }
252
253
    # group available items by branch
254
    my %items_by_branch = ();
255
    foreach my $item (@$available_items) {
256
        push @{ $items_by_branch{ $item->{holdingbranch} } }, $item unless exists $allocated_items{ $item->{itemnumber} };
257
    }
258
259
    # now handle the title-level requests
260
    $num_items_remaining = scalar(@$available_items) - scalar(keys %allocated_items); 
261
    foreach my $request (@$hold_requests) {
262
        last if $num_items_remaining <= 0;
263
        next if defined($request->{itemnumber}); # already handled these
264
265
        # look for local match first
266
        my $pickup_branch = $request->{branchcode};
267
        if (exists $items_by_branch{$pickup_branch} and 
268
            not ($items_by_branch{$pickup_branch}->[0]->{holdallowed} == 1 and 
269
                 $request->{borrowerbranch} ne $items_by_branch{$pickup_branch}->[0]->{homebranch}) 
270
           ) {
271
            my $item = pop @{ $items_by_branch{$pickup_branch} };
272
            delete $items_by_branch{$pickup_branch} if scalar(@{ $items_by_branch{$pickup_branch} }) == 0;
273
            $item_map{$item->{itemnumber}} = { 
274
                                                borrowernumber => $request->{borrowernumber},
275
                                                biblionumber => $request->{biblionumber},
276
                                                holdingbranch => $pickup_branch,
277
                                                pickup_branch => $pickup_branch,
278
                                                item_level => 0,
279
                                                reservedate => $request->{reservedate},
280
                                                reservenotes => $request->{reservenotes},
281
                                             };
282
            $num_items_remaining--;
283
        } else {
284
            my @pull_branches = ();
285
            if ($#branches_to_use > -1) {
286
                @pull_branches = @branches_to_use;
287
            } else {
288
                @pull_branches = sort keys %items_by_branch;
289
            }
290
            foreach my $branch (@pull_branches) {
291
                next unless exists $items_by_branch{$branch} and
292
                            not ($items_by_branch{$branch}->[0]->{holdallowed} == 1 and 
293
                                $request->{borrowerbranch} ne $items_by_branch{$branch}->[0]->{homebranch});
294
                my $item = pop @{ $items_by_branch{$branch} };
295
                delete $items_by_branch{$branch} if scalar(@{ $items_by_branch{$branch} }) == 0;
296
                $item_map{$item->{itemnumber}} = { 
297
                                                    borrowernumber => $request->{borrowernumber},
298
                                                    biblionumber => $request->{biblionumber},
299
                                                    holdingbranch => $branch,
300
                                                    pickup_branch => $pickup_branch,
301
                                                    item_level => 0,
302
                                                    reservedate => $request->{reservedate},
303
                                                    reservenotes => $request->{reservenotes},
304
                                                 };
305
                $num_items_remaining--; 
306
                last;
307
            }
308
        }
309
    }
310
    return \%item_map;
311
}
312
313
=head2 CreatePickListFromItemMap 
314
315
=cut
316
317
sub CreatePicklistFromItemMap {
318
    my $item_map = shift;
319
320
    my $dbh = C4::Context->dbh;
321
322
    my $sth_load=$dbh->prepare("
323
        INSERT INTO tmp_holdsqueue (biblionumber,itemnumber,barcode,surname,firstname,phone,borrowernumber,
324
                                    cardnumber,reservedate,title, itemcallnumber,
325
                                    holdingbranch,pickbranch,notes, item_level_request)
326
        VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
327
    ");
328
329
    foreach my $itemnumber  (sort keys %$item_map) {
330
        my $mapped_item = $item_map->{$itemnumber};
331
        my $biblionumber = $mapped_item->{biblionumber}; 
332
        my $borrowernumber = $mapped_item->{borrowernumber}; 
333
        my $pickbranch = $mapped_item->{pickup_branch};
334
        my $holdingbranch = $mapped_item->{holdingbranch};
335
        my $reservedate = $mapped_item->{reservedate};
336
        my $reservenotes = $mapped_item->{reservenotes};
337
        my $item_level = $mapped_item->{item_level};
338
339
        my $item = GetItem($itemnumber);
340
        my $barcode = $item->{barcode};
341
        my $itemcallnumber = $item->{itemcallnumber};
342
343
        my $borrower = GetMember('borrowernumber'=>$borrowernumber);
344
        my $cardnumber = $borrower->{'cardnumber'};
345
        my $surname = $borrower->{'surname'};
346
        my $firstname = $borrower->{'firstname'};
347
        my $phone = $borrower->{'phone'};
348
   
349
        my $bib = GetBiblioData($biblionumber);
350
        my $title = $bib->{title}; 
351
352
        $sth_load->execute($biblionumber, $itemnumber, $barcode, $surname, $firstname, $phone, $borrowernumber,
353
                           $cardnumber, $reservedate, $title, $itemcallnumber,
354
                           $holdingbranch, $pickbranch, $reservenotes, $item_level);
355
    }
356
}
357
358
=head2 AddToHoldTargetMap
359
360
=cut
361
362
sub AddToHoldTargetMap {
363
    my $item_map = shift;
364
365
    my $dbh = C4::Context->dbh;
366
367
    my $insert_sql = q(
368
        INSERT INTO hold_fill_targets (borrowernumber, biblionumber, itemnumber, source_branchcode, item_level_request)
369
                               VALUES (?, ?, ?, ?, ?)
370
    );
371
    my $sth_insert = $dbh->prepare($insert_sql);
372
373
    foreach my $itemnumber (keys %$item_map) {
374
        my $mapped_item = $item_map->{$itemnumber};
375
        $sth_insert->execute($mapped_item->{borrowernumber}, $mapped_item->{biblionumber}, $itemnumber,
376
                             $mapped_item->{holdingbranch}, $mapped_item->{item_level});
377
    }
378
}
379
380
=head2 _get_branches_to_pull_from
381
382
Query system preferences to get ordered list of
383
branches to use to fill hold requests.
384
385
=cut
386
387
sub _get_branches_to_pull_from {
388
    my @branches_to_use = ();
389
  
390
    my $static_branch_list = C4::Context->preference("StaticHoldsQueueWeight");
391
    if ($static_branch_list) {
392
        @branches_to_use = map { s/^\s+//; s/\s+$//; $_; } split /,/, $static_branch_list;
393
    }
394
395
    @branches_to_use = shuffle(@branches_to_use) if  C4::Context->preference("RandomizeHoldsQueueWeight");
396
397
    return @branches_to_use;
398
}
(-)a/t/db_dependent/HoldsQueue.t (-1 / +159 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 items WHERE homebranch = '$borrower_branchcode'");
108
# We have a book available held in borrower branch
109
test_queue ('take from holdingbranch', 0, $borrower_branchcode, $borrower_branchcode);
110
test_queue ('take from holdingbranch', 1, $borrower_branchcode, $borrower_branchcode);
111
112
$dbh->do("DELETE FROM tmp_holdsqueue");
113
$dbh->do("DELETE FROM hold_fill_targets");
114
$dbh->do("DELETE FROM items WHERE holdingbranch = '$borrower_branchcode'");
115
# No book available in borrower branch, pick according to the rules
116
# Frst branch from StaticHoldsQueueWeight
117
test_queue ('take from lowest cost branch', 0, $borrower_branchcode, $other_branches[0]);
118
test_queue ('take from lowest cost branch', 1, $borrower_branchcode, $least_cost_branch_code);
119
my $queue = C4::HoldsQueue::GetHoldsQueueItems($least_cost_branch_code) || [];
120
my $queue_item = $queue->[0];
121
ok( $queue_item
122
 && $queue_item->{pickbranch} eq $borrower_branchcode
123
 && $queue_item->{holdingbranch} eq $least_cost_branch_code, "GetHoldsQueueItems" )
124
  or diag( "Expected item for pick $borrower_branchcode, hold $least_cost_branch_code, got ".Dumper($queue_item) );
125
126
# XXX All this tests are for borrower branch pick-up.
127
# Maybe needs expanding to homebranch or holdingbranch pick-up.
128
129
# Cleanup
130
$dbh->rollback;
131
132
exit;
133
134
sub test_queue {
135
    my ($test_name, $use_cost_matrix, $pick_branch, $hold_branch) = @_;
136
137
    $test_name = "$test_name (".($use_cost_matrix ? "" : "don't")." use cost matrix)";
138
139
    $use_cost_matrix_sth->execute($use_cost_matrix);
140
    C4::Context->_flush_preferences();
141
    C4::HoldsQueue::CreateQueue();
142
143
    my $results = $dbh->selectall_arrayref($test_sth, { Slice => {} }); # should be only one
144
    my $r = $results->[0];
145
146
    my $ok = is( $r->{pickbranch}, $pick_branch, "$test_name pick up branch");
147
    $ok &&=  is( $r->{holdingbranch}, $hold_branch, "$test_name holding branch")
148
      if $hold_branch;
149
150
    diag( "Wrong pick-up/hold: ". Dumper ($pick_branch,, $hold_branch, map dump_records($_), qw(reserves hold_fill_targets tmp_holdsqueue)) )
151
      unless $ok;
152
}
153
154
sub dump_records {
155
    my ($tablename) = @_;
156
    return $dbh->selectall_arrayref("SELECT * from $tablename where borrowernumber = ?", { Slice => {} }, $borrowernumber);
157
}
158
159

Return to bug 5911