Attachment #22357 for bug #7376

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




    return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
}

=head2 CanItemBeReturned

  ($returnallowed, $message) = CanItemBeReturned($item, $branch)

Check whether the item can be returned to the provided branch



=item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)

=item C<$message> If $message->{Wrongbranch},
                      $message->{Wrongbranch} is the branchcode where the item SHOULD be returned, if the return is not allowed.
                  If $message->{BranchTransferDenied},
                      $message->{BranchTransferDenied} is the CanItemBeTransferred() error code.

=back

=cut

sub CanItemBeReturned {
  my ($item, $branch) = @_;
  my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';

  # assume return is allowed to start
  my $allowed = 1;
  my $toBranch; #The branch this item needs to be transferred.
  my $message;

  # identify all cases where return is forbidden and determine the transfer destination branch
  if ($allowreturntobranch eq 'homebranch') {
    $toBranch = $item->{'homebranch'};
    if ($branch ne $toBranch) {
      $allowed = 0;
      $message->{Wrongbranch} = $toBranch;
    }
  }
  elsif ($allowreturntobranch eq 'holdingbranch') {
    $toBranch = $item->{'holdingbranch'};
    if ($branch ne $toBranch) {
      $allowed = 0;
      $message->{Wrongbranch} = $toBranch;
    }
  }
  elsif ($allowreturntobranch eq 'homeorholdingbranch') {
    $toBranch = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
    if ($branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
      $allowed = 0;
      $message->{Wrongbranch} = $toBranch;
    }
  }
  else {
    #
    $toBranch = $item->{'homebranch'};
  }
  # It needs to be ok to transfer the Item from the check-in branch to the $toBranch, for the Item to be accepted.
  #CanItemBeTransferred(), returns [1,undef] if transfer allowed, [0,errorMsg] if denied.
  if ( '1' ne   ( my $transferOk = CanItemBeTransferred($toBranch, $branch, $item, undef) )   ) {
	$allowed = 0;
    $message->{BranchTransferDenied} = $transferOk;
  }

  return ($allowed, $message);

=head2 AddReturn

  ($doreturn, $messages, $iteminformation, $borrower) =
      &AddReturn($barcode, $branch, $exemptfine, $dropbox, $overrides);

Returns a book.


will be removed.  This assumes that the fines accrual script has run
for _today_.

=item C<$overrides> A hash with various overrides as keys:
$overrides->{overrideBranchTransferDenied} == 1
TODO:: $exemptFine should be moved under this one as well, but the rule is,
if it's not broken, don't fix it :)

=back

C<&AddReturn> returns a list of four items:

so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
contain the branchcode of the incorrect and correct return library, respectively.

=item C<BranchTransferDenied>

Implements the UseBranchTransferLimits-preference.
This book cannot be transferred from this branch to the Item's homebranch, or other branch defined by
the  AllowReturnToBranch-preference.
C<$messages->{BranchTransferDenied}> contains the From-, To-branches and the code of failure.
See CanBookBeIssued() for more.

=item C<ResFound>

The item was reserved. The value is a reference-to-hash whose keys are

=cut

sub AddReturn {
    my ( $barcode, $branch, $exemptfine, $dropbox, $overrides ) = @_;

    if ($branch and not GetBranchDetail($branch)) {
        warn "AddReturn error: branch '$branch' not found.  Reverting to " . C4::Context->userenv->{'branch'};

    unless ($itemnumber) {
        return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower.  bail out.
    }
    my $issue = GetItemIssue($itemnumber);
#   warn Dumper($iteminformation);
    if ($issue and $issue->{borrowernumber}) {
        $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})

    }

    # check if the return is allowed at this branch
    my ($returnallowed, $message) = CanItemBeReturned($item, $branch);
    unless ($returnallowed){
        if (defined $message->{Wrongbranch}) {
            $messages->{'Wrongbranch'} = {
                Wrongbranch => $branch,
                Rightbranch => $message
            };
            $doreturn = 0;
            return ( $doreturn, $messages, $issue, $borrower );
        }
        if (defined $message->{BranchTransferDenied} &&
                (my @msgs = split('->', $message->{BranchTransferDenied}) ) &&
                ( ! exists $overrides->{overrideBranchTransferDenied} )      ) {
            $messages->{BranchTransferDenied} = {
                Frombranch => $msgs[0],
                Tobranch => $msgs[1],
                Code => $msgs[2]
            };
            $doreturn = 0;
            return ( $doreturn, $messages, $issue, $borrower );
        }
        #Some blocks can be overridden, so keep moving forward.
    }

    if ( $item->{'withdrawn'} ) { # book has been cancelled

Lines 70-75 sub do_checkin { Link Here

(-)a/C4/SIP/ILS/Transaction/Checkin.pm (+4 lines)
70	$self->destination_loc($messages->{Wrongbranch}->{Rightbranch});	70	$self->destination_loc($messages->{Wrongbranch}->{Rightbranch});
71	$self->alert_type('04'); # send to other branch	71	$self->alert_type('04'); # send to other branch
72	}	72	}
		73	if ($messages->{BranchTransferDenied}) {
		74	$self->destination_loc($messages->{BranchTransferDenied}->{Tobranch});
		75	$self->alert_type('04'); # send to other branch
		76	}
73	if ($messages->{WrongTransfer}) {	77	if ($messages->{WrongTransfer}) {
74	$self->destination_loc($messages->{WrongTransfer});	78	$self->destination_loc($messages->{WrongTransfer});
75	$self->alert_type('04'); # send to other branch	79	$self->alert_type('04'); # send to other branch

Lines 22-24 is already using that facililty, just change the definition of Link Here

(-)a/C4/SIP/README (+6 lines)
22		22
23	Make sure to update your syslog configuration to capture facility	23	Make sure to update your syslog configuration to capture facility
24	'local6' and record it.	24	'local6' and record it.
		25
		26	UNIT TEST CASES!
		27	-----------------
		28	Remember that the SIP-server is a remote program and you cannot make test cases which depend on non-permanent DB changes,
		29	Like when using the $dbh->{AutoCommit} = 0.
		30	All testing material needs to be INSERTed for real to the Koha DB and cannot be just rolled back.

Lines 3-8 Link Here

(-)a/C4/SIP/t/08checkin.t (-9 / +92 lines)
3		3
4	use strict;	4	use strict;
5	use warnings;	5	use warnings;
		6	#Can't run this test case without this directive from this directory.
		7	# Can't run this test case from any other directory without some kind of a hack either.
		8	use lib('../');
		9
		10	use lib('../../../t/db_dependent/');
		11	use UseBranchTransferLimits::PreparedTestEnvironment;
		12
6	use Clone qw(clone);	13	use Clone qw(clone);
7		14
8	use Sip::Constants qw(:all);	15	use Sip::Constants qw(:all);
Lines 24-29 use SIPtest qw(:basic :user1 :item1); Link Here
24	# alert: Y or N	31	# alert: Y or N
25	# date	32	# date
26		33
		34	print "WARNING! This test will INSERT the necessary testing material PERMANENTLY to your Koha DB.\n";
		35	print "You have 10 seconds to press CTRL-C.";
		36	sleep(10);
		37
		38
27	my $checkout_template = {	39	my $checkout_template = {
28	id => "Checkin: prep: check out item ($item_barcode)",	40	id => "Checkin: prep: check out item ($item_barcode)",
29	msg => "11YN20060329 203000 AO$instid\|AA$user_barcode\|AB$item_barcode\|AC\|",	41	msg => "11YN20060329 203000 AO$instid\|AA$user_barcode\|AB$item_barcode\|AC\|",
Lines 31-36 my $checkout_template = { Link Here
31	fields => [],	43	fields => [],
32	};	44	};
33		45
		46
34	my $checkin_test_template = {	47	my $checkin_test_template = {
35	id => "Checkin: Item ($item_barcode) is checked out",	48	id => "Checkin: Item ($item_barcode) is checked out",
36	msg => "09N20060102 08423620060113 084235AP$item_owner\|AO$instid\|AB$item_barcode\|AC$password\|",	49	msg => "09N20060102 08423620060113 084235AP$item_owner\|AO$instid\|AB$item_barcode\|AC$password\|",
Lines 56-70 my $checkin_test_template = { Link Here
56	required => 0, }, # 3M Extension	69	required => 0, }, # 3M Extension
57	],};	70	],};
58		71
59	my @tests = (
60	$SIPtest::login_test,
61	$SIPtest::sc_status_test,
62	$checkout_template,
63	$checkin_test_template,
64	);
65
66	my $test;	72	my $test;
67
68	# Checkin item that's not checked out. Basically, this	73	# Checkin item that's not checked out. Basically, this
69	# is identical to the first case, except the header says that	74	# is identical to the first case, except the header says that
70	# the ILS didn't check the item in, and there's no patron id.	75	# the ILS didn't check the item in, and there's no patron id.
Lines 73-79 $test->{id} = 'Checkin: Item not checked out'; Link Here
73	$test->{pat} = qr/^100[NY][NYU][NY]$datepat/o;	78	$test->{pat} = qr/^100[NY][NYU][NY]$datepat/o;
74	$test->{fields} = [grep $_->{field} ne FID_PATRON_ID, @{$test->{fields}}];	79	$test->{fields} = [grep $_->{field} ne FID_PATRON_ID, @{$test->{fields}}];
75		80
76	push @tests, $test;	81	########################################
		82	#>> Checking UseBranchTransferLimits >>#
		83	########################################
		84
		85	### Use case1: BranchTransfer denied.
		86
		87	my $branchtransfer_checkout_ok = {
		88	id => "Checkin: prep: BranchTransfer check out item (".$itemCPLFull->{barcode}." from CPL)",
		89	msg => "11YN20060329 203000 AO$instid\|AA".$borrower->{cardnumber}."\|AB".$itemCPLFull->{barcode}."\|AC\|",
		90	pat => qr/^121N[NYU][NY]$datepat/,
		91	fields => [],
		92	};
		93	my $branchtransfer_checkin_fails = {
		94	id => "Checkin: BranchTransfer Item (".$itemCPLFull->{barcode}.") check out denied to FFL",
		95	msg => "09N20060102 08423620060113 084235AP".'FFL'."\|AO$instid\|AB".$itemCPLFull->{barcode}."\|AC$password\|",
		96	pat => qr/^101[NY][NYU]Y$datepat/,
		97	fields => [
		98	$SIPtest::field_specs{(FID_INST_ID )},
		99	$SIPtest::field_specs{(FID_SCREEN_MSG)},
		100	$SIPtest::field_specs{(FID_PRINT_LINE)},
		101	{ field => FID_PATRON_ID,
		102	pat => qr/^$borrower->{cardnumber}$/,
		103	required => 1, },
		104	{ field => FID_ITEM_ID,
		105	pat => qr/^$itemCPLFull->{barcode}$/,
		106	required => 1, },
		107	{ field => FID_PERM_LOCN,
		108	pat => $textpat,
		109	required => 1, },
		110	{ field => FID_TITLE_ID,
		111	pat => qr/^$biblioitem->{title}\s*$/,
		112	required => 1, }, # not required by the spec.
		113	{ field => FID_DESTINATION_LOCATION,
		114	pat => qr/^FFL\s*$/,
		115	required => 0, }, # 3M Extension
		116	],};
		117
		118	### Use case2: BranchTransfer allowed.
		119
		120	my $branchtransfer_checkin_ok = {
		121	id => "Checkin: BranchTransfer Item (".$itemCPLFull->{barcode}.") check out allowed to IPT",
		122	msg => "09N20060102 08423620060113 084235AP".'IPT'."\|AO$instid\|AB".$itemCPLFull->{barcode}."\|AC$password\|",
		123	pat => qr/^101[NY][NYU]N$datepat/,
		124	fields => [
		125	$SIPtest::field_specs{(FID_INST_ID )},
		126	$SIPtest::field_specs{(FID_SCREEN_MSG)},
		127	$SIPtest::field_specs{(FID_PRINT_LINE)},
		128	{ field => FID_PATRON_ID,
		129	pat => qr/^$borrower->{cardnumber}$/,
		130	required => 1, },
		131	{ field => FID_ITEM_ID,
		132	pat => qr/^$itemCPLFull->{barcode}$/,
		133	required => 1, },
		134	{ field => FID_PERM_LOCN,
		135	pat => $textpat,
		136	required => 1, },
		137	{ field => FID_TITLE_ID,
		138	pat => qr/^$biblioitem->{title}\s*$/,
		139	required => 1, }, # not required by the spec.
		140	{ field => FID_DESTINATION_LOCATION,
		141	pat => qr/^IPT\s*$/,
		142	required => 0, }, # 3M Extension
		143	],};
		144
		145	#######################################
146	#<< UseBranchTransferLimits Checked <<#
147	#######################################
148
149
150	my @tests = (
151	$SIPtest::login_test,
152	$SIPtest::sc_status_test,
153	$checkout_template,
154	$checkin_test_template,
155	$test,
156	$branchtransfer_checkout_ok,
157	$branchtransfer_checkin_fails,
158	$branchtransfer_checkin_ok,
159	);
77		160
78	#	161	#
79	# Still need tests for magnetic media	162	# Still need tests for magnetic media

Lines 124-129 foreach ( $query->param ) { Link Here

(-)a/circ/returns.pl (-1 / +19 lines)
124	push( @inputloop, \%input );	124	push( @inputloop, \%input );
125	}	125	}
126		126
		127	### Build the overrides-object used to signal various modules about different overrides.
		128	my $overrides;
		129
		130	#Used to skip the UseBranchTransferLimits-check in AddReserve.
		131	if ($query->param('overrideBranchTransferDenied')) {
		132	$overrides->{overrideBranchTransferDenied} = 1;
		133	}
		134
		135
127	############	136	############
128	# Deal with the requests....	137	# Deal with the requests....
129		138
Lines 216-222 if ($barcode) { Link Here
216	# save the return	225	# save the return
217	#	226	#
218	( $returned, $messages, $issueinformation, $borrower ) =	227	( $returned, $messages, $issueinformation, $borrower ) =
219	AddReturn( $barcode, $userenv_branch, $exemptfine, $dropboxmode); # do the return	228	AddReturn( $barcode, $userenv_branch, $exemptfine, $dropboxmode, $overrides); # do the return
220	my $homeorholdingbranchreturn = C4::Context->preference('HomeOrHoldingBranchReturn');	229	my $homeorholdingbranchreturn = C4::Context->preference('HomeOrHoldingBranchReturn');
221	$homeorholdingbranchreturn \|\|= 'homebranch';	230	$homeorholdingbranchreturn \|\|= 'homebranch';
222		231
Lines 329-334 if ( $messages->{'Wrongbranch'} ){ Link Here
329	);	338	);
330	}	339	}
331		340
		341	if ( $messages->{'BranchTransferDenied'} ){
		342	$template->param(
		343	BranchTransferDenied => $messages->{'BranchTransferDenied'},
		344	);
		345	}
		346
332	# case of wrong transfert, if the document wasn't transfered to the right library (according to branchtransfer (tobranch) BDD)	347	# case of wrong transfert, if the document wasn't transfered to the right library (according to branchtransfer (tobranch) BDD)
333		348
334	if ( $messages->{'WrongTransfer'} and not $messages->{'WasTransfered'}) {	349	if ( $messages->{'WrongTransfer'} and not $messages->{'WasTransfered'}) {
Lines 440-445 foreach my $code ( keys %$messages ) { Link Here
440	elsif ( $code eq 'WasTransfered' ) {	455	elsif ( $code eq 'WasTransfered' ) {
441	; # FIXME... anything to do here?	456	; # FIXME... anything to do here?
442	}	457	}
		458	elsif ( $code eq 'BranchTransferDenied' ) {
		459	; # I am confused as well # FIXME... anything to do here?
		460	}
443	elsif ( $code eq 'withdrawn' ) {	461	elsif ( $code eq 'withdrawn' ) {
444	$err{withdrawn} = 1;	462	$err{withdrawn} = 1;
445	$exit_required_p = 1 if C4::Context->preference("BlockReturnOfWithdrawnItems");	463	$exit_required_p = 1 if C4::Context->preference("BlockReturnOfWithdrawnItems");




<div class="dialog alert"><h3>Cannot check in</h3><p>This item must be checked in at its home library. <strong>NOT CHECKED IN</strong></p>
</div>
[% END %]
[% IF ( BranchTransferDenied ) %]
<div class="dialog alert"><h3>Cannot check in</h3>
	<p>Cannot receive this item because it cannot be transferred to it's original pickup location. This branch transfer rule blocks the check-in:<br/>
		[% BranchTransferDenied.Frombranch %] -> [% BranchTransferDenied.Tobranch %] -> [% BranchTransferDenied.Code %]
	</p>
	[% IF CAN_user_circulate %]
	<form method="post" action="returns.pl" class="confirm">
        <input type="hidden" name="barcode" value="[% itembarcode %]" />
        <input type="hidden" name="overrideBranchTransferDenied" value="1" />
        <input type="submit" value="Override" class="deny" />
    </form>
	[% END %]
</div>
[% END %]
<!-- case of a mistake in transfer loop -->
[% IF ( WrongTransfer ) %]<div id="return2" class="dialog message"><!-- WrongTransfer --><h3>Please return <a href="/cgi-bin/koha/catalogue/detail.pl?type=intra&amp;biblionumber=[% itembiblionumber %]">[% title |html %]</a> to [% TransferWaitingAt | $KohaBranchName %]</h3><h3><a href="#" onclick="Dopop('transfer-slip.pl?transferitem=[% itemnumber %]&amp;&amp;branchcode=[% homebranch %]&amp;op=slip'); return true;">Print slip</a> or <a href="/cgi-bin/koha/circ/returns.pl?itemnumber=[% itemnumber %]&amp;canceltransfer=1">Cancel transfer</a></h3>
[% IF ( wborcnum ) %]<h5>Hold for:</h5>




            }

            # UseBranchTransferLimits checking.
            my ($transferOk, $message) = CanItemBeTransferred( $pickupLocation, $item->{'holdingbranch'}, $item, undef );
            if (! $transferOk) {
                $canreserve = 0;
            }

        }
    }

    #Collect the amout of items that pass the CanItemBeTransferred-check. This is needed to tell
    #  the user if some or all Items cannot be transferred to the pickup location.
    my $branchTransferableItemsCount = 0;



            #Check for UseBranchTransferLimit. $numCopiesAvailable is incremented because this Item
            #  could still be available from another pickup location
            my ($transferOk, $errorMsg) = CanItemBeTransferred( $pickupBranch, undef, GetItem($itemNum), undef );
            if (! $transferOk) {
                $itemLoopIter->{available} = 0;
                $itemLoopIter->{branchTransferBlocked} = 1;

Lines 1-9 Link Here

(-)a/t/db_dependent/Circulation/CanItemBeTransferred.t (-176 / +48 lines)
1	use Modern::Perl;	1	use Modern::Perl;
2	use Test::More tests => 20;	2	use Test::More tests => 24;
		3
		4	use lib('../');
		5	use UseBranchTransferLimits::PreparedTestEnvironment qw($biblioitem $itemCPLFull $itemCPLLite $borrower);
3		6
4	use C4::Circulation;	7	use C4::Circulation;
5	use C4::Context;	8	use C4::Context;
6	use C4::Record;	9	use C4::Record;
		10	use C4::Members;
7		11
8	my $dbh = C4::Context->dbh;	12	my $dbh = C4::Context->dbh;
9	$dbh->{AutoCommit} = 0;	13	$dbh->{AutoCommit} = 0;
Lines 14-50 my $originalBranchTransferLimitsType = C4::Context->preference('BranchTransferLi Link Here
14	### Preparing our tests we want to run ###	18	### Preparing our tests we want to run ###
15	sub runTestsForCCode {	19	sub runTestsForCCode {
16	my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_;	20	my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_;
		21
		22	C4::Context->set_preference("BranchTransferLimitsType", 'ccode');
17		23
18	print 'Running tests for '.C4::Context->preference("BranchTransferLimitsType")."\n";	24	print 'Running tests for '.C4::Context->preference("BranchTransferLimitsType")."\n";
19		25
20	#howto use: CanItemBeTransferred( $toBranch, $fromBranch, $item, $biblioitem] );	26	#howto use: CanItemBeTransferred( $toBranch, $fromBranch, $item, $biblioitem] );
21	my $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, $biblioitem );	27	my $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, $biblioitem );
22	is ( $result, 1, "Successful branch transfer, full parameters" );	28	is ( $result, 1, "Successful branch transfer, full parameters" );
23		29
24	$result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, $biblioitem );	30	$result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, $biblioitem );
25	is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, full parameters" );	31	is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, full parameters" );
26		32
27	$result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, undef );	33	$result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, undef );
28	is ( $result, 1, "Successful branch transfer, full parameters, no Biblio defined" );	34	is ( $result, 1, "Successful branch transfer, full parameters, no Biblio defined" );
29		35
30	$result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, undef );	36	$result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, undef );
31	is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, full parameters, no Biblio defined" );	37	is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, full parameters, no Biblio defined" );
32		38
33	$result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, $biblioitem );	39	$result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, $biblioitem );
34	is ( $result, 1, "Successful branch transfer, using defaults for \$fromBranch" );	40	is ( $result, 1, "Successful branch transfer, using defaults for \$fromBranch" );
35		41
36	$result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, $biblioitem );	42	$result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, $biblioitem );
37	is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, using defaults for \$fromBranch" );	43	is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, using defaults for \$fromBranch" );
38		44
39	$result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, undef );	45	$result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, undef );
40	is ( $result, 1, "Successful branch transfer, using minimum parameters" );	46	is ( $result, 1, "Successful branch transfer, using minimum parameters" );
41		47
42	$result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, undef );	48	$result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, undef );
43	is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, using minimum parameters" );	49	is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, using minimum parameters" );
44		50
45	$result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLLite, undef );	51	$result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLLite, undef );
46	is ( $result, 1, "Successful branch transfer, using minimum parameters" );	52	is ( $result, 1, "Successful branch transfer, using minimum parameters" );
47		53
48	$result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLLite, undef );	54	$result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLLite, undef );
49	is ( $result, 1, "Not failing branch transfer, because CCODE cannot be found from the item and it is not a part of the biblio." );	55	is ( $result, 1, "Not failing branch transfer, because CCODE cannot be found from the item and it is not a part of the biblio." );
50	}	56	}
Lines 52-85 sub runTestsForCCode { Link Here
52		58
53	sub runTestsForItype {	59	sub runTestsForItype {
54	my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_;	60	my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_;
		61
		62	C4::Context->set_preference("BranchTransferLimitsType", 'itemtype');
55		63
56	print 'Running tests for '.C4::Context->preference("BranchTransferLimitsType")."\n";	64	print 'Running tests for '.C4::Context->preference("BranchTransferLimitsType")."\n";
57		65
58	#howto use: CanItemBeTransferred( $toBranch, $fromBranch, $item, $biblioitem] );	66	#howto use: CanItemBeTransferred( $toBranch, $fromBranch, $item, $biblioitem] );
59	my $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, $biblioitem );	67	my $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, $biblioitem );
60	is ( $result, 1, "Successful branch transfer, full parameters" );	68	is ( $result, 1, "Successful branch transfer, full parameters" );
61		69
62	$result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, $biblioitem );	70	$result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, $biblioitem );
63	is ( $result, 'CPL->IPT->BK', "Failing branch transfer, full parameters" );	71	is ( $result, 'CPL->IPT->BK', "Failing branch transfer, full parameters" );
64		72
65	$result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, undef );	73	$result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, undef );
66	is ( $result, 1, "Successful branch transfer, full parameters, no Biblio defined" );	74	is ( $result, 1, "Successful branch transfer, full parameters, no Biblio defined" );
67		75
68	$result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, undef );	76	$result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, undef );
69	is ( $result, 'CPL->IPT->BK', "Failing branch transfer, full parameters, no Biblio defined" );	77	is ( $result, 'CPL->IPT->BK', "Failing branch transfer, full parameters, no Biblio defined" );
70		78
71	$result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, $biblioitem );	79	$result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, $biblioitem );
72	is ( $result, 1, "Successful branch transfer, using defaults for \$fromBranch" );	80	is ( $result, 1, "Successful branch transfer, using defaults for \$fromBranch" );
73		81
74	$result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, $biblioitem );	82	$result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, $biblioitem );
75	is ( $result, 'CPL->IPT->BK', "Failing branch transfer, using defaults for \$fromBranch" );	83	is ( $result, 'CPL->IPT->BK', "Failing branch transfer, using defaults for \$fromBranch" );
76		84
77	$result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, undef );	85	$result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, undef );
78	is ( $result, 1, "Successful branch transfer, using minimum parameters" );	86	is ( $result, 1, "Successful branch transfer, using minimum parameters" );
79		87
80	$result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, undef );	88	$result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, undef );
81	is ( $result, 'CPL->IPT->BK', "Failing branch transfer, using minimum parameters" );	89	is ( $result, 'CPL->IPT->BK', "Failing branch transfer, using minimum parameters" );
82		90
83	$result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLLite, undef );	91	$result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLLite, undef );
84	is ( $result, 1, "Successful branch transfer, using minimum parameters, itemtype is pulled from Biblio" );	92	is ( $result, 1, "Successful branch transfer, using minimum parameters, itemtype is pulled from Biblio" );
85		93
Lines 88-260 sub runTestsForItype { Link Here
88	}	96	}
89	### Tests prepared	97	### Tests prepared
90		98
91	### Preparing our generic testing data ###	99	### Run them tests!
92
93	#Set the item variables
94	my $ccode = 'FANTASY';
95	my $itemtype = 'BK';
96
97	## Add a example Bibliographic record
98	my $bibFramework = ''; #Using the default bibliographic framework.
99	my $marcxml;
100	if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
101	$marcxml=qq(
102	<?xml version="1.0" encoding="UTF-8"?>
103	<record
104	xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
105	xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
106	xmlns="http://www.loc.gov/MARC21/slim">
107	<leader>01534njm a2200229 4500</leader>
108	<controlfield tag="001">4172</controlfield>
109	<datafield tag="071" ind1=" " ind2=" ">
110	<subfield code="a">8344482</subfield>
111	</datafield>
112	<datafield tag="090" ind1=" " ind2=" ">
113	<subfield code="a">4172</subfield>
114	</datafield>
115	<datafield tag="100" ind1=" " ind2=" ">
116	<subfield code="a">20040408 frey50 </subfield>
117	</datafield>
118	<datafield tag="126" ind1=" " ind2=" ">
119	<subfield code="a">agbxhx cd</subfield>
120	</datafield>
121	<datafield tag="200" ind1="1" ind2=" ">
122	<subfield code="a">The Beatles anthology 1965-1967</subfield>
123	<subfield code="e">vol.2</subfield>
124	<subfield code="f">The Beatles</subfield>
125	<subfield code="b">CD</subfield>
126	</datafield>
127	<datafield tag="210" ind1=" " ind2="1">
128	<subfield code="a">Null</subfield>
129	<subfield code="c">Emi music</subfield>
130	<subfield code="d">1996</subfield>
131	</datafield>
132	<datafield tag="322" ind1=" " ind2="1">
133	<subfield code="a">anthologie des beatles concernant l'époque musicale de 1965 à 1968 période la plus expérimentale et prolifique du groupe</subfield>
134	</datafield>
135	<datafield tag="327" ind1="1" ind2=" ">
136	<subfield code="a">Real love</subfield>
137	<subfield code="a">Yes it is</subfield>
138	</datafield>
139	<datafield tag="345" ind1=" " ind2=" ">
140	<subfield code="a">CVS</subfield>
141	<subfield code="b">0724383444823</subfield>
142	<subfield code="c">disque compact</subfield>
143	<subfield code="d">34 E</subfield>
144	</datafield>
145	</record>
146	);
147	}
148	else { # Using Marc21 by default
149	$marcxml=qq(<?xml version="1.0" encoding="UTF-8"?>
150	<record format="MARC21" type="Bibliographic">
151	<leader>00000cim a22000004a 4500</leader>
152	<controlfield tag="001">1001</controlfield>
153	<controlfield tag="005">2013-06-03 07:04:07+02</controlfield>
154	<controlfield tag="007">ss\|\|\|\|j\|\|\|\|\|\|\|</controlfield>
155	<controlfield tag="008"> uuuu xxk\|\|\|\|\|\|\|\|\|\|\|\|\|\|\|\|\|eng\|c</controlfield>
156	<datafield tag="020" ind1=" " ind2=" ">
157	<subfield code="a">0-00-103147-3</subfield>
158	<subfield code="c">14.46 EUR</subfield>
159	</datafield>
160	<datafield tag="041" ind1="0" ind2=" ">
161	<subfield code="d">eng</subfield>
162	</datafield>
163	<datafield tag="084" ind1=" " ind2=" ">
164	<subfield code="a">83.5</subfield>
165	<subfield code="2">ykl</subfield>
166	</datafield>
167	<datafield tag="100" ind1="1" ind2=" ">
168	<subfield code="a">SHAKESPEARE, WILLIAM.</subfield>
169	</datafield>
170	<datafield tag="245" ind1="1" ind2="4">
171	<subfield code="a">THE TAMING OF THE SHREW /</subfield>
172	<subfield code="c">WILLIAM SHAKESPEARE</subfield>
173	<subfield code="h">[ÄÄNITE].</subfield>
174	</datafield>
175	<datafield tag="260" ind1=" " ind2=" ">
176	<subfield code="a">LONDON :</subfield>
177	<subfield code="b">COLLINS.</subfield>
178	</datafield>
179	<datafield tag="300" ind1=" " ind2=" ">
180	<subfield code="a">2 ÄÄNIKASETTIA.</subfield>
181	</datafield>
182	<datafield tag="852" ind1=" " ind2=" ">
183	<subfield code="a">FI-Jm</subfield>
184	<subfield code="h">83.5</subfield>
185	</datafield>
186	<datafield tag="852" ind1=" " ind2=" ">
187	<subfield code="a">FI-Konti</subfield>
188	<subfield code="h">83.5</subfield>
189	</datafield>
190	</record>
191	);
192	}
193
194	my $record=C4::Record::marcxml2marc($marcxml);
195
196	# This should work regardless of the Marc flavour.
197	my ( $biblioitemtypeTagid, $biblioitemtypeSubfieldid ) =
198	C4::Biblio::GetMarcFromKohaField( 'biblioitems.itemtype', $bibFramework );
199	my $itemtypeField = MARC::Field->new($biblioitemtypeTagid, '', '',
200	$biblioitemtypeSubfieldid => $itemtype);
201	$record->append_fields( $itemtypeField );
202
203	my ( $newBiblionumber, $newBiblioitemnumber ) = C4::Biblio::AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } );
204
205	## Add an item with a ccode.
206	my ($item_bibnum, $item_bibitemnum);
207	my ($itemCPLFull, $itemCPLFullId); #Item with a itemtype and ccode in its data.
208	my ($itemCPLLite, $itemCPLLiteId); #Item with no itemtype nor ccode in its data. Forces to look for it from the biblio.
209	($item_bibnum, $item_bibitemnum, $itemCPLFullId) = C4::Items::AddItem({ barcode => 'CPLFull', homebranch => 'CPL', holdingbranch => 'CPL', ccode => $ccode, itemtype => $itemtype}, $newBiblionumber);#, biblioitemnumber => $newBiblioitemnumber, biblionumber => $newBiblioitemnumber });
210	($item_bibnum, $item_bibitemnum, $itemCPLLiteId) = C4::Items::AddItem({ barcode => 'CPLLite', homebranch => 'CPL', holdingbranch => 'CPL'}, $newBiblionumber);# biblioitemnumber => $newBiblioitemnumber, biblionumber => $newBiblioitemnumber });
211
212
213	### Created the generic testing material. ###
214	### Setting preferences for ccode use-case ###
215
216	C4::Context->set_preference("BranchTransferLimitsType", 'ccode');
217
218	## Add the TransferLimit rules:
219	## IPT -> CPL -> FFL -> IPT
220	# to from
221	C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', $ccode );
222	C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', $ccode );
223	C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', $ccode );
224
225	## Ready to start testing ccode use-case ##
226
227	$itemCPLFull = C4::Items::GetItem($itemCPLFullId);
228	$itemCPLLite = C4::Items::GetItem($itemCPLLiteId);
229	my $biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} );
230
231
232	runTestsForCCode($itemCPLFull, $itemCPLLite, $biblioitem);	100	runTestsForCCode($itemCPLFull, $itemCPLLite, $biblioitem);
233		101
		102	runTestsForItype($itemCPLFull, $itemCPLLite, $biblioitem);
		103
234		104
		105	#One cannot return an Item which has homebranch in CPL to FFL
		106	my $datedue = C4::Circulation::AddIssue( $borrower, 'CPLFull') or BAIL_OUT("Cannot check-out an Item!");
		107	my ($returnOk, $errorMessage) = C4::Circulation::AddReturn('CPLFull', 'FFL', undef, undef, undef);
		108	is( exists $errorMessage->{BranchTransferDenied}, 1, "Check-in failed because of a branch transfer limitation." );
235		109
236	### ccode tested
237	### Setting preferences for itemtype use-case ###
238		110
239	C4::Context->set_preference("BranchTransferLimitsType", 'itemtype');	111	#One can return an Item which has homebranch in FFL to CPL
		112	($returnOk, $errorMessage) = C4::Circulation::AddReturn('CPLFull', 'CPL', undef, undef, undef);
		113	is( $returnOk, 1, "Check-in succeeds." );
240		114
241	## Add the TransferLimit rules:
242	## IPT -> CPL -> FFL -> IPT
243	# to from
244	C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', $itemtype );
245	C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', $itemtype );
246	C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', $itemtype );
247		115
248	## Ready to start testing itemtype use-case ##	116	#One can override a denied branch transfer
		117	$datedue = C4::Circulation::AddIssue( $borrower, 'CPLFull') or BAIL_OUT("Cannot check-out an Item!");
		118	($returnOk, $errorMessage) = C4::Circulation::AddReturn('CPLFull', 'FFL', undef, undef, {overrideBranchTransferDenied => 1});
		119	is( $returnOk, 1, "Check-in succeeds because transfer limits are overridden." );
249		120
250	$itemCPLFull = C4::Items::GetItem($itemCPLFullId);
251	$itemCPLLite = C4::Items::GetItem($itemCPLLiteId);
252	$biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} );
253		121
		122	#Failing a check-in regardless of override, since failure happens because Item's must be returned to their homebranches.
		123	#Important to see that overriding BranchTransferDenied doesn't break other functionality.
		124	C4::Context->set_preference("AllowReturnToBranch", 'homebranch');
		125	$datedue = C4::Circulation::AddIssue( $borrower, 'CPLFull') or BAIL_OUT("Cannot check-out an Item!");
		126	($returnOk, $errorMessage) = C4::Circulation::AddReturn('CPLFull', 'FFL', undef, undef, {overrideBranchTransferDenied => 1});
		127	is( $returnOk, 0, "Overridden check-in fails, because AllowReturnToBranch-check fails." );
254		128
255	runTestsForItype($itemCPLFull, $itemCPLLite, $biblioitem);
256		129
257	### itemtype tested
258		130
259	### Reset default preferences	131	### Reset default preferences
260	C4::Context->set_preference("BranchTransferLimitsType", $originalBranchTransferLimitsType);	132	C4::Context->set_preference("BranchTransferLimitsType", $originalBranchTransferLimitsType);




package UseBranchTransferLimits::PreparedTestEnvironment;

use Modern::Perl;

use C4::Circulation;
use C4::Context;
use C4::Record;
use C4::Members;

### Naming shared variables ###
use base 'Exporter';
our @EXPORT = qw($biblioitem $itemCPLFull $itemCPLLite $borrower);

my $dbh = C4::Context->dbh;

##########################################
### Preparing our generic testing data ###
##########################################

### Naming shared variables ###
our ($biblioitem, $itemCPLFull, $itemCPLLite, $borrower);

#Set the item variables
my $ccode = 'FANTASY';
my $itemtype = 'BK';


## Check if defaults already exist
my $itemnumber = C4::Items::GetItemnumberFromBarcode('CPLFull');
unless ($itemnumber) {

    ## Add a example Bibliographic record
    my $bibFramework = ''; #Using the default bibliographic framework.
    my $marcxml=qq(<?xml version="1.0" encoding="UTF-8"?>
    <record format="MARC21" type="Bibliographic">
      <leader>00000cim a22000004a 4500</leader>
      <controlfield tag="007">ss||||j|||||||</controlfield>
      <controlfield tag="008">       uuuu    xxk|||||||||||||||||eng|c</controlfield>
      <datafield tag="100" ind1="1" ind2=" ">
        <subfield code="a">SHAKESPEARE, WILLIAM.</subfield>
      </datafield>
      <datafield tag="245" ind1="1" ind2="4">
        <subfield code="a">THE TAMING OF THE SHREW /</subfield>
        <subfield code="c">WILLIAM SHAKESPEARE</subfield>
        <subfield code="h">[ÄÄNITE].</subfield>
      </datafield>
    </record>
    );
    my $record=C4::Record::marcxml2marc($marcxml);

    # Add an itemtype definition to the Record.
    my ( $biblioitemtypeTagid, $biblioitemtypeSubfieldid ) =
                C4::Biblio::GetMarcFromKohaField( 'biblioitems.itemtype', $bibFramework );
    my $itemtypeField = MARC::Field->new($biblioitemtypeTagid, '', '',
                                         $biblioitemtypeSubfieldid => $itemtype);
    $record->append_fields( $itemtypeField );

    my ( $biblionumber, $biblioitemnumber ) = C4::Biblio::AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } );

    ## Add an item with a ccode.
    my ($item_bibnum, $item_bibitemnum);
    my ($itemCPLFullId); #Item with a itemtype and ccode in its data.
    my ($itemCPLLiteId); #Item with no itemtype nor ccode in its data. Forces to look for it from the biblio.
    ($item_bibnum, $item_bibitemnum, $itemCPLFullId) = C4::Items::AddItem({ barcode => 'CPLFull', homebranch => 'CPL', holdingbranch => 'CPL', ccode => $ccode, itemtype => $itemtype}, $biblionumber);#, biblioitemnumber => $biblioitemnumber, biblionumber => $biblioitemnumber });
    ($item_bibnum, $item_bibitemnum, $itemCPLLiteId) = C4::Items::AddItem({ barcode => 'CPLLite', homebranch => 'CPL', holdingbranch => 'CPL'}, $biblionumber);# biblioitemnumber => $biblioitemnumber, biblionumber => $biblioitemnumber });

    $itemCPLFull = C4::Items::GetItem($itemCPLFullId);
    $itemCPLLite = C4::Items::GetItem($itemCPLLiteId);
    $biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} );
}
else {
    $itemCPLFull = C4::Items::GetItem($itemnumber);

    $itemnumber = C4::Items::GetItemnumberFromBarcode('CPLLite');
    $itemCPLLite = C4::Items::GetItem($itemnumber);

    $biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} );
}




### Created the generic testing material. ###


### Setting preferences for ccode use-case ###
C4::Context->set_preference("BranchTransferLimitsType", 'ccode');
## Add the TransferLimit rules:
## IPT -> CPL -> FFL -> IPT
#                                            to     from
C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', $ccode );
C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', $ccode );
C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', $ccode );


### Setting preferences for itemtype use-case ###
C4::Context->set_preference("BranchTransferLimitsType", 'itemtype');
## Add the TransferLimit rules:
## IPT -> CPL -> FFL -> IPT
#                                            to     from
C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', $itemtype );
C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', $itemtype );
C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', $itemtype );



############################
### Testing checking-in! ###
############################

## Set up the user environment to a funky branch
C4::Context->_new_userenv('xxx');
C4::Context::set_userenv(0,0,0,'firstname','surname', 'CPL', 'Centerville', '', '', '');
(C4::Context->userenv->{branch} eq 'CPL') or BAIL_OUT("Unable to set the userenv!");

## Set a simple circ policy
$dbh->do('DELETE FROM issuingrules');
$dbh->do(
    q{INSERT INTO issuingrules (categorycode, branchcode, itemtype, reservesallowed,
                                maxissueqty, issuelength, lengthunit,
                                renewalsallowed, renewalperiod,
                                fine, chargeperiod)
      VALUES (?, ?, ?, ?,
              ?, ?, ?,
              ?, ?,
              ?, ?
             )
    },
    {},
    '*', '*', '*', 25,
    20, 14, 'days',
    1, 7,
    .10, 1
);

## Add a Borrower
$borrower = C4::Members::GetMember(cardnumber => 'cardnumber1234');
unless ($borrower) {
    my %borrower_data = (
        firstname =>  'Katrin',
        surname => 'Reservation',
        categorycode => 'S',
        branchcode => 'CPL',
        cardnumber => 'cardnumber1234',
        userid => 'katrin.reservation',
        password => '1234',
    );
    my $borrowernumber = C4::Members::AddMember(%borrower_data);
    $borrower = C4::Members::GetMember(borrowernumber => $borrowernumber);
}

Return to bug 7376

Lines 1041-1049 sub CanBookBeIssued { Link Here

(-)a/C4/Circulation.pm (-24 / +76 lines)
1041	return ( \%issuingimpossible, \%needsconfirmation, \%alerts );	1041	return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
1042	}	1042	}
1043		1043
1044	=head2 CanBookBeReturned	1044	=head2 CanItemBeReturned
1045		1045
1046	($returnallowed, $message) = CanBookBeReturned($item, $branch)	1046	($returnallowed, $message) = CanItemBeReturned($item, $branch)
1047		1047
1048	Check whether the item can be returned to the provided branch	1048	Check whether the item can be returned to the provided branch
1049		1049
Lines 1061-1090 Returns: Link Here
1061		1061
1062	=item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)	1062	=item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1063		1063
1064	=item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed	1064	=item C<$message> If $message->{Wrongbranch},
		1065	$message->{Wrongbranch} is the branchcode where the item SHOULD be returned, if the return is not allowed.
		1066	If $message->{BranchTransferDenied},
		1067	$message->{BranchTransferDenied} is the CanItemBeTransferred() error code.
1065		1068
1066	=back	1069	=back
1067		1070
1068	=cut	1071	=cut
1069		1072
1070	sub CanBookBeReturned {	1073	sub CanItemBeReturned {
1071	my ($item, $branch) = @_;	1074	my ($item, $branch) = @_;
1072	my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") \|\| 'anywhere';	1075	my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") \|\| 'anywhere';
1073		1076
1074	# assume return is allowed to start	1077	# assume return is allowed to start
1075	my $allowed = 1;	1078	my $allowed = 1;
		1079	my $toBranch; #The branch this item needs to be transferred.
1076	my $message;	1080	my $message;
1077		1081
1078	# identify all cases where return is forbidden	1082	# identify all cases where return is forbidden and determine the transfer destination branch
1079	if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {	1083	if ($allowreturntobranch eq 'homebranch') {
1080	$allowed = 0;	1084	$toBranch = $item->{'homebranch'};
1081	$message = $item->{'homebranch'};	1085	if ($branch ne $toBranch) {
1082	} elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {	1086	$allowed = 0;
1083	$allowed = 0;	1087	$message->{Wrongbranch} = $toBranch;
1084	$message = $item->{'holdingbranch'};	1088	}
1085	} elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {	1089	}
1086	$allowed = 0;	1090	elsif ($allowreturntobranch eq 'holdingbranch') {
1087	$message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary	1091	$toBranch = $item->{'holdingbranch'};
		1092	if ($branch ne $toBranch) {
		1093	$allowed = 0;
		1094	$message->{Wrongbranch} = $toBranch;
		1095	}
		1096	}
		1097	elsif ($allowreturntobranch eq 'homeorholdingbranch') {
		1098	$toBranch = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
		1099	if ($branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
		1100	$allowed = 0;
		1101	$message->{Wrongbranch} = $toBranch;
		1102	}
		1103	}
		1104	else {
		1105	#
		1106	$toBranch = $item->{'homebranch'};
		1107	}
		1108	# It needs to be ok to transfer the Item from the check-in branch to the $toBranch, for the Item to be accepted.
		1109	#CanItemBeTransferred(), returns [1,undef] if transfer allowed, [0,errorMsg] if denied.
		1110	if ( '1' ne ( my $transferOk = CanItemBeTransferred($toBranch, $branch, $item, undef) ) ) {
		1111	$allowed = 0;
		1112	$message->{BranchTransferDenied} = $transferOk;
1088	}	1113	}
1089		1114
1090	return ($allowed, $message);	1115	return ($allowed, $message);
Lines 1631-1637 sub GetBranchItemRule { Link Here
1631	=head2 AddReturn	1656	=head2 AddReturn
1632		1657
1633	($doreturn, $messages, $iteminformation, $borrower) =	1658	($doreturn, $messages, $iteminformation, $borrower) =
1634	&AddReturn($barcode, $branch, $exemptfine, $dropbox);	1659	&AddReturn($barcode, $branch, $exemptfine, $dropbox, $overrides);
1635		1660
1636	Returns a book.	1661	Returns a book.
1637		1662
Lines 1650-1655 overdue charges are applied and C<$dropbox> is true, the last charge Link Here
1650	will be removed. This assumes that the fines accrual script has run	1675	will be removed. This assumes that the fines accrual script has run
1651	for _today_.	1676	for _today_.
1652		1677
		1678	=item C<$overrides> A hash with various overrides as keys:
		1679	$overrides->{overrideBranchTransferDenied} == 1
		1680	TODO:: $exemptFine should be moved under this one as well, but the rule is,
		1681	if it's not broken, don't fix it :)
		1682
1653	=back	1683	=back
1654		1684
1655	C<&AddReturn> returns a list of four items:	1685	C<&AddReturn> returns a list of four items:
Lines 1685-1690 This book has was returned to the wrong branch. The value is a hashref Link Here
1685	so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>	1715	so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1686	contain the branchcode of the incorrect and correct return library, respectively.	1716	contain the branchcode of the incorrect and correct return library, respectively.
1687		1717
		1718	=item C<BranchTransferDenied>
		1719
		1720	Implements the UseBranchTransferLimits-preference.
		1721	This book cannot be transferred from this branch to the Item's homebranch, or other branch defined by
		1722	the AllowReturnToBranch-preference.
		1723	C<$messages->{BranchTransferDenied}> contains the From-, To-branches and the code of failure.
		1724	See CanBookBeIssued() for more.
		1725
1688	=item C<ResFound>	1726	=item C<ResFound>
1689		1727
1690	The item was reserved. The value is a reference-to-hash whose keys are	1728	The item was reserved. The value is a reference-to-hash whose keys are
Lines 1703-1709 patron who last borrowed the book. Link Here
1703	=cut	1741	=cut
1704		1742
1705	sub AddReturn {	1743	sub AddReturn {
1706	my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;	1744	my ( $barcode, $branch, $exemptfine, $dropbox, $overrides ) = @_;
1707		1745
1708	if ($branch and not GetBranchDetail($branch)) {	1746	if ($branch and not GetBranchDetail($branch)) {
1709	warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};	1747	warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
Lines 1722-1728 sub AddReturn { Link Here
1722	unless ($itemnumber) {	1760	unless ($itemnumber) {
1723	return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower. bail out.	1761	return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower. bail out.
1724	}	1762	}
1725	my $issue = GetItemIssue($itemnumber);	1763	my $issue = GetItemIssue($itemnumber);
1726	# warn Dumper($iteminformation);	1764	# warn Dumper($iteminformation);
1727	if ($issue and $issue->{borrowernumber}) {	1765	if ($issue and $issue->{borrowernumber}) {
1728	$borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})	1766	$borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
Lines 1758-1771 sub AddReturn { Link Here
1758	}	1796	}
1759		1797
1760	# check if the return is allowed at this branch	1798	# check if the return is allowed at this branch
1761	my ($returnallowed, $message) = CanBookBeReturned($item, $branch);	1799	my ($returnallowed, $message) = CanItemBeReturned($item, $branch);
1762	unless ($returnallowed){	1800	unless ($returnallowed){
1763	$messages->{'Wrongbranch'} = {	1801	if (defined $message->{Wrongbranch}) {
1764	Wrongbranch => $branch,	1802	$messages->{'Wrongbranch'} = {
1765	Rightbranch => $message	1803	Wrongbranch => $branch,
1766	};	1804	Rightbranch => $message
1767	$doreturn = 0;	1805	};
1768	return ( $doreturn, $messages, $issue, $borrower );	1806	$doreturn = 0;
		1807	return ( $doreturn, $messages, $issue, $borrower );
		1808	}
		1809	if (defined $message->{BranchTransferDenied} &&
		1810	(my @msgs = split('->', $message->{BranchTransferDenied}) ) &&
		1811	( ! exists $overrides->{overrideBranchTransferDenied} ) ) {
		1812	$messages->{BranchTransferDenied} = {
		1813	Frombranch => $msgs[0],
		1814	Tobranch => $msgs[1],
		1815	Code => $msgs[2]
		1816	};
		1817	$doreturn = 0;
		1818	return ( $doreturn, $messages, $issue, $borrower );
		1819	}
		1820	#Some blocks can be overridden, so keep moving forward.
1769	}	1821	}
1770		1822
1771	if ( $item->{'withdrawn'} ) { # book has been cancelled	1823	if ( $item->{'withdrawn'} ) { # book has been cancelled

Lines 91-96 $(document).ready(function () { Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/circ/returns.tt (+14 lines)
91	<div class="dialog alert"><h3>Cannot check in</h3><p>This item must be checked in at its home library. <strong>NOT CHECKED IN</strong></p>	91	<div class="dialog alert"><h3>Cannot check in</h3><p>This item must be checked in at its home library. <strong>NOT CHECKED IN</strong></p>
92	</div>	92	</div>
93	[% END %]	93	[% END %]
		94	[% IF ( BranchTransferDenied ) %]
		95	<div class="dialog alert"><h3>Cannot check in</h3>
		96	<p>Cannot receive this item because it cannot be transferred to it's original pickup location. This branch transfer rule blocks the check-in:<br/>
		97	[% BranchTransferDenied.Frombranch %] -> [% BranchTransferDenied.Tobranch %] -> [% BranchTransferDenied.Code %]
		98	</p>
		99	[% IF CAN_user_circulate %]
		100	<form method="post" action="returns.pl" class="confirm">
		101	<input type="hidden" name="barcode" value="[% itembarcode %]" />
		102	<input type="hidden" name="overrideBranchTransferDenied" value="1" />
		103	<input type="submit" value="Override" class="deny" />
		104	</form>
		105	[% END %]
		106	</div>
		107	[% END %]
94	<!-- case of a mistake in transfer loop -->	108	<!-- case of a mistake in transfer loop -->
95	[% IF ( WrongTransfer ) %]<div id="return2" class="dialog message"><!-- WrongTransfer --><h3>Please return <a href="/cgi-bin/koha/catalogue/detail.pl?type=intra&biblionumber=[% itembiblionumber %]">[% title \|html %]</a> to [% TransferWaitingAt \| $KohaBranchName %]</h3><h3><a href="#" onclick="Dopop('transfer-slip.pl?transferitem=[% itemnumber %]&&branchcode=[% homebranch %]&op=slip'); return true;">Print slip</a> or <a href="/cgi-bin/koha/circ/returns.pl?itemnumber=[% itemnumber %]&canceltransfer=1">Cancel transfer</a></h3>	109	[% IF ( WrongTransfer ) %]<div id="return2" class="dialog message"><!-- WrongTransfer --><h3>Please return <a href="/cgi-bin/koha/catalogue/detail.pl?type=intra&biblionumber=[% itembiblionumber %]">[% title \|html %]</a> to [% TransferWaitingAt \| $KohaBranchName %]</h3><h3><a href="#" onclick="Dopop('transfer-slip.pl?transferitem=[% itemnumber %]&&branchcode=[% homebranch %]&op=slip'); return true;">Print slip</a> or <a href="/cgi-bin/koha/circ/returns.pl?itemnumber=[% itemnumber %]&canceltransfer=1">Cancel transfer</a></h3>
96	[% IF ( wborcnum ) %]<h5>Hold for:</h5>	110	[% IF ( wborcnum ) %]<h5>Hold for:</h5>

Lines 249-255 if ( $query->param('place_reserve') ) { Link Here

(-)a/opac/opac-reserve.pl (-3 / +3 lines)
249	}	249	}
250		250
251	# UseBranchTransferLimits checking.	251	# UseBranchTransferLimits checking.
252	my ($transferOk, $message) = CheckBranchTransferAllowed( $pickupLocation, $item->{'holdingbranch'}, $item, undef );	252	my ($transferOk, $message) = CanItemBeTransferred( $pickupLocation, $item->{'holdingbranch'}, $item, undef );
253	if (! $transferOk) {	253	if (! $transferOk) {
254	$canreserve = 0;	254	$canreserve = 0;
255	}	255	}
Lines 405-411 foreach my $biblioNum (@biblionumbers) { Link Here
405	}	405	}
406	}	406	}
407		407
408	#Collect the amout of items that pass the CheckBranchTransferAllowed-check. This is needed to tell	408	#Collect the amout of items that pass the CanItemBeTransferred-check. This is needed to tell
409	# the user if some or all Items cannot be transferred to the pickup location.	409	# the user if some or all Items cannot be transferred to the pickup location.
410	my $branchTransferableItemsCount = 0;	410	my $branchTransferableItemsCount = 0;
411		411
Lines 518-524 foreach my $biblioNum (@biblionumbers) { Link Here
518		518
519	#Check for UseBranchTransferLimit. $numCopiesAvailable is incremented because this Item	519	#Check for UseBranchTransferLimit. $numCopiesAvailable is incremented because this Item
520	# could still be available from another pickup location	520	# could still be available from another pickup location
521	my ($transferOk, $errorMsg) = CheckBranchTransferAllowed( $pickupBranch, undef, GetItem($itemNum), undef );	521	my ($transferOk, $errorMsg) = CanItemBeTransferred( $pickupBranch, undef, GetItem($itemNum), undef );
522	if (! $transferOk) {	522	if (! $transferOk) {
523	$itemLoopIter->{available} = 0;	523	$itemLoopIter->{available} = 0;
524	$itemLoopIter->{branchTransferBlocked} = 1;	524	$itemLoopIter->{branchTransferBlocked} = 1;

Line 0 Link Here

(-)a/t/db_dependent/UseBranchTransferLimits/PreparedTestEnvironment.pm (-1 / +150 lines)
0	-	1	package UseBranchTransferLimits::PreparedTestEnvironment;
		2
		3	use Modern::Perl;
		4
		5	use C4::Circulation;
		6	use C4::Context;
		7	use C4::Record;
		8	use C4::Members;
		9
		10	### Naming shared variables ###
		11	use base 'Exporter';
		12	our @EXPORT = qw($biblioitem $itemCPLFull $itemCPLLite $borrower);
		13
		14	my $dbh = C4::Context->dbh;
		15
		16	##########################################
		17	### Preparing our generic testing data ###
		18	##########################################
		19
		20	### Naming shared variables ###
		21	our ($biblioitem, $itemCPLFull, $itemCPLLite, $borrower);
		22
		23	#Set the item variables
		24	my $ccode = 'FANTASY';
		25	my $itemtype = 'BK';
		26
		27
		28	## Check if defaults already exist
		29	my $itemnumber = C4::Items::GetItemnumberFromBarcode('CPLFull');
		30	unless ($itemnumber) {
		31
		32	## Add a example Bibliographic record
		33	my $bibFramework = ''; #Using the default bibliographic framework.
		34	my $marcxml=qq(<?xml version="1.0" encoding="UTF-8"?>
		35	<record format="MARC21" type="Bibliographic">
		36	<leader>00000cim a22000004a 4500</leader>
		37	<controlfield tag="007">ss\|\|\|\|j\|\|\|\|\|\|\|</controlfield>
		38	<controlfield tag="008"> uuuu xxk\|\|\|\|\|\|\|\|\|\|\|\|\|\|\|\|\|eng\|c</controlfield>
		39	<datafield tag="100" ind1="1" ind2=" ">
		40	<subfield code="a">SHAKESPEARE, WILLIAM.</subfield>
		41	</datafield>
		42	<datafield tag="245" ind1="1" ind2="4">
		43	<subfield code="a">THE TAMING OF THE SHREW /</subfield>
		44	<subfield code="c">WILLIAM SHAKESPEARE</subfield>
		45	<subfield code="h">[ÄÄNITE].</subfield>
		46	</datafield>
		47	</record>
		48	);
		49	my $record=C4::Record::marcxml2marc($marcxml);
		50
		51	# Add an itemtype definition to the Record.
		52	my ( $biblioitemtypeTagid, $biblioitemtypeSubfieldid ) =
		53	C4::Biblio::GetMarcFromKohaField( 'biblioitems.itemtype', $bibFramework );
		54	my $itemtypeField = MARC::Field->new($biblioitemtypeTagid, '', '',
		55	$biblioitemtypeSubfieldid => $itemtype);
		56	$record->append_fields( $itemtypeField );
		57
		58	my ( $biblionumber, $biblioitemnumber ) = C4::Biblio::AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } );
		59
		60	## Add an item with a ccode.
		61	my ($item_bibnum, $item_bibitemnum);
		62	my ($itemCPLFullId); #Item with a itemtype and ccode in its data.
		63	my ($itemCPLLiteId); #Item with no itemtype nor ccode in its data. Forces to look for it from the biblio.
		64	($item_bibnum, $item_bibitemnum, $itemCPLFullId) = C4::Items::AddItem({ barcode => 'CPLFull', homebranch => 'CPL', holdingbranch => 'CPL', ccode => $ccode, itemtype => $itemtype}, $biblionumber);#, biblioitemnumber => $biblioitemnumber, biblionumber => $biblioitemnumber });
		65	($item_bibnum, $item_bibitemnum, $itemCPLLiteId) = C4::Items::AddItem({ barcode => 'CPLLite', homebranch => 'CPL', holdingbranch => 'CPL'}, $biblionumber);# biblioitemnumber => $biblioitemnumber, biblionumber => $biblioitemnumber });
66
67	$itemCPLFull = C4::Items::GetItem($itemCPLFullId);
68	$itemCPLLite = C4::Items::GetItem($itemCPLLiteId);
69	$biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} );
70	}
71	else {
72	$itemCPLFull = C4::Items::GetItem($itemnumber);
73
74	$itemnumber = C4::Items::GetItemnumberFromBarcode('CPLLite');
75	$itemCPLLite = C4::Items::GetItem($itemnumber);
76
77	$biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} );
78	}
79
80
81
82
83	### Created the generic testing material. ###
84
85
86	### Setting preferences for ccode use-case ###
87	C4::Context->set_preference("BranchTransferLimitsType", 'ccode');
88	## Add the TransferLimit rules:
89	## IPT -> CPL -> FFL -> IPT
90	# to from
91	C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', $ccode );
92	C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', $ccode );
93	C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', $ccode );
94
95
96	### Setting preferences for itemtype use-case ###
97	C4::Context->set_preference("BranchTransferLimitsType", 'itemtype');
98	## Add the TransferLimit rules:
99	## IPT -> CPL -> FFL -> IPT
100	# to from
101	C4::Circulation::CreateBranchTransferLimit( 'IPT', 'CPL', $itemtype );
102	C4::Circulation::CreateBranchTransferLimit( 'CPL', 'FFL', $itemtype );
103	C4::Circulation::CreateBranchTransferLimit( 'FFL', 'IPT', $itemtype );
104
105
106
107	############################
108	### Testing checking-in! ###
109	############################
110
111	## Set up the user environment to a funky branch
112	C4::Context->_new_userenv('xxx');
113	C4::Context::set_userenv(0,0,0,'firstname','surname', 'CPL', 'Centerville', '', '', '');
114	(C4::Context->userenv->{branch} eq 'CPL') or BAIL_OUT("Unable to set the userenv!");
115
116	## Set a simple circ policy
117	$dbh->do('DELETE FROM issuingrules');
118	$dbh->do(
119	q{INSERT INTO issuingrules (categorycode, branchcode, itemtype, reservesallowed,
120	maxissueqty, issuelength, lengthunit,
121	renewalsallowed, renewalperiod,
122	fine, chargeperiod)
123	VALUES (?, ?, ?, ?,
124	?, ?, ?,
125	?, ?,
126	?, ?
127	)
128	},
129	{},
130	'', '', '*', 25,
131	20, 14, 'days',
132	1, 7,
133	.10, 1
134	);
135
136	## Add a Borrower
137	$borrower = C4::Members::GetMember(cardnumber => 'cardnumber1234');
138	unless ($borrower) {
139	my %borrower_data = (
140	firstname => 'Katrin',
141	surname => 'Reservation',
142	categorycode => 'S',
143	branchcode => 'CPL',
144	cardnumber => 'cardnumber1234',
145	userid => 'katrin.reservation',
146	password => '1234',
147	);
148	my $borrowernumber = C4::Members::AddMember(%borrower_data);
149	$borrower = C4::Members::GetMember(borrowernumber => $borrowernumber);
150	}