Bug 17600: Standardize our EXPORT_OK
[srvgit] / Koha / Item.pm
index 71f6b78..c653dc2 100644 (file)
@@ -19,24 +19,23 @@ 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;
 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;
@@ -89,13 +88,22 @@ sub store {
         $self->itype($self->biblio->biblioitem->itemtype);
     }
 
-    my $today         = dt_from_string;
-    my $plugin_action = 'create';
+    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);
         }
@@ -114,12 +122,9 @@ sub store {
             $self->cn_sort($cn_sort);
         }
 
-        logaction( "CATALOGUING", "ADD", $self->itemnumber, "item" )
-          if $log_action && C4::Context->preference("CataloguingLog");
-
     } else { # ModItem
 
-        $plugin_action = 'modify';
+        $action = 'modify';
 
         my %updated_columns = $self->_result->get_dirty_columns;
         return $self->SUPER::store unless %updated_columns;
@@ -186,8 +191,6 @@ sub store {
             $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 ) {
@@ -195,10 +198,15 @@ sub 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 => $plugin_action });
+    $self->get_from_storage->_after_item_action_hooks({ action => $action });
 
     return $result;
 }
@@ -401,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 transfer if the item is in transit or undef
+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.
+
+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
@@ -553,67 +673,6 @@ sub can_be_transferred {
 
 }
 
-=head3 _can_pickup_locations
-
-$item->_can_pickup_locations({ to => $to_libraries, from => $from_library })
-Checks if an item can be transferred to given libraries.
-
-This feature is controlled by two system preferences:
-UseBranchTransferLimits to enable / disable the feature
-BranchTransferLimitsType to use either an itemnumber or ccode as an identifier
-                         for setting the limitations
-
-Takes HASHref that can have the following parameters:
-    MANDATORY PARAMETERS:
-    $to   : Array of Koha::Libraries
-    OPTIONAL PARAMETERS:
-    $from : Koha::Library  # if not given, item holdingbranch
-                           # will be used instead
-
-Returns arry of Koha::Libraries that item can be transferred to $to_library and
-are pickup_locations
-
-If checking only one library please use $item->can_be_transferred.
-
-=cut
-
-sub _can_pickup_locations {
-    my ($self, $params ) = @_;
-
-    my $to   = $params->{to};
-    my $from = $params->{from};
-    $from = defined $from ? $from->branchcode : $self->holdingbranch;
-
-    my @pickup_locations;
-    my @destination_codes;
-    foreach my $lib (@$to){
-        next unless $lib->pickup_location;
-        push @destination_codes, $lib->branchcode;
-        push @pickup_locations, $lib;
-    }
-
-    return \@pickup_locations unless C4::Context->preference('UseBranchTransferLimits');
-
-    my $limittype = C4::Context->preference('BranchTransferLimitsType');
-    my $limiter = $limittype eq 'itemtype' ? $self->effective_itemtype : $self->ccode;
-
-    my $limits = Koha::Item::Transfer::Limits->search({
-                fromBranch => $from,
-                $limittype => $limiter
-            });
-    my @limits = $limits->get_column('toBranch');
-    return \@pickup_locations unless @limits;
-
-    my @can_transfer = Koha::Libraries->search({
-        pickup_location => 1,
-        branchcode => {
-            -in => \@destination_codes,
-            -not_in => \@limits,
-        }
-    });
-    return \@can_transfer;
-}
-
 =head3 pickup_locations
 
 $pickup_locations = $item->pickup_locations( {patron => $patron } )
@@ -633,36 +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;
-    }
+        }
+    ) unless C4::Context->preference('UseBranchTransferLimits');
 
-    my $pickup_locations = $self->_can_pickup_locations({
-        to => \@libs
-    });
+    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
@@ -1004,7 +1086,7 @@ sub _set_found_trigger {
 
                     if ( $refund ) {
                         # Revert the forgive credit
-                        $refund->void();
+                        $refund->void({ interface => 'trigger' });
                         $self->{_restored} = 1;
                     }