use Koha::Logger;

use Algorithm::Munkres qw();

sub _allocateWithTransportCostMatrix {

    my (

        $hold_requests, $available_items, $branches_to_use, $libraries, $transport_cost_matrix, $allocated_items,

        $items_by_itemnumber

    ) = @_;

    my @allocated;

    my @remaining_items = grep { !exists $allocated_items->{ $_->{itemnumber} } && $_->{holdallowed} ne 'not_allowed'; }

        @$available_items;

    my @requests  = grep { !defined $_->{itemnumber} } @$hold_requests;

    my @remaining = ();

    my $num_agents = scalar(@remaining_items);

    my $num_tasks  = scalar(@requests);

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

    if ( $num_tasks > $num_agents ) {

        @remaining = @requests[ $num_agents - 1 .. $num_tasks - 1 ];

        @requests  = @requests[ 0 .. $num_agents - 1 ];

        $num_tasks = $num_agents;

    }

    my @m = map { [ (undef) x $num_tasks ] } ( 1 .. $num_agents );

    my $inf = -1;    # Initially represent infinity with a negative value.

    my $max = 0;

    # If some candidate holds requests cannot be filled and there are

    # hold requests remaining, we will try again a limited number of

    # times.

    #

    # 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;

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 $na = $num_agents - $num_tasks;

            my $nm = $nr < $na ? $nr : $na;

            push @requests, ( splice @remaining, 0, $nm );

            $num_tasks += $nm;

        }

        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 $request = $requests[$j];

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

                my $srcbranch     = $item->{holdingbranch};

                my $cost;

                $cost = $inf unless _checkHoldPolicy( $item, $request );

                $cost = $inf

                    unless $items_by_itemnumber->{ $item->{itemnumber} }->{_object}

                    ->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );

                # If hold itemtype is set, item's itemtype must match

                $cost = $inf unless ( !$request->{itemtype}

                    || $item->{itype} eq $request->{itemtype} );

                # If hold item_group is set, item's item_group must match

                $cost = $inf

                    unless (

                    !$request->{item_group_id}

                    || (   $item->{_object}->item_group

                        && $item->{_object}->item_group->id eq $request->{item_group_id} )

                    );

                if ( !defined $cost ) {

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

                    if ( !defined $cell && $pickup_branch eq $srcbranch ) {

                        $cost = 0;

                    } elsif ( !defined $cell || $cell->{disable_transfer} ) {

                        $cost = $inf;

                    } else {

                        $cost = $cell->{cost};

                    }

                }

                $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;

                }

                if ( $cost > $max ) {

                    $max = $cost;

                }

            }

        }

        # Remove any item which have no finite transport cost with respect to any of the hold requests.

        for ( my $i = 0, my $i0 = 0 ; $i < $num_agents ; $i++ ) {

            if ( !$candidate_agents[$i] ) {

                splice @m,               $i - $i0, 1;

                splice @remaining_items, $i - $i0, 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++ ) {

                    splice @{ $m[$i] }, $j - $j0, 1;

                }

                splice @requests, $j - $j0, 1;

                $j0++;

                $removed_something = 1;

            }

        }

        $num_tasks = scalar(@requests);

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

            $r = $num_tasks - 1;

            next RETRY;

        }

        if ( $num_tasks > $num_agents ) {

            return [] if $num_agents == 0;

            unshift @remaining, ( splice @requests, $num_agents );

            $num_tasks = $num_agents;

        }

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

        # Substitute infinity with a cost that is higher than the total of

        # any possible assignment.  This ensures that any possible

        # assignment will be selected before any assignment of infinite

        # cost.  Infinite cost assignments can be be filtered out at the

        # end.

        $inf = $max * $num_tasks + 1;

        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

                    # different values.

                    $m[$i][$j] = $inf + ( $num_tasks - $j );

                }

            }

        }

        my $res = [ (undef) x $num_agents ];

        Algorithm::Munkres::assign( \@m, $res );

        my @unallocated = ();

        @allocated = ();

        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, [

                    $item->{itemnumber},

                    {

                        borrowernumber => $request->{borrowernumber},

                        biblionumber   => $request->{biblionumber},

                        holdingbranch  => $item->{holdingbranch},

                        pickup_branch  => $request->{branchcode}

                            || $request->{borrowerbranch},

                        reserve_id   => $request->{reserve_id},

                        item_level   => $request->{item_level_hold},

                        reservedate  => $request->{reservedate},

                        reservenotes => $request->{reservenotes},

                    }

                ];

            }

        }

        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++ ) {

                    if ( $u < scalar(@unallocated) && $unallocated[$u] == $j ) {

                        $u++;

                    } elsif ( $u > 0 ) {

                        $m[$i][ $j - $u ] = $m[$i][$j];

                        push @rs, $requests[$j];

                    }

                }

            }

            @requests  = @rs;

            $num_tasks = scalar(@requests);

            $r = $num_tasks - 1;

        } else {

            if ( $retries == 0 && @unallocated && @remaining ) {

                Koha::Logger->get->warn(

                    "There are available items that have not been allocated and remaining holds, but we abort trying to fill these after $RETRIES retries."

                );

            }

            last RETRY;

        }

    }

    return \@allocated;

}

    if ( defined $transport_cost_matrix ) {

        my $allocations = _allocateWithTransportCostMatrix(

            $hold_requests,         $available_items,  $branches_to_use, $libraries,

            $transport_cost_matrix, \%allocated_items, \%items_by_itemnumber

        );

        for my $allocation (@$allocations) {

            $item_map{ $allocation->[0] } = $allocation->[1];

            $num_items_remaining--;

        }

        return \%item_map;

    }

requires 'Algorithm::Munkres', '0.08';