X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FCirculation.pm;h=6c3a8d4d6610955ed4746c0be6eb13a7171a5c04;hb=1c4125cd0ec8cca40dc23930f0676d94358b9868;hp=864794326560d2010ef007a86f88b3643dcc01e4;hpb=839c97ab30fb0f0113ef3029ad128a06a544721d;p=koha.git diff --git a/C4/Circulation.pm b/C4/Circulation.pm index 8647943265..6c3a8d4d66 100644 --- a/C4/Circulation.pm +++ b/C4/Circulation.pm @@ -44,7 +44,15 @@ use Data::Dumper; use Koha::DateUtils; use Koha::Calendar; use Carp; - +use Date::Calc qw( + Today + Today_and_Now + Add_Delta_YM + Add_Delta_DHMS + Date_to_Days + Day_of_Week + Add_Delta_Days +); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); BEGIN { @@ -724,7 +732,7 @@ sub CanBookBeIssued { # if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) { # 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'}); + &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'}, undef, $item->{'ccode'}); ModDateLastSeen( $item->{'itemnumber'} ); return( { STATS => 1 }, {}); } @@ -941,9 +949,174 @@ sub CanBookBeIssued { } } } + # + # CHECK AGE RESTRICTION + # + + # get $marker from preferences. Could be something like "FSK|PEGI|Alter|Age:" + my $markers = C4::Context->preference('AgeRestrictionMarker' ); + my $bibvalues = $biblioitem->{'agerestriction'}; + if (($markers)&&($bibvalues)) + { + # Split $bibvalues to something like FSK 16 or PEGI 6 + my @values = split ' ', $bibvalues; + + # Search first occurence of one of the markers + my @markers = split /\|/, $markers; + my $index = 0; + my $take = -1; + for my $value (@values) { + $index ++; + for my $marker (@markers) { + $marker =~ s/^\s+//; #remove leading spaces + $marker =~ s/\s+$//; #remove trailing spaces + if (uc($marker) eq uc($value)) { + $take = $index; + last; + } + } + if ($take > -1) { + last; + } + } + # Index points to the next value + my $restrictionyear = 0; + if (($take <= $#values) && ($take >= 0)){ + $restrictionyear += $values[$take]; + } + + if ($restrictionyear > 0) { + if ( $borrower->{'dateofbirth'} ) { + my @alloweddate = split /-/,$borrower->{'dateofbirth'} ; + $alloweddate[0] += $restrictionyear; + #Prevent runime eror on leap year (invalid date) + if (($alloweddate[1] == 2) && ($alloweddate[2] == 29)) { + $alloweddate[2] = 28; + } + + if ( Date_to_Days(Today) < Date_to_Days(@alloweddate) -1 ) { + if (C4::Context->preference('AgeRestrictionOverride' )) { + $needsconfirmation{AGE_RESTRICTION} = "$bibvalues"; + } + else { + $issuingimpossible{AGE_RESTRICTION} = "$bibvalues"; + } + } + } + } + } + +## check for high holds decreasing loan period + my $decrease_loan = C4::Context->preference('decreaseLoanHighHolds'); + if ( $decrease_loan && $decrease_loan == 1 ) { + my ( $reserved, $num, $duration, $returndate ) = + checkHighHolds( $item, $borrower ); + + if ( $num >= C4::Context->preference('decreaseLoanHighHoldsValue') ) { + $needsconfirmation{HIGHHOLDS} = { + num_holds => $num, + duration => $duration, + returndate => output_pref($returndate), + }; + } + } + return ( \%issuingimpossible, \%needsconfirmation, \%alerts ); } +=head2 CanBookBeReturned + + ($returnallowed, $message) = CanBookBeReturned($item, $branch) + +Check whether the item can be returned to the provided branch + +=over 4 + +=item C<$item> is a hash of item information as returned from GetItem + +=item C<$branch> is the branchcode where the return is taking place + +=back + +Returns: + +=over 4 + +=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 + +=back + +=cut + +sub CanBookBeReturned { + my ($item, $branch) = @_; + my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere'; + + # assume return is allowed to start + my $allowed = 1; + 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 + } + + return ($allowed, $message); +} + +=head2 CheckHighHolds + + used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in + decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan + has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date + +=cut + +sub checkHighHolds { + my ( $item, $borrower ) = @_; + my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} ); + my $branch = _GetCircControlBranch( $item, $borrower ); + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( +'select count(borrowernumber) as num_holds from reserves where biblionumber=?' + ); + $sth->execute( $item->{'biblionumber'} ); + my ($holds) = $sth->fetchrow_array; + if ($holds) { + my $issuedate = DateTime->now( time_zone => C4::Context->tz() ); + + my $calendar = Koha::Calendar->new( branchcode => $branch ); + + my $itype = + ( C4::Context->preference('item-level_itypes') ) + ? $biblio->{'itype'} + : $biblio->{'itemtype'}; + my $orig_due = + C4::Circulation::CalcDateDue( $issuedate, $itype, $branch, + $borrower ); + + my $reduced_datedue = + $calendar->addDate( $issuedate, + C4::Context->preference('decreaseLoanHighHoldsDuration') ); + + if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) { + return ( 1, $holds, + C4::Context->preference('decreaseLoanHighHoldsDuration'), + $reduced_datedue ); + } + } + return ( 0, 0, 0, undef ); +} + =head2 AddIssue &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate]) @@ -1001,7 +1174,7 @@ sub AddIssue { } if ($borrower and $barcode and $barcodecheck ne '0'){#??? wtf # find which item we issue - my $item = GetItem('', $barcode) or return undef; # if we don't get an Item, abort. + 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 @@ -1108,7 +1281,7 @@ sub AddIssue { C4::Context->userenv->{'branch'}, 'issue', $charge, ($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'}, - $item->{'itype'}, $borrower->{'borrowernumber'} + $item->{'itype'}, $borrower->{'borrowernumber'}, undef, $item->{'ccode'} ); # Send a checkout slip. @@ -1276,7 +1449,7 @@ sub GetIssuingRule { return $irule if defined($irule) ; # if no rule matches, - return undef; + return; } =head2 GetBranchBorrowerCircRule @@ -1413,7 +1586,8 @@ sub GetBranchItemRule { foreach my $attempt (@attempts) { my ($query, @bind_params) = @{$attempt}; - my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params ); + my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params ) + or next; # Since branch/category and branch/itemtype use the same per-branch # defaults tables, we have to check that the key we want is set, not @@ -1558,29 +1732,25 @@ sub AddReturn { $branches->{$hbr}->{PE} and $messages->{'IsPermanent'} = $hbr; } - # if indy branches and returning to different branch, refuse the return unless canreservefromotherbranches is turned on - if ($hbr ne $branch && C4::Context->preference("IndependantBranches") && !(C4::Context->preference("canreservefromotherbranches"))){ + # check if the return is allowed at this branch + my ($returnallowed, $message) = CanBookBeReturned($item, $branch); + unless ($returnallowed){ $messages->{'Wrongbranch'} = { Wrongbranch => $branch, - Rightbranch => $hbr, + Rightbranch => $message }; $doreturn = 0; - # bailing out here - in this case, current desired behavior - # is to act as if no return ever happened at all. - # FIXME - even in an indy branches situation, there should - # still be an option for the library to accept the item - # and transfer it to its owning library. return ( $doreturn, $messages, $issue, $borrower ); } if ( $item->{'wthdrawn'} ) { # book has been cancelled $messages->{'wthdrawn'} = 1; - $doreturn = 0; + $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems"); } # case of a return of document (deal with issues and holdingbranch) - if ($doreturn) { my $today = DateTime->now( time_zone => C4::Context->tz() ); + if ($doreturn) { my $datedue = $issue->{date_due}; $borrower or warn "AddReturn without current borrower"; my $circControlBranch; @@ -1590,7 +1760,6 @@ sub AddReturn { # FIXME: check issuedate > returndate, factoring in holidays #$circControlBranch = _GetCircControlBranch($item,$borrower) unless ( $item->{'issuedate'} eq C4::Dates->today('iso') );; $circControlBranch = _GetCircControlBranch($item,$borrower); - my $datedue = $issue->{date_due}; $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $today ) == -1 ? 1 : 0; } @@ -1654,14 +1823,18 @@ sub AddReturn { 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); + if ( $issue->{overdue} && $issue->{date_due} ) { +# fix fine days + my $debardate = + _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today ); + $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, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'} ); + my ($resfound, $resrec); + ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'} ) unless ( $item->{'wthdrawn'} ); if ($resfound) { $resrec->{'ResFound'} = $resfound; $messages->{'ResFound'} = $resrec; @@ -1673,7 +1846,7 @@ sub AddReturn { $branch, $stat_type, '0', '', $item->{'itemnumber'}, $biblio->{'itemtype'}, - $borrowernumber + $borrowernumber, undef, $item->{'ccode'} ); # Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then. @@ -1781,26 +1954,27 @@ sub MarkIssueReturned { $sth_del->execute($borrowernumber, $itemnumber); } -=head2 _FixFineDaysOnReturn +=head2 _debar_user_on_return - &_FixFineDaysOnReturn($borrower, $item, $datedue); + _debar_user_on_return($borrower, $item, $datedue, today); C<$borrower> borrower hashref C<$item> item hashref -C<$datedue> date due +C<$datedue> date due DateTime object -Internal function, called only by AddReturn that calculate and update the user fine days, and debars him +C<$today> DateTime object representing the return time + +Internal function, called only by AddReturn that calculates and updates + the user fine days, and debars him if necessary. + +Should only be called for overdue returns =cut -sub _FixFineDaysOnReturn { - my ( $borrower, $item, $datedue ) = @_; - return unless ($datedue); - - my $dt_due = dt_from_string( $datedue ); - my $dt_today = DateTime->now( time_zone => C4::Context->tz() ); +sub _debar_user_on_return { + my ( $borrower, $item, $dt_due, $dt_today ) = @_; my $branchcode = _GetCircControlBranch( $item, $borrower ); my $calendar = Koha::Calendar->new( branchcode => $branchcode ); @@ -1809,35 +1983,41 @@ sub _FixFineDaysOnReturn { my $deltadays = $calendar->days_between( $dt_due, $dt_today ); my $circcontrol = C4::Context::preference('CircControl'); - my $issuingrule = GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode ); - my $finedays = $issuingrule->{finedays}; - my $unit = $issuingrule->{lengthunit}; - - # exit if no finedays defined - return unless $finedays; - # finedays is in days, so hourly loans must multiply by 24 - # thus 1 hour late equals 1 day suspension * finedays rate - $finedays = $finedays * 24 if ($unit eq 'hours'); - - # grace period is measured in the same units as the loan - my $grace = DateTime::Duration->new( $unit => $issuingrule->{firstremind} ); - - if ( ( $deltadays - $grace )->is_positive ) { # you can't compare DateTime::Durations with logical operators - my $new_debar_dt = $dt_today->clone()->add_duration( $deltadays * $finedays ); - my $borrower_debar_dt = dt_from_string( $borrower->{debarred} ); - # check to see if the current debar date is a valid date - if ( $borrower->{debarred} && $borrower_debar_dt ) { - # if so, is it before the new date? update only if true - if ( DateTime->compare( $borrower_debar_dt, $new_debar_dt ) == -1 ) { - C4::Members::DebarMember( $borrower->{borrowernumber}, $new_debar_dt->ymd() ); - return $new_debar_dt->ymd(); + my $issuingrule = + GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode ); + my $finedays = $issuingrule->{finedays}; + my $unit = $issuingrule->{lengthunit}; + + if ($finedays) { + + # finedays is in days, so hourly loans must multiply by 24 + # thus 1 hour late equals 1 day suspension * finedays rate + $finedays = $finedays * 24 if ( $unit eq 'hours' ); + + # grace period is measured in the same units as the loan + my $grace = + DateTime::Duration->new( $unit => $issuingrule->{firstremind} ); + if ( $deltadays->subtract($grace)->is_positive() ) { + + my $new_debar_dt = + $dt_today->clone()->add_duration( $deltadays * $finedays ); + if ( $borrower->{debarred} ) { + my $borrower_debar_dt = dt_from_string( $borrower->{debarred} ); + + # Update patron only if new date > old + if ( DateTime->compare( $borrower_debar_dt, $new_debar_dt ) != + -1 ) + { + return; + } + } - # if the borrower's debar date is not set or valid, debar them - } else { - C4::Members::DebarMember( $borrower->{borrowernumber}, $new_debar_dt->ymd() ); + C4::Members::DebarMember( $borrower->{borrowernumber}, + $new_debar_dt->ymd() ); return $new_debar_dt->ymd(); } } + return; } =head2 _FixOverduesOnReturn @@ -1879,7 +2059,7 @@ sub _FixOverduesOnReturn { return 0 unless $data; # no warning, there's just nothing to fix my $uquery; - my @bind = ($borrowernumber, $item, $data->{'accountno'}); + my @bind = ($data->{'accountlines_id'}); if ($exemptfine) { $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0"; if (C4::Context->preference("FinesLog")) { @@ -1899,7 +2079,7 @@ sub _FixOverduesOnReturn { } else { $uquery = "update accountlines set accounttype='F' "; } - $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)"; + $uquery .= " where (accountlines_id = ?)"; my $usth = $dbh->prepare($uquery); return $usth->execute(@bind); } @@ -1942,9 +2122,8 @@ sub _FixAccountForLostAndReturned { $amountleft = $data->{'amountoutstanding'} - $amount; # Um, isn't this the same as ZERO? We just tested those two things are == } my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0' - WHERE (borrowernumber = ?) - AND (itemnumber = ?) AND (accountno = ?) "); - $usth->execute($data->{'borrowernumber'},$itemnumber,$acctno); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in. + WHERE (accountlines_id = ?)"); + $usth->execute($data->{'accountlines_id'}); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in. #check if any credit is left if so writeoff other accounts my $nextaccntno = getnextacctno($data->{'borrowernumber'}); $amountleft *= -1 if ($amountleft < 0); @@ -1963,12 +2142,11 @@ sub _FixAccountForLostAndReturned { $newamtos = $accdata->{'amountoutstanding'} - $amountleft; $amountleft = 0; } - my $thisacct = $accdata->{'accountno'}; + my $thisacct = $accdata->{'accountlines_id'}; # FIXME: move prepares outside while loop! my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ? - WHERE (borrowernumber = ?) - AND (accountno=?)"); - $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct'); # FIXME: '$thisacct' is a string literal! + WHERE (accountlines_id = ?)"); + $usth->execute($newamtos,'$thisacct'); # FIXME: '$thisacct' is a string literal! $usth = $dbh->prepare("INSERT INTO accountoffsets (borrowernumber, accountno, offsetaccount, offsetamount) VALUES @@ -2151,7 +2329,7 @@ tables issues and the firstname,surname & cardnumber from borrowers. sub GetBiblioIssues { my $biblionumber = shift; - return undef unless $biblionumber; + return unless $biblionumber; my $dbh = C4::Context->dbh; my $query = " SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname @@ -2329,13 +2507,13 @@ from the book's item type. =cut sub AddRenewal { - my $borrowernumber = shift or return undef; - my $itemnumber = shift or return undef; + my $borrowernumber = shift or return; + my $itemnumber = shift or return; my $branch = shift; my $datedue = shift; my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd(); - my $item = GetItem($itemnumber) or return undef; - my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef; + my $item = GetItem($itemnumber) or return; + my $biblio = GetBiblioFromItemNumber($itemnumber) or return; my $dbh = C4::Context->dbh; # Find the issues record for this book @@ -2356,7 +2534,7 @@ sub AddRenewal { # based on the value of the RenewalPeriodBase syspref. unless ($datedue) { - my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return undef; + my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return; my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'}; $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ? @@ -2398,7 +2576,7 @@ sub AddRenewal { 'Rent', $charge, $itemnumber ); } # Log the renewal - UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber); + UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'}); return $datedue; } @@ -2885,6 +3063,7 @@ sub CalcDateDue { # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate if ( C4::Context->preference('ReturnBeforeExpiry') ) { my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso' ); + $expiry_dt->set( hour => 23, minute => 59); if ( DateTime->compare( $datedue, $expiry_dt ) == 1 ) { $datedue = $expiry_dt->clone; }