#!/usr/bin/perl

# Test C4::HoldsQueue::CreateQueue() for optimal allocation using the
# transport cost matrix.
#
# Wraps tests in transaction that's rolled back, so no data is destroyed
# MySQL WARNING: This makes sense only if your tables are InnoDB, otherwise
# transactions are not supported and mess is left behind

use Modern::Perl;

use Test::More tests => 117;
use Data::Dumper;

use C4::Context;
use Koha::Database;
use C4::Reserves qw( AddReserve );
use C4::HoldsQueue;

use t::lib::TestBuilder;
use t::lib::Mocks;

sub mock_cost_matrix {
    my $matrix  = shift;
    my $builder = shift;
    my $schema  = shift;

    my $rows = scalar(@$matrix);
    my $cols = $rows > 0 ? scalar( @{ $matrix->[0] } ) : 0;

    my $max = $rows >= $cols ? $rows : $cols;

    my @libraries = ();

    for ( my $i = 0 ; $i < $max ; $i++ ) {
        push @libraries, $builder->build(
            {
                source => 'Branch',
            }
        );
    }

    for ( my $i = 0 ; $i < scalar(@$matrix) ; $i++ ) {
        for ( my $j = 0 ; $j < scalar( @{ $matrix->[$i] } ) ; $j++ ) {
            if ( $i != $j ) {
                my $tc_rs = $schema->resultset('TransportCost');
                my $cost  = $matrix->[$i]->[$j];
                $tc_rs->create(
                    {
                        frombranch       => $libraries[$i]->{branchcode},
                        tobranch         => $libraries[$j]->{branchcode},
                        cost             => $cost,
                        disable_transfer => ( $cost < 0 ? 1 : 0 )
                    }
                );
            }
        }
    }

    return \@libraries;
}

sub mock_scenario {
    my $libraries           = shift;
    my $items_at_library    = shift;
    my $reserves_at_library = shift;
    my $builder             = shift;

    my @borrowers = ();

    for ( my $i = 0 ; $i < scalar(@$libraries) ; $i++ ) {
        my @at_library = ();
        for ( my $j = 0 ; $j < $reserves_at_library->[$i] ; $j++ ) {
            push @at_library, $builder->build(
                {
                    source => 'Borrower',
                    value  => {
                        branchcode => $libraries->[$i]->{branchcode},
                    }
                }
            );
        }
        push @borrowers, \@at_library;
    }

    my $biblio = $builder->build_sample_biblio();

    my @items = ();

    for ( my $i = 0 ; $i < scalar(@$libraries) ; $i++ ) {
        for ( my $j = 0 ; $j < $items_at_library->[$i] ; $j++ ) {
            push @items, $builder->build_sample_item(
                {
                    biblionumber  => $biblio->biblionumber,
                    holdingbranch => $libraries->[$i]->{branchcode},
                    homebranch    => $libraries->[$i]->{branchcode},
                }
            );
        }
    }

    for ( my $i = 0 ; $i < scalar(@$libraries) ; $i++ ) {
        for ( my $j = 0 ; $j < $reserves_at_library->[$i] ; $j++ ) {
            my $borrower = $borrowers[$i]->[$j];
            AddReserve(
                {
                    branchcode     => $borrower->{branchcode},
                    borrowernumber => $borrower->{borrowernumber},
                    biblionumber   => $biblio->biblionumber,
                    priority       => 1 + $j + $i * scalar(@$libraries),
                }
            );
        }
    }
}

sub library_index {
    my ( $branchcode, $libraries ) = @_;

    for ( my $i = 0 ; $i < scalar(@$libraries) ; $i++ ) {
        if ( $libraries->[$i]->{branchcode} eq $branchcode ) {
            return $i;
        }
    }

    return -1;
}

sub allocation_indices {
    my ( $libraries, $allocations ) = @_;

    my @allocations = ();

    for ( my $i = 0 ; $i < scalar(@$allocations) ; $i++ ) {
        my $pick    = library_index( $allocations->[$i]->{pickbranch},    $libraries );
        my $holding = library_index( $allocations->[$i]->{holdingbranch}, $libraries );
        push @allocations, [ $holding, $pick ];
    }

    return @allocations;
}

sub total_cost {
    my ( $matrix, $libraries, $allocations ) = @_;

    my @allocations = allocation_indices( $libraries, $allocations );
    my $total       = 0;

    for my $allocation (@allocations) {
        my $cost = $matrix->[ $allocation->[0] ]->[ $allocation->[1] ];
        $total += $cost;
    }

    return $total;
}

# Mock a scenario for reservations on a biblio.
#
# Parameters:
# $label               - Label for scenario
# $matrix              - Transport cost matrix (array of arrays of numbers).
# $items_at_library    - Array specifying the number of items for the biblio at each library.
#                        Indices correspond to the indices in the transport cost matrix.
# $reserves_at_library - Array specifying the number of holds on the biblio at each library.
#                        Indices correspond to the indices in the transport cost matrix.
# $expected_allocation - Array of tuples specifying expected allocation on the form
#                        [<index of holding library>, <index of of pick library>].  Specify
#                        undefined if optimal allocation is ambiguous
# $expected_total_cost - The expected total cost of the allocation.
sub test_allocation {
    my ( $label, $matrix, $items_at_library, $reserves_at_library, $expected_allocation, $expected_total_cost ) = @_;

    my $schema = Koha::Database->schema;
    $schema->storage->txn_begin;
    my $dbh = C4::Context->dbh;

    my $builder = t::lib::TestBuilder->new;

    t::lib::Mocks::mock_preference( 'UseBranchTransferLimits',  '0' );
    t::lib::Mocks::mock_preference( 'BranchTransferLimitsType', 'itemtype' );
    t::lib::Mocks::mock_preference( 'UseTransportCostMatrix',   '1' );

    my $libraries = mock_cost_matrix( $matrix, $builder, $schema );

    mock_scenario( $libraries, $items_at_library, $reserves_at_library, $builder );

    C4::HoldsQueue::CreateQueue();

    my $holds_queue = $dbh->selectall_arrayref( "SELECT * FROM tmp_holdsqueue", { Slice => {} } );

    if ($expected_allocation) {
        my @indices = allocation_indices( $libraries, $holds_queue );

        is( scalar(@indices), scalar(@$expected_allocation), "$label correct number of allocations" );

        # print STDERR Dumper(\@indices);

        while ( my $expected = shift @$expected_allocation ) {
            my $found = 0;
            for ( my $i = 0 ; $i < scalar(@indices) ; $i++ ) {
                if (   $expected->[0] == $indices[$i]->[0]
                    && $expected->[1] == $indices[$i]->[1] )
                {
                    $found = 1;
                    $indices[$i] = [ -1, -1 ];
                    last;
                }
            }
            ok( $found, "$label - allocation contained [" . $expected->[0] . ", " . $expected->[1] . "]" );
        }
    }

    is( total_cost( $matrix, $libraries, $holds_queue ), $expected_total_cost, "$label the total cost is as expected" );

    $schema->txn_rollback;
}

test_allocation(
    "trivial case",
    [],
    [],
    [],
    [],
    0
);

test_allocation(
    "unit case",
    [ [0] ],
    [1],
    [1],
    [ [ 0, 0 ] ],
    0
);

test_allocation(
    "all local allocations",
    [
        [ 0, 1, 1 ],
        [ 1, 0, 1 ],
        [ 1, 1, 0 ]
    ],
    [ 1, 1, 1 ],
    [ 1, 1, 1 ],
    undef,
    0
);

test_allocation(
    "some non-local allocations",
    [
        [ 0, 1, 1 ],
        [ 1, 0, 1 ],
        [ 1, 1, 0 ]
    ],
    [ 3,        0,        0 ],
    [ 1,        1,        1 ],
    [ [ 0, 0 ], [ 0, 1 ], [ 0, 2 ] ],
    2
);

test_allocation(
    "different costs 1",
    [
        [ 0,  2,  2 ],
        [ 1,  0,  1 ],
        [ -1, -1, 0 ]
    ],
    [ 3,        3,        0 ],
    [ 0,        0,        3 ],
    [ [ 1, 2 ], [ 1, 2 ], [ 1, 2 ] ],
    3
);

test_allocation(
    "different costs 2",
    [
        [ 0,  2,  2 ],
        [ 1,  0,  1 ],
        [ -1, -1, 0 ]
    ],
    [ 2,        2,        0 ],
    [ 0,        0,        3 ],
    [ [ 1, 2 ], [ 1, 2 ], [ 0, 2 ] ],
    4
);

test_allocation(
    "allocation prohibited",
    [
        [ 0,  -1 ],
        [ -1, 0 ],
    ],
    [ 2, 0 ],
    [ 0, 2 ],
    [],
    0
);

test_allocation(
    "some allocation prohibited",
    [
        [ 0,  -1, -1 ],
        [ -1, 0,  1 ],
        [ -1, -1, 0 ]
    ],
    [ 2,        2, 0 ],
    [ 0,        0, 4 ],
    [ [ 1, 2 ], [ 1, 2 ] ],
    2
);

test_allocation(
    "local allocation suboptimal",
    [
        [ 0, 1, 1 ],
        [ 1, 0, 10 ],
        [ 1, 1, 0 ]
    ],
    [ 1,        2, 0 ],
    [ 1,        0, 1 ],
    [ [ 0, 2 ], [ 1, 0 ] ],
    2
);

test_allocation(
    "prefer fewer fails",
    [
        [ 0,  1,  1,  1,  1 ],
        [ -1, 0,  -1, -1, 1 ],
        [ -1, -1, 0,  -1, -1 ],
        [ -1, -1, -1, 0,  -1 ],
        [ -1, -1, -1, -1, 0 ]
    ],
    [ 1,        1, 0, 0, 0 ],
    [ 0,        0, 1, 1, 1 ],
    [ [ 0, 2 ], [ 1, 4 ] ],
    2
);

test_allocation(
    "large volume",
    [
        [ (0) x 38, 23, 8 ],
        [ (0) x 38, 31, 29 ],
        [ (0) x 38, 10, 21 ],
        [ (0) x 38, 98, 58 ],
        [ (0) x 38, 24, 93 ],
        [ (0) x 38, 62, 71 ],
        [ (0) x 38, 75, 3 ],
        [ (0) x 38, 86, 32 ],
        [ (0) x 38, 45, 38 ],
        [ (0) x 38, 83, 75 ],
        [ (0) x 38, 45, 16 ],
        [ (0) x 38, 60, 7 ],
        [ (0) x 38, 83, 79 ],
        [ (0) x 38, 54, 59 ],
        [ (0) x 38, 78, 44 ],
        [ (0) x 38, 77, 49 ],
        [ (0) x 38, 9,  8 ],
        [ (0) x 38, 13, 63 ],
        [ (0) x 38, 82, 6 ],
        [ (0) x 38, 62, 9 ],
        [ (0) x 38, 22, 94 ],
        [ (0) x 38, 58, 8 ],
        [ (0) x 38, 39, 1 ],
        [ (0) x 38, 69, 71 ],
        [ (0) x 38, 13, 26 ],
        [ (0) x 38, 3,  67 ],
        [ (0) x 38, 39, 33 ],
        [ (0) x 38, 60, 91 ],
        [ (0) x 38, 46, 44 ],
        [ (0) x 38, 71, 59 ],
        [ (0) x 38, 66, 93 ],
        [ (0) x 38, 38, 92 ],
        [ (0) x 38, 72, 71 ],
        [ (0) x 38, 0,  7 ],
        [ (0) x 38, 44, 87 ],
        [ (0) x 38, 74, 41 ],
        [ (0) x 38, 21, 78 ],
        [ (0) x 38, 90, 68 ],
        [ (0) x 38, 96, 18 ],
        [ (0) x 38, 47, 68 ],
    ],
    [ (5) x 38, (0) x 2 ],
    [ (0) x 38, (40) x 2 ],
    [
        ( [ 33, 38 ] ) x 5,    # cost 0
        ( [ 22, 39 ] ) x 5,    # cost 1
        ( [ 6,  39 ] ) x 5,    # cost 3
        ( [ 25, 38 ] ) x 5,    # cost 3
        ( [ 18, 39 ] ) x 5,    # cost 6
        ( [ 11, 39 ] ) x 5,    # cost 7
        ( [ 0,  39 ] ) x 5,    # cost 8
        ( [ 21, 39 ] ) x 5,    # cost 8
        ( [ 16, 38 ] ) x 5,    # cost 9
        ( [ 19, 39 ] ) x 5,    # cost 9
        ( [ 2,  38 ] ) x 5,    # cost 10
        ( [ 17, 38 ] ) x 5,    # cost 13
        ( [ 24, 38 ] ) x 5,    # cost 13
        ( [ 10, 39 ] ) x 5,    # cost 16
        ( [ 36, 38 ] ) x 5,    # cost 21
        ( [ 20, 38 ] ) x 5,    # cost 22
    ],
    745
);