From 88c66b2037b2c4c369643110b45e78e49b067d42 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

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

TODO: Complete work of LIFO queues for get_transfer and add tests for
that
---
 Koha/Exceptions/Item/Transfer.pm | 16 ++++++++
 Koha/Item.pm                     | 65 ++++++++++++++++++++++++++++++--
 t/db_dependent/Koha/Item.t       | 39 ++++++++++++++++++-
 3 files changed, 115 insertions(+), 5 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..f9ef23f23b
--- /dev/null
+++ b/Koha/Exceptions/Item/Transfer.pm
@@ -0,0 +1,16 @@
+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"
+    }
+);
+
+1;
diff --git a/Koha/Item.pm b/Koha/Item.pm
index 9560a567cb..91a3d85b8a 100644
--- a/Koha/Item.pm
+++ b/Koha/Item.pm
@@ -36,6 +36,7 @@ use C4::Log qw( logaction );
 
 use Koha::Checkouts;
 use Koha::CirculationRules;
+use Koha::Exceptions::Item::Transfer;
 use Koha::Item::Transfer::Limits;
 use Koha::Item::Transfers;
 use Koha::Patrons;
@@ -379,19 +380,75 @@ sub holds {
     return Koha::Holds->_new_from_dbic( $holds_rs );
 }
 
+=head3 request_transfer
+
+  my $transfer = $item->request_transfer( { to => $tobranch, reason => $reason } );
+
+Add a transfer request for this item to the given branch for the given reason.
+
+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" );
+        }
+    }
+
+    Koha::Exceptions::Item::Transfer::Found->throw()
+      if ( $self->get_transfer );
+    # FIXME: Add override functionality to allow for queing transfers
+
+    my $from   = $self->holdingbranch;
+    my $to     = $params->{to};
+    my $reason = $params->{reason};
+
+    my $transfer = Koha::Item::Transfer->new(
+        {
+            itemnumber    => $self->itemnumber,
+            daterequested => dt_from_string,
+            frombranch    => $from,
+            tobranch      => $to,
+            reason        => $reason,
+            comments      => $params->{comment}
+        }
+    )->store();
+    return $transfer;
+}
+
 =head3 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 20547d71b4..d51f1f6ff1 100644
--- a/t/db_dependent/Koha/Item.t
+++ b/t/db_dependent/Koha/Item.t
@@ -19,7 +19,8 @@
 
 use Modern::Perl;
 
-use Test::More tests => 6;
+use Test::More tests => 7;
+use Test::Exception;
 
 use C4::Biblio;
 use C4::Circulation;
@@ -341,6 +342,42 @@ subtest 'pickup_locations' => sub {
     $schema->storage->txn_rollback;
 };
 
+subtest 'request_transfer' => sub {
+    plan tests => 4;
+    $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->branchcode } ) }
+    '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->branchcode, 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->branchcode, reason => 'Manual' } ) }
+    'Koha::Exceptions::Item::Transfer::Found',
+      'Exception thrown if transfer is already in progress';
+
+    $schema->storage->txn_rollback;
+};
+
 subtest 'deletion' => sub {
     plan tests => 12;
 
-- 
2.20.1