From d3c562979d4dfe0184df75a2ea5278ef3ee0b12f Mon Sep 17 00:00:00 2001 From: Olli-Antti Kivilahti Date: Tue, 15 Oct 2013 12:08:23 +0300 Subject: [PATCH] Bug 11005 [ENH] - Centralize the UseBranchTransferLimits-check under one function Created a C4::Circulation::CanItemBeTransferred() as a more convenient branch transfer check than the previous multiline if-else mess. This is a more pleasant and readable approach to generalizing branch transfer checks accross Koha. Includes a error message as the return value so the precise reasons for denial need not be constructed when needed. Also a small fix to branchtransfers.pl to make a warning happen only during debugging. Unit tests included which test the new C4 function. -- Rebased by chrisc@catalyst.net.nz fixing conflict. This patch mixes whitespace clean up and functional changes, however if you view it with git show -w You can see just the actual changes. Currently is failing the tests on my dev set up --- C4/Circulation.pm | 395 +++++++++++++--------- circ/branchtransfers.pl | 5 +- t/db_dependent/Circulation/CanItemBeTransferred.t | 262 ++++++++++++++ 3 files changed, 501 insertions(+), 161 deletions(-) create mode 100644 t/db_dependent/Circulation/CanItemBeTransferred.t diff --git a/C4/Circulation.pm b/C4/Circulation.pm index 6b700ec..9f45d12 100644 --- a/C4/Circulation.pm +++ b/C4/Circulation.pm @@ -61,13 +61,13 @@ use Date::Calc qw( use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); BEGIN { - require Exporter; + require Exporter; $VERSION = 3.07.00.049; # for version checking - @ISA = qw(Exporter); + @ISA = qw(Exporter); - # FIXME subs that should probably be elsewhere - push @EXPORT, qw( - &barcodedecode + # FIXME subs that should probably be elsewhere + push @EXPORT, qw( + &barcodedecode &LostItem &ReturnLostItem ); @@ -86,31 +86,32 @@ BEGIN { &GetIssuingRule &GetBranchBorrowerCircRule &GetBranchItemRule - &GetBiblioIssues - &GetOpenIssue - &AnonymiseIssueHistory + &GetBiblioIssues + &GetOpenIssue + &AnonymiseIssueHistory &CheckIfIssuedToPatron &IsItemIssued - ); + ); - # subs to deal with returns - push @EXPORT, qw( - &AddReturn + # subs to deal with returns + push @EXPORT, qw( + &AddReturn &MarkIssueReturned - ); + ); - # subs to deal with transfers - push @EXPORT, qw( - &transferbook - &GetTransfers - &GetTransfersFromTo - &updateWrongTransfer - &DeleteTransfer + # subs to deal with transfers + push @EXPORT, qw( + &transferbook + &GetTransfers + &GetTransfersFromTo + &updateWrongTransfer + &DeleteTransfer + &CanItemBeTransferred &IsBranchTransferAllowed &CreateBranchTransferLimit &DeleteBranchTransferLimits &TransferSlip - ); + ); # subs to deal with offline circulation push @EXPORT, qw( @@ -163,30 +164,30 @@ sub barcodedecode { my $branch = C4::Branch::mybranch(); $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter; $filter or return $barcode; # ensure filter is defined, else return untouched barcode - if ($filter eq 'whitespace') { - $barcode =~ s/\s//g; - } elsif ($filter eq 'cuecat') { - chomp($barcode); - my @fields = split( /\./, $barcode ); - my @results = map( decode($_), @fields[ 1 .. $#fields ] ); - ($#results == 2) and return $results[2]; - } elsif ($filter eq 'T-prefix') { - if ($barcode =~ /^[Tt](\d)/) { - (defined($1) and $1 eq '0') and return $barcode; + if ($filter eq 'whitespace') { + $barcode =~ s/\s//g; + } elsif ($filter eq 'cuecat') { + chomp($barcode); + my @fields = split( /\./, $barcode ); + my @results = map( decode($_), @fields[ 1 .. $#fields ] ); + ($#results == 2) and return $results[2]; + } elsif ($filter eq 'T-prefix') { + if ($barcode =~ /^[Tt](\d)/) { + (defined($1) and $1 eq '0') and return $barcode; $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1) - } + } return sprintf("T%07d", $barcode); # FIXME: $barcode could be "T1", causing warning: substr outside of string # Why drop the nonzero digit after the T? # Why pass non-digits (or empty string) to "T%07d"? - } elsif ($filter eq 'libsuite8') { - unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it. - if($barcode =~ m/^(\d)/i){ #Some barcodes even start with 0's & numbers and are assumed to have b as the item type in the libsuite8 software + } elsif ($filter eq 'libsuite8') { + unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it. + if($barcode =~ m/^(\d)/i){ #Some barcodes even start with 0's & numbers and are assumed to have b as the item type in the libsuite8 software $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i; }else{ - $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i; - } - } + $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i; + } + } } elsif ($filter eq 'EAN13') { my $ean = CheckDigits('ean'); if ( $ean->is_valid($barcode) ) { @@ -195,7 +196,7 @@ sub barcodedecode { } else { warn "# [$barcode] not valid EAN-13/UPC-A\n"; } - } + } return $barcode; # return barcode, modified or not } @@ -301,7 +302,8 @@ sub transferbook { my $messages; my $dotransfer = 1; my $branches = GetBranches(); - my $itemnumber = GetItemnumberFromBarcode( $barcode ); + my $item = GetItem(undef,$barcode,undef); + my $itemnumber = $item->{itemnumber}; my $issue = GetItemIssue($itemnumber); my $biblio = GetBiblioFromItemNumber($itemnumber); @@ -316,16 +318,10 @@ sub transferbook { my $fbr = $biblio->{'holdingbranch'}; # if using Branch Transfer Limits - if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) { - if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) { - if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) { - $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'}; - $dotransfer = 0; - } - } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) { - $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") }; - $dotransfer = 0; - } + my $errMsg; + ($dotransfer, $errMsg) = CanItemBeTransferred( $tbr, $fbr, $item, $biblio ); + if ( ! $dotransfer ) { + $messages->{'NotAllowed'} = $errMsg; } # if is permanent... @@ -373,15 +369,15 @@ sub transferbook { sub TooMany { my $borrower = shift; my $biblionumber = shift; - my $item = shift; + my $item = shift; my $cat_borrower = $borrower->{'categorycode'}; my $dbh = C4::Context->dbh; - my $branch; - # Get which branchcode we need - $branch = _GetCircControlBranch($item,$borrower); - my $type = (C4::Context->preference('item-level_itypes')) - ? $item->{'itype'} # item-level - : $item->{'itemtype'}; # biblio-level + my $branch; + # Get which branchcode we need + $branch = _GetCircControlBranch($item,$borrower); + my $type = (C4::Context->preference('item-level_itypes')) + ? $item->{'itype'} # item-level + : $item->{'itemtype'}; # biblio-level # given branch, patron category, and item type, determine # applicable issuing rule @@ -698,15 +694,15 @@ sub CanBookBeIssued { my $item = GetItem(GetItemnumberFromBarcode( $barcode )); my $issue = GetItemIssue($item->{itemnumber}); - my $biblioitem = GetBiblioItemData($item->{biblioitemnumber}); - $item->{'itemtype'}=$item->{'itype'}; + my $biblioitem = GetBiblioItemData($item->{biblioitemnumber}); + $item->{'itemtype'}=$item->{'itype'}; my $dbh = C4::Context->dbh; # MANDATORY CHECKS - unless item exists, nothing else matters unless ( $item->{barcode} ) { $issuingimpossible{UNKNOWN_BARCODE} = 1; } - return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible; + return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible; # # DUE DATE is OK ? -- should already have checked. @@ -739,7 +735,7 @@ sub CanBookBeIssued { # BORROWER STATUS # if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) { - # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 . + # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 . &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'}, undef, $item->{'ccode'}); ModDateLastSeen( $item->{'itemnumber'} ); return( { STATS => 1 }, {}); @@ -809,12 +805,12 @@ sub CanBookBeIssued { my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'}); if ($blocktype == -1) { ## patron has outstanding overdue loans - if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){ - $issuingimpossible{USERBLOCKEDOVERDUE} = $count; - } - elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){ - $needsconfirmation{USERBLOCKEDOVERDUE} = $count; - } + if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){ + $issuingimpossible{USERBLOCKEDOVERDUE} = $count; + } + elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){ + $needsconfirmation{USERBLOCKEDOVERDUE} = $count; + } } elsif($blocktype == 1) { # patron has accrued fine days $issuingimpossible{USERBLOCKEDREMAINING} = $count; @@ -823,7 +819,7 @@ sub CanBookBeIssued { # # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS # - my ($current_loan_count, $max_loans_allowed) = TooMany( $borrower, $item->{biblionumber}, $item ); + my ($current_loan_count, $max_loans_allowed) = TooMany( $borrower, $item->{biblionumber}, $item ); # if TooMany max_loans_allowed returns 0 the user doesn't have permission to check out this book if (defined $max_loans_allowed && $max_loans_allowed == 0) { $needsconfirmation{PATRON_CANT} = 1; @@ -1178,7 +1174,7 @@ AddIssue does the following things : sub AddIssue { my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_; my $dbh = C4::Context->dbh; - my $barcodecheck=CheckValidBarcode($barcode); + my $barcodecheck=CheckValidBarcode($barcode); if ($datedue && ref $datedue ne 'DateTime') { $datedue = dt_from_string($datedue); } @@ -1192,42 +1188,42 @@ sub AddIssue { } } - if ($borrower and $barcode and $barcodecheck ne '0'){#??? wtf - # find which item we issue - my $item = GetItem('', $barcode) or return; # if we don't get an Item, abort. - my $branch = _GetCircControlBranch($item,$borrower); - - # get actual issuing if there is one - my $actualissue = GetItemIssue( $item->{itemnumber}); - - # get biblioinformation for this item - my $biblio = GetBiblioFromItemNumber($item->{itemnumber}); - - # - # check if we just renew the issue. - # - if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) { - $datedue = AddRenewal( - $borrower->{'borrowernumber'}, - $item->{'itemnumber'}, - $branch, - $datedue, - $issuedate, # here interpreted as the renewal date - ); - } - else { + if ($borrower and $barcode and $barcodecheck ne '0'){#??? wtf + # find which item we issue + my $item = GetItem('', $barcode) or return; # if we don't get an Item, abort. + my $branch = _GetCircControlBranch($item,$borrower); + + # get actual issuing if there is one + my $actualissue = GetItemIssue( $item->{itemnumber}); + + # get biblioinformation for this item + my $biblio = GetBiblioFromItemNumber($item->{itemnumber}); + + # + # check if we just renew the issue. + # + if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) { + $datedue = AddRenewal( + $borrower->{'borrowernumber'}, + $item->{'itemnumber'}, + $branch, + $datedue, + $issuedate, # here interpreted as the renewal date + ); + } + else { # it's NOT a renewal - if ( $actualissue->{borrowernumber}) { - # This book is currently on loan, but not to the person - # who wants to borrow it now. mark it returned before issuing to the new borrower - AddReturn( - $item->{'barcode'}, - C4::Context->userenv->{'branch'} - ); - } + if ( $actualissue->{borrowernumber}) { + # This book is currently on loan, but not to the person + # who wants to borrow it now. mark it returned before issuing to the new borrower + AddReturn( + $item->{'barcode'}, + C4::Context->userenv->{'branch'} + ); + } MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve ); - # Starting process for transfer job (checking transfert and validate it if we have one) + # Starting process for transfer job (checking transfert and validate it if we have one) my ($datesent) = GetTransfers($item->{'itemnumber'}); if ($datesent) { # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....) @@ -1444,7 +1440,7 @@ sub GetIssuingRule { my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null" ); my $irule; - $sth->execute( $borrowertype, $itemtype, $branchcode ); + $sth->execute( $borrowertype, $itemtype, $branchcode ); $irule = $sth->fetchrow_hashref; return $irule if defined($irule) ; @@ -1805,7 +1801,7 @@ sub AddReturn { if ($doreturn) { my $datedue = $issue->{date_due}; $borrower or warn "AddReturn without current borrower"; - my $circControlBranch; + my $circControlBranch; if ($dropbox) { # define circControlBranch only if dropbox mode is set # don't allow dropbox mode to create an invalid entry in issues (issuedate > today) @@ -2745,22 +2741,22 @@ sub AddRenewal { # Send a renewal slip according to checkout alert preferencei if ( C4::Context->preference('RenewalSendNotice') eq '1') { - my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ); - my $circulation_alert = 'C4::ItemCirculationAlertPreference'; - my %conditions = ( - branchcode => $branch, - categorycode => $borrower->{categorycode}, - item_type => $item->{itype}, - notification => 'CHECKOUT', - ); - if ($circulation_alert->is_enabled_for(\%conditions)) { - SendCirculationAlert({ - type => 'RENEWAL', - item => $item, - borrower => $borrower, - branch => $branch, - }); - } + my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ); + my $circulation_alert = 'C4::ItemCirculationAlertPreference'; + my %conditions = ( + branchcode => $branch, + categorycode => $borrower->{categorycode}, + item_type => $item->{itype}, + notification => 'CHECKOUT', + ); + if ($circulation_alert->is_enabled_for(\%conditions)) { + SendCirculationAlert({ + type => 'RENEWAL', + item => $item, + borrower => $borrower, + branch => $branch, + }); + } } # Remove any OVERDUES related debarment if the borrower has no overdues @@ -2775,7 +2771,7 @@ sub AddRenewal { # Log the renewal UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'}); - return $datedue; + return $datedue; } sub GetRenewCount { @@ -3138,7 +3134,7 @@ sub SendCirculationAlert { my %message_name = ( CHECKIN => 'Item_Check_in', CHECKOUT => 'Item_Checkout', - RENEWAL => 'Item_Checkout', + RENEWAL => 'Item_Checkout', ); my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({ borrowernumber => $borrower->{borrowernumber}, @@ -3186,20 +3182,20 @@ This function validate the line of brachtransfer but with the wrong destination =cut sub updateWrongTransfer { - my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_; - my $dbh = C4::Context->dbh; + my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_; + my $dbh = C4::Context->dbh; # first step validate the actual line of transfert . - my $sth = - $dbh->prepare( - "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL" - ); - $sth->execute($FromLibrary,$itemNumber); + my $sth = + $dbh->prepare( + "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL" + ); + $sth->execute($FromLibrary,$itemNumber); # second step create a new line of branchtransfer to the right location . - ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary); + ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary); #third step changing holdingbranch of item - UpdateHoldingbranch($FromLibrary,$itemNumber); + UpdateHoldingbranch($FromLibrary,$itemNumber); } =head2 UpdateHoldingbranch @@ -3211,7 +3207,7 @@ Simple methode for updating hodlingbranch in items BDD line =cut sub UpdateHoldingbranch { - my ( $branch,$itemnumber ) = @_; + my ( $branch,$itemnumber ) = @_; ModItem({ holdingbranch => $branch }, undef, $itemnumber); } @@ -3331,9 +3327,9 @@ sub CheckRepeatableHolidays{ my($itemnumber,$week_day,$branchcode)=@_; my $dbh = C4::Context->dbh; my $query = qq|SELECT count(*) - FROM repeatable_holidays - WHERE branchcode=? - AND weekday=?|; + FROM repeatable_holidays + WHERE branchcode=? + AND weekday=?|; my $sth = $dbh->prepare($query); $sth->execute($branchcode,$week_day); my $result=$sth->fetchrow; @@ -3359,12 +3355,12 @@ sub CheckSpecialHolidays{ my ($years,$month,$day,$itemnumber,$branchcode) = @_; my $dbh = C4::Context->dbh; my $query=qq|SELECT count(*) - FROM `special_holidays` - WHERE year=? - AND month=? - AND day=? + FROM `special_holidays` + WHERE year=? + AND month=? + AND day=? AND branchcode=? - |; + |; my $sth = $dbh->prepare($query); $sth->execute($years,$month,$day,$branchcode); my $countspecial=$sth->fetchrow ; @@ -3388,11 +3384,11 @@ sub CheckRepeatableSpecialHolidays{ my ($month,$day,$itemnumber,$branchcode) = @_; my $dbh = C4::Context->dbh; my $query=qq|SELECT count(*) - FROM `repeatable_holidays` - WHERE month=? - AND day=? + FROM `repeatable_holidays` + WHERE month=? + AND day=? AND branchcode=? - |; + |; my $sth = $dbh->prepare($query); $sth->execute($month,$day,$branchcode); my $countspecial=$sth->fetchrow ; @@ -3405,15 +3401,96 @@ sub CheckValidBarcode{ my ($barcode) = @_; my $dbh = C4::Context->dbh; my $query=qq|SELECT count(*) - FROM items + FROM items WHERE barcode=? - |; + |; my $sth = $dbh->prepare($query); $sth->execute($barcode); my $exist=$sth->fetchrow ; return $exist; } + +=head2 CanItemBeTransferred + +A convenience function to easily check item transfer limits. + + ($allowed, $errorMessage) = CanItemBeTransferred( $toBranch, $fromBranch, $item, $biblioitem ); + ($allowed, $errorMessage) = CanItemBeTransferred( $toBranch, undef, $item, undef] ); + +Checks if UseBranchTransferLimits global preference is in use. +Checks if the given item can be transferred from $fromBranch to $toBranch. +This is dependant on the global setting: +* UseBranchTransferLimits +and "Administration" -> "Library transfer limits" + +C<$toBranch> = the transfer destination library's code +C<$fromBranch> = OPTIONAL, the transfer departure library's code + DEFAULT: using the item's holdingbranch +C<$item> = item-object from items-table +C<$biblioitem> = OPTIONAL, biblioitem-object, is needed when using CCODE instead if + using itemtype to limit branch transfers. + If biblioitem-object is available, it should be provided for performance reasons. +C if transfer is not allowed: (0, "$fromBranch->$toBranch->transfer limit code") + (1) if transfer allowed. +=cut + +sub CanItemBeTransferred { + + #When we check for BranchTransferLimit global settings centrally, it makes + # using this functionality much easier. + unless ( C4::Context->preference("UseBranchTransferLimits") == 1 ) { + return 1; + } + + #Init parameter variables + my ( $toBranch, $fromBranch, $item, $biblioitem ) = @_; + + #Check the $fromBranch and set the DEFAULT value + $fromBranch = $item->{holdingbranch} if ! defined $fromBranch; + + if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed. + + #This is the CCode or itemtype value used to find the correct transfer rule for this item. + my $code; + + ## Figure out the $code! + ## First we need to figure out are we using CCODE or itemtype, this limits do we need $biblioitem or not. + ## Since $biblioitem can be optional, we cannot count that it is defined. + if ( C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) { + if (C4::Context->preference("item-level_itypes") && defined $item->{'itype'}) { + $code = $item->{'itype'}; #Easiest way to get the $code is from the item. + } + elsif (defined $biblioitem->{itemtype}) { + $code = $biblioitem->{itemtype} + } + #If code cannot be resolved from $item or $biblioitem, we need to escalate to the DB + else { + $biblioitem = C4::Biblio::GetBiblioFromItemNumber( $item->{itemnumber} ); + $code = $biblioitem->{itemtype} + } + + } else { + my $limitType = C4::Context->preference("BranchTransferLimitsType"); + if (defined $item->{ $limitType }) { + $code = $item->{ $limitType }; + } + else { + #collection code (ccode) is not present in the Biblio, so no point looking there. + # If the Item doesn't have a itemtype, then give up and let the transfer pass. + } + } + ## Phew we finally got the $code, now it's time to rumble! + + if (! IsBranchTransferAllowed($toBranch, $fromBranch, $code)) { + return 0, "$fromBranch->$toBranch->$code"; + } + else { + return 1; + } +} + + =head2 IsBranchTransferAllowed $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code ); @@ -3423,23 +3500,23 @@ Code is either an itemtype or collection doe depending on the pref BranchTransfe =cut sub IsBranchTransferAllowed { - my ( $toBranch, $fromBranch, $code ) = @_; + my ( $toBranch, $fromBranch, $code ) = @_; - if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed. + if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed. - my $limitType = C4::Context->preference("BranchTransferLimitsType"); - my $dbh = C4::Context->dbh; + my $limitType = C4::Context->preference("BranchTransferLimitsType"); + my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?"); - $sth->execute( $toBranch, $fromBranch, $code ); - my $limit = $sth->fetchrow_hashref(); + my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?"); + $sth->execute( $toBranch, $fromBranch, $code ); + my $limit = $sth->fetchrow_hashref(); - ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed* - if ( $limit->{'limitId'} ) { - return 0; - } else { - return 1; - } + ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed* + if ( $limit->{'limitId'} ) { + return 0; + } else { + return 1; + } } =head2 CreateBranchTransferLimit diff --git a/circ/branchtransfers.pl b/circ/branchtransfers.pl index 3be7bb4..4e1ef17 100755 --- a/circ/branchtransfers.pl +++ b/circ/branchtransfers.pl @@ -206,10 +206,11 @@ foreach my $code ( keys %$messages ) { $err{errbadcode} = 1; } elsif ( $code eq "NotAllowed" ) { - warn "NotAllowed: $messages->{'NotAllowed'} to " . $branches->{ $messages->{'NotAllowed'} }->{'branchname'}; + warn "NotAllowed: $messages->{'NotAllowed'} to " . $branches->{ $messages->{'NotAllowed'} }->{'branchname'} if $ENV{DEBUG}; + # Do we really want a error log message here? --atz $err{errnotallowed} = 1; - my ( $tbr, $typecode ) = split( /::/, $messages->{'NotAllowed'} ); + my ( $fbr, $tbr, $typecode ) = split( '->', $messages->{'NotAllowed'} ); $err{tbr} = $branches->{ $tbr }->{'branchname'}; $err{code} = $typecode; $err{codeType} = $codeTypeDescription; diff --git a/t/db_dependent/Circulation/CanItemBeTransferred.t b/t/db_dependent/Circulation/CanItemBeTransferred.t new file mode 100644 index 0000000..a74b074 --- /dev/null +++ b/t/db_dependent/Circulation/CanItemBeTransferred.t @@ -0,0 +1,262 @@ +use Modern::Perl; +use Test::More tests => 20; + +use C4::Circulation; +use C4::Context; +use C4::Record; + +my $dbh = C4::Context->dbh; +$dbh->{AutoCommit} = 0; +$dbh->{RaiseError} = 1; + +my $originalBranchTransferLimitsType = C4::Context->preference('BranchTransferLimitsType'); + +### Preparing our tests we want to run ### +sub runTestsForCCode { + my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_; + + 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." ); +} + + +sub runTestsForItype { + my ($itemCPLFull, $itemCPLLite, $biblioitem) = @_; + + 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" ); + + $result = C4::Circulation::CanItemBeTransferred( 'IPT', undef, $itemCPLLite, undef ); + is ( $result, 'CPL->IPT->BK', "Failing branch transfer, using minimum parameters, itemtype is pulled from Biblio" ); +} +### 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} ); + + +runTestsForCCode($itemCPLFull, $itemCPLLite, $biblioitem); + + + +### ccode tested +### 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 ); + +## Ready to start testing itemtype use-case ## + +$itemCPLFull = C4::Items::GetItem($itemCPLFullId); +$itemCPLLite = C4::Items::GetItem($itemCPLLiteId); +$biblioitem = C4::Biblio::GetBiblioFromItemNumber( $itemCPLFull->{itemnumber} ); + + +runTestsForItype($itemCPLFull, $itemCPLLite, $biblioitem); + +### itemtype tested + +### Reset default preferences +C4::Context->set_preference("BranchTransferLimitsType", $originalBranchTransferLimitsType); + +$dbh->rollback; \ No newline at end of file -- 2.0.0