Bug 5549 : overdues display should be hours mins aware
[koha.git] / C4 / Reserves.pm
index fde1223..a63e30f 100644 (file)
@@ -3,6 +3,7 @@ package C4::Reserves;
 # Copyright 2000-2002 Katipo Communications
 #           2006 SAN Ouest Provence
 #           2007-2010 BibLibre Paul POULAIN
+#           2011 Catalyst IT
 #
 # This file is part of Koha.
 #
@@ -26,7 +27,6 @@ use C4::Context;
 use C4::Biblio;
 use C4::Members;
 use C4::Items;
-use C4::Search;
 use C4::Circulation;
 use C4::Accounts;
 
@@ -86,7 +86,7 @@ This modules provides somes functions to deal with reservations.
 BEGIN {
     # set the version for version checking
     $VERSION = 3.01;
-       require Exporter;
+    require Exporter;
     @ISA = qw(Exporter);
     @EXPORT = qw(
         &AddReserve
@@ -109,6 +109,7 @@ BEGIN {
         &ModReserveStatus
         &ModReserveCancelAll
         &ModReserveMinusPriority
+        &MoveReserve
         
         &CheckReserves
         &CanBookBeReserved
@@ -120,7 +121,10 @@ BEGIN {
         
         &AlterPriority
         &ToggleLowestPriority
+
+        &ReserveSlip
     );
+    @EXPORT_OK = qw( MergeHolds );
 }    
 
 =head2 AddReserve
@@ -192,32 +196,31 @@ sub AddReserve {
     # Send e-mail to librarian if syspref is active
     if(C4::Context->preference("emailLibrarianWhenHoldIsPlaced")){
         my $borrower = C4::Members::GetMember(borrowernumber => $borrowernumber);
-        my $biblio   = GetBiblioData($biblionumber);
-        my $letter = C4::Letters::getletter( 'reserves', 'HOLDPLACED');
-       my $branchcode = $borrower->{branchcode};
-        my $branch_details = C4::Branch::GetBranchDetail($branchcode);
-        my $admin_email_address =$branch_details->{'branchemail'} || C4::Context->preference('KohaAdminEmailAddress');
-
-        my %keys = (%$borrower, %$biblio);
-        foreach my $key (keys %keys) {
-            my $replacefield = "<<$key>>";
-            $letter->{content} =~ s/$replacefield/$keys{$key}/g;
-            $letter->{title} =~ s/$replacefield/$keys{$key}/g;
+        my $branch_details = C4::Branch::GetBranchDetail($borrower->{branchcode});
+        if ( my $letter =  C4::Letters::GetPreparedLetter (
+            module => 'reserves',
+            letter_code => 'HOLDPLACED',
+            branchcode => $branch,
+            tables => {
+                'branches'  => $branch_details,
+                'borrowers' => $borrower,
+                'biblio'    => $biblionumber,
+            },
+        ) ) {
+
+            my $admin_email_address =$branch_details->{'branchemail'} || C4::Context->preference('KohaAdminEmailAddress');
+
+            C4::Letters::EnqueueLetter(
+                {   letter                 => $letter,
+                    borrowernumber         => $borrowernumber,
+                    message_transport_type => 'email',
+                    from_address           => $admin_email_address,
+                    to_address           => $admin_email_address,
+                }
+            );
         }
-        
-        C4::Letters::EnqueueLetter(
-                            {   letter                 => $letter,
-                                borrowernumber         => $borrowernumber,
-                                message_transport_type => 'email',
-                                from_address           => $admin_email_address,
-                                to_address           => $admin_email_address,
-                            }
-                        );
-        
-
     }
 
-
     #}
     ($const eq "o" || $const eq "e") or return;   # FIXME: why not have a useful return value?
     $query = qq/
@@ -382,9 +385,15 @@ sub GetReservesFromBorrowernumber {
 sub CanBookBeReserved{
     my ($borrowernumber, $biblionumber) = @_;
 
-    my @items = GetItemsInfo($biblionumber);
+    my @items = get_itemnumbers_of($biblionumber);
+    #get items linked via host records
+    my @hostitems = get_hostitemnumbers_of($biblionumber);
+    if (@hostitems){
+       push (@items,@hostitems);
+    }
+
     foreach my $item (@items){
-        return 1 if CanItemBeReserved($borrowernumber, $item->{itemnumber});
+        return 1 if CanItemBeReserved($borrowernumber, $item);
     }
     return 0;
 }
@@ -516,7 +525,7 @@ sub GetOtherReserves {
     my ($itemnumber) = @_;
     my $messages;
     my $nextreservinfo;
-    my ( $restype, $checkreserves ) = CheckReserves($itemnumber);
+    my ( undef, $checkreserves, undef ) = CheckReserves($itemnumber);
     if ($checkreserves) {
         my $iteminfo = GetItem($itemnumber);
         if ( $iteminfo->{'holdingbranch'} ne $checkreserves->{'branchcode'} ) {
@@ -731,8 +740,8 @@ sub GetReserveStatus {
 
 =head2 CheckReserves
 
-  ($status, $reserve) = &CheckReserves($itemnumber);
-  ($status, $reserve) = &CheckReserves(undef, $barcode);
+  ($status, $reserve, $all_reserves) = &CheckReserves($itemnumber);
+  ($status, $reserve, $all_reserves) = &CheckReserves(undef, $barcode);
 
 Find a book in the reserves.
 
@@ -760,17 +769,32 @@ sub CheckReserves {
     my ( $item, $barcode ) = @_;
     my $dbh = C4::Context->dbh;
     my $sth;
-    my $select = "
-    SELECT items.biblionumber,
+    my $select;
+    if (C4::Context->preference('item-level_itypes')){
+       $select = "
+           SELECT items.biblionumber,
            items.biblioitemnumber,
            itemtypes.notforloan,
            items.notforloan AS itemnotforloan,
            items.itemnumber
-    FROM   items
-    LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
-    LEFT JOIN itemtypes   ON biblioitems.itemtype   = itemtypes.itemtype
-    ";
-
+           FROM   items
+           LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
+           LEFT JOIN itemtypes   ON items.itype   = itemtypes.itemtype
+        ";
+    }
+    else {
+       $select = "
+           SELECT items.biblionumber,
+           items.biblioitemnumber,
+           itemtypes.notforloan,
+           items.notforloan AS itemnotforloan,
+           items.itemnumber
+           FROM   items
+           LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
+           LEFT JOIN itemtypes   ON biblioitems.itemtype   = itemtypes.itemtype
+        ";
+    }
+   
     if ($item) {
         $sth = $dbh->prepare("$select WHERE itemnumber = ?");
         $sth->execute($item);
@@ -782,11 +806,11 @@ sub CheckReserves {
     # note: we get the itemnumber because we might have started w/ just the barcode.  Now we know for sure we have it.
     my ( $biblio, $bibitem, $notforloan_per_itemtype, $notforloan_per_item, $itemnumber ) = $sth->fetchrow_array;
 
-    return ( 0, 0 ) unless $itemnumber; # bail if we got nothing.
+    return ( '' ) unless $itemnumber; # bail if we got nothing.
 
     # if item is not for loan it cannot be reserved either.....
     #    execpt where items.notforloan < 0 :  This indicates the item is holdable. 
-    return ( 0, 0 ) if  ( $notforloan_per_item > 0 ) or $notforloan_per_itemtype;
+    return ( '' ) if  ( $notforloan_per_item > 0 ) or $notforloan_per_itemtype;
 
     # Find this item in the reserves
     my @reserves = _Findgroupreserve( $bibitem, $biblio, $itemnumber );
@@ -800,11 +824,11 @@ sub CheckReserves {
         my $priority = 10000000;
         foreach my $res (@reserves) {
             if ( $res->{'itemnumber'} == $itemnumber && $res->{'priority'} == 0) {
-                return ( "Waiting", $res ); # Found it
+                return ( "Waiting", $res, \@reserves ); # Found it
             } else {
                 # See if this item is more important than what we've got so far
                 if ( $res->{'priority'} && $res->{'priority'} < $priority ) {
-                    my $borrowerinfo=C4::Members::GetMemberDetails($res->{'borrowernumber'});
+                    my $borrowerinfo=C4::Members::GetMember(borrowernumber => $res->{'borrowernumber'});
                     my $iteminfo=C4::Items::GetItem($itemnumber);
                     my $branch=C4::Circulation::_GetCircControlBranch($iteminfo,$borrowerinfo);
                     my $branchitemrule = C4::Circulation::GetBranchItemRule($branch,$iteminfo->{'itype'});
@@ -821,11 +845,10 @@ sub CheckReserves {
     # We return the most important (i.e. next) reservation.
     if ($highest) {
         $highest->{'itemnumber'} = $item;
-        return ( "Reserved", $highest );
-    }
-    else {
-        return ( 0, 0 );
+        return ( "Reserved", $highest, \@reserves );
     }
+
+    return ( '' );
 }
 
 =head2 CancelExpiredReserves
@@ -838,10 +861,12 @@ Cancels all reserves with an expiration date from before today.
 
 sub CancelExpiredReserves {
 
+    # Cancel reserves that have passed their expiration date.
     my $dbh = C4::Context->dbh;
     my $sth = $dbh->prepare( "
         SELECT * FROM reserves WHERE DATE(expirationdate) < DATE( CURDATE() ) 
         AND expirationdate IS NOT NULL
+        AND found IS NULL
     " );
     $sth->execute();
 
@@ -849,6 +874,24 @@ sub CancelExpiredReserves {
         CancelReserve( $res->{'biblionumber'}, '', $res->{'borrowernumber'} );
     }
   
+    # Cancel reserves that have been waiting too long
+    if ( C4::Context->preference("ExpireReservesMaxPickUpDelay") ) {
+        my $max_pickup_delay = C4::Context->preference("ReservesMaxPickUpDelay");
+        my $charge = C4::Context->preference("ExpireReservesMaxPickUpDelayCharge");
+
+        my $query = "SELECT * FROM reserves WHERE TO_DAYS( NOW() ) - TO_DAYS( waitingdate ) > ? AND found = 'W' AND priority = 0";
+        $sth = $dbh->prepare( $query );
+        $sth->execute( $max_pickup_delay );
+
+        while (my $res = $sth->fetchrow_hashref ) {
+            if ( $charge ) {
+                manualinvoice($res->{'borrowernumber'}, $res->{'itemnumber'}, 'Hold waiting too long', 'F', $charge);
+            }
+
+            CancelReserve( $res->{'biblionumber'}, '', $res->{'borrowernumber'} );
+        }
+    }
+
 }
 
 =head2 CancelReserve
@@ -1115,13 +1158,9 @@ sub ModReserveStatus {
 
     #first : check if we have a reservation for this item .
     my ($itemnumber, $newstatus) = @_;
-    my $dbh          = C4::Context->dbh;
-    my $query = " UPDATE reserves
-    SET    found=?,waitingdate = now()
-    WHERE itemnumber=?
-      AND found IS NULL
-      AND priority = 0
-    ";
+    my $dbh = C4::Context->dbh;
+
+    my $query = "UPDATE reserves SET found = ?, waitingdate = NOW() WHERE itemnumber = ? AND found IS NULL AND priority = 0";
     my $sth_set = $dbh->prepare($query);
     $sth_set->execute( $newstatus, $itemnumber );
 
@@ -1174,15 +1213,15 @@ sub ModReserveAffect {
     }
     else {
     # affect the reserve to Waiting as well.
-    $query = "
-        UPDATE reserves
-        SET     priority = 0,
-                found = 'W',
-                waitingdate=now(),
-                itemnumber = ?
-        WHERE borrowernumber = ?
-          AND biblionumber = ?
-    ";
+        $query = "
+            UPDATE reserves
+            SET     priority = 0,
+                    found = 'W',
+                    waitingdate = NOW(),
+                    itemnumber = ?
+            WHERE borrowernumber = ?
+              AND biblionumber = ?
+        ";
     }
     $sth = $dbh->prepare($query);
     $sth->execute( $itemnumber, $borrowernumber,$biblionumber);
@@ -1662,10 +1701,21 @@ sub _koha_notify_reserve {
 
     my $dbh = C4::Context->dbh;
     my $borrower = C4::Members::GetMember(borrowernumber => $borrowernumber);
+    
+    # Try to get the borrower's email address
+    my $to_address;
+    my $which_address = C4::Context->preference('AutoEmailPrimaryAddress');
+    # If the system preference is set to 'first valid' (value == OFF), look up email address
+    if ($which_address eq 'OFF') {
+        $to_address = C4::Members::GetFirstValidEmailAddress( $borrowernumber );
+    } else {
+        $to_address = $borrower->{$which_address};
+    }
+    
     my $letter_code;
     my $print_mode = 0;
     my $messagingprefs;
-    if ( $borrower->{'email'} || $borrower->{'smsalertnumber'} ) {
+    if ( $to_address || $borrower->{'smsalertnumber'} ) {
         $messagingprefs = C4::Members::Messaging::GetMessagingPreferences( { borrowernumber => $borrowernumber, message_name => 'Hold_Filled' } );
 
         return if ( !defined( $messagingprefs->{'letter_code'} ) );
@@ -1687,21 +1737,21 @@ sub _koha_notify_reserve {
 
     my $admin_email_address = $branch_details->{'branchemail'} || C4::Context->preference('KohaAdminEmailAddress');
 
-    my $letter = getletter( 'reserves', $letter_code );
-    die "Could not find a letter called '$letter_code' in the 'reserves' module" unless( $letter );
+    my $letter =  C4::Letters::GetPreparedLetter (
+        module => 'reserves',
+        letter_code => $letter_code,
+        branchcode => $reserve->{branchcode},
+        tables => {
+            'branches'  => $branch_details,
+            'borrowers' => $borrower,
+            'biblio'    => $biblionumber,
+            'reserves'  => $reserve,
+            'items', $reserve->{'itemnumber'},
+        },
+        substitute => { today => C4::Dates->new()->output() },
+    ) or die "Could not find a letter called '$letter_code' in the 'reserves' module";
 
-    C4::Letters::parseletter( $letter, 'branches', $reserve->{'branchcode'} );
-    C4::Letters::parseletter( $letter, 'borrowers', $borrowernumber );
-    C4::Letters::parseletter( $letter, 'biblio', $biblionumber );
-    C4::Letters::parseletter( $letter, 'reserves', $borrowernumber, $biblionumber );
 
-    if ( $reserve->{'itemnumber'} ) {
-        C4::Letters::parseletter( $letter, 'items', $reserve->{'itemnumber'} );
-    }
-    my $today = C4::Dates->new()->output();
-    $letter->{'title'} =~ s/<<today>>/$today/g;
-    $letter->{'content'} =~ s/<<today>>/$today/g;
-    $letter->{'content'} =~ s/<<[a-z0-9_]+\.[a-z0-9]+>>//g; #remove any stragglers
 
     if ( $print_mode ) {
         C4::Letters::EnqueueLetter( {
@@ -1783,6 +1833,127 @@ sub _ShiftPriorityByDateAndPriority {
     return $new_priority;  # so the caller knows what priority they wind up receiving
 }
 
+=head2 MoveReserve
+
+  MoveReserve( $itemnumber, $borrowernumber, $cancelreserve )
+
+Use when checking out an item to handle reserves
+If $cancelreserve boolean is set to true, it will remove existing reserve
+
+=cut
+
+sub MoveReserve {
+    my ( $itemnumber, $borrowernumber, $cancelreserve ) = @_;
+
+    my ( $restype, $res, $all_reserves ) = CheckReserves( $itemnumber );
+    return unless $res;
+
+    my $biblionumber     =  $res->{biblionumber};
+    my $biblioitemnumber = $res->{biblioitemnumber};
+
+    if ($res->{borrowernumber} == $borrowernumber) {
+        ModReserveFill($res);
+    }
+    else {
+        # warn "Reserved";
+        # The item is reserved by someone else.
+        # Find this item in the reserves
+
+        my $borr_res;
+        foreach (@$all_reserves) {
+            $_->{'borrowernumber'} == $borrowernumber or next;
+            $_->{'biblionumber'}   == $biblionumber   or next;
+
+            $borr_res = $_;
+            last;
+        }
+
+        if ( $borr_res ) {
+            # The item is reserved by the current patron
+            ModReserveFill($borr_res);
+        }
+
+        if ($cancelreserve) { # cancel reserves on this item
+            CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
+            CancelReserve($res->{'biblionumber'}, 0, $res->{'borrowernumber'});
+        }
+    }
+}
+
+=head2 MergeHolds
+
+  MergeHolds($dbh,$to_biblio, $from_biblio);
+
+This shifts the holds from C<$from_biblio> to C<$to_biblio> and reorders them by the date they were placed
+
+=cut
+
+sub MergeHolds {
+    my ( $dbh, $to_biblio, $from_biblio ) = @_;
+    my $sth = $dbh->prepare(
+        "SELECT count(*) as reservenumber FROM reserves WHERE biblionumber = ?"
+    );
+    $sth->execute($from_biblio);
+    if ( my $data = $sth->fetchrow_hashref() ) {
+
+        # holds exist on old record, if not we don't need to do anything
+        $sth = $dbh->prepare(
+            "UPDATE reserves SET biblionumber = ? WHERE biblionumber = ?");
+        $sth->execute( $to_biblio, $from_biblio );
+
+        # Reorder by date
+        # don't reorder those already waiting
+
+        $sth = $dbh->prepare(
+"SELECT * FROM reserves WHERE biblionumber = ? AND (found <> ? AND found <> ? OR found is NULL) ORDER BY reservedate ASC"
+        );
+        my $upd_sth = $dbh->prepare(
+"UPDATE reserves SET priority = ? WHERE biblionumber = ? AND borrowernumber = ?
+        AND reservedate = ? AND constrainttype = ? AND (itemnumber = ? or itemnumber is NULL) "
+        );
+        $sth->execute( $to_biblio, 'W', 'T' );
+        my $priority = 1;
+        while ( my $reserve = $sth->fetchrow_hashref() ) {
+            $upd_sth->execute(
+                $priority,                    $to_biblio,
+                $reserve->{'borrowernumber'}, $reserve->{'reservedate'},
+                $reserve->{'constrainttype'}, $reserve->{'itemnumber'}
+            );
+            $priority++;
+        }
+    }
+}
+
+=head2 ReserveSlip
+
+  ReserveSlip($branchcode, $borrowernumber, $biblionumber)
+
+  Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
+
+=cut
+
+sub ReserveSlip {
+    my ($branch, $borrowernumber, $biblionumber) = @_;
+
+#   return unless ( C4::Context->boolean_preference('printreserveslips') );
+
+    my $reserve = GetReserveInfo($borrowernumber,$biblionumber )
+      or return;
+
+    return  C4::Letters::GetPreparedLetter (
+        module => 'circulation',
+        letter_code => 'RESERVESLIP',
+        branchcode => $branch,
+        tables => {
+            'reserves'    => $reserve,
+            'branches'    => $reserve->{branchcode},
+            'borrowers'   => $reserve,
+            'biblio'      => $reserve,
+            'items'       => $reserve,
+        },
+    );
+}
+
 =head1 AUTHOR
 
 Koha Development Team <http://koha-community.org/>