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

(-)a/C4/HoldsQueue.pm (-41 / +63 lines)
Lines 363-395 sub _checkHoldPolicy { Link Here
363
    return 0 unless $item->{holdallowed} ne 'not_allowed';
363
    return 0 unless $item->{holdallowed} ne 'not_allowed';
364
364
365
    return 0
365
    return 0
366
      if $item->{holdallowed} eq 'from_home_library'
366
        if $item->{holdallowed} eq 'from_home_library'
367
      && $item->{homebranch} ne $request->{borrowerbranch};
367
        && $item->{homebranch} ne $request->{borrowerbranch};
368
368
369
    return 0
369
    return 0
370
      if $item->{'holdallowed'} eq 'from_local_hold_group'
370
        if $item->{'holdallowed'} eq 'from_local_hold_group'
371
      && !Koha::Libraries->find( $item->{homebranch} )
371
        && !Koha::Libraries->find( $item->{homebranch} )
372
              ->validate_hold_sibling( { branchcode => $request->{borrowerbranch} } );
372
        ->validate_hold_sibling( { branchcode => $request->{borrowerbranch} } );
373
373
374
    my $hold_fulfillment_policy = $item->{hold_fulfillment_policy};
374
    my $hold_fulfillment_policy = $item->{hold_fulfillment_policy};
375
375
376
    return 0
376
    return 0
377
      if $hold_fulfillment_policy eq 'holdgroup'
377
        if $hold_fulfillment_policy eq 'holdgroup'
378
      && !Koha::Libraries->find( $item->{homebranch} )
378
        && !Koha::Libraries->find( $item->{homebranch} )
379
            ->validate_hold_sibling( { branchcode => $request->{branchcode} } );
379
        ->validate_hold_sibling( { branchcode => $request->{branchcode} } );
380
380
381
    return 0
381
    return 0
382
      if $hold_fulfillment_policy eq 'homebranch'
382
        if $hold_fulfillment_policy eq 'homebranch'
383
      && $request->{branchcode} ne $item->{$hold_fulfillment_policy};
383
        && $request->{branchcode} ne $item->{$hold_fulfillment_policy};
384
384
385
    return 0
385
    return 0
386
      if $hold_fulfillment_policy eq 'holdingbranch'
386
        if $hold_fulfillment_policy eq 'holdingbranch'
387
      && $request->{branchcode} ne $item->{$hold_fulfillment_policy};
387
        && $request->{branchcode} ne $item->{$hold_fulfillment_policy};
388
388
389
    return 0
389
    return 0
390
      if $hold_fulfillment_policy eq 'patrongroup'
390
        if $hold_fulfillment_policy eq 'patrongroup'
391
      && !Koha::Libraries->find( $request->{borrowerbranch} )
391
        && !Koha::Libraries->find( $request->{borrowerbranch} )
392
              ->validate_hold_sibling( { branchcode => $request->{branchcode} } );
392
        ->validate_hold_sibling( { branchcode => $request->{branchcode} } );
393
393
394
    return 1;
394
    return 1;
395
395
Lines 415-421 sub _allocateWithTransportCostMatrix { Link Here
415
    return [] if $num_agents == 0 || $num_tasks == 0;
415
    return [] if $num_agents == 0 || $num_tasks == 0;
416
416
417
    if ( $num_tasks > $num_agents ) {
417
    if ( $num_tasks > $num_agents ) {
418
        @remaining = @requests[ $num_agents - 1 .. $num_tasks - 1 ];
418
        @remaining = @requests[ $num_agents .. $num_tasks - 1 ];
419
        @requests  = @requests[ 0 .. $num_agents - 1 ];
419
        @requests  = @requests[ 0 .. $num_agents - 1 ];
420
        $num_tasks = $num_agents;
420
        $num_tasks = $num_agents;
421
    }
421
    }
Lines 431-446 sub _allocateWithTransportCostMatrix { Link Here
431
    #
431
    #
432
    # The limit is chosen arbitrarily and only servers to keep the
432
    # The limit is chosen arbitrarily and only servers to keep the
433
    # asymptotic worst case to O(num_tasksĀ³).
433
    # asymptotic worst case to O(num_tasksĀ³).
434
    my $RETRIES = 8;
434
    my $RETRIES          = 8;
435
    my $retries = $RETRIES;
435
    my $retries          = $RETRIES;
436
    my $r       = 0;
436
    my $r                = 0;
437
    my @candidate_tasks  = ( (0) x $num_tasks );
438
    my @candidate_agents = ( (0) x $num_agents );
437
439
438
RETRY:
440
RETRY:
439
    while (1) {
441
    while (1) {
440
441
        return [] if $num_agents == 0 || $num_tasks == 0;
442
        return [] if $num_agents == 0 || $num_tasks == 0;
442
443
443
        if ( $num_tasks < $num_agents && @remaining ) {
444
        if ( $num_tasks < $num_agents && @remaining ) {
445
444
            # On retry, move tasks from @remaining to @requests up to
446
            # On retry, move tasks from @remaining to @requests up to
445
            # the number of agents.
447
            # the number of agents.
446
            my $nr = scalar(@remaining);
448
            my $nr = scalar(@remaining);
Lines 448-457 RETRY: Link Here
448
            my $nm = $nr < $na ? $nr : $na;
450
            my $nm = $nr < $na ? $nr : $na;
449
            push @requests, ( splice @remaining, 0, $nm );
451
            push @requests, ( splice @remaining, 0, $nm );
450
            $num_tasks += $nm;
452
            $num_tasks += $nm;
453
            for ( my $t = scalar(@candidate_tasks) ; $t < $num_tasks ; $t++ ) {
454
                push @candidate_tasks, 0;
455
            }
451
        }
456
        }
452
457
453
        my @candidate_tasks  = ( (0) x $num_tasks );
454
        my @candidate_agents = ( (0) x $num_agents );
455
        for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
458
        for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
456
            for ( my $j = $r ; $j < $num_tasks ; $j++ ) {
459
            for ( my $j = $r ; $j < $num_tasks ; $j++ ) {
457
                my $item    = $remaining_items[$i];
460
                my $item    = $remaining_items[$i];
Lines 460-499 RETRY: Link Here
460
                my $pickup_branch = $request->{branchcode} || $request->{borrowerbranch};
463
                my $pickup_branch = $request->{branchcode} || $request->{borrowerbranch};
461
                my $srcbranch     = $item->{holdingbranch};
464
                my $srcbranch     = $item->{holdingbranch};
462
465
463
                my $cost;
466
                $m[$i][$j] = $inf
464
467
                    and next
465
                $cost = $inf unless _checkHoldPolicy( $item, $request );
468
                    unless _checkHoldPolicy( $item, $request );
466
                $cost = $inf
469
                $m[$i][$j] = $inf
470
                    and next
467
                    unless $items_by_itemnumber->{ $item->{itemnumber} }->{_object}
471
                    unless $items_by_itemnumber->{ $item->{itemnumber} }->{_object}
468
                    ->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );
472
                    ->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );
469
473
470
                # If hold itemtype is set, item's itemtype must match
474
                # If hold itemtype is set, item's itemtype must match
471
                $cost = $inf unless ( !$request->{itemtype}
475
                $m[$i][$j] = $inf
476
                    and next
477
                    unless ( !$request->{itemtype}
472
                    || $item->{itype} eq $request->{itemtype} );
478
                    || $item->{itype} eq $request->{itemtype} );
473
479
474
                # If hold item_group is set, item's item_group must match
480
                # If hold item_group is set, item's item_group must match
475
                $cost = $inf
481
                $m[$i][$j] = $inf
482
                    and next
476
                    unless (
483
                    unless (
477
                    !$request->{item_group_id}
484
                    !$request->{item_group_id}
478
                    || (   $item->{_object}->item_group
485
                    || (   $item->{_object}->item_group
479
                        && $item->{_object}->item_group->id eq $request->{item_group_id} )
486
                        && $item->{_object}->item_group->id eq $request->{item_group_id} )
480
                    );
487
                    );
481
488
482
                if ( !defined $cost ) {
489
                my $cell = $transport_cost_matrix->{$pickup_branch}{$srcbranch};
483
                    my $cell = $transport_cost_matrix->{$pickup_branch}{$srcbranch};
490
                my $cost;
484
491
485
                    if ( !defined $cell && $pickup_branch eq $srcbranch ) {
492
                if ( !defined $cell && $pickup_branch eq $srcbranch ) {
486
                        $cost = 0;
493
                    $cost = 0;
487
                    } elsif ( !defined $cell || $cell->{disable_transfer} ) {
494
                } elsif ( !defined $cell || $cell->{disable_transfer} ) {
488
                        $cost = $inf;
495
                    $cost = $inf;
489
                    } else {
496
                } else {
497
                    if ( defined $cell->{cost} ) {
490
                        $cost = $cell->{cost};
498
                        $cost = $cell->{cost};
499
                    } else {
500
                        $cost = $inf;
491
                    }
501
                    }
492
                }
502
                }
493
503
494
                $m[$i][$j] = $cost;
504
                $m[$i][$j] = $cost;
495
505
496
                if ( $cost != $inf ) {
506
                if ( $cost != $inf ) {
507
497
                    # There is at least one possible item in row $i and column $j
508
                    # There is at least one possible item in row $i and column $j
498
                    $candidate_tasks[$j]  = 1;
509
                    $candidate_tasks[$j]  = 1;
499
                    $candidate_agents[$i] = 1;
510
                    $candidate_agents[$i] = 1;
Lines 513-522 RETRY: Link Here
513
                $i0++;
524
                $i0++;
514
            }
525
            }
515
        }
526
        }
527
516
        $num_agents = scalar(@remaining_items);
528
        $num_agents = scalar(@remaining_items);
517
529
518
        # Remove any hold request for which there is no finite transport cost item available.
530
        # Remove any hold request for which there is no finite transport cost item available.
519
        my $removed_something = 0;
531
        my $removed_something = 0;
532
520
        for ( my $j = 0, my $j0 = 0 ; $j < $num_tasks ; $j++ ) {
533
        for ( my $j = 0, my $j0 = 0 ; $j < $num_tasks ; $j++ ) {
521
            if ( !$candidate_tasks[$j] ) {
534
            if ( !$candidate_tasks[$j] ) {
522
                for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
535
                for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
Lines 527-540 RETRY: Link Here
527
                $removed_something = 1;
540
                $removed_something = 1;
528
            }
541
            }
529
        }
542
        }
543
530
        $num_tasks = scalar(@requests);
544
        $num_tasks = scalar(@requests);
531
545
532
        if ( $num_agents > $num_tasks && @remaining ) {
546
        if ( $num_agents > $num_tasks && @remaining ) {
533
            $r = $num_tasks - 1;
547
548
            $r                = $num_tasks;
549
            @candidate_tasks  = ( (1) x $num_tasks );
550
            @candidate_agents = ( (1) x $num_agents );
534
            next RETRY;
551
            next RETRY;
535
        }
552
        }
536
553
537
        if ( $num_tasks > $num_agents ) {
554
        if ( $num_tasks > $num_agents ) {
555
538
            return [] if $num_agents == 0;
556
            return [] if $num_agents == 0;
539
            unshift @remaining, ( splice @requests, $num_agents );
557
            unshift @remaining, ( splice @requests, $num_agents );
540
            $num_tasks = $num_agents;
558
            $num_tasks = $num_agents;
Lines 552-557 RETRY: Link Here
552
        for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
570
        for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
553
            for ( my $j = 0 ; $j < $num_tasks ; $j++ ) {
571
            for ( my $j = 0 ; $j < $num_tasks ; $j++ ) {
554
                if ( $m[$i][$j] < 0 ) {
572
                if ( $m[$i][$j] < 0 ) {
573
555
                    # Bias towards not allocating items to holds closer to
574
                    # Bias towards not allocating items to holds closer to
556
                    # the end of the queue in the queue if not all holds
575
                    # the end of the queue in the queue if not all holds
557
                    # can be filled by representing infinity with
576
                    # can be filled by representing infinity with
Lines 570-584 RETRY: Link Here
570
        for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
589
        for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
571
            my $j = $res->[$i];
590
            my $j = $res->[$i];
572
            if ( !defined $j || $j >= $num_tasks ) {
591
            if ( !defined $j || $j >= $num_tasks ) {
592
573
                # If the algorithm zero-pads the matrix
593
                # If the algorithm zero-pads the matrix
574
                # (Algorithm::Munkres version 0.08) holds may be
594
                # (Algorithm::Munkres version 0.08) holds may be
575
                # allocated to nonexisting items ($j >= 0).  We just ignore these.
595
                # allocated to nonexisting items ($j >= 0).  We just ignore these.
576
                next;
596
                next;
577
            }
597
            }
578
            if ( $m[$i][$j] > $max ) {
598
            if ( $m[$i][$j] > $max ) {
599
579
                # No finite cost item was assigned to this hold.
600
                # No finite cost item was assigned to this hold.
580
                push @unallocated, $j;
601
                push @unallocated, $j;
581
            } else {
602
            } else {
603
582
                my $request = $requests[$j];
604
                my $request = $requests[$j];
583
                my $item    = $remaining_items[$i];
605
                my $item    = $remaining_items[$i];
584
                push @allocated, [
606
                push @allocated, [
Lines 599-607 RETRY: Link Here
599
        }
621
        }
600
622
601
        if ( $retries-- > 0 && @unallocated && @remaining ) {
623
        if ( $retries-- > 0 && @unallocated && @remaining ) {
624
602
            # Remove the transport cost of unfilled holds and compact the matrix.
625
            # Remove the transport cost of unfilled holds and compact the matrix.
603
            # Also remove the hold request from the array.
626
            # Also remove the hold request from the array.
604
            my @rs = ();
605
            for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
627
            for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
606
                my $u = 0;
628
                my $u = 0;
607
                for ( my $j = 0 ; $j < $num_tasks ; $j++ ) {
629
                for ( my $j = 0 ; $j < $num_tasks ; $j++ ) {
Lines 609-622 RETRY: Link Here
609
                        $u++;
631
                        $u++;
610
                    } elsif ( $u > 0 ) {
632
                    } elsif ( $u > 0 ) {
611
                        $m[$i][ $j - $u ] = $m[$i][$j];
633
                        $m[$i][ $j - $u ] = $m[$i][$j];
612
                        push @rs, $requests[$j];
613
                    }
634
                    }
614
                }
635
                }
615
            }
636
            }
616
            @requests  = @rs;
637
            for ( my $u = 0 ; $u < scalar(@unallocated) ; $u++ ) {
638
                splice @requests, $unallocated[$u], 1;
639
            }
617
            $num_tasks = scalar(@requests);
640
            $num_tasks = scalar(@requests);
618
641
619
            $r = $num_tasks - 1;
642
            $r = $num_tasks;
620
        } else {
643
        } else {
621
            if ( $retries == 0 && @unallocated && @remaining ) {
644
            if ( $retries == 0 && @unallocated && @remaining ) {
622
                Koha::Logger->get->warn(
645
                Koha::Logger->get->warn(
623
- 

Return to bug 35826