927c0680b9
Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com> Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com> Signed-off-by: Katrin Fischer <katrin.fischer@bsz-bw.de>
406 lines
11 KiB
Perl
Executable file
406 lines
11 KiB
Perl
Executable file
#!/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
|
|
);
|