Bug 17600: Standardize our EXPORT_OK
[srvgit] / Koha / Item.pm
index 398e4b4..c653dc2 100644 (file)
@@ -19,18 +19,16 @@ 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::ClassSource; # FIXME We would like to avoid that
+use C4::ClassSource qw( GetClassSort );
 use C4::Log qw( logaction );
 
 use Koha::Checkouts;
@@ -94,9 +92,18 @@ sub store {
     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);
         }
@@ -405,17 +412,25 @@ sub holds {
 =head3 request_transfer
 
   my $transfer = $item->request_transfer(
-      { to => $to_library, reason => $reason, force => 0 } );
+    {
+        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 'force' is passed to override the limits.
+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.
 
-Note: At this time, only one active transfer (i.e pending arrival date) may exist
-at a time for any given item. An exception will be thrown should you attempt to
-add a request when a transfer has already been queued, whether it is in transit
-or just at the request stage.
+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
 
@@ -431,13 +446,16 @@ sub request_transfer {
         }
     }
 
-    my $request;
-    Koha::Exceptions::Item::Transfer::Found->throw( transfer => $request )
-      if ( $request = $self->get_transfer );
-    # FIXME: Add override functionality to allow for queing transfers
-
     Koha::Exceptions::Item::Transfer::Limit->throw()
-      unless ( $params->{force} || $self->can_be_transferred( { to => $params->{to} } ) );
+      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(
         {
@@ -449,6 +467,7 @@ sub request_transfer {
             comments      => $params->{comment}
         }
     )->store();
+
     return $transfer;
 }
 
@@ -458,25 +477,65 @@ sub request_transfer {
 
 Return the active transfer request or undef
 
-Note: Transfers are retrieved in a LIFO (Last In First Out) order using this method.
+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.
 
-FIXME: Add Tests for LIFO functionality
+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 },
         {
-            order_by => [ { -asc => 'datesent' }, { -asc => 'daterequested' } ],
-            rows     => 1
+            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);
 }
 
+=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
 
 Gets and sets the last borrower to return an item.
@@ -634,8 +693,8 @@ sub pickup_locations {
       C4::Circulation::GetBranchItemRule( $circ_control_branch, $self->itype );
 
     if(defined $patron) {
-        return Koha::Libraries->new()->empty if $branchitemrule->{holdallowed} == 3 && !$self->home_branch->validate_hold_sibling( {branchcode => $patron->branchcode} );
-        return Koha::Libraries->new()->empty 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();
@@ -1027,7 +1086,7 @@ sub _set_found_trigger {
 
                     if ( $refund ) {
                         # Revert the forgive credit
-                        $refund->void();
+                        $refund->void({ interface => 'trigger' });
                         $self->{_restored} = 1;
                     }