Bug 26057: Add 'cancel' method to Koha::Item::Transfer

This patch adds the 'cancel' method to Koha::Item::Transfer which sets
the transfer as cancelled by updating the datecancelled field. We also
update Koha::Item->get_transfer here to accomodate for the new
resolution available for a transfer.

Test plan:
1/ Run the included unit tests additions (t/db_dependent/Koha/Items.t,
t/db_dependent/Koha/Item/Transfer.t

Signed-off-by: Kathleen Milne <kathleen.milne@cne-siar.gov.uk>
Signed-off-by: Joonas Kylmälä <joonas.kylmala@helsinki.fi>

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>

Koha/Exceptions/Item/Transfer.pm

@@ -1,5 +1,20 @@
 package Koha::Exceptions::Item::Transfer;
 
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
 use Modern::Perl;
 
 use Exception::Class (
@@ -8,19 +23,50 @@ use Exception::Class (
         description => 'Something went wrong'
     },
     'Koha::Exceptions::Item::Transfer::Found' => {
-        isa => 'Koha::Exceptions::Item::Transfer',
+        isa         => 'Koha::Exceptions::Item::Transfer',
         description => "Active item transfer already exists",
-        fields => ['transfer']
+        fields      => ['transfer']
     },
     'Koha::Exceptions::Item::Transfer::Limit' => {
-        isa => 'Koha::Exceptions::Item::Transfer',
+        isa         => 'Koha::Exceptions::Item::Transfer',
         description => "Transfer not allowed"
     },
     'Koha::Exceptions::Item::Transfer::Out' => {
-        isa => 'Koha::Exceptions::Item::Transfer',
+        isa         => 'Koha::Exceptions::Item::Transfer',
         description => "Transfer item is currently checked out"
+    },
+    'Koha::Exceptions::Item::Transfer::Transit' => {
+        isa         => 'Koha::Exceptions::Item::Transfer',
+        description => "Transfer item is currently in transit"
     }
-
 );
 
+=head1 NAME
+
+Koha::Exceptions::Item::Transfer - Base class for Transfer exceptions
+
+=head1 Exceptions
+
+=head2 Koha::Exceptions::Item::Transfer
+
+Generic Item::Transfer exception
+
+=head2 Koha::Exceptions::Item::Transfer::Found
+
+Exception to be used when an active item transfer prevents a transfer action.
+
+=head2 Koha::Exceptions::Item::Transfer::Limit
+
+Exception to be used when transfer limits prevent a transfer action.
+
+=head2 Koha::Exceptions::Item::Transfer::Out
+
+Exception to be used when an active checkout prevents a transfer action.
+
+=head2 Koha::Exceptions::Item::Transfer::Transit
+
+Exception to be used when an in transit transfer prevents a transfer action.
+
+=cut
+
 1;

Koha/Item.pm

@@ -471,10 +471,14 @@ we still expect the item to end up at a final location eventually.
 sub get_transfer {
     my ($self) = @_;
     my $transfer_rs = $self->_result->branchtransfers->search(
-        { datearrived => undef },
         {
-            order_by => [ { -desc => 'datesent' }, { -asc => 'daterequested' } ],
-            rows     => 1
+            datearrived   => undef,
+            datecancelled => undef
+        },
+        {
+            order_by =>
+              [ { -desc => 'datesent' }, { -asc => 'daterequested' } ],
+            rows => 1
         }
     )->first;
     return unless $transfer_rs;

Koha/Item/Transfer.pm

@@ -116,6 +116,32 @@ sub receive {
     return $self;
 }
 
+=head3 cancel
+
+  $transfer->cancel($reason);
+
+Cancel the transfer by setting the datecancelled time and recording the reason.
+
+=cut
+
+sub cancel {
+    my ( $self, $reason ) = @_;
+
+    Koha::Exceptions::MissingParameter->throw(
+        error => "The 'reason' parameter is mandatory" )
+      unless defined($reason);
+
+    # Throw exception if item is in transit already
+    Koha::Exceptions::Item::Transfer::Transit->throw() if ( $self->in_transit );
+
+    # Update the cancelled date
+    $self->set(
+        { datecancelled => dt_from_string, cancellation_reason => $reason } )
+      ->store;
+
+    return $self;
+}
+
 =head3 type
 
 =cut

t/db_dependent/Koha/Item/Transfer.t

@@ -24,7 +24,7 @@ use Koha::DateUtils;
 
 use t::lib::TestBuilder;
 
-use Test::More tests => 4;
+use Test::More tests => 5;
 use Test::Exception;
 
 my $schema  = Koha::Database->new->schema;
@@ -204,5 +204,59 @@ subtest 'in_transit tests' => sub {
     ok( !$transfer->in_transit, 'in_transit returns false when datearrived is defined');
 
 
+    $schema->storage->txn_rollback;
+};
+
+subtest 'cancel tests' => sub {
+    plan tests => 6;
+
+    $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,
+            datelastseen  => undef
+        }
+    );
+    my $cancellation_reason = 'Manual';
+
+    my $transfer = $builder->build_object(
+        {
+            class => 'Koha::Item::Transfers',
+            value => {
+                itemnumber          => $item->itemnumber,
+                frombranch          => $library2->branchcode,
+                tobranch            => $library1->branchcode,
+                datesent            => \'NOW()',
+                datearrived         => undef,
+                datecancelled       => undef,
+                reason              => 'Manual',
+                cancellation_reason => undef
+            }
+        }
+    );
+    is( ref($transfer), 'Koha::Item::Transfer', 'Mock transfer added' );
+
+    # Missing mandatory parameter
+    throws_ok { $transfer->cancel() } 'Koha::Exceptions::MissingParameter',
+      'Exception thrown if a reason is not passed to cancel';
+
+    # Item in transit should result in failure
+    throws_ok { $transfer->cancel($cancellation_reason) }
+    'Koha::Exceptions::Item::Transfer::Transit',
+      'Exception thrown if item is in transit';
+
+    $transfer->datesent(undef)->store();
+
+    # Transit state unset
+    $transfer->discard_changes;
+    $transfer->cancel($cancellation_reason);
+    ok( $transfer->datecancelled, 'Cancellation date set upon call to cancel' );
+    is( $transfer->cancellation_reason, 'Manual', 'Cancellation reason is set');
+    is( $transfer->reason, 'Manual', 'Reason is not updated by cancelling the transfer' );
+
     $schema->storage->txn_rollback;
 };

t/db_dependent/Koha/Items.t

@@ -1184,7 +1184,7 @@ subtest 'store' => sub {
 };
 
 subtest 'get_transfer' => sub {
-    plan tests => 6;
+    plan tests => 7;
 
     my $transfer = $new_item_1->get_transfer();
     is( $transfer, undef, 'Koha::Item->get_transfer should return undef if the item is not in transit' );
@@ -1201,6 +1201,7 @@ subtest 'get_transfer' => sub {
                 reason        => 'Manual',
                 datesent      => undef,
                 datearrived   => undef,
+                datecancelled => undef,
                 daterequested => \'NOW()'
             }
         }
@@ -1213,12 +1214,13 @@ subtest 'get_transfer' => sub {
         {
             class => 'Koha::Item::Transfers',
             value => {
-                itemnumber  => $new_item_1->itemnumber,
-                frombranch  => $new_item_1->holdingbranch,
-                tobranch    => $library_to->{branchcode},
-                reason      => 'Manual',
-                datesent    => undef,
-                datearrived => undef,
+                itemnumber    => $new_item_1->itemnumber,
+                frombranch    => $new_item_1->holdingbranch,
+                tobranch      => $library_to->{branchcode},
+                reason        => 'Manual',
+                datesent      => undef,
+                datearrived   => undef,
+                datecancelled => undef,
                 daterequested => \'NOW()'
             }
         }
@@ -1235,12 +1237,13 @@ subtest 'get_transfer' => sub {
         {
             class => 'Koha::Item::Transfers',
             value => {
-                itemnumber  => $new_item_1->itemnumber,
-                frombranch  => $new_item_1->holdingbranch,
-                tobranch    => $library_to->{branchcode},
-                reason      => 'Manual',
-                datesent    => undef,
-                datearrived => undef,
+                itemnumber    => $new_item_1->itemnumber,
+                frombranch    => $new_item_1->holdingbranch,
+                tobranch      => $library_to->{branchcode},
+                reason        => 'Manual',
+                datesent      => undef,
+                datearrived   => undef,
+                datecancelled => undef,
                 daterequested => \'NOW()'
             }
         }
@@ -1250,6 +1253,10 @@ subtest 'get_transfer' => sub {
     $transfer = $new_item_1->get_transfer();
     is( $transfer->branchtransfer_id, $transfer_1->branchtransfer_id, 'Koha::Item->get_transfer returns the next queued transfer');
     is( $transfer->itemnumber, $new_item_1->itemnumber, 'Koha::Item->get_transfer returns the right items transfer' );
+
+    $transfer_1->datecancelled(\'NOW()')->store;
+    $transfer = $new_item_1->get_transfer();
+    is( $transfer->branchtransfer_id, $transfer_3->branchtransfer_id, 'Koha::Item->get_transfer ignores cancelled transfers');
 };
 
 subtest 'holds' => sub {