From 85c1414be5267fe58c71aea6e8e0859ad76c5b6f Mon Sep 17 00:00:00 2001
From: Martin Renvoize <martin.renvoize@ptfs-europe.com>
Date: Mon, 20 Jan 2020 15:11:53 +0000
Subject: [PATCH] Bug 25755: Add Koha::Item->request_transfer method
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This patch adds the request_transfer method to the Koha::Item object.
The new method requires `to` and `reason` parameters and will throw an
exception if an active transfer request is found on the item.

Test plan
1/ Run the included updated tests in t/db_dependent/Koha/Item.t
2/ Verify the tests pass
3/ Signoff

Signed-off-by: Kathleen Milne <kathleen.milne@cne-siar.gov.uk>
Signed-off-by: Katrin Fischer <katrin.fischer.83@web.de>
Signed-off-by: Joonas Kylmälä <joonas.kylmala@helsinki.fi>
---
 Koha/Exceptions/Item/Transfer.pm | 21 ++++++++++
 Koha/Item.pm                     | 71 +++++++++++++++++++++++++++++---
 t/db_dependent/Koha/Item.t       | 65 ++++++++++++++++++++++++++++-
 3 files changed, 151 insertions(+), 6 deletions(-)
 create mode 100644 Koha/Exceptions/Item/Transfer.pm

diff --git a/Koha/Exceptions/Item/Transfer.pm b/Koha/Exceptions/Item/Transfer.pm
new file mode 100644
index 0000000000..746877bd04
--- /dev/null
+++ b/Koha/Exceptions/Item/Transfer.pm
@@ -0,0 +1,21 @@
+package Koha::Exceptions::Item::Transfer;
+
+use Modern::Perl;
+
+use Exception::Class (
+
+    'Koha::Exceptions::Item::Transfer' => {
+        description => 'Something went wrong'
+    },
+    'Koha::Exceptions::Item::Transfer::Found' => {
+        isa => 'Koha::Exceptions::Item::Transfer',
+        description => "Active item transfer already exists",
+        fields => ['transfer']
+    },
+    'Koha::Exceptions::Item::Transfer::Limit' => {
+        isa => 'Koha::Exceptions::Item::Transfer',
+        description => "Transfer not allowed"
+    }
+);
+
+1;
diff --git a/Koha/Item.pm b/Koha/Item.pm
index 5c9d86e49a..398e4b411b 100644
--- a/Koha/Item.pm
+++ b/Koha/Item.pm
@@ -37,6 +37,7 @@ 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;
@@ -401,19 +402,79 @@ sub holds {
     return Koha::Holds->_new_from_dbic( $holds_rs );
 }
 
+=head3 request_transfer
+
+  my $transfer = $item->request_transfer(
+      { to => $to_library, reason => $reason, force => 0 } );
+
+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.
+
+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.
+
+=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" );
+        }
+    }
+
+    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} } ) );
+
+    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 LIFO (Last In First Out) order using this method.
+
+FIXME: Add Tests for LIFO functionality
 
 =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 },
+        {
+            order_by => [ { -asc => '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 last_returned_by
diff --git a/t/db_dependent/Koha/Item.t b/t/db_dependent/Koha/Item.t
index f2713b4e26..5a6d16ae85 100755
--- a/t/db_dependent/Koha/Item.t
+++ b/t/db_dependent/Koha/Item.t
@@ -19,13 +19,15 @@
 
 use Modern::Perl;
 
-use Test::More tests => 7;
+use Test::More tests => 8;
+use Test::Exception;
 
 use C4::Biblio;
 use C4::Circulation;
 
 use Koha::Items;
 use Koha::Database;
+use Koha::DateUtils;
 use Koha::Old::Items;
 
 use List::MoreUtils qw(all);
@@ -451,6 +453,67 @@ subtest 'pickup_locations' => sub {
     $schema->storage->txn_rollback;
 };
 
+subtest 'request_transfer' => sub {
+    plan tests => 7;
+    $schema->storage->txn_begin;
+
+    my $library1 = $builder->build_object( { class => 'Koha::Libraries' } );
+    my $library2 = $builder->build_object( { class => 'Koha::Libraries' } );
+    my $item     = $builder->build_sample_item(
+        {
+            homebranch    => $library1->branchcode,
+            holdingbranch => $library2->branchcode,
+        }
+    );
+
+    # Mandatory fields tests
+    throws_ok { $item->request_transfer( { to => $library1 } ) }
+    'Koha::Exceptions::MissingParameter',
+      'Exception thrown if `reason` parameter is missing';
+
+    throws_ok { $item->request_transfer( { reason => 'Manual' } ) }
+    'Koha::Exceptions::MissingParameter',
+      'Exception thrown if `to` parameter is missing';
+
+    # Successful request
+    my $transfer = $item->request_transfer({ to => $library1, reason => 'Manual' });
+    is( ref($transfer), 'Koha::Item::Transfer',
+        'Koha::Item->request_transfer should return a Koha::Item::Transfer object'
+    );
+
+    # Transfer already in progress
+    throws_ok { $item->request_transfer( { to => $library2, reason => 'Manual' } ) }
+    'Koha::Exceptions::Item::Transfer::Found',
+      'Exception thrown if transfer is already in progress';
+
+    my $exception = $@;
+    is( ref( $exception->transfer ),
+        'Koha::Item::Transfer',
+        'The exception contains the found Koha::Item::Transfer' );
+
+    $transfer->datearrived(dt_from_string)->store();
+
+    # BranchTransferLimits
+    t::lib::Mocks::mock_preference('UseBranchTransferLimits', 1);
+    t::lib::Mocks::mock_preference('BranchTransferLimitsType', 'itemtype');
+    my $limit = Koha::Item::Transfer::Limit->new({
+        fromBranch => $library2->branchcode,
+        toBranch => $library1->branchcode,
+        itemtype => $item->effective_itemtype,
+    })->store;
+
+    throws_ok { $item->request_transfer( { to => $library1, reason => 'Manual' } ) }
+    'Koha::Exceptions::Item::Transfer::Limit',
+      'Exception thrown if transfer is prevented by limits';
+
+    my $forced_transfer = $item->request_transfer( { to => $library1, reason => 'Manual', force => 1 } );
+    is( ref($forced_transfer), 'Koha::Item::Transfer',
+        'Koha::Item->request_transfer allowed when forced'
+    );
+
+    $schema->storage->txn_rollback;
+};
+
 subtest 'deletion' => sub {
     plan tests => 12;
 
-- 
2.20.1