Attachment #161956 for bug #35826

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




    return 0 unless $item->{holdallowed} ne 'not_allowed';

    return 0
        if $item->{holdallowed} eq 'from_home_library'
        && $item->{homebranch} ne $request->{borrowerbranch};

    return 0
        if $item->{'holdallowed'} eq 'from_local_hold_group'
        && !Koha::Libraries->find( $item->{homebranch} )
        ->validate_hold_sibling( { branchcode => $request->{borrowerbranch} } );

    my $hold_fulfillment_policy = $item->{hold_fulfillment_policy};

    return 0
        if $hold_fulfillment_policy eq 'holdgroup'
        && !Koha::Libraries->find( $item->{homebranch} )
        ->validate_hold_sibling( { branchcode => $request->{branchcode} } );

    return 0
        if $hold_fulfillment_policy eq 'homebranch'
        && $request->{branchcode} ne $item->{$hold_fulfillment_policy};

    return 0
        if $hold_fulfillment_policy eq 'holdingbranch'
        && $request->{branchcode} ne $item->{$hold_fulfillment_policy};

    return 0
        if $hold_fulfillment_policy eq 'patrongroup'
        && !Koha::Libraries->find( $request->{borrowerbranch} )
        ->validate_hold_sibling( { branchcode => $request->{branchcode} } );

    return 1;


    return [] if $num_agents == 0 || $num_tasks == 0;

    if ( $num_tasks > $num_agents ) {
        @remaining = @requests[ $num_agents .. $num_tasks - 1 ];
        @requests  = @requests[ 0 .. $num_agents - 1 ];
        $num_tasks = $num_agents;
    }

    #
    # The limit is chosen arbitrarily and only servers to keep the
    # asymptotic worst case to O(num_tasks³).
    my $RETRIES          = 8;
    my $retries          = $RETRIES;
    my $r                = 0;
    my @candidate_tasks  = ( (0) x $num_tasks );
    my @candidate_agents = ( (0) x $num_agents );

RETRY:
    while (1) {

        return [] if $num_agents == 0 || $num_tasks == 0;

        if ( $num_tasks < $num_agents && @remaining ) {

            # On retry, move tasks from @remaining to @requests up to
            # the number of agents.
            my $nr = scalar(@remaining);

            my $nm = $nr < $na ? $nr : $na;
            push @requests, ( splice @remaining, 0, $nm );
            $num_tasks += $nm;
            for ( my $t = scalar(@candidate_tasks) ; $t < $num_tasks ; $t++ ) {
                push @candidate_tasks, 0;
            }
        }

        my @candidate_tasks  = ( (0) x $num_tasks );
        my @candidate_agents = ( (0) x $num_agents );
        for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
            for ( my $j = $r ; $j < $num_tasks ; $j++ ) {
                my $item    = $remaining_items[$i];

                my $pickup_branch = $request->{branchcode} || $request->{borrowerbranch};
                my $srcbranch     = $item->{holdingbranch};

                $m[$i][$j] = $inf
                    and next
                    unless _checkHoldPolicy( $item, $request );
                $m[$i][$j] = $inf
                    and next
                    unless $items_by_itemnumber->{ $item->{itemnumber} }->{_object}
                    ->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );

                # If hold itemtype is set, item's itemtype must match
                $m[$i][$j] = $inf
                    and next
                    unless ( !$request->{itemtype}
                    || $item->{itype} eq $request->{itemtype} );

                # If hold item_group is set, item's item_group must match
                $m[$i][$j] = $inf
                    and next
                    unless (
                    !$request->{item_group_id}
                    || (   $item->{_object}->item_group
                        && $item->{_object}->item_group->id eq $request->{item_group_id} )
                    );

                my $cell = $transport_cost_matrix->{$pickup_branch}{$srcbranch};
                my $cost;

                if ( !defined $cell && $pickup_branch eq $srcbranch ) {
                    $cost = 0;
                } elsif ( !defined $cell || $cell->{disable_transfer} ) {
                    $cost = $inf;
                } else {
                    if ( defined $cell->{cost} ) {
                        $cost = $cell->{cost};
                    } else {
                        $cost = $inf;
                    }
                }

                $m[$i][$j] = $cost;

                if ( $cost != $inf ) {

                    # There is at least one possible item in row $i and column $j
                    $candidate_tasks[$j]  = 1;
                    $candidate_agents[$i] = 1;

                $i0++;
            }
        }

        $num_agents = scalar(@remaining_items);

        # Remove any hold request for which there is no finite transport cost item available.
        my $removed_something = 0;

        for ( my $j = 0, my $j0 = 0 ; $j < $num_tasks ; $j++ ) {
            if ( !$candidate_tasks[$j] ) {
                for ( my $i = 0 ; $i < $num_agents ; $i++ ) {

                $removed_something = 1;
            }
        }

        $num_tasks = scalar(@requests);

        if ( $num_agents > $num_tasks && @remaining ) {

            $r                = $num_tasks;
            @candidate_tasks  = ( (1) x $num_tasks );
            @candidate_agents = ( (1) x $num_agents );
            next RETRY;
        }

        if ( $num_tasks > $num_agents ) {

            return [] if $num_agents == 0;
            unshift @remaining, ( splice @requests, $num_agents );
            $num_tasks = $num_agents;

        for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
            for ( my $j = 0 ; $j < $num_tasks ; $j++ ) {
                if ( $m[$i][$j] < 0 ) {

                    # Bias towards not allocating items to holds closer to
                    # the end of the queue in the queue if not all holds
                    # can be filled by representing infinity with

        for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
            my $j = $res->[$i];
            if ( !defined $j || $j >= $num_tasks ) {

                # If the algorithm zero-pads the matrix
                # (Algorithm::Munkres version 0.08) holds may be
                # allocated to nonexisting items ($j >= 0).  We just ignore these.
                next;
            }
            if ( $m[$i][$j] > $max ) {

                # No finite cost item was assigned to this hold.
                push @unallocated, $j;
            } else {

                my $request = $requests[$j];
                my $item    = $remaining_items[$i];
                push @allocated, [

        }

        if ( $retries-- > 0 && @unallocated && @remaining ) {

            # Remove the transport cost of unfilled holds and compact the matrix.
            # Also remove the hold request from the array.
            my @rs = ();
            for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
                my $u = 0;
                for ( my $j = 0 ; $j < $num_tasks ; $j++ ) {

                        $u++;
                    } elsif ( $u > 0 ) {
                        $m[$i][ $j - $u ] = $m[$i][$j];
                        push @rs, $requests[$j];
                    }
                }
            }
            for ( my $u = 0 ; $u < scalar(@unallocated) ; $u++ ) {
                splice @requests, $unallocated[$u], 1;
            }
            $num_tasks = scalar(@requests);

            $r = $num_tasks;
        } else {
            if ( $retries == 0 && @unallocated && @remaining ) {
                Koha::Logger->get->warn(
- 

Return to bug 35826

Lines 363-395 sub _checkHoldPolicy { Link Here

(-)a/C4/HoldsQueue.pm (-41 / +63 lines)
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	-