Attachment 22696 Details for Bug 7376 – Bug 7376 - Transfer limits should be checked at check-in

[patch] Bug 7376 - Transfer limits should be checked at check-in

Bug-7376---Transfer-limits-should-be-checked-at-ch.patch (text/plain), 36.83 KB, created by Olli-Antti Kivilahti on 2013-11-04 11:41:48 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Olli-Antti Kivilahti

Created: 2013-11-04 11:41:48 UTC

Size: 36.83 KB

patch

obsolete

>From a72f3d20dff8ff47f0be192480032926e806b286 Mon Sep 17 00:00:00 2001
>From: Olli-Antti Kivilahti <olli-antti.kivilahti@jns.fi>
>Date: Wed, 23 Oct 2013 17:58:09 +0300
>Subject: [PATCH] Bug 7376 - Transfer limits should be checked at check-in
>
>Extended UseBranchTransferLimits-check to the check-in case.
>Made it possible to override the check-in with circulation-permission if BranchTransfer is denied.
>Made unit tests for the C4/Circulation.pm and C4/SIP/t/08checkin.t
>
>*Also added override-functionality to Circulation::AddReturn() to override BranchTransferLimits. (+unit tests)
>*Renamed CanBookBeReturned to CanItemBeReturned since that function was referenced from AddReturn only.
>--This is because function name misguidingly references to a book/Biblio/Title-level, even if the functionality is strictly
>--Item dependent.
>*Removed duplicating code by making CanItemBeTransferred() call IsBranchTransferAllowed().
>*Made a unit test library out of CanItemBeTransferred.t's environment initialization parts,
>  so these need not be duplicated whenever UseBranchTransferLimits-related functionality is tested.
>*Documented SIP-testing hardships to C4/SIP/README
>---
> 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                               |  27 +++
> t/db_dependent/Circulation/CanItemBeTransferred.t  | 186 ++++-----------------
> .../PreparedTestEnvironment.pm                     | 150 +++++++++++++++++
> 9 files changed, 417 insertions(+), 191 deletions(-)
> create mode 100644 t/db_dependent/UseBranchTransferLimits/PreparedTestEnvironment.pm
>
>diff --git a/C4/Circulation.pm b/C4/Circulation.pm
>index 15c2f61..b8f3aae 100644
>--- a/C4/Circulation.pm
>+++ b/C4/Circulation.pm
>@@ -1042,9 +1042,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
> 
>@@ -1062,30 +1062,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);
>@@ -1632,7 +1657,7 @@ sub GetBranchItemRule {
> =head2 AddReturn
> 
>   ($doreturn, $messages, $iteminformation, $borrower) =
>-      &AddReturn($barcode, $branch, $exemptfine, $dropbox);
>+      &AddReturn($barcode, $branch, $exemptfine, $dropbox, $overrides);
> 
> Returns a book.
> 
>@@ -1651,6 +1676,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:
>@@ -1686,6 +1716,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<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
>@@ -1704,7 +1742,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'};
>@@ -1723,7 +1761,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})
>@@ -1759,14 +1797,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
>diff --git a/C4/SIP/ILS/Transaction/Checkin.pm b/C4/SIP/ILS/Transaction/Checkin.pm
>index db1f102..d875fa2 100644
>--- a/C4/SIP/ILS/Transaction/Checkin.pm
>+++ b/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
>diff --git a/C4/SIP/README b/C4/SIP/README
>index 73acdfd..36cd224 100644
>--- a/C4/SIP/README
>+++ b/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.
>\ No newline at end of file
>diff --git a/C4/SIP/t/08checkin.t b/C4/SIP/t/08checkin.t
>index d7923ee..db3dea0 100644
>--- a/C4/SIP/t/08checkin.t
>+++ b/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
>diff --git a/circ/returns.pl b/circ/returns.pl
>index 93f36f2..3fe0a67 100755
>--- a/circ/returns.pl
>+++ b/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");
>diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/circ/returns.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/circ/returns.tt
>index fb30311..fcf2a96 100644
>--- a/koha-tmpl/intranet-tmpl/prog/en/modules/circ/returns.tt
>+++ b/koha-tmpl/intranet-tmpl/prog/en/modules/circ/returns.tt
>@@ -91,6 +91,20 @@ $(document).ready(function () {
> <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 %]
> 
> [% IF ( WrongTransfer ) %]<div id="return2" class="dialog message"><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>
>diff --git a/opac/opac-reserve.pl b/opac/opac-reserve.pl
>index 97d136a..7a40a92 100755
>--- a/opac/opac-reserve.pl
>+++ b/opac/opac-reserve.pl
>@@ -246,6 +246,12 @@ if ( $query->param('place_reserve') ) {
>                 $found = 'W'
>                   unless C4::Context->preference('ReservesNeedReturns');
>             }
>+
>+            # UseBranchTransferLimits checking.
>+            my ($transferOk, $message) = CanItemBeTransferred( $pickupLocation, $item->{'holdingbranch'}, $item, undef );
>+            if (! $transferOk) {
>+                $canreserve = 0;
>+            }
>         }
>         else {
>             $canreserve = 1 if CanBookBeReserved( $borrowernumber, $biblioNum );
>@@ -398,6 +404,13 @@ foreach my $biblioNum (@biblionumbers) {
>         }
>     }
> 
>+<<<<<<< HEAD
>+=======
>+    #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;
>+
>+>>>>>>> Bug 7376 - Transfer limits should be checked at check-in
>     $biblioLoopIter{itemLoop} = [];
>     my $numCopiesAvailable = 0;
>     foreach my $itemInfo (@{$biblioData->{itemInfos}}) {
>@@ -503,6 +516,20 @@ foreach my $biblioNum (@biblionumbers) {
>         if (IsAvailableForItemLevelRequest($itemNum) and $policy_holdallowed and CanItemBeReserved($borrowernumber,$itemNum) and ($itemLoopIter->{already_reserved} ne 1)) {
>             $itemLoopIter->{available} = 1;
>             $numCopiesAvailable++;
>+<<<<<<< HEAD
>+=======
>+
>+            #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;
>+            }
>+            else {
>+                $branchTransferableItemsCount++;
>+            }
>+>>>>>>> Bug 7376 - Transfer limits should be checked at check-in
>         }
> 
> 	# FIXME: move this to a pm
>diff --git a/t/db_dependent/Circulation/CanItemBeTransferred.t b/t/db_dependent/Circulation/CanItemBeTransferred.t
>index a74b074..b4abc44 100644
>--- a/t/db_dependent/Circulation/CanItemBeTransferred.t
>+++ b/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;
>@@ -15,6 +19,8 @@ my $originalBranchTransferLimitsType = C4::Context->preference('BranchTransferLi
> 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] );
>@@ -53,6 +59,8 @@ 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] );
>@@ -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(
>-    <?xml version="1.0" encoding="UTF-8"?>
>-    <record
>-        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
>-        xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
>-        xmlns="http://www.loc.gov/MARC21/slim">
>-      <leader>01534njm a2200229   4500</leader>
>-      <controlfield tag="001">4172</controlfield>
>-      <datafield tag="071" ind1=" " ind2=" ">
>-        <subfield code="a">8344482</subfield>
>-      </datafield>
>-      <datafield tag="090" ind1=" " ind2=" ">
>-        <subfield code="a">4172</subfield>
>-      </datafield>
>-      <datafield tag="100" ind1=" " ind2=" ">
>-        <subfield code="a">20040408              frey50        </subfield>
>-      </datafield>
>-      <datafield tag="126" ind1=" " ind2=" ">
>-        <subfield code="a">agbxhx       cd</subfield>
>-      </datafield>
>-      <datafield tag="200" ind1="1" ind2=" ">
>-        <subfield code="a">The Beatles anthology 1965-1967</subfield>
>-        <subfield code="e">vol.2</subfield>
>-        <subfield code="f">The Beatles</subfield>
>-        <subfield code="b">CD</subfield>
>-      </datafield>
>-      <datafield tag="210" ind1=" " ind2="1">
>-        <subfield code="a">Null</subfield>
>-        <subfield code="c">Emi music</subfield>
>-        <subfield code="d">1996</subfield>
>-      </datafield>
>-      <datafield tag="322" ind1=" " ind2="1">
>-        <subfield code="a">anthologie des beatles concernant l'&#xE9;poque musicale de 1965 &#xE0; 1968 p&#xE9;riode la plus exp&#xE9;rimentale et prolifique du groupe</subfield>
>-      </datafield>
>-      <datafield tag="327" ind1="1" ind2=" ">
>-        <subfield code="a">Real love</subfield>
>-        <subfield code="a">Yes it is</subfield>
>-      </datafield>
>-      <datafield tag="345" ind1=" " ind2=" ">
>-        <subfield code="a">CVS</subfield>
>-        <subfield code="b">0724383444823</subfield>
>-        <subfield code="c">disque compact</subfield>
>-        <subfield code="d">34 E</subfield>
>-      </datafield>
>-    </record>
>-    );
>-}
>-else { # Using Marc21 by default
>-    $marcxml=qq(<?xml version="1.0" encoding="UTF-8"?>
>-    <record format="MARC21" type="Bibliographic">
>-      <leader>00000cim a22000004a 4500</leader>
>-      <controlfield tag="001">1001</controlfield>
>-      <controlfield tag="005">2013-06-03 07:04:07+02</controlfield>
>-      <controlfield tag="007">ss||||j|||||||</controlfield>
>-      <controlfield tag="008">       uuuu    xxk|||||||||||||||||eng|c</controlfield>
>-      <datafield tag="020" ind1=" " ind2=" ">
>-        <subfield code="a">0-00-103147-3</subfield>
>-        <subfield code="c">14.46 EUR</subfield>
>-      </datafield>
>-      <datafield tag="041" ind1="0" ind2=" ">
>-        <subfield code="d">eng</subfield>
>-      </datafield>
>-      <datafield tag="084" ind1=" " ind2=" ">
>-        <subfield code="a">83.5</subfield>
>-        <subfield code="2">ykl</subfield>
>-      </datafield>
>-      <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>
>-      <datafield tag="260" ind1=" " ind2=" ">
>-        <subfield code="a">LONDON :</subfield>
>-        <subfield code="b">COLLINS.</subfield>
>-      </datafield>
>-      <datafield tag="300" ind1=" " ind2=" ">
>-        <subfield code="a">2 ÃÃNIKASETTIA.</subfield>
>-      </datafield>
>-      <datafield tag="852" ind1=" " ind2=" ">
>-        <subfield code="a">FI-Jm</subfield>
>-        <subfield code="h">83.5</subfield>
>-      </datafield>
>-      <datafield tag="852" ind1=" " ind2=" ">
>-        <subfield code="a">FI-Konti</subfield>
>-        <subfield code="h">83.5</subfield>
>-      </datafield>
>-    </record>
>-    );
>-}
>-
>-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);
> 
> 
>-### ccode tested
>-### Setting preferences for itemtype use-case ###
>+#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." );
> 
>-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 );
>+#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." );
> 
>-## Ready to start testing itemtype use-case ##
> 
>-$itemCPLFull = C4::Items::GetItem($itemCPLFullId);
>-$itemCPLLite = C4::Items::GetItem($itemCPLLiteId);
>-$biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} );
>+#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." );
> 
> 
>-runTestsForItype($itemCPLFull, $itemCPLLite, $biblioitem);
>+#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." );
>+
> 
>-### itemtype tested
> 
> ### Reset default preferences
> C4::Context->set_preference("BranchTransferLimitsType", $originalBranchTransferLimitsType);
>diff --git a/t/db_dependent/UseBranchTransferLimits/PreparedTestEnvironment.pm b/t/db_dependent/UseBranchTransferLimits/PreparedTestEnvironment.pm
>new file mode 100644
>index 0000000..4ede953
>--- /dev/null
>+++ b/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(<?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);
>+}
>-- 
>1.8.1.2

Actions: View | Diff | Splinter Review

Attachments on bug 7376: 6954 | 21715 | 21805 | 22016 | 22017 | 22323 | 22357 | 22696 | 23168 | 76559 | 76866 | 76876 | 92740 | 92774 | 93190 | 93191 | 93192 | 93193 | 93194 | 93195 | 93196 | 107077 | 107078 | 107079 | 115369 | 115370 | 116493 | 116494 | 116927 | 116928 | 116937 | 116938 | 120897 | 120898 | 120899 | 120900 | 120901 | 120902 | 120903 | 144435 | 144436 | 144437 | 144438 | 144439 | 144440 | 144441