Bug 11030 - Add 359, 947 and 969 fields in french unimarc_complete framework - followup
[koha_fer] / C4 / Circulation.pm
index 0a22b76..6b700ec 100644 (file)
@@ -79,6 +79,7 @@ BEGIN {
                &AddIssue
                &AddRenewal
                &GetRenewCount
+        &GetSoonestRenewDate
                &GetItemIssue
                &GetItemIssues
                &GetIssuingCharges
@@ -896,7 +897,7 @@ sub CanBookBeIssued {
     }
     if ( C4::Context->preference("IndependentBranches") ) {
         my $userenv = C4::Context->userenv;
-        if ( ($userenv) && ( $userenv->{flags} % 2 != 1 ) ) {
+        unless ( C4::Context->IsSuperLibrarian() ) {
             if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ){
                 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
                 $issuingimpossible{'itemhomebranch'} = $item->{C4::Context->preference("HomeOrHoldingBranch")};
@@ -971,64 +972,35 @@ sub CanBookBeIssued {
             }
         }
     }
-    #
-    # CHECK AGE RESTRICTION
-    #
 
+    ## 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;
+    my $markers         = C4::Context->preference('AgeRestrictionMarker');
+    my $bibvalues       = $biblioitem->{'agerestriction'};
+    my $restriction_age = GetAgeRestriction( $bibvalues );
+
+    if ( $restriction_age > 0 ) {
+        if ( $borrower->{'dateofbirth'} ) {
+            my @alloweddate = split /-/, $borrower->{'dateofbirth'};
+            $alloweddate[0] += $restriction_age;
+
+            #Prevent runime eror on leap year (invalid date)
+            if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
+                $alloweddate[2] = 28;
             }
-        }
-        # 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";
                 }
-
-                if ( Date_to_Days(Today) <  Date_to_Days(@alloweddate) -1  ) {
-                    if (C4::Context->preference('AgeRestrictionOverride' )) {
-                        $needsconfirmation{AGE_RESTRICTION} = "$bibvalues";
-                    }
-                    else {
-                        $issuingimpossible{AGE_RESTRICTION} = "$bibvalues";
-                    }
+                else {
+                    $issuingimpossible{AGE_RESTRICTION} = "$bibvalues";
                 }
             }
         }
     }
 
-## check for high holds decreasing loan period
+    ## 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 ) =
@@ -1043,6 +1015,32 @@ sub CanBookBeIssued {
         }
     }
 
+    if (
+        !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
+        # don't do the multiple loans per bib check if we've
+        # already determined that we've got a loan on the same item
+        !$issuingimpossible{NO_MORE_RENEWALS} &&
+        !$needsconfirmation{RENEW_ISSUE}
+    ) {
+        # Check if borrower has already issued an item from the same biblio
+        # Only if it's not a subscription
+        my $biblionumber = $item->{biblionumber};
+        require C4::Serials;
+        my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
+        unless ($is_a_subscription) {
+            my $issues = GetIssues( {
+                borrowernumber => $borrower->{borrowernumber},
+                biblionumber   => $biblionumber,
+            } );
+            my @issues = $issues ? @$issues : ();
+            # if we get here, we don't already have a loan on this item,
+            # so if there are any loans on this bib, ask for confirmation
+            if (scalar @issues > 0) {
+                $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
+            }
+        }
+    }
+
     return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
 }
 
@@ -1636,7 +1634,7 @@ sub GetBranchItemRule {
 =head2 AddReturn
 
   ($doreturn, $messages, $iteminformation, $borrower) =
-      &AddReturn($barcode, $branch, $exemptfine, $dropbox);
+      &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
 
 Returns a book.
 
@@ -1647,13 +1645,16 @@ Returns a book.
 =item C<$branch> is the code of the branch where the book is being returned.
 
 =item C<$exemptfine> indicates that overdue charges for the item will be
-removed.
+removed. Optional.
 
 =item C<$dropbox> indicates that the check-in date is assumed to be
 yesterday, or the last non-holiday as defined in C4::Calendar .  If
 overdue charges are applied and C<$dropbox> is true, the last charge
 will be removed.  This assumes that the fines accrual script has run
-for _today_.
+for _today_. Optional.
+
+=item C<$return_date> allows the default return date to be overridden
+by the given return date. Optional.
 
 =back
 
@@ -1708,7 +1709,7 @@ patron who last borrowed the book.
 =cut
 
 sub AddReturn {
-    my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
+    my ( $barcode, $branch, $exemptfine, $dropbox, $return_date ) = @_;
 
     if ($branch and not GetBranchDetail($branch)) {
         warn "AddReturn error: branch '$branch' not found.  Reverting to " . C4::Context->userenv->{'branch'};
@@ -1755,6 +1756,26 @@ sub AddReturn {
 
     my $borrowernumber = $borrower->{'borrowernumber'} || undef;    # we don't know if we had a borrower or not
 
+    my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
+    if ($yaml) {
+        $yaml = "$yaml\n\n";  # YAML is anal on ending \n. Surplus does not hurt
+        my $rules;
+        eval { $rules = YAML::Load($yaml); };
+        if ($@) {
+            warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
+        }
+        else {
+            foreach my $key ( keys %$rules ) {
+                if ( $item->{notforloan} eq $key ) {
+                    $messages->{'NotForLoanStatusUpdated'} = { from => $item->{notforloan}, to => $rules->{$key} };
+                    ModItem( { notforloan => $rules->{$key} }, undef, $itemnumber );
+                    last;
+                }
+            }
+        }
+    }
+
+
     # check if the book is in a permanent collection....
     # FIXME -- This 'PE' attribute is largely undocumented.  afaict, there's no user interface that reflects this functionality.
     if ( $hbr ) {
@@ -1780,8 +1801,9 @@ sub AddReturn {
 
     # case of a return of document (deal with issues and holdingbranch)
     my $today = DateTime->now( time_zone => C4::Context->tz() );
+
     if ($doreturn) {
-    my $datedue = $issue->{date_due};
+        my $datedue = $issue->{date_due};
         $borrower or warn "AddReturn without current borrower";
                my $circControlBranch;
         if ($dropbox) {
@@ -1790,36 +1812,48 @@ 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);
-        $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $today ) == -1 ? 1 : 0;
+            $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $today ) == -1 ? 1 : 0;
         }
 
         if ($borrowernumber) {
-            if( C4::Context->preference('CalculateFinesOnReturn') && $issue->{'overdue'}){
-            # we only need to calculate and change the fines if we want to do that on return
-            # Should be on for hourly loans
+            if ( ( C4::Context->preference('CalculateFinesOnReturn') && $issue->{'overdue'} ) || $return_date ) {
+                # we only need to calculate and change the fines if we want to do that on return
+                # Should be on for hourly loans
                 my $control = C4::Context->preference('CircControl');
                 my $control_branchcode =
                     ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
                   : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
                   :                                     $issue->{branchcode};
 
+                my $date_returned =
+                  $return_date ? dt_from_string($return_date) : $today;
+
                 my ( $amount, $type, $unitcounttotal ) =
                   C4::Overdues::CalcFine( $item, $borrower->{categorycode},
-                    $control_branchcode, $datedue, $today );
+                    $control_branchcode, $datedue, $date_returned );
 
                 $type ||= q{};
 
-                if ( $amount > 0
-                    && C4::Context->preference('finesMode') eq 'production' )
-                {
-                    C4::Overdues::UpdateFine( $issue->{itemnumber},
-                        $issue->{borrowernumber},
-                        $amount, $type, output_pref($datedue) );
+                if ( C4::Context->preference('finesMode') eq 'production' ) {
+                    if ( $amount > 0 ) {
+                        C4::Overdues::UpdateFine( $issue->{itemnumber},
+                            $issue->{borrowernumber},
+                            $amount, $type, output_pref($datedue) );
+                    }
+                    elsif ($return_date) {
+
+                       # Backdated returns may have fines that shouldn't exist,
+                       # so in this case, we need to drop those fines to 0
+
+                        C4::Overdues::UpdateFine( $issue->{itemnumber},
+                            $issue->{borrowernumber},
+                            0, $type, output_pref($datedue) );
+                    }
                 }
             }
 
             MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
-                $circControlBranch, '', $borrower->{'privacy'} );
+                $circControlBranch, $return_date, $borrower->{'privacy'} );
 
             # FIXME is the "= 1" right?  This could be the borrower hash.
             $messages->{'WasReturned'} = 1;
@@ -1875,10 +1909,21 @@ sub AddReturn {
         defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!";  # zero is OK, check defined
         
         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);
+        # fix fine days
+            my ($debardate,$reminder) = _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today );
+            if ($reminder){
+                $messages->{'PrevDebarred'} = $debardate;
+            } else {
+                $messages->{'Debarred'} = $debardate if $debardate;
+            }
+        # there's no overdue on the item but borrower had been previously debarred
+        } elsif ( $issue->{date_due} and $borrower->{'debarred'} ) {
+             my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
+             $borrower_debar_dt->truncate(to => 'day');
+             my $today_dt = $today->clone()->truncate(to => 'day');
+             if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
+                 $messages->{'PrevDebarred'} = $borrower->{'debarred'};
+             }
         }
     }
 
@@ -2060,17 +2105,31 @@ sub _debar_user_on_return {
         # 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 $suspension_days = $deltadays * $finedays;
+
+            # If the max suspension days is < than the suspension days
+            # the suspension days is limited to this maximum period.
+            my $max_sd = $issuingrule->{maxsuspensiondays};
+            if ( defined $max_sd ) {
+                $max_sd = DateTime::Duration->new( days => $max_sd );
+                $suspension_days = $max_sd
+                  if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
+            }
 
             my $new_debar_dt =
-              $dt_today->clone()->add_duration( $deltadays * $finedays );
+              $dt_today->clone()->add_duration( $suspension_days );
 
             Koha::Borrower::Debarments::AddUniqueDebarment({
                 borrowernumber => $borrower->{borrowernumber},
                 expiration     => $new_debar_dt->ymd(),
                 type           => 'SUSPENSION',
             });
-
+            # if borrower was already debarred but does not get an extra debarment
+            if ( $borrower->{debarred} eq Koha::Borrower::Debarments::IsDebarred($borrower->{borrowernumber}) ) {
+                    return ($borrower->{debarred},1);
+            }
             return $new_debar_dt->ymd();
         }
     }
@@ -2324,6 +2383,73 @@ sub GetOpenIssue {
 
 }
 
+=head2 GetIssues
+
+    $issues = GetIssues({});    # return all issues!
+    $issues = GetIssues({ borrowernumber => $borrowernumber, biblionumber => $biblionumber });
+
+Returns all pending issues that match given criteria.
+Returns a arrayref or undef if an error occurs.
+
+Allowed criteria are:
+
+=over 2
+
+=item * borrowernumber
+
+=item * biblionumber
+
+=item * itemnumber
+
+=back
+
+=cut
+
+sub GetIssues {
+    my ($criteria) = @_;
+
+    # Build filters
+    my @filters;
+    my @allowed = qw(borrowernumber biblionumber itemnumber);
+    foreach (@allowed) {
+        if (defined $criteria->{$_}) {
+            push @filters, {
+                field => $_,
+                value => $criteria->{$_},
+            };
+        }
+    }
+
+    # Do we need to join other tables ?
+    my %join;
+    if (defined $criteria->{biblionumber}) {
+        $join{items} = 1;
+    }
+
+    # Build SQL query
+    my $where = '';
+    if (@filters) {
+        $where = "WHERE " . join(' AND ', map { "$_->{field} = ?" } @filters);
+    }
+    my $query = q{
+        SELECT issues.*
+        FROM issues
+    };
+    if (defined $join{items}) {
+        $query .= q{
+            LEFT JOIN items ON (issues.itemnumber = items.itemnumber)
+        };
+    }
+    $query .= $where;
+
+    # Execute SQL query
+    my $dbh = C4::Context->dbh;
+    my $sth = $dbh->prepare($query);
+    my $rv = $sth->execute(map { $_->{value} } @filters);
+
+    return $rv ? $sth->fetchall_arrayref({}) : undef;
+}
+
 =head2 GetItemIssues
 
   $issues = &GetItemIssues($itemnumber, $history);
@@ -2472,26 +2598,44 @@ sub CanBookBeRenewed {
 
     my $dbh       = C4::Context->dbh;
     my $renews    = 1;
-    my $renewokay = 0;
+    my $renewokay = 1;
     my $error;
 
     my $item      = GetItem($itemnumber)      or return ( 0, 'no_item' );
     my $itemissue = GetItemIssue($itemnumber) or return ( 0, 'no_checkout' );
 
     $borrowernumber ||= $itemissue->{borrowernumber};
-    my $borrower = C4::Members::GetMemberDetails($borrowernumber)
+    my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
       or return;
 
     my $branchcode  = _GetCircControlBranch($item, $borrower);
 
     my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
 
-    if ( ( $issuingrule->{renewalsallowed} > $itemissue->{renewals} ) || $override_limit ) {
-        $renewokay = 1;
-    } else {
+    if ( $issuingrule->{norenewalbefore} ) {
+
+        # Get current time and add norenewalbefore. If this is smaller than date_due, it's too soon for renewal.
+        if (
+            DateTime->now( time_zone => C4::Context->tz() )->add(
+                $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore}
+            ) < $itemissue->{date_due}
+        )
+        {
+            $renewokay = 0;
+            $error     = "too_soon";
+        }
+    }
+
+    if ( $issuingrule->{renewalsallowed} <= $itemissue->{renewals} ) {
+        $renewokay = 0;
         $error = "too_many";
     }
 
+    if ( $override_limit ) {
+        $renewokay = 1;
+        $error     = undef;
+    }
+
     my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves( $itemnumber );
 
     if ( $resfound ) { # '' when no hold was found
@@ -2668,6 +2812,54 @@ sub GetRenewCount {
     return ( $renewcount, $renewsallowed, $renewsleft );
 }
 
+=head2 GetSoonestRenewDate
+
+  $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
+
+Find out the soonest possible renew date of a borrowed item.
+
+C<$borrowernumber> is the borrower number of the patron who currently
+has the item on loan.
+
+C<$itemnumber> is the number of the item to renew.
+
+C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
+renew date, based on the value "No renewal before" of the applicable
+issuing rule. Returns the current date if the item can already be
+renewed, and returns undefined if the borrower, loan, or item
+cannot be found.
+
+=cut
+
+sub GetSoonestRenewDate {
+    my ( $borrowernumber, $itemnumber ) = @_;
+
+    my $dbh = C4::Context->dbh;
+
+    my $item      = GetItem($itemnumber)      or return;
+    my $itemissue = GetItemIssue($itemnumber) or return;
+
+    $borrowernumber ||= $itemissue->{borrowernumber};
+    my $borrower = C4::Members::GetMemberDetails($borrowernumber)
+      or return;
+
+    my $branchcode = _GetCircControlBranch( $item, $borrower );
+    my $issuingrule =
+      GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
+
+    my $now = DateTime->now( time_zone => C4::Context->tz() );
+
+    if ( $issuingrule->{norenewalbefore} ) {
+        my $soonestrenewal =
+          $itemissue->{date_due}->subtract(
+            $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
+
+        $soonestrenewal = $now > $soonestrenewal ? $now : $soonestrenewal;
+        return $soonestrenewal;
+    }
+    return $now;
+}
+
 =head2 GetIssuingCharges
 
   ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
@@ -3522,6 +3714,44 @@ sub IsItemIssued {
     return $sth->fetchrow;
 }
 
+sub GetAgeRestriction {
+    my ($record_restrictions) = @_;
+    my $markers = C4::Context->preference('AgeRestrictionMarker');
+
+    # Split $record_restrictions to something like FSK 16 or PEGI 6
+    my @values = split ' ', uc($record_restrictions);
+    return unless @values;
+
+    # Search first occurence of one of the markers
+    my @markers = split /\|/, uc($markers);
+    return unless @markers;
+
+    my $index            = 0;
+    my $restriction_year = 0;
+    for my $value (@values) {
+        $index++;
+        for my $marker (@markers) {
+            $marker =~ s/^\s+//;    #remove leading spaces
+            $marker =~ s/\s+$//;    #remove trailing spaces
+            if ( $marker eq $value ) {
+                if ( $index <= $#values ) {
+                    $restriction_year += $values[$index];
+                }
+                last;
+            }
+            elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
+
+                # Perhaps it is something like "K16" (as in Finland)
+                $restriction_year += $1;
+                last;
+            }
+        }
+        last if ( $restriction_year > 0 );
+    }
+
+    return $restriction_year;
+}
+
 1;
 
 __END__