@@ -, +, @@ --This is because function name misguidingly references to a book/Biblio/Title-level, even if the functionality is strictly --Item dependent. so these need not be duplicated whenever UseBranchTransferLimits-related functionality is tested. --- C4/Circulation.pm | 100 ++++++--- C4/SIP/ILS/Transaction/Checkin.pm | 4 + C4/SIP/README | 6 + C4/SIP/t/08checkin.t | 101 +++++++++- circ/returns.pl | 20 +- .../intranet-tmpl/prog/en/modules/circ/returns.tt | 14 ++ opac/opac-reserve.pl | 6 +- t/db_dependent/Circulation/CanItemBeTransferred.t | 224 +++++---------------- .../PreparedTestEnvironment.pm | 150 ++++++++++++++ 9 files changed, 412 insertions(+), 213 deletions(-) create mode 100644 t/db_dependent/UseBranchTransferLimits/PreparedTestEnvironment.pm --- a/C4/Circulation.pm +++ a/C4/Circulation.pm @@ -1041,9 +1041,9 @@ sub CanBookBeIssued { return ( \%issuingimpossible, \%needsconfirmation, \%alerts ); } -=head2 CanBookBeReturned +=head2 CanItemBeReturned - ($returnallowed, $message) = CanBookBeReturned($item, $branch) + ($returnallowed, $message) = CanItemBeReturned($item, $branch) Check whether the item can be returned to the provided branch @@ -1061,30 +1061,55 @@ Returns: =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0) -=item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed +=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 CanBookBeReturned { +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 - if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) { - $allowed = 0; - $message = $item->{'homebranch'}; - } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) { - $allowed = 0; - $message = $item->{'holdingbranch'}; - } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) { - $allowed = 0; - $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary + # 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); @@ -1631,7 +1656,7 @@ sub GetBranchItemRule { =head2 AddReturn ($doreturn, $messages, $iteminformation, $borrower) = - &AddReturn($barcode, $branch, $exemptfine, $dropbox); + &AddReturn($barcode, $branch, $exemptfine, $dropbox, $overrides); Returns a book. @@ -1650,6 +1675,11 @@ overdue charges are applied and C<$dropbox> is true, the last charge 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: @@ -1685,6 +1715,14 @@ This book has was returned to the wrong branch. The value is a hashref so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}> contain the branchcode of the incorrect and correct return library, respectively. +=item C + +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 The item was reserved. The value is a reference-to-hash whose keys are @@ -1703,7 +1741,7 @@ patron who last borrowed the book. =cut sub AddReturn { - my ( $barcode, $branch, $exemptfine, $dropbox ) = @_; + 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'}; @@ -1722,7 +1760,7 @@ sub AddReturn { unless ($itemnumber) { return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower. bail out. } - my $issue = GetItemIssue($itemnumber); + my $issue = GetItemIssue($itemnumber); # warn Dumper($iteminformation); if ($issue and $issue->{borrowernumber}) { $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber}) @@ -1758,14 +1796,28 @@ sub AddReturn { } # check if the return is allowed at this branch - my ($returnallowed, $message) = CanBookBeReturned($item, $branch); + my ($returnallowed, $message) = CanItemBeReturned($item, $branch); unless ($returnallowed){ - $messages->{'Wrongbranch'} = { - Wrongbranch => $branch, - Rightbranch => $message - }; - $doreturn = 0; - return ( $doreturn, $messages, $issue, $borrower ); + 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 --- a/C4/SIP/ILS/Transaction/Checkin.pm +++ a/C4/SIP/ILS/Transaction/Checkin.pm @@ -70,6 +70,10 @@ sub do_checkin { $self->destination_loc($messages->{Wrongbranch}->{Rightbranch}); $self->alert_type('04'); # send to other branch } + if ($messages->{BranchTransferDenied}) { + $self->destination_loc($messages->{BranchTransferDenied}->{Tobranch}); + $self->alert_type('04'); # send to other branch + } if ($messages->{WrongTransfer}) { $self->destination_loc($messages->{WrongTransfer}); $self->alert_type('04'); # send to other branch --- a/C4/SIP/README +++ a/C4/SIP/README @@ -22,3 +22,9 @@ is already using that facililty, just change the definition of Make sure to update your syslog configuration to capture facility 'local6' and record it. + +UNIT TEST CASES! +----------------- +Remember that the SIP-server is a remote program and you cannot make test cases which depend on non-permanent DB changes, +Like when using the $dbh->{AutoCommit} = 0. +All testing material needs to be INSERTed for real to the Koha DB and cannot be just rolled back. --- a/C4/SIP/t/08checkin.t +++ a/C4/SIP/t/08checkin.t @@ -3,6 +3,13 @@ use strict; use warnings; +#Can't run this test case without this directive from this directory. +# Can't run this test case from any other directory without some kind of a hack either. +use lib('../'); + +use lib('../../../t/db_dependent/'); +use UseBranchTransferLimits::PreparedTestEnvironment; + use Clone qw(clone); use Sip::Constants qw(:all); @@ -24,6 +31,11 @@ use SIPtest qw(:basic :user1 :item1); # alert: Y or N # date +print "WARNING! This test will INSERT the necessary testing material PERMANENTLY to your Koha DB.\n"; +print "You have 10 seconds to press CTRL-C."; +sleep(10); + + my $checkout_template = { id => "Checkin: prep: check out item ($item_barcode)", msg => "11YN20060329 203000 AO$instid|AA$user_barcode|AB$item_barcode|AC|", @@ -31,6 +43,7 @@ my $checkout_template = { fields => [], }; + my $checkin_test_template = { id => "Checkin: Item ($item_barcode) is checked out", msg => "09N20060102 08423620060113 084235AP$item_owner|AO$instid|AB$item_barcode|AC$password|", @@ -56,15 +69,7 @@ my $checkin_test_template = { required => 0, }, # 3M Extension ],}; -my @tests = ( - $SIPtest::login_test, - $SIPtest::sc_status_test, - $checkout_template, - $checkin_test_template, - ); - my $test; - # Checkin item that's not checked out. Basically, this # is identical to the first case, except the header says that # the ILS didn't check the item in, and there's no patron id. @@ -73,7 +78,85 @@ $test->{id} = 'Checkin: Item not checked out'; $test->{pat} = qr/^100[NY][NYU][NY]$datepat/o; $test->{fields} = [grep $_->{field} ne FID_PATRON_ID, @{$test->{fields}}]; -push @tests, $test; +######################################## +#>> Checking UseBranchTransferLimits >># +######################################## + +### Use case1: BranchTransfer denied. + +my $branchtransfer_checkout_ok = { + id => "Checkin: prep: BranchTransfer check out item (".$itemCPLFull->{barcode}." from CPL)", + msg => "11YN20060329 203000 AO$instid|AA".$borrower->{cardnumber}."|AB".$itemCPLFull->{barcode}."|AC|", + pat => qr/^121N[NYU][NY]$datepat/, + fields => [], +}; +my $branchtransfer_checkin_fails = { + id => "Checkin: BranchTransfer Item (".$itemCPLFull->{barcode}.") check out denied to FFL", + msg => "09N20060102 08423620060113 084235AP".'FFL'."|AO$instid|AB".$itemCPLFull->{barcode}."|AC$password|", + pat => qr/^101[NY][NYU]Y$datepat/, + fields => [ + $SIPtest::field_specs{(FID_INST_ID )}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^$borrower->{cardnumber}$/, + required => 1, }, + { field => FID_ITEM_ID, + pat => qr/^$itemCPLFull->{barcode}$/, + required => 1, }, + { field => FID_PERM_LOCN, + pat => $textpat, + required => 1, }, + { field => FID_TITLE_ID, + pat => qr/^$biblioitem->{title}\s*$/, + required => 1, }, # not required by the spec. + { field => FID_DESTINATION_LOCATION, + pat => qr/^FFL\s*$/, + required => 0, }, # 3M Extension + ],}; + +### Use case2: BranchTransfer allowed. + +my $branchtransfer_checkin_ok = { + id => "Checkin: BranchTransfer Item (".$itemCPLFull->{barcode}.") check out allowed to IPT", + msg => "09N20060102 08423620060113 084235AP".'IPT'."|AO$instid|AB".$itemCPLFull->{barcode}."|AC$password|", + pat => qr/^101[NY][NYU]N$datepat/, + fields => [ + $SIPtest::field_specs{(FID_INST_ID )}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^$borrower->{cardnumber}$/, + required => 1, }, + { field => FID_ITEM_ID, + pat => qr/^$itemCPLFull->{barcode}$/, + required => 1, }, + { field => FID_PERM_LOCN, + pat => $textpat, + required => 1, }, + { field => FID_TITLE_ID, + pat => qr/^$biblioitem->{title}\s*$/, + required => 1, }, # not required by the spec. + { field => FID_DESTINATION_LOCATION, + pat => qr/^IPT\s*$/, + required => 0, }, # 3M Extension + ],}; + +####################################### +#<< UseBranchTransferLimits Checked <<# +####################################### + + +my @tests = ( + $SIPtest::login_test, + $SIPtest::sc_status_test, + $checkout_template, + $checkin_test_template, + $test, + $branchtransfer_checkout_ok, + $branchtransfer_checkin_fails, + $branchtransfer_checkin_ok, +); # # Still need tests for magnetic media --- a/circ/returns.pl +++ a/circ/returns.pl @@ -124,6 +124,15 @@ foreach ( $query->param ) { push( @inputloop, \%input ); } +### Build the overrides-object used to signal various modules about different overrides. +my $overrides; + +#Used to skip the UseBranchTransferLimits-check in AddReserve. +if ($query->param('overrideBranchTransferDenied')) { + $overrides->{overrideBranchTransferDenied} = 1; +} + + ############ # Deal with the requests.... @@ -216,7 +225,7 @@ if ($barcode) { # save the return # ( $returned, $messages, $issueinformation, $borrower ) = - AddReturn( $barcode, $userenv_branch, $exemptfine, $dropboxmode); # do the return + AddReturn( $barcode, $userenv_branch, $exemptfine, $dropboxmode, $overrides); # do the return my $homeorholdingbranchreturn = C4::Context->preference('HomeOrHoldingBranchReturn'); $homeorholdingbranchreturn ||= 'homebranch'; @@ -329,6 +338,12 @@ if ( $messages->{'Wrongbranch'} ){ ); } +if ( $messages->{'BranchTransferDenied'} ){ + $template->param( + BranchTransferDenied => $messages->{'BranchTransferDenied'}, + ); +} + # case of wrong transfert, if the document wasn't transfered to the right library (according to branchtransfer (tobranch) BDD) if ( $messages->{'WrongTransfer'} and not $messages->{'WasTransfered'}) { @@ -440,6 +455,9 @@ foreach my $code ( keys %$messages ) { elsif ( $code eq 'WasTransfered' ) { ; # FIXME... anything to do here? } + elsif ( $code eq 'BranchTransferDenied' ) { + ; # I am confused as well # FIXME... anything to do here? + } elsif ( $code eq 'withdrawn' ) { $err{withdrawn} = 1; $exit_required_p = 1 if C4::Context->preference("BlockReturnOfWithdrawnItems"); --- a/koha-tmpl/intranet-tmpl/prog/en/modules/circ/returns.tt +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/circ/returns.tt @@ -91,6 +91,20 @@ $(document).ready(function () {

Cannot check in

This item must be checked in at its home library. NOT CHECKED IN

[% END %] +[% IF ( BranchTransferDenied ) %] +

Cannot check in

+

Cannot receive this item because it cannot be transferred to it's original pickup location. This branch transfer rule blocks the check-in:
+ [% BranchTransferDenied.Frombranch %] -> [% BranchTransferDenied.Tobranch %] -> [% BranchTransferDenied.Code %] +

+ [% IF CAN_user_circulate %] +
+ + + +
+ [% END %] +
+[% END %] [% IF ( WrongTransfer ) %]

Please return [% title |html %] to [% TransferWaitingAt | $KohaBranchName %]

Print slip or Cancel transfer

[% IF ( wborcnum ) %]
Hold for:
--- a/opac/opac-reserve.pl +++ a/opac/opac-reserve.pl @@ -249,7 +249,7 @@ if ( $query->param('place_reserve') ) { } # UseBranchTransferLimits checking. - my ($transferOk, $message) = CheckBranchTransferAllowed( $pickupLocation, $item->{'holdingbranch'}, $item, undef ); + my ($transferOk, $message) = CanItemBeTransferred( $pickupLocation, $item->{'holdingbranch'}, $item, undef ); if (! $transferOk) { $canreserve = 0; } @@ -405,7 +405,7 @@ foreach my $biblioNum (@biblionumbers) { } } - #Collect the amout of items that pass the CheckBranchTransferAllowed-check. This is needed to tell + #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; @@ -518,7 +518,7 @@ foreach my $biblioNum (@biblionumbers) { #Check for UseBranchTransferLimit. $numCopiesAvailable is incremented because this Item # could still be available from another pickup location - my ($transferOk, $errorMsg) = CheckBranchTransferAllowed( $pickupBranch, undef, GetItem($itemNum), undef ); + my ($transferOk, $errorMsg) = CanItemBeTransferred( $pickupBranch, undef, GetItem($itemNum), undef ); if (! $transferOk) { $itemLoopIter->{available} = 0; $itemLoopIter->{branchTransferBlocked} = 1; --- a/t/db_dependent/Circulation/CanItemBeTransferred.t +++ a/t/db_dependent/Circulation/CanItemBeTransferred.t @@ -1,9 +1,13 @@ use Modern::Perl; -use Test::More tests => 20; +use Test::More tests => 24; + +use lib('../'); +use UseBranchTransferLimits::PreparedTestEnvironment qw($biblioitem $itemCPLFull $itemCPLLite $borrower); use C4::Circulation; use C4::Context; use C4::Record; +use C4::Members; my $dbh = C4::Context->dbh; $dbh->{AutoCommit} = 0; @@ -14,37 +18,39 @@ my $originalBranchTransferLimitsType = C4::Context->preference('BranchTransferLi ### Preparing our tests we want to run ### sub runTestsForCCode { my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_; + + C4::Context->set_preference("BranchTransferLimitsType", 'ccode'); print 'Running tests for '.C4::Context->preference("BranchTransferLimitsType")."\n"; - + #howto use: CanItemBeTransferred( $toBranch, $fromBranch, $item, $biblioitem] ); my $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, $biblioitem ); is ( $result, 1, "Successful branch transfer, full parameters" ); - + $result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, $biblioitem ); is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, full parameters" ); - + $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, undef ); is ( $result, 1, "Successful branch transfer, full parameters, no Biblio defined" ); - + $result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, undef ); is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, full parameters, no Biblio defined" ); - + $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, $biblioitem ); is ( $result, 1, "Successful branch transfer, using defaults for \$fromBranch" ); - + $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, $biblioitem ); is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, using defaults for \$fromBranch" ); - + $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, undef ); is ( $result, 1, "Successful branch transfer, using minimum parameters" ); - + $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, undef ); is ( $result, 'CPL->IPT->FANTASY', "Failing branch transfer, using minimum parameters" ); - + $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLLite, undef ); is ( $result, 1, "Successful branch transfer, using minimum parameters" ); - + $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLLite, undef ); is ( $result, 1, "Not failing branch transfer, because CCODE cannot be found from the item and it is not a part of the biblio." ); } @@ -52,34 +58,36 @@ sub runTestsForCCode { sub runTestsForItype { my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_; + + C4::Context->set_preference("BranchTransferLimitsType", 'itemtype'); print 'Running tests for '.C4::Context->preference("BranchTransferLimitsType")."\n"; - + #howto use: CanItemBeTransferred( $toBranch, $fromBranch, $item, $biblioitem] ); my $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, $biblioitem ); is ( $result, 1, "Successful branch transfer, full parameters" ); - + $result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, $biblioitem ); is ( $result, 'CPL->IPT->BK', "Failing branch transfer, full parameters" ); - + $result = C4::Circulation::CanItemBeTransferred( 'CPL', 'IPT', $itemCPLFull, undef ); is ( $result, 1, "Successful branch transfer, full parameters, no Biblio defined" ); - + $result = C4::Circulation::CanItemBeTransferred( 'IPT', 'CPL', $itemCPLFull, undef ); is ( $result, 'CPL->IPT->BK', "Failing branch transfer, full parameters, no Biblio defined" ); - + $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, $biblioitem ); is ( $result, 1, "Successful branch transfer, using defaults for \$fromBranch" ); - + $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, $biblioitem ); is ( $result, 'CPL->IPT->BK', "Failing branch transfer, using defaults for \$fromBranch" ); - + $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLFull, undef ); is ( $result, 1, "Successful branch transfer, using minimum parameters" ); - + $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLFull, undef ); is ( $result, 'CPL->IPT->BK', "Failing branch transfer, using minimum parameters" ); - + $result = C4::Circulation::CanItemBeTransferred( 'FFL', undef, $itemCPLLite, undef ); is ( $result, 1, "Successful branch transfer, using minimum parameters, itemtype is pulled from Biblio" ); @@ -88,173 +96,37 @@ sub runTestsForItype { } ### Tests prepared -### Preparing our generic testing data ### - -#Set the item variables -my $ccode = 'FANTASY'; -my $itemtype = 'BK'; - -## Add a example Bibliographic record -my $bibFramework = ''; #Using the default bibliographic framework. -my $marcxml; -if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) { - $marcxml=qq( - - - 01534njm a2200229 4500 - 4172 - - 8344482 - - - 4172 - - - 20040408 frey50 - - - agbxhx cd - - - The Beatles anthology 1965-1967 - vol.2 - The Beatles - CD - - - Null - Emi music - 1996 - - - anthologie des beatles concernant l'époque musicale de 1965 à 1968 période la plus expérimentale et prolifique du groupe - - - Real love - Yes it is - - - CVS - 0724383444823 - disque compact - 34 E - - - ); -} -else { # Using Marc21 by default - $marcxml=qq( - - 00000cim a22000004a 4500 - 1001 - 2013-06-03 07:04:07+02 - ss||||j||||||| - uuuu xxk|||||||||||||||||eng|c - - 0-00-103147-3 - 14.46 EUR - - - eng - - - 83.5 - ykl - - - SHAKESPEARE, WILLIAM. - - - THE TAMING OF THE SHREW / - WILLIAM SHAKESPEARE - [ÄÄNITE]. - - - LONDON : - COLLINS. - - - 2 ÄÄNIKASETTIA. - - - FI-Jm - 83.5 - - - FI-Konti - 83.5 - - - ); -} - -my $record=C4::Record::marcxml2marc($marcxml); - -# This should work regardless of the Marc flavour. -my ( $biblioitemtypeTagid, $biblioitemtypeSubfieldid ) = - C4::Biblio::GetMarcFromKohaField( 'biblioitems.itemtype', $bibFramework ); -my $itemtypeField = MARC::Field->new($biblioitemtypeTagid, '', '', - $biblioitemtypeSubfieldid => $itemtype); -$record->append_fields( $itemtypeField ); - -my ( $newBiblionumber, $newBiblioitemnumber ) = C4::Biblio::AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } ); - -## Add an item with a ccode. -my ($item_bibnum, $item_bibitemnum); -my ($itemCPLFull, $itemCPLFullId); #Item with a itemtype and ccode in its data. -my ($itemCPLLite, $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}, $newBiblionumber);#, biblioitemnumber => $newBiblioitemnumber, biblionumber => $newBiblioitemnumber }); -($item_bibnum, $item_bibitemnum, $itemCPLLiteId) = C4::Items::AddItem({ barcode => 'CPLLite', homebranch => 'CPL', holdingbranch => 'CPL'}, $newBiblionumber);# biblioitemnumber => $newBiblioitemnumber, biblionumber => $newBiblioitemnumber }); - - -### 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 ); - -## Ready to start testing ccode use-case ## - -$itemCPLFull = C4::Items::GetItem($itemCPLFullId); -$itemCPLLite = C4::Items::GetItem($itemCPLLiteId); -my $biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} ); - - +### Run them tests! runTestsForCCode($itemCPLFull, $itemCPLLite, $biblioitem); +runTestsForItype($itemCPLFull, $itemCPLLite, $biblioitem); + +#One cannot return an Item which has homebranch in CPL to FFL +my $datedue = C4::Circulation::AddIssue( $borrower, 'CPLFull') or BAIL_OUT("Cannot check-out an Item!"); +my ($returnOk, $errorMessage) = C4::Circulation::AddReturn('CPLFull', 'FFL', undef, undef, undef); +is( exists $errorMessage->{BranchTransferDenied}, 1, "Check-in failed because of a branch transfer limitation." ); -### ccode tested -### Setting preferences for itemtype use-case ### -C4::Context->set_preference("BranchTransferLimitsType", 'itemtype'); +#One can return an Item which has homebranch in FFL to CPL +($returnOk, $errorMessage) = C4::Circulation::AddReturn('CPLFull', 'CPL', undef, undef, undef); +is( $returnOk, 1, "Check-in succeeds." ); -## 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 ); -## Ready to start testing itemtype use-case ## +#One can override a denied branch transfer +$datedue = C4::Circulation::AddIssue( $borrower, 'CPLFull') or BAIL_OUT("Cannot check-out an Item!"); +($returnOk, $errorMessage) = C4::Circulation::AddReturn('CPLFull', 'FFL', undef, undef, {overrideBranchTransferDenied => 1}); +is( $returnOk, 1, "Check-in succeeds because transfer limits are overridden." ); -$itemCPLFull = C4::Items::GetItem($itemCPLFullId); -$itemCPLLite = C4::Items::GetItem($itemCPLLiteId); -$biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} ); +#Failing a check-in regardless of override, since failure happens because Item's must be returned to their homebranches. +#Important to see that overriding BranchTransferDenied doesn't break other functionality. +C4::Context->set_preference("AllowReturnToBranch", 'homebranch'); +$datedue = C4::Circulation::AddIssue( $borrower, 'CPLFull') or BAIL_OUT("Cannot check-out an Item!"); +($returnOk, $errorMessage) = C4::Circulation::AddReturn('CPLFull', 'FFL', undef, undef, {overrideBranchTransferDenied => 1}); +is( $returnOk, 0, "Overridden check-in fails, because AllowReturnToBranch-check fails." ); -runTestsForItype($itemCPLFull, $itemCPLLite, $biblioitem); -### itemtype tested ### Reset default preferences C4::Context->set_preference("BranchTransferLimitsType", $originalBranchTransferLimitsType); --- a/t/db_dependent/UseBranchTransferLimits/PreparedTestEnvironment.pm +++ a/t/db_dependent/UseBranchTransferLimits/PreparedTestEnvironment.pm @@ -0,0 +1,150 @@ +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( + + 00000cim a22000004a 4500 + ss||||j||||||| + uuuu xxk|||||||||||||||||eng|c + + SHAKESPEARE, WILLIAM. + + + THE TAMING OF THE SHREW / + WILLIAM SHAKESPEARE + [ÄÄNITE]. + + + ); + 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); +} --