X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FCirculation.pm;h=999f61776450b60d29b79577cc148e35c08308ad;hb=973f84513f980722c2a5a30e9d7c8dd04f3af0ee;hp=bceee8ba3032fe06e0fdc619983b923a8e79cb08;hpb=6626e8fccad7f8d5d77ea220d8ddc24f0a124756;p=koha_gimpoz diff --git a/C4/Circulation.pm b/C4/Circulation.pm index bceee8ba30..999f617764 100644 --- a/C4/Circulation.pm +++ b/C4/Circulation.pm @@ -1,6 +1,7 @@ package C4::Circulation; # Copyright 2000-2002 Katipo Communications +# copyright 2010 BibLibre # # This file is part of Koha. # @@ -23,7 +24,6 @@ use strict; use C4::Context; use C4::Stats; use C4::Reserves; -use C4::Koha; use C4::Biblio; use C4::Items; use C4::Members; @@ -31,6 +31,7 @@ use C4::Dates; use C4::Calendar; use C4::Accounts; use C4::ItemCirculationAlertPreference; +use C4::Dates qw(format_date); use C4::Message; use C4::Debug; use Date::Calc qw( @@ -41,6 +42,8 @@ use Date::Calc qw( Date_to_Days Day_of_Week Add_Delta_Days + check_date + Delta_Days ); use POSIX qw(strftime); use C4::Branch; # GetBranches @@ -57,8 +60,9 @@ BEGIN { # FIXME subs that should probably be elsewhere push @EXPORT, qw( - &FixOverduesOnReturn &barcodedecode + &LostItem + &ReturnLostItem ); # subs to deal with issuing a book @@ -69,14 +73,13 @@ BEGIN { &AddRenewal &GetRenewCount &GetItemIssue - &GetOpenIssue &GetItemIssues - &GetBorrowerIssues &GetIssuingCharges &GetIssuingRule &GetBranchBorrowerCircRule &GetBranchItemRule &GetBiblioIssues + &GetOpenIssue &AnonymiseIssueHistory ); @@ -96,7 +99,17 @@ BEGIN { &IsBranchTransferAllowed &CreateBranchTransferLimit &DeleteBranchTransferLimits + &TransferSlip ); + + # subs to deal with offline circulation + push @EXPORT, qw( + &GetOfflineOperations + &GetOfflineOperation + &AddOfflineOperation + &DeleteOfflineOperation + &ProcessOfflineOperation + ); } =head1 NAME @@ -117,11 +130,9 @@ Also deals with stocktaking. =head2 barcodedecode -=head3 $str = &barcodedecode($barcode, [$filter]); - -=over 4 + $str = &barcodedecode($barcode, [$filter]); -=item Generic filter function for barcode string. +Generic filter function for barcode string. Called on every circ if the System Pref itemBarcodeInputFilter is set. Will do some manipulation of the barcode for systems that deliver a barcode to circulation.pl that differs from the barcode stored for the item. @@ -132,8 +143,6 @@ The optional $filter argument is to allow for testing or explicit behavior that ignores the System Pref. Valid values are the same as the System Pref options. -=back - =cut # FIXME -- the &decode fcn below should be wrapped into this one. @@ -141,6 +150,7 @@ System Pref options. # sub barcodedecode { my ($barcode, $filter) = @_; + 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') { @@ -159,24 +169,28 @@ sub barcodedecode { # 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 + $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i; + }else{ + $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i; + } + } } return $barcode; # return barcode, modified or not } =head2 decode -=head3 $str = &decode($chunk); + $str = &decode($chunk); -=over 4 - -=item Decodes a segment of a string emitted by a CueCat barcode scanner and +Decodes a segment of a string emitted by a CueCat barcode scanner and returns it. FIXME: Should be replaced with Barcode::Cuecat from CPAN or Javascript based decoding on the client side. -=back - =cut sub decode { @@ -208,7 +222,8 @@ sub decode { =head2 transferbook -($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, $barcode, $ignore_reserves); + ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, + $barcode, $ignore_reserves); Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer. @@ -221,15 +236,17 @@ Otherwise, if an item is reserved, the transfer fails. Returns three values: -=head3 $dotransfer +=over + +=item $dotransfer is true if the transfer was successful. -=head3 $messages +=item $messages is a reference-to-hash which may have any of the following keys: -=over 4 +=over =item C @@ -257,6 +274,8 @@ The item was eligible to be transferred. Barring problems communicating with the =back +=back + =cut sub transferbook { @@ -311,7 +330,7 @@ sub transferbook { # find reserves..... # That'll save a database query. - my ( $resfound, $resrec ) = + my ( $resfound, $resrec, undef ) = CheckReserves( $itemnumber ); if ( $resfound and not $ignoreRs ) { $resrec->{'ResFound'} = $resfound; @@ -415,7 +434,7 @@ sub TooMany { my $max_loans_allowed = $issuing_rule->{'maxissueqty'}; if ($current_loan_count >= $max_loans_allowed) { - return "$current_loan_count / $max_loans_allowed"; + return ($current_loan_count, $max_loans_allowed); } } @@ -443,7 +462,7 @@ sub TooMany { my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty}; if ($current_loan_count >= $max_loans_allowed) { - return "$current_loan_count / $max_loans_allowed"; + return ($current_loan_count, $max_loans_allowed); } } @@ -561,21 +580,23 @@ sub itemissues { =head2 CanBookBeIssued -Check if a book can be issued. + ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, + $barcode, $duedatespec, $inprocess, $ignore_reserves ); -( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess ); +Check if a book can be issued. C<$issuingimpossible> and C<$needsconfirmation> are some hashref. =over 4 -=item C<$borrower> hash with borrower informations (from GetMemberDetails) +=item C<$borrower> hash with borrower informations (from GetMember or GetMemberDetails) =item C<$barcode> is the bar code of the book being issued. =item C<$duedatespec> is a C4::Dates object. -=item C<$inprocess> +=item C<$inprocess> boolean switch +=item C<$ignore_reserves> boolean switch =back @@ -620,8 +641,8 @@ item withdrawn. item is restricted (set by ??) -C<$needsconfirmation> a reference to a hash. It contains reasons why the loan could be prevented, -but ones that can be overriden by the operator. +C<$needsconfirmation> a reference to a hash. It contains reasons why the loan +could be prevented, but ones that can be overriden by the operator. Possible values are : @@ -643,7 +664,7 @@ reserved for someone else. =head3 INVALID_DATE -sticky due date is invalid +sticky due date is invalid or due date in the past =head3 TOO_MANY @@ -652,7 +673,7 @@ if the borrower borrows to much things =cut sub CanBookBeIssued { - my ( $borrower, $barcode, $duedate, $inprocess ) = @_; + my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves ) = @_; my %needsconfirmation; # filled with problems that needs confirmations my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE my $item = GetItem(GetItemnumberFromBarcode( $barcode )); @@ -675,13 +696,17 @@ sub CanBookBeIssued { my $branch = _GetCircControlBranch($item,$borrower); my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'}; - my $loanlength = GetLoanLength( $borrower->{'categorycode'}, $itype, $branch ); - $duedate = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $loanlength, $branch, $borrower ); + $duedate = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $itype, $branch, $borrower ); # Offline circ calls AddIssue directly, doesn't run through here # So issuingimpossible should be ok. } - $issuingimpossible{INVALID_DATE} = $duedate->output('syspref') unless ( $duedate && $duedate->output('iso') ge C4::Dates->today('iso') ); + if ($duedate) { + $needsconfirmation{INVALID_DATE} = $duedate->output('syspref') + unless $duedate->output('iso') ge C4::Dates->today('iso'); + } else { + $issuingimpossible{INVALID_DATE} = $duedate->output('syspref'); + } # # BORROWER STATUS @@ -717,17 +742,24 @@ sub CanBookBeIssued { # DEBTS my ($amount) = C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->output('iso') ); + my $amountlimit = C4::Context->preference("noissuescharge"); + my $allowfineoverride = C4::Context->preference("AllowFineOverride"); + my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride"); if ( C4::Context->preference("IssuingInProcess") ) { - my $amountlimit = C4::Context->preference("noissuescharge"); - if ( $amount > $amountlimit && !$inprocess ) { + if ( $amount > $amountlimit && !$inprocess && !$allowfineoverride) { $issuingimpossible{DEBT} = sprintf( "%.2f", $amount ); - } - elsif ( $amount > 0 && $amount <= $amountlimit && !$inprocess ) { + } elsif ( $amount > $amountlimit && !$inprocess && $allowfineoverride) { + $needsconfirmation{DEBT} = sprintf( "%.2f", $amount ); + } elsif ( $allfinesneedoverride && $amount > 0 && $amount <= $amountlimit && !$inprocess ) { $needsconfirmation{DEBT} = sprintf( "%.2f", $amount ); } } else { - if ( $amount > 0 ) { + if ( $amount > $amountlimit && $allowfineoverride ) { + $needsconfirmation{DEBT} = sprintf( "%.2f", $amount ); + } elsif ( $amount > $amountlimit && !$allowfineoverride) { + $issuingimpossible{DEBT} = sprintf( "%.2f", $amount ); + } elsif ( $amount > 0 && $allfinesneedoverride ) { $needsconfirmation{DEBT} = sprintf( "%.2f", $amount ); } } @@ -749,12 +781,16 @@ sub CanBookBeIssued { # # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS # - my $toomany = TooMany( $borrower, $item->{biblionumber}, $item ); - # if TooMany return / 0, then the user has no permission to check out this book - if ($toomany =~ /\/ 0/) { + 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 ($max_loans_allowed eq 0) { $needsconfirmation{PATRON_CANT} = 1; } else { - $needsconfirmation{TOO_MANY} = $toomany if $toomany; + if($max_loans_allowed){ + $needsconfirmation{TOO_MANY} = 1; + $needsconfirmation{current_loan_count} = $current_loan_count; + $needsconfirmation{max_loans_allowed} = $max_loans_allowed; + } } # @@ -793,7 +829,7 @@ sub CanBookBeIssued { } } } - if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 ) + if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} > 0 ) { $issuingimpossible{WTHDRAWN} = 1; } @@ -834,45 +870,61 @@ sub CanBookBeIssued { elsif ($issue->{borrowernumber}) { # issued to someone else - my $currborinfo = C4::Members::GetMemberDetails( $issue->{borrowernumber} ); + my $currborinfo = C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} ); # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})"; - $needsconfirmation{ISSUED_TO_ANOTHER} = -"$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})"; - } - - # See if the item is on reserve. - my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} ); - if ($restype) { - my $resbor = $res->{'borrowernumber'}; - my ( $resborrower ) = C4::Members::GetMemberDetails( $resbor, 0 ); - my $branches = GetBranches(); - my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'}; - if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" ) - { - # The item is on reserve and waiting, but has been - # reserved by some other patron. - $needsconfirmation{RESERVE_WAITING} = -"$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)"; - } - elsif ( $restype eq "Reserved" ) { - # The item is on reserve for someone else. - $needsconfirmation{RESERVED} = -"$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})"; + $needsconfirmation{ISSUED_TO_ANOTHER} = 1; + $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'}; + $needsconfirmation{issued_surname} = $currborinfo->{'surname'}; + $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'}; + $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'}; + } + + unless ( $ignore_reserves ) { + # See if the item is on reserve. + my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} ); + if ($restype) { + my $resbor = $res->{'borrowernumber'}; + if ( $resbor ne $borrower->{'borrowernumber'} ) { + my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor ); + my $branchname = GetBranchName( $res->{'branchcode'} ); + if ( $restype eq "Waiting" ) + { + # The item is on reserve and waiting, but has been + # reserved by some other patron. + $needsconfirmation{RESERVE_WAITING} = 1; + $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'}; + $needsconfirmation{'ressurname'} = $resborrower->{'surname'}; + $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'}; + $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'}; + $needsconfirmation{'resbranchname'} = $branchname; + $needsconfirmation{'reswaitingdate'} = format_date($res->{'waitingdate'}); + } + elsif ( $restype eq "Reserved" ) { + # The item is on reserve for someone else. + $needsconfirmation{RESERVED} = 1; + $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'}; + $needsconfirmation{'ressurname'} = $resborrower->{'surname'}; + $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'}; + $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'}; + $needsconfirmation{'resbranchname'} = $branchname; + $needsconfirmation{'resreservedate'} = format_date($res->{'reservedate'}); + } + } } } - return ( \%issuingimpossible, \%needsconfirmation ); + return ( \%issuingimpossible, \%needsconfirmation ); } =head2 AddIssue -Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed. + &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate]) -&AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate]) +Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed. =over 4 -=item C<$borrower> is a hash with borrower informations (from GetMemberDetails). +=item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails). =item C<$barcode> is the barcode of the item being issued. @@ -906,7 +958,6 @@ sub AddIssue { my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_; my $dbh = C4::Context->dbh; my $barcodecheck=CheckValidBarcode($barcode); - # $issuedate defaults to today. if ( ! defined $issuedate ) { $issuedate = strftime( "%Y-%m-%d", localtime ); @@ -947,39 +998,7 @@ sub AddIssue { ); } - # See if the item is on reserve. - my ( $restype, $res ) = - C4::Reserves::CheckReserves( $item->{'itemnumber'} ); - if ($restype) { - my $resbor = $res->{'borrowernumber'}; - if ( $resbor eq $borrower->{'borrowernumber'} ) { - # The item is reserved by the current patron - ModReserveFill($res); - } - elsif ( $restype eq "Waiting" ) { - # warn "Waiting"; - # The item is on reserve and waiting, but has been - # reserved by some other patron. - } - elsif ( $restype eq "Reserved" ) { - # warn "Reserved"; - # The item is reserved by someone else. - if ($cancelreserve) { # cancel reserves on this item - CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); - } - } - if ($cancelreserve) { - CancelReserve($res->{'biblionumber'}, 0, $res->{'borrowernumber'}); - } - else { - # set waiting reserve to first in reserve queue as book isn't waiting now - ModReserve(1, - $res->{'biblionumber'}, - $res->{'borrowernumber'}, - $res->{'branchcode'} - ); - } - } + MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve ); # Starting process for transfer job (checking transfert and validate it if we have one) my ($datesent) = GetTransfers($item->{'itemnumber'}); @@ -1005,8 +1024,7 @@ sub AddIssue { ); unless ($datedue) { my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'}; - my $loanlength = GetLoanLength( $borrower->{'categorycode'}, $itype, $branch ); - $datedue = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $loanlength, $branch, $borrower ); + $datedue = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $itype, $branch, $borrower ); } $sth->execute( @@ -1021,6 +1039,12 @@ sub AddIssue { CartToShelf( $item->{'itemnumber'} ); } $item->{'issues'}++; + + ## If item was lost, it has now been found, reverse any list item charges if neccessary. + if ( $item->{'itemlost'} ) { + _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef, $item->{'barcode'} ); + } + ModItem({ issues => $item->{'issues'}, holdingbranch => C4::Context->userenv->{'branch'}, itemlost => 0, @@ -1076,9 +1100,9 @@ sub AddIssue { =head2 GetLoanLength -Get loan length for an itemtype, a borrower type and a branch + my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode) -my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode) +Get loan length for an itemtype, a borrower type and a branch =cut @@ -1136,8 +1160,70 @@ sub GetLoanLength { return 21; } + +=head2 GetHardDueDate + + my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode) + +Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch + +=cut + +sub GetHardDueDate { + my ( $borrowertype, $itemtype, $branchcode ) = @_; + my $dbh = C4::Context->dbh; + my $sth = + $dbh->prepare( +"select hardduedate, hardduedatecompare from issuingrules where categorycode=? and itemtype=? and branchcode=?" + ); + $sth->execute( $borrowertype, $itemtype, $branchcode ); + my $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + $sth->execute( $borrowertype, "*", $branchcode ); + $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + $sth->execute( "*", $itemtype, $branchcode ); + $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + $sth->execute( "*", "*", $branchcode ); + $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + $sth->execute( $borrowertype, $itemtype, "*" ); + $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + $sth->execute( $borrowertype, "*", "*" ); + $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + $sth->execute( "*", $itemtype, "*" ); + $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + $sth->execute( "*", "*", "*" ); + $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + # if no rule is set => return undefined + return (undef, undef); +} + =head2 GetIssuingRule + my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode) + FIXME - This is a copy-paste of GetLoanLength as a stop-gap. Do not wish to change API for GetLoanLength this close to release, however, Overdues::GetIssuingRules is broken. @@ -1145,8 +1231,6 @@ this close to release, however, Overdues::GetIssuingRules is broken. Get the issuing rule for an itemtype, a borrower type and a branch Returns a hashref from the issuingrules table. -my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode) - =cut sub GetIssuingRule { @@ -1193,11 +1277,7 @@ sub GetIssuingRule { =head2 GetBranchBorrowerCircRule -=over 4 - -my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode); - -=back + my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode); Retrieves circulation rule attributes that apply to the given branch and patron category, regardless of item type. @@ -1280,11 +1360,7 @@ sub GetBranchBorrowerCircRule { =head2 GetBranchItemRule -=over 4 - -my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype); - -=back + my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype); Retrieves circulation rule attributes that apply to the given branch and item type, regardless of patron category. @@ -1344,8 +1420,8 @@ sub GetBranchItemRule { =head2 AddReturn -($doreturn, $messages, $iteminformation, $borrower) = - &AddReturn($barcode, $branch, $exemptfine, $dropbox); + ($doreturn, $messages, $iteminformation, $borrower) = + &AddReturn($barcode, $branch, $exemptfine, $dropbox); Returns a book. @@ -1428,7 +1504,8 @@ sub AddReturn { my $biblio; my $doreturn = 1; my $validTransfert = 0; - + my $stat_type = 'return'; + # get information on item my $itemnumber = GetItemnumberFromBarcode( $barcode ); unless ($itemnumber) { @@ -1445,12 +1522,18 @@ sub AddReturn { # even though item is not on loan, it may still be transferred; therefore, get current branch info $doreturn = 0; # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later. + # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on + if (C4::Context->preference("RecordLocalUseOnReturn")) { + $messages->{'LocalUse'} = 1; + $stat_type = 'localuse'; + } } my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed"; # full item data, but no borrowernumber or checkout info (no issue) # we know GetItem should work because GetItemnumberFromBarcode worked - my $hbr = $item->{C4::Context->preference("HomeOrHoldingBranch")} || ''; + my $hbr = C4::Context->preference("HomeOrHoldingBranchReturn") || "homebranch"; + $hbr = $item->{$hbr} || ''; # item must be from items table -- issues table has branchcode and issuingbranch, not homebranch nor holdingbranch my $borrowernumber = $borrower->{'borrowernumber'} || undef; # we don't know if we had a borrower or not @@ -1494,7 +1577,7 @@ sub AddReturn { } if ($borrowernumber) { - MarkIssueReturned($borrowernumber, $item->{'itemnumber'}, $circControlBranch); + MarkIssueReturned($borrowernumber, $item->{'itemnumber'}, $circControlBranch, '', $borrower->{'privacy'}); $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right? This could be the borrower hash. } @@ -1538,11 +1621,15 @@ sub AddReturn { if ($borrowernumber) { my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox); defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined + + # fix fine days + my $debardate = _FixFineDaysOnReturn( $borrower, $item, $issue->{date_due} ); + $messages->{'Debarred'} = $debardate if ($debardate); } # find reserves..... # if we don't have a reserve with the status W, we launch the Checkreserves routine - my ($resfound, $resrec) = C4::Reserves::CheckReserves( $item->{'itemnumber'} ); + my ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'} ); if ($resfound) { $resrec->{'ResFound'} = $resfound; $messages->{'ResFound'} = $resrec; @@ -1551,7 +1638,7 @@ sub AddReturn { # update stats? # Record the fact that this book was returned. UpdateStats( - $branch, 'return', '0', '', + $branch, $stat_type, '0', '', $item->{'itemnumber'}, $biblio->{'itemtype'}, $borrowernumber @@ -1581,7 +1668,7 @@ sub AddReturn { #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch . - if ($doreturn and ($branch ne $hbr) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) ){ + if (($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $hbr) and not $messages->{'WrongTransfer'}){ if ( C4::Context->preference("AutomaticItemReturn" ) or (C4::Context->preference("UseBranchTransferLimits") and ! IsBranchTransferAllowed($branch, $hbr, $item->{C4::Context->preference("BranchTransferLimitsType")} ) @@ -1599,11 +1686,7 @@ sub AddReturn { =head2 MarkIssueReturned -=over 4 - -MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate); - -=back + MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy); Unconditionally marks an issue as being returned by moving the C row to C and @@ -1615,6 +1698,9 @@ it's safe to do this, i.e. last non-holiday > issuedate. if C<$returndate> is specified (in iso format), it is used as the date of the return. It is ignored when a dropbox_branch is passed in. +C<$privacy> contains the privacy parameter. If the patron has set privacy to 2, +the old_issue is immediately anonymised + Ideally, this function would be internal to C, not exported, but it is currently needed by one routine in C. @@ -1622,7 +1708,7 @@ routine in C. =cut sub MarkIssueReturned { - my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate ) = @_; + my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_; my $dbh = C4::Context->dbh; my $query = "UPDATE issues SET returndate="; my @bind; @@ -1646,15 +1732,80 @@ sub MarkIssueReturned { WHERE borrowernumber = ? AND itemnumber = ?"); $sth_copy->execute($borrowernumber, $itemnumber); + # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber + if ( $privacy == 2) { + # The default of 0 does not work due to foreign key constraints + # The anonymisation will fail quietly if AnonymousPatron is not a valid entry + my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0; + my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=? + WHERE borrowernumber = ? + AND itemnumber = ?"); + $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber); + } my $sth_del = $dbh->prepare("DELETE FROM issues WHERE borrowernumber = ? AND itemnumber = ?"); $sth_del->execute($borrowernumber, $itemnumber); } +=head2 _FixFineDaysOnReturn + + &_FixFineDaysOnReturn($borrower, $item, $datedue); + +C<$borrower> borrower hashref + +C<$item> item hashref + +C<$datedue> date due + +Internal function, called only by AddReturn that calculate and update the user fine days, and debars him + +=cut + +sub _FixFineDaysOnReturn { + my ( $borrower, $item, $datedue ) = @_; + + if ($datedue) { + $datedue = C4::Dates->new( $datedue, "iso" ); + } else { + return; + } + + my $branchcode = _GetCircControlBranch( $item, $borrower ); + my $calendar = C4::Calendar->new( branchcode => $branchcode ); + my $today = C4::Dates->new(); + + my $deltadays = $calendar->daysBetween( $datedue, C4::Dates->new() ); + + my $circcontrol = C4::Context::preference('CircControl'); + my $issuingrule = GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode ); + my $finedays = $issuingrule->{finedays}; + + # exit if no finedays defined + return unless $finedays; + my $grace = $issuingrule->{firstremind}; + + if ( $deltadays - $grace > 0 ) { + my @newdate = Add_Delta_Days( Today(), $deltadays * $finedays ); + my $isonewdate = join( '-', @newdate ); + my ( $deby, $debm, $debd ) = split( /-/, $borrower->{debarred} ); + if ( check_date( $deby, $debm, $debd ) ) { + my @olddate = split( /-/, $borrower->{debarred} ); + + if ( Delta_Days( @olddate, @newdate ) > 0 ) { + C4::Members::DebarMember( $borrower->{borrowernumber}, $isonewdate ); + return $isonewdate; + } + } else { + C4::Members::DebarMember( $borrower->{borrowernumber}, $isonewdate ); + return $isonewdate; + } + } +} + =head2 _FixOverduesOnReturn - &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode); + &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode); C<$brn> borrowernumber @@ -1718,7 +1869,7 @@ sub _FixOverduesOnReturn { =head2 _FixAccountForLostAndReturned - &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]); + &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]); Calculates the charge for a book lost and returned. @@ -1735,10 +1886,11 @@ sub _FixAccountForLostAndReturned { my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description my $dbh = C4::Context->dbh; # check for charge made for lost book - my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC"); + my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC"); $sth->execute($itemnumber); my $data = $sth->fetchrow_hashref; $data or return; # bail if there is nothing to do + $data->{accounttype} eq 'W' and return; # Written off # writeoff this amount my $offset; @@ -1826,7 +1978,7 @@ sub _GetCircControlBranch { my $circcontrol = C4::Context->preference('CircControl'); my $branch; - if ($circcontrol eq 'PickupLibrary') { + if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) { $branch= C4::Context->userenv->{'branch'}; } elsif ($circcontrol eq 'PatronLibrary') { $branch=$borrower->{branchcode}; @@ -1849,7 +2001,7 @@ sub _GetCircControlBranch { =head2 GetItemIssue -$issue = &GetItemIssue($itemnumber); + $issue = &GetItemIssue($itemnumber); Returns patron currently having a book, or undef if not checked out. @@ -1876,7 +2028,7 @@ sub GetItemIssue { =head2 GetOpenIssue -$issue = GetOpenIssue( $itemnumber ); + $issue = GetOpenIssue( $itemnumber ); Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued @@ -1898,7 +2050,7 @@ sub GetOpenIssue { =head2 GetItemIssues -$issues = &GetItemIssues($itemnumber, $history); + $issues = &GetItemIssues($itemnumber, $history); Returns patrons that have issued a book @@ -1941,7 +2093,7 @@ sub GetItemIssues { =head2 GetBiblioIssues -$issues = GetBiblioIssues($biblionumber); + $issues = GetBiblioIssues($biblionumber); this function get all issues from a biblionumber. @@ -1985,11 +2137,7 @@ sub GetBiblioIssues { =head2 GetUpcomingDueIssues -=over 4 - -my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } ); - -=back + my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } ); =cut @@ -2000,9 +2148,10 @@ sub GetUpcomingDueIssues { my $dbh = C4::Context->dbh; my $statement = <{'categorycode'}, - (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} , - $issuedata->{'branchcode'} ); # that's the circ control branch. + my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return undef; + my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'}; $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ? C4::Dates->new($issuedata->{date_due}, 'iso') : C4::Dates->new(); - $datedue = CalcDateDue($datedue,$loanlength,$issuedata->{'branchcode'},$borrower); + $datedue = CalcDateDue($datedue,$itemtype,$issuedata->{'branchcode'},$borrower); } # Update the issues record to have the new due date, and a new count @@ -2192,16 +2338,15 @@ sub AddRenewal { if ( $charge > 0 ) { my $accountno = getnextacctno( $borrowernumber ); my $item = GetBiblioFromItemNumber($itemnumber); + my $manager_id = 0; + $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; $sth = $dbh->prepare( "INSERT INTO accountlines - (date, - borrowernumber, accountno, amount, - description, - accounttype, amountoutstanding, itemnumber - ) - VALUES (now(),?,?,?,?,?,?,?)" + (date, borrowernumber, accountno, amount, manager_id, + description,accounttype, amountoutstanding, itemnumber) + VALUES (now(),?,?,?,?,?,?,?,?)" ); - $sth->execute( $borrowernumber, $accountno, $charge, + $sth->execute( $borrowernumber, $accountno, $charge, $manager_id, "Renewal of Rental Item $item->{'title'} $item->{'barcode'}", 'Rent', $charge, $itemnumber ); $sth->finish; @@ -2219,7 +2364,7 @@ sub GetRenewCount { my $renewsallowed = 0; my $renewsleft = 0; - my $borrower = C4::Members::GetMemberDetails($bornum); + my $borrower = C4::Members::GetMember( borrowernumber => $bornum); my $item = GetItem($itemno); # Look in the issues table for this item, lent to this borrower, @@ -2242,12 +2387,13 @@ sub GetRenewCount { $renewsallowed = $issuingrule->{'renewalsallowed'}; $renewsleft = $renewsallowed - $renewcount; + if($renewsleft < 0){ $renewsleft = 0; } return ( $renewcount, $renewsallowed, $renewsleft ); } =head2 GetIssuingCharges -($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber); + ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber); Calculate how much it would cost for a given patron to borrow a given item, including any applicable discounts. @@ -2271,42 +2417,81 @@ sub GetIssuingCharges { my $item_type; # Get the book's item type and rental charge (via its biblioitem). - my $qcharge = "SELECT itemtypes.itemtype,rentalcharge FROM items - LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber"; - $qcharge .= (C4::Context->preference('item-level_itypes')) - ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype " - : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype "; - - $qcharge .= "WHERE items.itemnumber =?"; - - my $sth1 = $dbh->prepare($qcharge); - $sth1->execute($itemnumber); - if ( my $data1 = $sth1->fetchrow_hashref ) { - $item_type = $data1->{'itemtype'}; - $charge = $data1->{'rentalcharge'}; - my $q2 = "SELECT rentaldiscount FROM borrowers + my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items + LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber'; + $charge_query .= (C4::Context->preference('item-level_itypes')) + ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype' + : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype'; + + $charge_query .= ' WHERE items.itemnumber =?'; + + my $sth = $dbh->prepare($charge_query); + $sth->execute($itemnumber); + if ( my $item_data = $sth->fetchrow_hashref ) { + $item_type = $item_data->{itemtype}; + $charge = $item_data->{rentalcharge}; + my $branch = C4::Branch::mybranch(); + my $discount_query = q|SELECT rentaldiscount, + issuingrules.itemtype, issuingrules.branchcode + FROM borrowers LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode WHERE borrowers.borrowernumber = ? - AND issuingrules.itemtype = ?"; - my $sth2 = $dbh->prepare($q2); - $sth2->execute( $borrowernumber, $item_type ); - if ( my $data2 = $sth2->fetchrow_hashref ) { - my $discount = $data2->{'rentaldiscount'}; - if ( $discount eq 'NULL' ) { - $discount = 0; - } + AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*') + AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|; + my $discount_sth = $dbh->prepare($discount_query); + $discount_sth->execute( $borrowernumber, $item_type, $branch ); + my $discount_rules = $discount_sth->fetchall_arrayref({}); + if (@{$discount_rules}) { + # We may have multiple rules so get the most specific + my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type); $charge = ( $charge * ( 100 - $discount ) ) / 100; } - $sth2->finish; } - $sth1->finish; + $sth->finish; # we havent _explicitly_ fetched all rows return ( $charge, $item_type ); } +# Select most appropriate discount rule from those returned +sub _get_discount_from_rule { + my ($rules_ref, $branch, $itemtype) = @_; + my $discount; + + if (@{$rules_ref} == 1) { # only 1 applicable rule use it + $discount = $rules_ref->[0]->{rentaldiscount}; + return (defined $discount) ? $discount : 0; + } + # could have up to 4 does one match $branch and $itemtype + my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref}; + if (@d) { + $discount = $d[0]->{rentaldiscount}; + return (defined $discount) ? $discount : 0; + } + # do we have item type + all branches + @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref}; + if (@d) { + $discount = $d[0]->{rentaldiscount}; + return (defined $discount) ? $discount : 0; + } + # do we all item types + this branch + @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref}; + if (@d) { + $discount = $d[0]->{rentaldiscount}; + return (defined $discount) ? $discount : 0; + } + # so all and all (surely we wont get here) + @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref}; + if (@d) { + $discount = $d[0]->{rentaldiscount}; + return (defined $discount) ? $discount : 0; + } + # none of the above + return 0; +} + =head2 AddIssuingCharge -&AddIssuingCharge( $itemno, $borrowernumber, $charge ) + &AddIssuingCharge( $itemno, $borrowernumber, $charge ) =cut @@ -2314,21 +2499,23 @@ sub AddIssuingCharge { my ( $itemnumber, $borrowernumber, $charge ) = @_; my $dbh = C4::Context->dbh; my $nextaccntno = getnextacctno( $borrowernumber ); + my $manager_id = 0; + $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv; my $query =" INSERT INTO accountlines (borrowernumber, itemnumber, accountno, date, amount, description, accounttype, - amountoutstanding) - VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?) + amountoutstanding, manager_id) + VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?) "; my $sth = $dbh->prepare($query); - $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge ); + $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id ); $sth->finish; } =head2 GetTransfers -GetTransfers($itemnumber); + GetTransfers($itemnumber); =cut @@ -2354,7 +2541,7 @@ sub GetTransfers { =head2 GetTransfersFromTo -@results = GetTransfersFromTo($frombranch,$tobranch); + @results = GetTransfersFromTo($frombranch,$tobranch); Returns the list of pending transfers between $from and $to branch @@ -2384,7 +2571,7 @@ sub GetTransfersFromTo { =head2 DeleteTransfer -&DeleteTransfer($itemnumber); + &DeleteTransfer($itemnumber); =cut @@ -2402,11 +2589,14 @@ sub DeleteTransfer { =head2 AnonymiseIssueHistory -$rows = AnonymiseIssueHistory($borrowernumber,$date) + $rows = AnonymiseIssueHistory($date,$borrowernumber) This function write NULL instead of C<$borrowernumber> given on input arg into the table issues. if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>. +If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy +setting (force delete). + return the number of affected rows. =cut @@ -2417,12 +2607,24 @@ sub AnonymiseIssueHistory { my $dbh = C4::Context->dbh; my $query = " UPDATE old_issues - SET borrowernumber = NULL - WHERE returndate < '".$date."' + SET borrowernumber = ? + WHERE returndate < ? AND borrowernumber IS NOT NULL "; - $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber; - my $rows_affected = $dbh->do($query); + + # The default of 0 does not work due to foreign key constraints + # The anonymisation will fail quietly if AnonymousPatron is not a valid entry + my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0; + my @bind_params = ($anonymouspatron, $date); + if (defined $borrowernumber) { + $query .= " AND borrowernumber = ?"; + push @bind_params, $borrowernumber; + } else { + $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0"; + } + my $sth = $dbh->prepare($query); + $sth->execute(@bind_params); + my $rows_affected = $sth->rows; ### doublecheck row count return function return $rows_affected; } @@ -2468,18 +2670,25 @@ sub SendCirculationAlert { my ($type, $item, $borrower, $branch) = ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch}); my %message_name = ( - CHECKIN => 'Item Check-in', - CHECKOUT => 'Item Checkout', + CHECKIN => 'Item_Check_in', + CHECKOUT => 'Item_Checkout', ); my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({ borrowernumber => $borrower->{borrowernumber}, message_name => $message_name{$type}, }); - my $letter = C4::Letters::getletter('circulation', $type); - C4::Letters::parseletter($letter, 'biblio', $item->{biblionumber}); - C4::Letters::parseletter($letter, 'biblioitems', $item->{biblionumber}); - C4::Letters::parseletter($letter, 'borrowers', $borrower->{borrowernumber}); - C4::Letters::parseletter($letter, 'branches', $branch); + my $letter = C4::Letters::GetPreparedLetter ( + module => 'circulation', + letter_code => $type, + branchcode => $branch, + tables => { + 'biblio' => $item->{biblionumber}, + 'biblioitems' => $item->{biblionumber}, + 'borrowers' => $borrower, + 'branches' => $branch, + } + ) or return; + my @transports = @{ $borrower_preferences->{transports} }; # warn "no transports" unless @transports; for (@transports) { @@ -2494,12 +2703,13 @@ sub SendCirculationAlert { $message->update; } } - $letter; + + return $letter; } =head2 updateWrongTransfer -$items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary); + $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary); This function validate the line of brachtransfer but with the wrong destination (mistake from a librarian ...), and create a new line in branchtransfer from the actual library to the original library of reservation @@ -2525,7 +2735,8 @@ sub updateWrongTransfer { =head2 UpdateHoldingbranch -$items = UpdateHoldingbranch($branch,$itmenumber); + $items = UpdateHoldingbranch($branch,$itmenumber); + Simple methode for updating hodlingbranch in items BDD line =cut @@ -2537,26 +2748,53 @@ sub UpdateHoldingbranch { =head2 CalcDateDue -$newdatedue = CalcDateDue($startdate,$loanlength,$branchcode); -this function calculates the due date given the loan length , +$newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower); + +this function calculates the due date given the start date and configured circulation rules, checking against the holidays calendar as per the 'useDaysMode' syspref. C<$startdate> = C4::Dates object representing start date of loan period (assumed to be today) +C<$itemtype> = itemtype code of item in question C<$branch> = location whose calendar to use -C<$loanlength> = loan length prior to adjustment +C<$borrower> = Borrower object + =cut sub CalcDateDue { - my ($startdate,$loanlength,$branch,$borrower) = @_; + my ($startdate,$itemtype,$branch,$borrower) = @_; my $datedue; + my $loanlength = GetLoanLength($borrower->{'categorycode'},$itemtype, $branch); - if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar - my $timedue = time + ($loanlength) * 86400; - #FIXME - assumes now even though we take a startdate - my @datearr = localtime($timedue); - $datedue = C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso'); + # if globalDueDate ON the datedue is set to that date + if ( C4::Context->preference('globalDueDate') + && ( C4::Context->preference('globalDueDate') =~ C4::Dates->regexp('syspref') ) ) { + $datedue = C4::Dates->new( C4::Context->preference('globalDueDate') ); } else { - my $calendar = C4::Calendar->new( branchcode => $branch ); - $datedue = $calendar->addDate($startdate, $loanlength); + # otherwise, calculate the datedue as normal + if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar + my $timedue = time + ($loanlength) * 86400; + #FIXME - assumes now even though we take a startdate + my @datearr = localtime($timedue); + $datedue = C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso'); + } else { + my $calendar = C4::Calendar->new( branchcode => $branch ); + $datedue = $calendar->addDate($startdate, $loanlength); + } + } + + # if Hard Due Dates are used, retreive them and apply as necessary + my ($hardduedate, $hardduedatecompare) = GetHardDueDate($borrower->{'categorycode'},$itemtype, $branch); + if ( $hardduedate && $hardduedate->output('iso') && $hardduedate->output('iso') ne '0000-00-00') { + # if the calculated due date is after the 'before' Hard Due Date (ceiling), override + if ( $datedue->output( 'iso' ) gt $hardduedate->output( 'iso' ) && $hardduedatecompare == -1) { + $datedue = $hardduedate; + # if the calculated date is before the 'after' Hard Due Date (floor), override + } elsif ( $datedue->output( 'iso' ) lt $hardduedate->output( 'iso' ) && $hardduedatecompare == 1) { + $datedue = $hardduedate; + # if the hard due date is set to 'exactly', overrride + } elsif ( $hardduedatecompare == 0) { + $datedue = $hardduedate; + } + # in all other cases, keep the date due as it is } # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate @@ -2564,28 +2802,22 @@ sub CalcDateDue { $datedue = C4::Dates->new( $borrower->{dateexpiry}, 'iso' ); } - # if ceilingDueDate ON the datedue can't be after the ceiling date - if ( C4::Context->preference('ceilingDueDate') - && ( C4::Context->preference('ceilingDueDate') =~ C4::Dates->regexp('syspref') ) ) { - my $ceilingDate = C4::Dates->new( C4::Context->preference('ceilingDueDate') ); - if ( $datedue->output( 'iso' ) gt $ceilingDate->output( 'iso' ) ) { - $datedue = $ceilingDate; - } - } - return $datedue; } =head2 CheckValidDatedue - This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref . - To be replaced by CalcDateDue() once C4::Calendar use is tested. -$newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode); + $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode); + +This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref . +To be replaced by CalcDateDue() once C4::Calendar use is tested. + this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref. C<$date_due> = returndate calculate with no day check C<$itemnumber> = itemnumber C<$branchcode> = location of issue (affected by 'CircControl' syspref) C<$loanlength> = loan length prior to adjustment + =cut sub CheckValidDatedue { @@ -2614,8 +2846,10 @@ return $newdatedue; =head2 CheckRepeatableHolidays -$countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode); -this function checks if the date due is a repeatable holiday + $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode); + +This function checks if the date due is a repeatable holiday + C<$date_due> = returndate calculate with no day check C<$itemnumber> = itemnumber C<$branchcode> = localisation of issue @@ -2639,8 +2873,10 @@ return $result; =head2 CheckSpecialHolidays -$countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode); -this function check if the date is a special holiday + $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode); + +This function check if the date is a special holiday + C<$years> = the years of datedue C<$month> = the month of datedue C<$day> = the day of datedue @@ -2668,8 +2904,10 @@ return $countspecial; =head2 CheckRepeatableSpecialHolidays -$countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode); -this function check if the date is a repeatble special holidays + $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode); + +This function check if the date is a repeatble special holidays + C<$month> = the month of datedue C<$day> = the day of datedue C<$itemnumber> = itemnumber @@ -2711,7 +2949,7 @@ return $exist; =head2 IsBranchTransferAllowed -$allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code ); + $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code ); Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType @@ -2739,7 +2977,7 @@ sub IsBranchTransferAllowed { =head2 CreateBranchTransferLimit -CreateBranchTransferLimit( $toBranch, $fromBranch, $code ); + CreateBranchTransferLimit( $toBranch, $fromBranch, $code ); $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to. @@ -2758,24 +2996,202 @@ sub CreateBranchTransferLimit { =head2 DeleteBranchTransferLimits -DeleteBranchTransferLimits(); +DeleteBranchTransferLimits($frombranch); + +Deletes all the branch transfer limits for one branch =cut sub DeleteBranchTransferLimits { - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("TRUNCATE TABLE branch_transfer_limits"); - $sth->execute(); + my $branch = shift; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?"); + $sth->execute($branch); +} + +sub ReturnLostItem{ + my ( $borrowernumber, $itemnum ) = @_; + + MarkIssueReturned( $borrowernumber, $itemnum ); + my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber ); + my @datearr = localtime(time); + my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3]; + my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}"; + ModItem({ paidfor => "Paid for by $bor $date" }, undef, $itemnum); +} + + +sub LostItem{ + my ($itemnumber, $mark_returned, $charge_fee) = @_; + + my $dbh = C4::Context->dbh(); + my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title + FROM issues + JOIN items USING (itemnumber) + JOIN biblio USING (biblionumber) + WHERE issues.itemnumber=?"); + $sth->execute($itemnumber); + my $issues=$sth->fetchrow_hashref(); + $sth->finish; + + # if a borrower lost the item, add a replacement cost to the their record + if ( my $borrowernumber = $issues->{borrowernumber} ){ + + C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}") + if $charge_fee; + #FIXME : Should probably have a way to distinguish this from an item that really was returned. + #warn " $issues->{'borrowernumber'} / $itemnumber "; + MarkIssueReturned($borrowernumber,$itemnumber) if $mark_returned; + } +} + +sub GetOfflineOperations { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp"); + $sth->execute(C4::Context->userenv->{'branch'}); + my $results = $sth->fetchall_arrayref({}); + $sth->finish; + return $results; +} + +sub GetOfflineOperation { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?"); + $sth->execute( shift ); + my $result = $sth->fetchrow_hashref; + $sth->finish; + return $result; +} + +sub AddOfflineOperation { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber) VALUES(?,?,?,?,?,?)"); + $sth->execute( @_ ); + return "Added."; +} + +sub DeleteOfflineOperation { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?"); + $sth->execute( shift ); + return "Deleted."; +} + +sub ProcessOfflineOperation { + my $operation = shift; + + my $report; + if ( $operation->{action} eq 'return' ) { + $report = ProcessOfflineReturn( $operation ); + } elsif ( $operation->{action} eq 'issue' ) { + $report = ProcessOfflineIssue( $operation ); + } + + DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid}; + + return $report; +} + +sub ProcessOfflineReturn { + my $operation = shift; + + my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} ); + + if ( $itemnumber ) { + my $issue = GetOpenIssue( $itemnumber ); + if ( $issue ) { + MarkIssueReturned( + $issue->{borrowernumber}, + $itemnumber, + undef, + $operation->{timestamp}, + ); + ModItem( + { renewals => 0, onloan => undef }, + $issue->{'biblionumber'}, + $itemnumber + ); + return "Success."; + } else { + return "Item not issued."; + } + } else { + return "Item not found."; + } +} + +sub ProcessOfflineIssue { + my $operation = shift; + + my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber + + if ( $borrower->{borrowernumber} ) { + my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} ); + unless ($itemnumber) { + return "Barcode not found."; + } + my $issue = GetOpenIssue( $itemnumber ); + + if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned + MarkIssueReturned( + $issue->{borrowernumber}, + $itemnumber, + undef, + $operation->{timestamp}, + ); + } + AddIssue( + $borrower, + $operation->{'barcode'}, + undef, + 1, + $operation->{timestamp}, + undef, + ); + return "Success."; + } else { + return "Borrower not found."; + } +} + + + +=head2 TransferSlip + + TransferSlip($user_branch, $itemnumber, $to_branch) + + Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef + +=cut + +sub TransferSlip { + my ($branch, $itemnumber, $to_branch) = @_; + + my $item = GetItem( $itemnumber ) + or return; + + my $pulldate = C4::Dates->new(); + + return C4::Letters::GetPreparedLetter ( + module => 'circulation', + letter_code => 'TRANSFERSLIP', + branchcode => $branch, + tables => { + 'branches' => $to_branch, + 'biblio' => $item->{biblionumber}, + 'items' => $item, + }, + ); } - 1; +1; __END__ =head1 AUTHOR -Koha Developement team +Koha Development Team =cut