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 (+615 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
        &TransportCostMatrix
47
        &UpdateTransportCostMatrix
48
     );
49
}
50
51
# XXX This is not safe in a persistant environment
52
my $dbh   = C4::Context->dbh;
53
54
=head1 FUNCTIONS
55
56
=head2 TransportCostMatrix
57
58
  TransportCostMatrix();
59
60
Returns Transport Cost Matrix as a hashref <to branch code> => <from branch code> => cost
61
62
=cut
63
64
sub TransportCostMatrix {
65
    my $transport_costs = $dbh->selectall_arrayref("SELECT * FROM transport_cost",{ Slice => {} });
66
67
    my %transport_cost_matrix;
68
    foreach (@$transport_costs) {
69
        my $from = $_->{frombranch};
70
        my $to = $_->{tobranch};
71
        my $cost = $_->{cost};
72
        my $disabled = $_->{disable_transfer};
73
        $transport_cost_matrix{$to}{$from} = { cost => $cost, disable_transfer => $disabled };
74
    }
75
    return \%transport_cost_matrix;
76
}
77
78
=head2 UpdateTransportCostMatrix
79
80
  UpdateTransportCostMatrix($records);
81
82
Updates full Transport Cost Matrix table. $records is an arrayref of records.
83
Records: { frombranch => <code>, tobranch => <code>, cost => <figure>, disable_transfer => <0,1> }
84
85
=cut
86
87
sub UpdateTransportCostMatrix {
88
    my ($records) = @_;
89
90
    my $sth = $dbh->prepare("INSERT INTO transport_cost (frombranch, tobranch, cost, disable_transfer) VALUES (?, ?, ?, ?)");
91
                 
92
    $dbh->do("TRUNCATE TABLE transport_cost");
93
    foreach (@$records) {
94
        my $cost = $_->{cost};
95
        my $from = $_->{frombranch};
96
        my $to = $_->{tobranch};
97
        if ( !defined ($cost) || ($cost !~ m/(0|[1-9][0-9]*)(\.[0-9]*)?/o) ) {
98
            warn  "Invalid $from -> $to cost $cost - nust be a number in 0 to 1 range, disablig";
99
            $_->{disable_transfer} = 1;
100
        }
101
        $sth->execute( $from, $to, $cost, $_->{disable_transfer} ? 1 : 0 );
102
    }
103
}
104
105
=head2 GetHoldsQueueItems
106
107
  GetHoldsQueueItems($branch);
108
109
Returns hold queue for a holding branch. If branch is omitted, then whole queue is returned
110
111
=cut
112
113
sub GetHoldsQueueItems {
114
    my ($branchlimit) = @_;
115
116
    my @bind_params = ();
117
    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
118
                  FROM tmp_holdsqueue
119
                       JOIN biblio      USING (biblionumber)
120
                  LEFT JOIN biblioitems USING (biblionumber)
121
                  LEFT JOIN items       USING (  itemnumber)
122
                /;
123
    if ($branchlimit) {
124
        $query .=" WHERE tmp_holdsqueue.holdingbranch = ?";
125
        push @bind_params, $branchlimit;
126
    }
127
    $query .= " ORDER BY ccode, location, cn_sort, author, title, pickbranch, reservedate";
128
    my $sth = $dbh->prepare($query);
129
    $sth->execute(@bind_params);
130
    my $items = [];
131
    while ( my $row = $sth->fetchrow_hashref ){
132
        $row->{reservedate} = format_date($row->{reservedate});
133
        my $record = GetMarcBiblio($row->{biblionumber});
134
        if ($record){
135
            $row->{subtitle} = GetRecordValue('subtitle',$record,'')->[0]->{subfield};
136
            $row->{parts} = GetRecordValue('parts',$record,'')->[0]->{subfield};
137
            $row->{numbers} = GetRecordValue('numbers',$record,'')->[0]->{subfield};
138
        }
139
        push @$items, $row;
140
    }
141
    return $items;
142
}
143
144
=head2 CreateQueue
145
146
  CreateQueue();
147
148
Top level function that turns reserves into tmp_holdsqueue and hold_fill_targets.
149
150
=cut
151
152
sub CreateQueue {
153
154
    $dbh->do("DELETE FROM tmp_holdsqueue");  # clear the old table for new info
155
    $dbh->do("DELETE FROM hold_fill_targets");
156
157
    my $total_bibs            = 0;
158
    my $total_requests        = 0;
159
    my $total_available_items = 0;
160
    my $num_items_mapped      = 0;
161
162
    my $branches_to_use;
163
    my $transport_cost_matrix;
164
    my $use_transport_cost_matrix = C4::Context->preference("UseTransportCostMatrix");
165
    if ($use_transport_cost_matrix) {
166
        debug( "Using cost matrix" );
167
        $transport_cost_matrix = TransportCostMatrix();
168
        unless (keys %$transport_cost_matrix) {
169
            warn "UseTransportCostMatrix set to yes, but matrix not populated";
170
            undef $transport_cost_matrix;
171
        }
172
    }
173
    unless ($transport_cost_matrix) {
174
        debug( "Not using cost matrix" );
175
        $branches_to_use = load_branches_to_pull_from();
176
    }
177
178
    my $bibs_with_pending_requests = GetBibsWithPendingHoldRequests();
179
    debug( "bibs_with_pending_requests: ".Dumper($bibs_with_pending_requests) );
180
181
    foreach my $biblionumber (@$bibs_with_pending_requests) {
182
        $total_bibs++;
183
        my $hold_requests   = GetPendingHoldRequestsForBib($biblionumber);
184
        my $available_items = GetItemsAvailableToFillHoldRequestsForBib($biblionumber, $branches_to_use);
185
        $total_requests        += scalar(@$hold_requests);
186
        $total_available_items += scalar(@$available_items);
187
188
        my $item_map = MapItemsToHoldRequests($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix);
189
        $item_map  or next;
190
        my $item_map_size = scalar(keys %$item_map)
191
        or next;;
192
193
        $num_items_mapped += $item_map_size;
194
        CreatePicklistFromItemMap($item_map);
195
        AddToHoldTargetMap($item_map);
196
        if (($item_map_size < scalar(@$hold_requests  )) and
197
            ($item_map_size < scalar(@$available_items))) {
198
            # DOUBLE CHECK, but this is probably OK - unfilled item-level requests
199
            # FIXME
200
            #warn "unfilled requests for $biblionumber";
201
            #warn Dumper($hold_requests), Dumper($available_items), Dumper($item_map);
202
        }
203
    }
204
}
205
206
=head2 GetBibsWithPendingHoldRequests
207
208
  my $biblionumber_aref = GetBibsWithPendingHoldRequests();
209
210
Return an arrayref of the biblionumbers of all bibs
211
that have one or more unfilled hold requests.
212
213
=cut
214
215
sub GetBibsWithPendingHoldRequests {
216
    my $dbh = C4::Context->dbh;
217
218
    my $bib_query = "SELECT DISTINCT biblionumber
219
                     FROM reserves
220
                     WHERE found IS NULL
221
                     AND priority > 0
222
                     AND reservedate <= CURRENT_DATE()";
223
    my $sth = $dbh->prepare($bib_query);
224
225
    $sth->execute();
226
    my $biblionumbers = $sth->fetchall_arrayref();
227
228
    return [ map { $_->[0] } @$biblionumbers ];
229
}
230
231
=head2 GetPendingHoldRequestsForBib
232
233
  my $requests = GetPendingHoldRequestsForBib($biblionumber);
234
235
Returns an arrayref of hashrefs to pending, unfilled hold requests
236
on the bib identified by $biblionumber.  The following keys
237
are present in each hashref:
238
239
    biblionumber
240
    borrowernumber
241
    itemnumber
242
    priority
243
    branchcode
244
    reservedate
245
    reservenotes
246
    borrowerbranch
247
248
The arrayref is sorted in order of increasing priority.
249
250
=cut
251
252
sub GetPendingHoldRequestsForBib {
253
    my $biblionumber = shift;
254
255
    my $dbh = C4::Context->dbh;
256
257
    my $request_query = "SELECT biblionumber, borrowernumber, itemnumber, priority, reserves.branchcode, 
258
                                reservedate, reservenotes, borrowers.branchcode AS borrowerbranch
259
                         FROM reserves
260
                         JOIN borrowers USING (borrowernumber)
261
                         WHERE biblionumber = ?
262
                         AND found IS NULL
263
                         AND priority > 0
264
                         AND reservedate <= CURRENT_DATE()
265
                         ORDER BY priority";
266
    my $sth = $dbh->prepare($request_query);
267
    $sth->execute($biblionumber);
268
269
    my $requests = $sth->fetchall_arrayref({});
270
    return $requests;
271
272
}
273
274
=head2 GetItemsAvailableToFillHoldRequestsForBib
275
276
  my $available_items = GetItemsAvailableToFillHoldRequestsForBib($biblionumber, $branches_ar);
277
278
Returns an arrayref of items available to fill hold requests
279
for the bib identified by C<$biblionumber>.  An item is available
280
to fill a hold request if and only if:
281
282
    * it is not on loan
283
    * it is not withdrawn
284
    * it is not marked notforloan
285
    * it is not currently in transit
286
    * it is not lost
287
    * it is not sitting on the hold shelf
288
289
=cut
290
291
sub GetItemsAvailableToFillHoldRequestsForBib {
292
    my ($biblionumber, $branches_to_use) = @_;
293
294
    my $dbh = C4::Context->dbh;
295
    my $items_query = "SELECT itemnumber, homebranch, holdingbranch, itemtypes.itemtype AS itype
296
                       FROM items ";
297
298
    if (C4::Context->preference('item-level_itypes')) {
299
        $items_query .=   "LEFT JOIN itemtypes ON (itemtypes.itemtype = items.itype) ";
300
    } else {
301
        $items_query .=   "JOIN biblioitems USING (biblioitemnumber)
302
                           LEFT JOIN itemtypes USING (itemtype) ";
303
    }
304
    $items_query .=   "WHERE items.notforloan = 0
305
                       AND holdingbranch IS NOT NULL
306
                       AND itemlost = 0
307
                       AND wthdrawn = 0
308
                       AND items.onloan IS NULL
309
                       AND (itemtypes.notforloan IS NULL OR itemtypes.notforloan = 0)
310
                       AND itemnumber NOT IN (
311
                           SELECT itemnumber
312
                           FROM reserves
313
                           WHERE biblionumber = ?
314
                           AND itemnumber IS NOT NULL
315
                           AND (found IS NOT NULL OR priority = 0)
316
                        )
317
                       AND items.biblionumber = ?";
318
    $items_query .=  " AND damaged = 0 "
319
      unless C4::Context->preference('AllowHoldsOnDamagedItems');
320
321
    my @params = ($biblionumber, $biblionumber);
322
    if ($branches_to_use && @$branches_to_use) {
323
        $items_query .= " AND holdingbranch IN (" . join (",", map { "?" } @$branches_to_use) . ")";
324
        push @params, @$branches_to_use;
325
    }
326
    my $sth = $dbh->prepare($items_query);
327
    $sth->execute(@params);
328
329
    my $items = $sth->fetchall_arrayref({});
330
    $items = [ grep { my @transfers = GetTransfers($_->{itemnumber}); $#transfers == -1; } @$items ]; 
331
    map { my $rule = GetBranchItemRule($_->{homebranch}, $_->{itype}); $_->{holdallowed} = $rule->{holdallowed}; $rule->{holdallowed} != 0 } @$items;
332
    return [ grep { $_->{holdallowed} != 0 } @$items ];
333
}
334
335
=head2 MapItemsToHoldRequests
336
337
  MapItemsToHoldRequests($hold_requests, $available_items, $branches, $transport_cost_matrix)
338
339
=cut
340
341
sub MapItemsToHoldRequests {
342
    my ($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix) = @_;
343
344
    # handle trival cases
345
    return unless scalar(@$hold_requests) > 0;
346
    return unless scalar(@$available_items) > 0;
347
348
    debug( "MapItemsToHoldRequests() for ".Dumper($hold_requests, $available_items, $branches_to_use, $transport_cost_matrix) );
349
    my $automatic_return = C4::Context->preference("AutomaticItemReturn");
350
351
    # identify item-level requests
352
    my %specific_items_requested = map { $_->{itemnumber} => 1 } 
353
                                   grep { defined($_->{itemnumber}) }
354
                                   @$hold_requests;
355
356
    # group available items by itemnumber
357
    my %items_by_itemnumber = map { $_->{itemnumber} => $_ } @$available_items;
358
359
    # items already allocated
360
    my %allocated_items = ();
361
362
    # map of items to hold requests
363
    my %item_map = ();
364
 
365
    # figure out which item-level requests can be filled    
366
    my $num_items_remaining = scalar(@$available_items);
367
    foreach my $request (@$hold_requests) {
368
        last if $num_items_remaining == 0;
369
370
        # is this an item-level request?
371
        if (defined($request->{itemnumber})) {
372
            # fill it if possible; if not skip it
373
            if (exists $items_by_itemnumber{$request->{itemnumber}} and
374
                not exists $allocated_items{$request->{itemnumber}}) {
375
                $item_map{$request->{itemnumber}} = { 
376
                    borrowernumber => $request->{borrowernumber},
377
                    biblionumber => $request->{biblionumber},
378
                    holdingbranch =>  $items_by_itemnumber{$request->{itemnumber}}->{holdingbranch},
379
                    pickup_branch => $request->{branchcode} || $request->{borrowerbranch},
380
                    item_level => 1,
381
                    reservedate => $request->{reservedate},
382
                    reservenotes => $request->{reservenotes},
383
                };
384
                $allocated_items{$request->{itemnumber}}++;
385
                $num_items_remaining--;
386
            }
387
        } else {
388
            # it's title-level request that will take up one item
389
            $num_items_remaining--;
390
        }
391
    }
392
393
    # group available items by branch
394
    my %items_by_branch = ();
395
    foreach my $item (@$available_items) {
396
        next unless $item->{holdallowed};
397
398
        push @{ $items_by_branch{  $automatic_return ? $item->{homebranch}
399
                                                     : $item->{holdingbranch} } }, $item
400
          unless exists $allocated_items{ $item->{itemnumber} };
401
    }
402
    return unless keys %items_by_branch;
403
404
    # now handle the title-level requests
405
    $num_items_remaining = scalar(@$available_items) - scalar(keys %allocated_items); 
406
    my $pull_branches;
407
    foreach my $request (@$hold_requests) {
408
        last if $num_items_remaining == 0;
409
        next if defined($request->{itemnumber}); # already handled these
410
411
        # look for local match first
412
        my $pickup_branch = $request->{branchcode} || $request->{borrowerbranch};
413
        my ($itemnumber, $holdingbranch);
414
415
        my $holding_branch_items = $automatic_return ? undef : $items_by_branch{$pickup_branch};
416
        if ( $holding_branch_items ) {
417
            foreach my $item (@$holding_branch_items) {
418
                if ( $request->{borrowerbranch} eq $item->{homebranch} ) {
419
                    $itemnumber = $item->{itemnumber};
420
                    last;
421
                }
422
            }
423
            $holdingbranch = $pickup_branch;
424
            $itemnumber ||= $holding_branch_items->[0]->{itemnumber};
425
        }
426
        elsif ($transport_cost_matrix) {
427
            $pull_branches = [keys %items_by_branch];
428
            $holdingbranch = least_cost_branch( $pickup_branch, $pull_branches, $transport_cost_matrix );
429
            if ( $holdingbranch ) {
430
431
                my $holding_branch_items = $items_by_branch{$holdingbranch};
432
                foreach my $item (@$holding_branch_items) {
433
                    next if $request->{borrowerbranch} ne $item->{homebranch};
434
435
                    $itemnumber = $item->{itemnumber};
436
                    last;
437
                }
438
                $itemnumber ||= $holding_branch_items->[0]->{itemnumber};
439
            }
440
            else {
441
                warn "No transport costs for $pickup_branch";
442
            }
443
        }
444
445
        unless ($itemnumber) {
446
            # not found yet, fall back to basics
447
            if ($branches_to_use) {
448
                $pull_branches = $branches_to_use;
449
            } else {
450
                $pull_branches = [keys %items_by_branch];
451
            }
452
            PULL_BRANCHES:
453
            foreach my $branch (@$pull_branches) {
454
                my $holding_branch_items = $items_by_branch{$branch}
455
                  or next;
456
457
                $holdingbranch ||= $branch;
458
                foreach my $item (@$holding_branch_items) {
459
                    next if $pickup_branch ne $item->{homebranch};
460
461
                    $itemnumber = $item->{itemnumber};
462
                    $holdingbranch = $branch;
463
                    last PULL_BRANCHES;
464
                }
465
            }
466
            $itemnumber ||= $items_by_branch{$holdingbranch}->[0]->{itemnumber}
467
              if $holdingbranch;
468
        }
469
470
        if ($itemnumber) {
471
            my $holding_branch_items = $items_by_branch{$holdingbranch}
472
              or die "Have $itemnumber, $holdingbranch, but no items!";
473
            @$holding_branch_items = grep { $_->{itemnumber} != $itemnumber } @$holding_branch_items;
474
            delete $items_by_branch{$holdingbranch} unless @$holding_branch_items;
475
476
            $item_map{$itemnumber} = {
477
                borrowernumber => $request->{borrowernumber},
478
                biblionumber => $request->{biblionumber},
479
                holdingbranch => $holdingbranch,
480
                pickup_branch => $pickup_branch,
481
                item_level => 0,
482
                reservedate => $request->{reservedate},
483
                reservenotes => $request->{reservenotes},
484
            };
485
            $num_items_remaining--; 
486
        }
487
    }
488
    return \%item_map;
489
}
490
491
=head2 CreatePickListFromItemMap 
492
493
=cut
494
495
sub CreatePicklistFromItemMap {
496
    my $item_map = shift;
497
498
    my $dbh = C4::Context->dbh;
499
500
    my $sth_load=$dbh->prepare("
501
        INSERT INTO tmp_holdsqueue (biblionumber,itemnumber,barcode,surname,firstname,phone,borrowernumber,
502
                                    cardnumber,reservedate,title, itemcallnumber,
503
                                    holdingbranch,pickbranch,notes, item_level_request)
504
        VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
505
    ");
506
507
    foreach my $itemnumber  (sort keys %$item_map) {
508
        my $mapped_item = $item_map->{$itemnumber};
509
        my $biblionumber = $mapped_item->{biblionumber}; 
510
        my $borrowernumber = $mapped_item->{borrowernumber}; 
511
        my $pickbranch = $mapped_item->{pickup_branch};
512
        my $holdingbranch = $mapped_item->{holdingbranch};
513
        my $reservedate = $mapped_item->{reservedate};
514
        my $reservenotes = $mapped_item->{reservenotes};
515
        my $item_level = $mapped_item->{item_level};
516
517
        my $item = GetItem($itemnumber);
518
        my $barcode = $item->{barcode};
519
        my $itemcallnumber = $item->{itemcallnumber};
520
521
        my $borrower = GetMember('borrowernumber'=>$borrowernumber);
522
        my $cardnumber = $borrower->{'cardnumber'};
523
        my $surname = $borrower->{'surname'};
524
        my $firstname = $borrower->{'firstname'};
525
        my $phone = $borrower->{'phone'};
526
   
527
        my $bib = GetBiblioData($biblionumber);
528
        my $title = $bib->{title}; 
529
530
        $sth_load->execute($biblionumber, $itemnumber, $barcode, $surname, $firstname, $phone, $borrowernumber,
531
                           $cardnumber, $reservedate, $title, $itemcallnumber,
532
                           $holdingbranch, $pickbranch, $reservenotes, $item_level);
533
    }
534
}
535
536
=head2 AddToHoldTargetMap
537
538
=cut
539
540
sub AddToHoldTargetMap {
541
    my $item_map = shift;
542
543
    my $dbh = C4::Context->dbh;
544
545
    my $insert_sql = q(
546
        INSERT INTO hold_fill_targets (borrowernumber, biblionumber, itemnumber, source_branchcode, item_level_request)
547
                               VALUES (?, ?, ?, ?, ?)
548
    );
549
    my $sth_insert = $dbh->prepare($insert_sql);
550
551
    foreach my $itemnumber (keys %$item_map) {
552
        my $mapped_item = $item_map->{$itemnumber};
553
        $sth_insert->execute($mapped_item->{borrowernumber}, $mapped_item->{biblionumber}, $itemnumber,
554
                             $mapped_item->{holdingbranch}, $mapped_item->{item_level});
555
    }
556
}
557
558
# Helper functions, not part of any interface
559
560
sub debug {
561
#   warn @_;
562
}
563
564
sub load_branches_to_pull_from {
565
    my $static_branch_list = C4::Context->preference("StaticHoldsQueueWeight")
566
      or return;
567
568
    my @branches_to_use = map { s/^\s+//; s/\s+$//; $_; } split /,/, $static_branch_list;
569
570
    @branches_to_use = shuffle(@branches_to_use) if  C4::Context->preference("RandomizeHoldsQueueWeight");
571
572
    return \@branches_to_use;
573
}
574
575
sub least_cost_branch {
576
577
    #$from - arrayref
578
    my ($to, $from, $transport_cost_matrix) = @_;
579
580
# Nothing really spectacular: supply to branch, a list of potential from branches
581
# and find the minimum from - to value from the transport_cost_matrix
582
    return $from->[0] if @$from == 1;
583
584
    my ($least_cost, @branch);
585
    foreach (@$from) {
586
        my $cell = $transport_cost_matrix->{$to}{$_};
587
        next if $cell->{disable_transfer};
588
589
        my $cost = $cell->{cost};
590
591
        unless (defined $least_cost) {
592
            $least_cost = $cost;
593
            push @branch, $_;
594
            next;
595
        }
596
597
        next if $cost > $least_cost;
598
599
        if ($cost == $least_cost) {
600
            push @branch, $_;
601
            next;
602
        }
603
604
        @branch = ($_);
605
        $least_cost = $cost;
606
    }
607
608
    return $branch[0];
609
610
    # XXX return a random @branch with minimum cost instead of the first one;
611
    # return $branch[0] if @branch == 1;
612
}
613
614
615
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 (+125 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);
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
my $use_transport_cost_matrix = C4::Context->preference("UseTransportCostMatrix");
44
45
my $update = $input->param('op') eq 'set-cost-matrix';
46
47
my ($cost_matrix, $have_matrix);
48
unless ($update) {
49
    $cost_matrix = TransportCostMatrix();
50
    $have_matrix = keys %$cost_matrix if $cost_matrix;
51
}
52
53
my $branches = GetBranches();
54
my @branchloop = map { code => $_,
55
                       name => $branches->{$_}->{'branchname'} },
56
                 sort { $branches->{$a}->{branchname} cmp $branches->{$b}->{branchname} }
57
                 keys %$branches;
58
my (@branchfromloop, @cost, @errors);
59
foreach my $branchfrom ( @branchloop ) {
60
    my $fromcode = $branchfrom->{code};
61
62
    my %from_row = ( code => $fromcode, name => $branchfrom->{name} );
63
    foreach my $branchto ( @branchloop ) {
64
        my $tocode = $branchto->{code};
65
66
        my %from_to_input_def = ( code => $tocode, name => $branchto->{name} );
67
        push @{ $from_row{branchtoloop} }, \%from_to_input_def;
68
69
        if ($fromcode eq $tocode) {
70
            $from_to_input_def{skip} = 1;
71
            next;
72
        }
73
74
        (my $from_to = "${fromcode}_${tocode}") =~ s/\W//go;
75
         $from_to_input_def{id} = $from_to;
76
        my $input_name   = "cost_$from_to";
77
        my $disable_name = "disable_$from_to";
78
79
        if ($update) {
80
            my $value = $from_to_input_def{value} = $input->param($input_name);
81
            if ( $input->param($disable_name) ) {
82
                $from_to_input_def{disabled} = 1;
83
            }
84
            else {
85
                push @errors, "Invalid value for $from_row{name} -> $from_to_input_def{name}"
86
                  unless $value =~ /\d/o && $value >= 0.0;
87
            }
88
        }
89
        else {
90
            if ($have_matrix) {
91
                if ( my $cell = $cost_matrix->{$tocode}{$fromcode} ) {
92
                    $from_to_input_def{value} = $cell->{cost};
93
                    $from_to_input_def{disabled} = 1 if $cell->{disable_transfer};
94
                }
95
            } else {
96
                $from_to_input_def{disabled} = 1;
97
            }
98
        }
99
    }
100
    
101
#              die Dumper(\%from_row);
102
    push @branchfromloop, \%from_row;
103
}
104
105
if ($update && !@errors) {
106
    my @update_recs = map {
107
        my $from = $_->{code};
108
        map { frombranch => $from, tobranch => $_->{code}, cost => $_->{value}, disable_transfer => $_->{disabled} || 0 },
109
            grep { $_->{code} ne $from }
110
            @{ $_->{branchtoloop} };
111
    } @branchfromloop;
112
113
    UpdateTransportCostMatrix(\@update_recs);
114
}
115
   
116
$template->param(
117
    branchloop => \@branchloop,
118
    branchfromloop => \@branchfromloop,
119
    WARNING_transport_cost_matrix_off => !$use_transport_cost_matrix,
120
    errors => \@errors,
121
);
122
output_html_with_http_headers $input, $cookie, $template->output;
123
124
exit 0;
125
(-)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 (+16 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(6,2) NOT NULL,
2796
      disable_transfer tinyint(1) NOT NULL DEFAULT 0,
2797
      CHECK ( frombranch <> tobranch ), -- a dud check, mysql does not support that
2798
      PRIMARY KEY (frombranch, tobranch),
2799
      CONSTRAINT transport_cost_ibfk_1 FOREIGN KEY (frombranch) REFERENCES branches (branchcode) ON DELETE CASCADE ON UPDATE CASCADE,
2800
      CONSTRAINT transport_cost_ibfk_2 FOREIGN KEY (tobranch) REFERENCES branches (`branchcode`) ON DELETE CASCADE ON UPDATE CASCADE
2801
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
2802
2803
--
2788
-- Table structure for table `biblioimages`
2804
-- Table structure for table `biblioimages`
2789
--
2805
--
2790
2806
(-)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 (+22 lines)
Lines 5246-5251 if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) { Link Here
5246
    SetVersion($DBversion);
5246
    SetVersion($DBversion);
5247
}
5247
}
5248
5248
5249
5250
5251
5252
$DBversion = "3.09.00.XXX";
5253
if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
5254
    $dbh->do("INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('UseTransportCostMatrix',0,'Use Transport Cost Matrix when filling holds','','YesNo')");
5255
5256
 $dbh->do("CREATE TABLE `transport_cost` (
5257
              `frombranch` varchar(10) NOT NULL,
5258
              `tobranch` varchar(10) NOT NULL,
5259
              `cost` decimal(6,2) NOT NULL,
5260
              `disable_transfer` tinyint(1) NOT NULL DEFAULT 0,
5261
              CHECK ( `frombranch` <> `tobranch` ), -- a dud check, mysql does not support that
5262
              PRIMARY KEY (`frombranch`, `tobranch`),
5263
              CONSTRAINT `transport_cost_ibfk_1` FOREIGN KEY (`frombranch`) REFERENCES `branches` (`branchcode`) ON DELETE CASCADE ON UPDATE CASCADE,
5264
              CONSTRAINT `transport_cost_ibfk_2` FOREIGN KEY (`tobranch`) REFERENCES `branches` (`branchcode`) ON DELETE CASCADE ON UPDATE CASCADE
5265
          ) ENGINE=InnoDB DEFAULT CHARSET=utf8");
5266
5267
    print "Upgrade to $DBversion done (creating `transport_cost` table; adding UseTransportCostMatrix systempref, in circulation)\n";
5268
    SetVersion ($DBversion);
5269
}
5270
5249
=head1 FUNCTIONS
5271
=head1 FUNCTIONS
5250
5272
5251
=head2 TableExists($table)
5273
=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/preferences/circulation.pref (+6 lines)
Lines 164-169 Circulation: Link Here
164
                  itemtype: item type
164
                  itemtype: item type
165
            - .
165
            - .
166
        -
166
        -
167
            - pref: UseTransportCostMatrix
168
              choices:
169
                  yes: Use
170
                  no: "Don't use"
171
            - Transport Cost Matrix for calculating optimal holds filling between branches.
172
        -
167
            - Use the checkout and fines rules of
173
            - Use the checkout and fines rules of
168
            - pref: CircControl
174
            - pref: CircControl
169
              type: choice
175
              type: choice
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/transport-cost-matrix.tt (+127 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 && val != '' && !isNaN(parseFloat(val)) && val >= 0.0) {
10
        return;
11
    }
12
    alert("Cost must be expressed as a decimal number >= 0");
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+'" onblur="check_transport_cost(this);" size="4" value="'+$.trim(cost)+'" />'+
32
        '<br/>Disable <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
37
function form_submit (f) {
38
    $(f).find('input:disabled').removeAttr("disabled");
39
    return true;
40
}
41
42
$(document).ready(function() {
43
    show_transport_cost_matrix([% IF UseTransportCostMatrix %]true[% ELSE %]false[% END %]);
44
});
45
//]]>
46
</script>
47
<style type="text/css">
48
.disabled-transfer {
49
    background-color: red;
50
}
51
.errors {
52
    color: red;
53
}
54
</style>
55
56
</head>
57
<body>
58
[% INCLUDE 'header.inc' %]
59
[% INCLUDE 'cat-search.inc' %]
60
61
<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>
62
63
<div id="doc3" class="yui-t1">
64
65
<div id="bd">
66
    <div id="yui-main">
67
    <div class="yui-b">
68
    <h1 class="parameters">
69
            Defining transport costs between libraries
70
    </h1>
71
[% IF ( WARNING_transport_cost_matrix_off ) %]
72
<div class="dialog message">Because the "UseTransportCostMatrix" system preference is currently not enabled, Transport Cost Matrix is not being used.  Go <a href="/cgi-bin/koha/admin/preferences.pl?op=search&amp;searchfield=UseTransportCostMatrix">here</a> if you wish to enable this feature.</div>
73
[% END %]
74
75
    <div class="container">
76
        <form method="post" action="?" onSubmit="return form_submit(this);">
77
            <input type="hidden" name="op" value="set-cost-matrix" />
78
            <div id="transport-cost-matrix">
79
                <div class="help">
80
                    <p>Costs are decimal values 0 to some arbitrarymax value (1 or 100), 0 being minimum (no) cost.</p>
81
                    <p>Red cells signify no transfer allowed</p>
82
                    <p>Click on the cell to edit</p>
83
                </div>
84
                <ul class="errors" %]>
85
                [% FOR e IN errors %]
86
                    <li>[% e %]</li>
87
                [% END %]
88
                </ul>
89
                <table>
90
                    <tr>
91
                        <th>From \ To</th>
92
                [% FOR b IN branchloop %]
93
                        <th>[% b.name %]</th>
94
                [% END %]
95
                    <tr>
96
                [% FOR bf IN branchfromloop %]
97
                    <tr>
98
                        <th>[% bf.name %]</th>
99
                    [% FOR bt IN bf.branchtoloop %]
100
                        <td>
101
                        [% IF bt.skip %]
102
                            &nbsp;
103
                        [% ELSE %]
104
                            <div id="celldiv_[% bt.id %]"[% IF bt.disabled %] class="disabled-transfer"[% END %]>
105
                            <div onclick="enable_cost_input('[% bt.id %]');">[% !bt.disabled && bt.value > '' ? bt.value : '&nbsp;' %]</div>
106
                            <input type="hidden" name="cost_[% bt.id %]" value="[% bt.value %]" />
107
                            [% IF bt.disabled %]
108
                            <input type="hidden" name="disable_[% bt.id %]" value="1" />
109
                            [% END %]
110
                            </div>
111
                        [% END %]
112
                        </td>
113
                    [% END %]
114
                    </tr>
115
                [% END %]
116
                </table>
117
            </div>
118
            <input type="submit" value="Save" class="submit" />
119
        </form>
120
    </div>
121
    </div>
122
    </div>
123
<div class="yui-b">
124
[% INCLUDE 'admin-menu.inc' %]
125
</div>
126
</div>
127
[% 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