Bug 17600: Standardize our EXPORT_OK
[srvgit] / Koha / Item.pm
index 29406b5..c653dc2 100644 (file)
@@ -19,25 +19,26 @@ package Koha::Item;
 
 use Modern::Perl;
 
-use Carp;
-use List::MoreUtils qw(any);
-use Data::Dumper;
-use Try::Tiny;
+use List::MoreUtils qw( any );
+use Data::Dumper qw( Dumper );
 
 use Koha::Database;
 use Koha::DateUtils qw( dt_from_string );
 
 use C4::Context;
-use C4::Circulation;
+use C4::Circulation qw( GetBranchItemRule );
 use C4::Reserves;
-use C4::Biblio qw( ModZebra ); # FIXME This is terrible, we should move the indexation code outside of C4::Biblio
-use C4::ClassSource; # FIXME We would like to avoid that
+use C4::ClassSource qw( GetClassSort );
 use C4::Log qw( logaction );
 
 use Koha::Checkouts;
 use Koha::CirculationRules;
+use Koha::CoverImages;
+use Koha::SearchEngine::Indexer;
+use Koha::Exceptions::Item::Transfer;
 use Koha::Item::Transfer::Limits;
 use Koha::Item::Transfers;
+use Koha::ItemTypes;
 use Koha::Patrons;
 use Koha::Plugins;
 use Koha::Libraries;
@@ -60,8 +61,8 @@ Koha::Item - Koha Item object class
 
     $item->store;
 
-$params can take an optional 'skip_modzebra_update' parameter.
-If set, the reindexation process will not happen (ModZebra not called)
+$params can take an optional 'skip_record_index' parameter.
+If set, the reindexation process will not happen (index_records not called)
 
 NOTE: This is a temporary fix to answer a performance issue when lot of items
 are added (or modified) at the same time.
@@ -87,11 +88,22 @@ sub store {
         $self->itype($self->biblio->biblioitem->itemtype);
     }
 
-    my $today = dt_from_string;
+    my $today  = dt_from_string;
+    my $action = 'create';
+
     unless ( $self->in_storage ) { #AddItem
+
         unless ( $self->permanent_location ) {
             $self->permanent_location($self->location);
         }
+
+        my $default_location = C4::Context->preference('NewItemsDefaultLocation');
+        unless ( $self->location || !$default_location ) {
+            $self->permanent_location( $self->location || $default_location )
+              unless $self->permanent_location;
+            $self->location($default_location);
+        }
+
         unless ( $self->replacementpricedate ) {
             $self->replacementpricedate($today);
         }
@@ -110,48 +122,50 @@ sub store {
             $self->cn_sort($cn_sort);
         }
 
-        C4::Biblio::ModZebra( $self->biblionumber, "specialUpdate", "biblioserver" )
-            unless $params->{skip_modzebra_update};
-
-        logaction( "CATALOGUING", "ADD", $self->itemnumber, "item" )
-          if $log_action && C4::Context->preference("CataloguingLog");
+    } else { # ModItem
 
-        $self->_after_item_action_hooks({ action => 'create' });
+        $action = 'modify';
 
-    } else { # ModItem
+        my %updated_columns = $self->_result->get_dirty_columns;
+        return $self->SUPER::store unless %updated_columns;
 
-        { # Update *_on  fields if needed
-          # Why not for AddItem as well?
-            my @fields = qw( itemlost withdrawn damaged );
-
-            # Only retrieve the item if we need to set an "on" date field
-            if ( $self->itemlost || $self->withdrawn || $self->damaged ) {
-                my $pre_mod_item = $self->get_from_storage;
-                for my $field (@fields) {
-                    if (    $self->$field
-                        and not $pre_mod_item->$field )
-                    {
-                        my $field_on = "${field}_on";
-                        $self->$field_on(
-                          DateTime::Format::MySQL->format_datetime( dt_from_string() )
-                        );
-                    }
-                }
+        # Retrieve the item for comparison if we need to
+        my $pre_mod_item = (
+                 exists $updated_columns{itemlost}
+              or exists $updated_columns{withdrawn}
+              or exists $updated_columns{damaged}
+        ) ? $self->get_from_storage : undef;
+
+        # Update *_on  fields if needed
+        # FIXME: Why not for AddItem as well?
+        my @fields = qw( itemlost withdrawn damaged );
+        for my $field (@fields) {
+
+            # If the field is defined but empty or 0, we are
+            # removing/unsetting and thus need to clear out
+            # the 'on' field
+            if (   exists $updated_columns{$field}
+                && defined( $self->$field )
+                && !$self->$field )
+            {
+                my $field_on = "${field}_on";
+                $self->$field_on(undef);
             }
-
-            # If the field is defined but empty, we are removing and,
-            # and thus need to clear out the 'on' field as well
-            for my $field (@fields) {
-                if ( defined( $self->$field ) && !$self->$field ) {
-                    my $field_on = "${field}_on";
-                    $self->$field_on(undef);
-                }
+            # If the field has changed otherwise, we much update
+            # the 'on' field
+            elsif (exists $updated_columns{$field}
+                && $updated_columns{$field}
+                && !$pre_mod_item->$field )
+            {
+                my $field_on = "${field}_on";
+                $self->$field_on(
+                    DateTime::Format::MySQL->format_datetime(
+                        dt_from_string()
+                    )
+                );
             }
         }
 
-        my %updated_columns = $self->_result->get_dirty_columns;
-        return $self->SUPER::store unless %updated_columns;
-
         if (   exists $updated_columns{itemcallnumber}
             or exists $updated_columns{cn_source} )
         {
@@ -168,20 +182,33 @@ sub store {
             $self->permanent_location( $self->location );
         }
 
-        C4::Biblio::ModZebra( $self->biblionumber, "specialUpdate", "biblioserver" )
-            unless $params->{skip_modzebra_update};
-
-        $self->_after_item_action_hooks({ action => 'modify' });
+        # If item was lost and has now been found,
+        # reverse any list item charges if necessary.
+        if (    exists $updated_columns{itemlost}
+            and $updated_columns{itemlost} <= 0
+            and $pre_mod_item->itemlost > 0 )
+        {
+            $self->_set_found_trigger($pre_mod_item);
+        }
 
-        logaction( "CATALOGUING", "MODIFY", $self->itemnumber, "item " . Dumper($self->unblessed) )
-          if $log_action && C4::Context->preference("CataloguingLog");
     }
 
     unless ( $self->dateaccessioned ) {
         $self->dateaccessioned($today);
     }
 
-    return $self->SUPER::store;
+    my $result = $self->SUPER::store;
+    if ( $log_action && C4::Context->preference("CataloguingLog") ) {
+        $action eq 'create'
+          ? logaction( "CATALOGUING", "ADD", $self->itemnumber, "item" )
+          : logaction( "CATALOGUING", "MODIFY", $self->itemnumber, "item " . Dumper( $self->unblessed ) );
+    }
+    my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
+    $indexer->index_records( $self->biblionumber, "specialUpdate", "biblioserver" )
+        unless $params->{skip_record_index};
+    $self->get_from_storage->_after_item_action_hooks({ action => $action });
+
+    return $result;
 }
 
 =head3 delete
@@ -195,15 +222,18 @@ sub delete {
     # FIXME check the item has no current issues
     # i.e. raise the appropriate exception
 
-    C4::Biblio::ModZebra( $self->biblionumber, "specialUpdate", "biblioserver" )
-        unless $params->{skip_modzebra_update};
+    my $result = $self->SUPER::delete;
+
+    my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
+    $indexer->index_records( $self->biblionumber, "specialUpdate", "biblioserver" )
+        unless $params->{skip_record_index};
 
     $self->_after_item_action_hooks({ action => 'delete' });
 
     logaction( "CATALOGUING", "DELETE", $self->itemnumber, "item" )
       if C4::Context->preference("CataloguingLog");
 
-    return $self->SUPER::delete;
+    return $result;
 }
 
 =head3 safe_delete
@@ -379,19 +409,131 @@ sub holds {
     return Koha::Holds->_new_from_dbic( $holds_rs );
 }
 
+=head3 request_transfer
+
+  my $transfer = $item->request_transfer(
+    {
+        to     => $to_library,
+        reason => $reason,
+        [ ignore_limits => 0, enqueue => 1, replace => 1 ]
+    }
+  );
+
+Add a transfer request for this item to the given branch for the given reason.
+
+An exception will be thrown if the BranchTransferLimits would prevent the requested
+transfer, unless 'ignore_limits' is passed to override the limits.
+
+An exception will be thrown if an active transfer (i.e pending arrival date) is found;
+The caller should catch such cases and retry the transfer request as appropriate passing
+an appropriate override.
+
+Overrides
+* enqueue - Used to queue up the transfer when the existing transfer is found to be in transit.
+* replace - Used to replace the existing transfer request with your own.
+
+=cut
+
+sub request_transfer {
+    my ( $self, $params ) = @_;
+
+    # check for mandatory params
+    my @mandatory = ( 'to', 'reason' );
+    for my $param (@mandatory) {
+        unless ( defined( $params->{$param} ) ) {
+            Koha::Exceptions::MissingParameter->throw(
+                error => "The $param parameter is mandatory" );
+        }
+    }
+
+    Koha::Exceptions::Item::Transfer::Limit->throw()
+      unless ( $params->{ignore_limits}
+        || $self->can_be_transferred( { to => $params->{to} } ) );
+
+    my $request = $self->get_transfer;
+    Koha::Exceptions::Item::Transfer::InQueue->throw( transfer => $request )
+      if ( $request && !$params->{enqueue} && !$params->{replace} );
+
+    $request->cancel( { reason => $params->{reason}, force => 1 } )
+      if ( defined($request) && $params->{replace} );
+
+    my $transfer = Koha::Item::Transfer->new(
+        {
+            itemnumber    => $self->itemnumber,
+            daterequested => dt_from_string,
+            frombranch    => $self->holdingbranch,
+            tobranch      => $params->{to}->branchcode,
+            reason        => $params->{reason},
+            comments      => $params->{comment}
+        }
+    )->store();
+
+    return $transfer;
+}
+
 =head3 get_transfer
 
-my $transfer = $item->get_transfer;
+  my $transfer = $item->get_transfer;
+
+Return the active transfer request or undef
+
+Note: Transfers are retrieved in a Modified FIFO (First In First Out) order
+whereby the most recently sent, but not received, transfer will be returned
+if it exists, otherwise the oldest unsatisfied transfer will be returned.
 
-Return the transfer if the item is in transit or undef
+This allows for transfers to queue, which is the case for stock rotation and
+rotating collections where a manual transfer may need to take precedence but
+we still expect the item to end up at a final location eventually.
 
 =cut
 
 sub get_transfer {
-    my ( $self ) = @_;
-    my $transfer_rs = $self->_result->branchtransfers->search({ datearrived => undef })->first;
+    my ($self) = @_;
+    my $transfer_rs = $self->_result->branchtransfers->search(
+        {
+            datearrived   => undef,
+            datecancelled => undef
+        },
+        {
+            order_by =>
+              [ { -desc => 'datesent' }, { -asc => 'daterequested' } ],
+            rows => 1
+        }
+    )->first;
     return unless $transfer_rs;
-    return Koha::Item::Transfer->_new_from_dbic( $transfer_rs );
+    return Koha::Item::Transfer->_new_from_dbic($transfer_rs);
+}
+
+=head3 get_transfers
+
+  my $transfer = $item->get_transfers;
+
+Return the list of outstanding transfers (i.e requested but not yet cancelled
+or received).
+
+Note: Transfers are retrieved in a Modified FIFO (First In First Out) order
+whereby the most recently sent, but not received, transfer will be returned
+first if it exists, otherwise requests are in oldest to newest request order.
+
+This allows for transfers to queue, which is the case for stock rotation and
+rotating collections where a manual transfer may need to take precedence but
+we still expect the item to end up at a final location eventually.
+
+=cut
+
+sub get_transfers {
+    my ($self) = @_;
+    my $transfer_rs = $self->_result->branchtransfers->search(
+        {
+            datearrived   => undef,
+            datecancelled => undef
+        },
+        {
+            order_by =>
+              [ { -desc => 'datesent' }, { -asc => 'daterequested' } ],
+        }
+    );
+    return Koha::Item::Transfers->_new_from_dbic($transfer_rs);
 }
 
 =head3 last_returned_by
@@ -528,6 +670,7 @@ sub can_be_transferred {
         $limittype => $limittype eq 'itemtype'
                         ? $self->effective_itemtype : $self->ccode
     })->count ? 0 : 1;
+
 }
 
 =head3 pickup_locations
@@ -549,39 +692,59 @@ sub pickup_locations {
     my $branchitemrule =
       C4::Circulation::GetBranchItemRule( $circ_control_branch, $self->itype );
 
-    my @libs;
     if(defined $patron) {
-        return \@libs if $branchitemrule->{holdallowed} == 3 && !$self->home_branch->validate_hold_sibling( {branchcode => $patron->branchcode} );
-        return \@libs if $branchitemrule->{holdallowed} == 1 && $self->home_branch->branchcode ne $patron->branchcode;
+        return Koha::Libraries->new()->empty if $branchitemrule->{holdallowed} eq 'from_local_hold_group' && !$self->home_branch->validate_hold_sibling( {branchcode => $patron->branchcode} );
+        return Koha::Libraries->new()->empty if $branchitemrule->{holdallowed} eq 'from_home_library' && $self->home_branch->branchcode ne $patron->branchcode;
     }
 
+    my $pickup_libraries = Koha::Libraries->search();
     if ($branchitemrule->{hold_fulfillment_policy} eq 'holdgroup') {
-        @libs  = $self->home_branch->get_hold_libraries;
-        push @libs, $self->home_branch unless scalar(@libs) > 0;
+        $pickup_libraries = $self->home_branch->get_hold_libraries;
     } elsif ($branchitemrule->{hold_fulfillment_policy} eq 'patrongroup') {
         my $plib = Koha::Libraries->find({ branchcode => $patron->branchcode});
-        @libs  = $plib->get_hold_libraries;
-        push @libs, $self->home_branch unless scalar(@libs) > 0;
+        $pickup_libraries = $plib->get_hold_libraries;
     } elsif ($branchitemrule->{hold_fulfillment_policy} eq 'homebranch') {
-        push @libs, $self->home_branch;
+        $pickup_libraries = Koha::Libraries->search({ branchcode => $self->homebranch });
     } elsif ($branchitemrule->{hold_fulfillment_policy} eq 'holdingbranch') {
-        push @libs, $self->holding_branch;
-    } else {
-        @libs = Koha::Libraries->search({
+        $pickup_libraries = Koha::Libraries->search({ branchcode => $self->holdingbranch });
+    };
+
+    return $pickup_libraries->search(
+        {
             pickup_location => 1
-        }, {
+        },
+        {
             order_by => ['branchname']
-        })->as_list;
-    }
-
-    my @pickup_locations;
-    foreach my $library (@libs) {
-        if ($library->pickup_location && $self->can_be_transferred({ to => $library })) {
-            push @pickup_locations, $library;
         }
+    ) unless C4::Context->preference('UseBranchTransferLimits');
+
+    my $limittype = C4::Context->preference('BranchTransferLimitsType');
+    my ($ccode, $itype) = (undef, undef);
+    if( $limittype eq 'ccode' ){
+        $ccode = $self->ccode;
+    } else {
+        $itype = $self->itype;
     }
+    my $limits = Koha::Item::Transfer::Limits->search(
+        {
+            fromBranch => $self->holdingbranch,
+            ccode      => $ccode,
+            itemtype   => $itype,
+        },
+        { columns => ['toBranch'] }
+    );
 
-    return \@pickup_locations;
+    return $pickup_libraries->search(
+        {
+            pickup_location => 1,
+            branchcode      => {
+                '-not_in' => $limits->_resultset->as_query
+            }
+        },
+        {
+            order_by => ['branchname']
+        }
+    );
 }
 
 =head3 article_request_type
@@ -762,6 +925,185 @@ sub renewal_branchcode {
     return $branchcode;
 }
 
+=head3 cover_images
+
+Return the cover images associated with this item.
+
+=cut
+
+sub cover_images {
+    my ( $self ) = @_;
+
+    my $cover_image_rs = $self->_result->cover_images;
+    return unless $cover_image_rs;
+    return Koha::CoverImages->_new_from_dbic($cover_image_rs);
+}
+
+=head3 _set_found_trigger
+
+    $self->_set_found_trigger
+
+Finds the most recent lost item charge for this item and refunds the patron
+appropriately, taking into account any payments or writeoffs already applied
+against the charge.
+
+Internal function, not exported, called only by Koha::Item->store.
+
+=cut
+
+sub _set_found_trigger {
+    my ( $self, $pre_mod_item ) = @_;
+
+    ## If item was lost, it has now been found, reverse any list item charges if necessary.
+    my $no_refund_after_days =
+      C4::Context->preference('NoRefundOnLostReturnedItemsAge');
+    if ($no_refund_after_days) {
+        my $today = dt_from_string();
+        my $lost_age_in_days =
+          dt_from_string( $pre_mod_item->itemlost_on )->delta_days($today)
+          ->in_units('days');
+
+        return $self unless $lost_age_in_days < $no_refund_after_days;
+    }
+
+    my $lostreturn_policy = Koha::CirculationRules->get_lostreturn_policy(
+        {
+            item          => $self,
+            return_branch => C4::Context->userenv
+            ? C4::Context->userenv->{'branch'}
+            : undef,
+        }
+      );
+
+    if ( $lostreturn_policy ) {
+
+        # refund charge made for lost book
+        my $lost_charge = Koha::Account::Lines->search(
+            {
+                itemnumber      => $self->itemnumber,
+                debit_type_code => 'LOST',
+                status          => [ undef, { '<>' => 'FOUND' } ]
+            },
+            {
+                order_by => { -desc => [ 'date', 'accountlines_id' ] },
+                rows     => 1
+            }
+        )->single;
+
+        if ( $lost_charge ) {
+
+            my $patron = $lost_charge->patron;
+            if ( $patron ) {
+
+                my $account = $patron->account;
+                my $total_to_refund = 0;
+
+                # Use cases
+                if ( $lost_charge->amount > $lost_charge->amountoutstanding ) {
+
+                    # some amount has been cancelled. collect the offsets that are not writeoffs
+                    # this works because the only way to subtract from this kind of a debt is
+                    # using the UI buttons 'Pay' and 'Write off'
+                    my $credits_offsets = Koha::Account::Offsets->search(
+                        {
+                            debit_id  => $lost_charge->id,
+                            credit_id => { '!=' => undef },     # it is not the debit itself
+                            type      => { '!=' => 'Writeoff' },
+                            amount    => { '<' => 0 }    # credits are negative on the DB
+                        }
+                    );
+
+                    $total_to_refund = ( $credits_offsets->count > 0 )
+                      ? $credits_offsets->total * -1    # credits are negative on the DB
+                      : 0;
+                }
+
+                my $credit_total = $lost_charge->amountoutstanding + $total_to_refund;
+
+                my $credit;
+                if ( $credit_total > 0 ) {
+                    my $branchcode =
+                      C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
+                    $credit = $account->add_credit(
+                        {
+                            amount      => $credit_total,
+                            description => 'Item found ' . $self->itemnumber,
+                            type        => 'LOST_FOUND',
+                            interface   => C4::Context->interface,
+                            library_id  => $branchcode,
+                            item_id     => $self->itemnumber,
+                            issue_id    => $lost_charge->issue_id
+                        }
+                    );
+
+                    $credit->apply( { debits => [$lost_charge] } );
+                    $self->{_refunded} = 1;
+                }
+
+                # Update the account status
+                $lost_charge->status('FOUND');
+                $lost_charge->store();
+
+                # Reconcile balances if required
+                if ( C4::Context->preference('AccountAutoReconcile') ) {
+                    $account->reconcile_balance;
+                }
+            }
+        }
+
+        # restore fine for lost book
+        if ( $lostreturn_policy eq 'restore' ) {
+            my $lost_overdue = Koha::Account::Lines->search(
+                {
+                    itemnumber      => $self->itemnumber,
+                    debit_type_code => 'OVERDUE',
+                    status          => 'LOST'
+                },
+                {
+                    order_by => { '-desc' => 'date' },
+                    rows     => 1
+                }
+            )->single;
+
+            if ( $lost_overdue ) {
+
+                my $patron = $lost_overdue->patron;
+                if ($patron) {
+                    my $account = $patron->account;
+
+                    # Update status of fine
+                    $lost_overdue->status('FOUND')->store();
+
+                    # Find related forgive credit
+                    my $refund = $lost_overdue->credits(
+                        {
+                            credit_type_code => 'FORGIVEN',
+                            itemnumber       => $self->itemnumber,
+                            status           => [ { '!=' => 'VOID' }, undef ]
+                        },
+                        { order_by => { '-desc' => 'date' }, rows => 1 }
+                    )->single;
+
+                    if ( $refund ) {
+                        # Revert the forgive credit
+                        $refund->void({ interface => 'trigger' });
+                        $self->{_restored} = 1;
+                    }
+
+                    # Reconcile balances if required
+                    if ( C4::Context->preference('AccountAutoReconcile') ) {
+                        $account->reconcile_balance;
+                    }
+                }
+            }
+        } elsif ( $lostreturn_policy eq 'charge' ) {
+            $self->{_charge} = 1;
+        }
+    }
+
+    return $self;
+}
+
 =head3 to_api_mapping
 
 This method returns the mapping for representing a Koha::Item object
@@ -800,7 +1142,6 @@ sub to_api_mapping {
         itemnotes                => 'public_notes',
         itemnotes_nonpublic      => 'internal_notes',
         holdingbranch            => 'holding_library_id',
-        paidfor                  => undef,
         timestamp                => 'timestamp',
         location                 => 'location',
         permanent_location       => 'permanent_location',
@@ -819,6 +1160,19 @@ sub to_api_mapping {
     };
 }
 
+=head3 itemtype
+
+    my $itemtype = $item->itemtype;
+
+    Returns Koha object for effective itemtype
+
+=cut
+
+sub itemtype {
+    my ( $self ) = @_;
+    return Koha::ItemTypes->find( $self->effective_itemtype );
+}
+
 =head2 Internal methods
 
 =head3 _after_item_action_hooks