Attachment #151541 for bug #33796

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




        }
        elsif ($transport_cost_matrix) {
            $pull_branches = [keys %items_by_branch];
            my @branches = least_cost_branch( $pickup_branch, $pull_branches, $transport_cost_matrix );
            if ( @branches ) {
                foreach my $branch ( @branches ) {
                    my $holding_branch_items = $items_by_branch{$branch};
                    foreach my $item (@$holding_branch_items) {
                        # If hold itemtype is set, item's itemtype must match
                        next unless ( !$request->{itemtype}
                            || $item->{itype} eq $request->{itemtype} );
                    next unless ( !$request->{itemtype}
                        || $item->{itype} eq $request->{itemtype} );

                        # If hold item_group is set, item's item_group must match
                        next unless (
                            !$request->{item_group_id}
                            || (   $item->{_object}->item_group
                                && $item->{_object}->item_group->id eq $request->{item_group_id} )
                        );

                        # Don't fill a hold with a non-transferrable item
                        next unless $items_by_itemnumber{ $item->{itemnumber} }->{_object}->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );

                        # Don't fill item level holds that contravene the hold pickup policy at this time
                        next unless _checkHoldPolicy($item, $request);

                        $itemnumber = $item->{itemnumber};
                        last;
                    }
                }
            }
            else {


        if ($itemnumber) {
            my $holding_branch_items = $items_by_branch{$holdingbranch}
              or next; #die "Have $itemnumber, $holdingbranch, but no items!";
            @$holding_branch_items = grep { $_->{itemnumber} != $itemnumber } @$holding_branch_items;
            delete $items_by_branch{$holdingbranch} unless @$holding_branch_items;


}

sub least_cost_branch {
    my ( $to, $from, $transport_cost_matrix ) = @_;
    #$from - arrayref
    my ($to, $from, $transport_cost_matrix) = @_;

    # Nothing really spectacular: supply to branch, a list of potential from branches
    # and find the minimum from - to value from the transport_cost_matrix
    return $from->[0] if ( @$from == 1 && $transport_cost_matrix->{$to}{$from->[0]}->{disable_transfer} != 1 );

    # If the pickup library is in the list of libraries to pull from,
    # return that library right away, it is obviously the least costly
    return ($to) if any { $_ eq $to } @$from;

    return $from->[0]
      if ( @$from == 1
        && $transport_cost_matrix->{$to}{ $from->[0] }->{disable_transfer} !=
        1 );

    my %costs;
    foreach my $f (@$from) {
        if ( $f eq $to ) {
            $costs{$f} = 0;
            $least_cost = $cost;
            push @branch, $_;
            next;
        }
        else {
            my $cell = $transport_cost_matrix->{$to}{$f};
            next if $cell->{disable_transfer};

            my $cost = $cell->{cost};
            next unless defined $cost;    # XXX should this be reported?

            $costs{$f} = $cost;
            push @branch, $_;
            next;
        }

        @branch = ($_);
        $least_cost = $cost;
    }

    my @branches = sort { $costs{$a} <=> $costs{$b} } keys %costs;

    return @branches;
    # return $branch[0] if @branch == 1;
}

=head3 update_queue_for_biblio





use Modern::Perl;

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

use C4::Calendar qw( new insert_single_holiday );

  or diag( "Expected item for pick $borrower_branchcode, hold $least_cost_branch_code, got ".Dumper($queue_item) );
ok( exists($queue_item->{itype}), 'item type included in queued items list (bug 5825)' );

is_deeply(
    C4::HoldsQueue::least_cost_branch( 'B', [ 'A', 'B', 'C' ] ), ['B'],
    'C4::HoldsQueue::least_cost_branch returns the local branch if it is in the list of branches to pull from'
);


    is( scalar @$items, 2, "Two items without active transfers correctly retrieved");
    is_deeply( [$items->[0]->{itemnumber},$items->[1]->{itemnumber}],[$item_2->itemnumber,$item_3->itemnumber],"Correct two items retrieved");

    $schema->storage->txn_rollback;
};

subtest "least_cost_branch" => sub {
    plan tests => 2;

    $schema->storage->txn_begin;

    my $libraryA = $builder->build(
        {
            source => 'Branch',
            value  => {
                branchcode => 'A',
            }
        }
    );
    my $libraryB = $builder->build(
        {
            source => 'Branch',
            value  => {
                branchcode => 'B',
            }
        }
    );
    my $libraryC = $builder->build(
        {
            source => 'Branch',
            value  => {
                branchcode => 'C',
            }
        }
    );

    $dbh->do("DELETE FROM transport_cost");
    my $transport_cost_insert_sth = $dbh->do("
        INSERT INTO transport_cost (frombranch, tobranch, cost ) VALUES
        ( 'A', 'B', 6 ),
        ( 'A', 'C', 5 ),
        ( 'B', 'A', 4 ),
        ( 'B', 'C', 3 ),
        ( 'C', 'A', 2 ),
        ( 'C', 'B', 1 );
    ");

    my $tcm = TransportCostMatrix();

    my @branches;
    @branches = C4::HoldsQueue::least_cost_branch( 'A', [ 'A', 'B', 'C' ], $tcm );
    is_deeply( \@branches, ['A', 'C', 'B'], 'Got correct list for A' );

    @branches = C4::HoldsQueue::least_cost_branch( 'B', [ 'A', 'B', 'C' ], $tcm );
    is_deeply( \@branches, ['B', 'C', 'A'], 'Got correct list for B' );

    $schema->storage->txn_rollback;
};
- 

Return to bug 33796

Lines 591-622 sub MapItemsToHoldRequests { Link Here

(-)a/C4/HoldsQueue.pm (-52 / +39 lines)
591	}	591	}
592	elsif ($transport_cost_matrix) {	592	elsif ($transport_cost_matrix) {
593	$pull_branches = [keys %items_by_branch];	593	$pull_branches = [keys %items_by_branch];
594	$holdingbranch = least_cost_branch( $pickup_branch, $pull_branches, $transport_cost_matrix );	594	my @branches = least_cost_branch( $pickup_branch, $pull_branches, $transport_cost_matrix );
595	if ( $holdingbranch ) {	595	if ( @branches ) {
596		596	foreach my $branch ( @branches ) {
597	my $holding_branch_items = $items_by_branch{$holdingbranch};	597	my $holding_branch_items = $items_by_branch{$branch};
598	foreach my $item (@$holding_branch_items) {	598	foreach my $item (@$holding_branch_items) {
599	next if $request->{borrowerbranch} ne $item->{$priority_branch};	599	# If hold itemtype is set, item's itemtype must match
600		600	next unless ( !$request->{itemtype}
601	# If hold itemtype is set, item's itemtype must match	601	\|\| $item->{itype} eq $request->{itemtype} );
602	next unless ( !$request->{itemtype}
603	\|\| $item->{itype} eq $request->{itemtype} );
604		602
605	# If hold item_group is set, item's item_group must match	603	# If hold item_group is set, item's item_group must match
606	next unless (	604	next unless (
607	!$request->{item_group_id}	605	!$request->{item_group_id}
608	\|\| ( $item->{_object}->item_group	606	\|\| ( $item->{_object}->item_group
609	&& $item->{_object}->item_group->id eq $request->{item_group_id} )	607	&& $item->{_object}->item_group->id eq $request->{item_group_id} )
610	);	608	);
611		609
612	# Don't fill a hold with a non-transferrable item	610	# Don't fill a hold with a non-transferrable item
613	next unless $items_by_itemnumber{ $item->{itemnumber} }->{_object}->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );	611	next unless $items_by_itemnumber{ $item->{itemnumber} }->{_object}->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );
614		612
615	# Don't fill item level holds that contravene the hold pickup policy at this time	613	# Don't fill item level holds that contravene the hold pickup policy at this time
616	next unless _checkHoldPolicy($item, $request);	614	next unless _checkHoldPolicy($item, $request);
617		615
618	$itemnumber = $item->{itemnumber};	616	$itemnumber = $item->{itemnumber};
619	last;	617	last;
		618	}
620	}	619	}
621	}	620	}
622	else {	621	else {
Lines 719-725 sub MapItemsToHoldRequests { Link Here
719		718
720	if ($itemnumber) {	719	if ($itemnumber) {
721	my $holding_branch_items = $items_by_branch{$holdingbranch}	720	my $holding_branch_items = $items_by_branch{$holdingbranch}
722	or die "Have $itemnumber, $holdingbranch, but no items!";	721	or next; #die "Have $itemnumber, $holdingbranch, but no items!";
723	@$holding_branch_items = grep { $_->{itemnumber} != $itemnumber } @$holding_branch_items;	722	@$holding_branch_items = grep { $_->{itemnumber} != $itemnumber } @$holding_branch_items;
724	delete $items_by_branch{$holdingbranch} unless @$holding_branch_items;	723	delete $items_by_branch{$holdingbranch} unless @$holding_branch_items;
725		724
Lines 846-892 sub load_branches_to_pull_from { Link Here
846	}	845	}
847		846
848	sub least_cost_branch {	847	sub least_cost_branch {
849		848	my ( $to, $from, $transport_cost_matrix ) = @_;
850	#$from - arrayref
851	my ($to, $from, $transport_cost_matrix) = @_;
852		849
853	# Nothing really spectacular: supply to branch, a list of potential from branches	850	# Nothing really spectacular: supply to branch, a list of potential from branches
854	# and find the minimum from - to value from the transport_cost_matrix	851	# and find the minimum from - to value from the transport_cost_matrix
855	return $from->[0] if ( @$from == 1 && $transport_cost_matrix->{$to}{$from->[0]}->{disable_transfer} != 1 );
856
857	# If the pickup library is in the list of libraries to pull from,
858	# return that library right away, it is obviously the least costly
859	return ($to) if any { $_ eq $to } @$from;
860		852
861	my ($least_cost, @branch);	853	return $from->[0]
862	foreach (@$from) {	854	if ( @$from == 1
863	my $cell = $transport_cost_matrix->{$to}{$_};	855	&& $transport_cost_matrix->{$to}{ $from->[0] }->{disable_transfer} !=
864	next if $cell->{disable_transfer};	856	1 );
865		857
866	my $cost = $cell->{cost};	858	my %costs;
867	next unless defined $cost; # XXX should this be reported?	859	foreach my $f (@$from) {
868		860	if ( $f eq $to ) {
869	unless (defined $least_cost) {	861	$costs{$f} = 0;
870	$least_cost = $cost;
871	push @branch, $_;
872	next;
873	}	862	}
		863	else {
		864	my $cell = $transport_cost_matrix->{$to}{$f};
		865	next if $cell->{disable_transfer};
874		866
875	next if $cost > $least_cost;	867	my $cost = $cell->{cost};
		868	next unless defined $cost; # XXX should this be reported?
876		869
877	if ($cost == $least_cost) {	870	$costs{$f} = $cost;
878	push @branch, $_;
879	next;
880	}	871	}
881
882	@branch = ($_);
883	$least_cost = $cost;
884	}	872	}
885		873
886	return $branch[0];	874	my @branches = sort { $costs{$a} <=> $costs{$b} } keys %costs;
887		875
888	# XXX return a random @branch with minimum cost instead of the first one;	876	return @branches;
889	# return $branch[0] if @branch == 1;
890	}	877	}
891		878
892	=head3 update_queue_for_biblio	879	=head3 update_queue_for_biblio

Lines 8-14 Link Here

(-)a/t/db_dependent/HoldsQueue.t (-4 / +57 lines)
8		8
9	use Modern::Perl;	9	use Modern::Perl;
10		10
11	use Test::More tests => 61;	11	use Test::More tests => 62;
12	use Data::Dumper;	12	use Data::Dumper;
13		13
14	use C4::Calendar qw( new insert_single_holiday );	14	use C4::Calendar qw( new insert_single_holiday );
Lines 171-178 ok( $queue_item Link Here
171	or diag( "Expected item for pick $borrower_branchcode, hold $least_cost_branch_code, got ".Dumper($queue_item) );	171	or diag( "Expected item for pick $borrower_branchcode, hold $least_cost_branch_code, got ".Dumper($queue_item) );
172	ok( exists($queue_item->{itype}), 'item type included in queued items list (bug 5825)' );	172	ok( exists($queue_item->{itype}), 'item type included in queued items list (bug 5825)' );
173		173
174	ok(	174	is_deeply(
175	C4::HoldsQueue::least_cost_branch( 'B', [ 'A', 'B', 'C' ] ) eq 'B',	175	C4::HoldsQueue::least_cost_branch( 'B', [ 'A', 'B', 'C' ] ), ['B'],
176	'C4::HoldsQueue::least_cost_branch returns the local branch if it is in the list of branches to pull from'	176	'C4::HoldsQueue::least_cost_branch returns the local branch if it is in the list of branches to pull from'
177	);	177	);
178		178
Lines 2090-2093 subtest "GetItemsAvailableToFillHoldsRequestsForBib" => sub { Link Here
2090	is( scalar @$items, 2, "Two items without active transfers correctly retrieved");	2090	is( scalar @$items, 2, "Two items without active transfers correctly retrieved");
2091	is_deeply( [$items->[0]->{itemnumber},$items->[1]->{itemnumber}],[$item_2->itemnumber,$item_3->itemnumber],"Correct two items retrieved");	2091	is_deeply( [$items->[0]->{itemnumber},$items->[1]->{itemnumber}],[$item_2->itemnumber,$item_3->itemnumber],"Correct two items retrieved");
2092		2092
		2093	$schema->storage->txn_rollback;
		2094	};
		2095
		2096	subtest "least_cost_branch" => sub {
		2097	plan tests => 2;
		2098
		2099	$schema->storage->txn_begin;
		2100
		2101	my $libraryA = $builder->build(
		2102	{
		2103	source => 'Branch',
		2104	value => {
		2105	branchcode => 'A',
		2106	}
		2107	}
		2108	);
		2109	my $libraryB = $builder->build(
		2110	{
		2111	source => 'Branch',
		2112	value => {
		2113	branchcode => 'B',
		2114	}
		2115	}
		2116	);
		2117	my $libraryC = $builder->build(
		2118	{
		2119	source => 'Branch',
		2120	value => {
		2121	branchcode => 'C',
		2122	}
		2123	}
		2124	);
		2125
		2126	$dbh->do("DELETE FROM transport_cost");
		2127	my $transport_cost_insert_sth = $dbh->do("
		2128	INSERT INTO transport_cost (frombranch, tobranch, cost ) VALUES
		2129	( 'A', 'B', 6 ),
		2130	( 'A', 'C', 5 ),
		2131	( 'B', 'A', 4 ),
		2132	( 'B', 'C', 3 ),
		2133	( 'C', 'A', 2 ),
		2134	( 'C', 'B', 1 );
		2135	");
		2136
		2137	my $tcm = TransportCostMatrix();
		2138
		2139	my @branches;
		2140	@branches = C4::HoldsQueue::least_cost_branch( 'A', [ 'A', 'B', 'C' ], $tcm );
		2141	is_deeply( \@branches, ['A', 'C', 'B'], 'Got correct list for A' );
		2142
		2143	@branches = C4::HoldsQueue::least_cost_branch( 'B', [ 'A', 'B', 'C' ], $tcm );
		2144	is_deeply( \@branches, ['B', 'C', 'A'], 'Got correct list for B' );
		2145
		2146	$schema->storage->txn_rollback;
2093	};	2147	};
2094	-