Bug 17600: Standardize our EXPORT_OK
[srvgit] / t / db_dependent / Koha / Item.t
index 09c8f7e..1ac523c 100755 (executable)
 
 use Modern::Perl;
 
-use Test::More tests => 7;
+use Test::More tests => 9;
+use Test::Exception;
 
-use C4::Biblio;
-use C4::Circulation;
+use C4::Biblio qw( GetMarcSubfieldStructure );
+use C4::Circulation qw( AddIssue AddReturn );
 
 use Koha::Items;
 use Koha::Database;
+use Koha::DateUtils;
 use Koha::Old::Items;
 
 use List::MoreUtils qw(all);
@@ -88,7 +90,7 @@ subtest 'has_pending_hold() tests' => sub {
 
 subtest "as_marc_field() tests" => sub {
 
-    my $mss = C4::Biblio::GetMarcSubfieldStructure( '', { unsafe => 1 } );
+    my $mss = C4::Biblio::GetMarcSubfieldStructure( '' );
 
     my @schema_columns = $schema->resultset('Item')->result_source->columns;
     my @mapped_columns = grep { exists $mss->{'items.'.$_} } @schema_columns;
@@ -139,7 +141,7 @@ subtest "as_marc_field() tests" => sub {
         }
     )->store;
 
-    $mss = C4::Biblio::GetMarcSubfieldStructure( '', { unsafe => 0 } );
+    $mss = C4::Biblio::GetMarcSubfieldStructure( '' );
     my @unlinked_subfields;
     push @unlinked_subfields, X => 'Something weird';
     $item->more_subfields_xml( C4::Items::_get_unlinked_subfields_xml( \@unlinked_subfields ) )->store;
@@ -212,69 +214,67 @@ subtest 'pickup_locations' => sub {
     my $patron1 = $builder->build_object( { class => 'Koha::Patrons', value => { branchcode => $library1->branchcode, firstname => '1' } } );
     my $patron4 = $builder->build_object( { class => 'Koha::Patrons', value => { branchcode => $library4->branchcode, firstname => '4' } } );
 
-    my $all_count = Koha::Libraries->search({ pickup_location => 1})->count();
-
     my $results = {
-        "1-1-1-any"           => $all_count,
-        "1-1-1-holdgroup"     => 2,
-        "1-1-1-patrongroup"   => 2,
-        "1-1-1-homebranch"    => 1,
-        "1-1-1-holdingbranch" => 1,
-        "1-1-2-any"           => $all_count,
-        "1-1-2-holdgroup"     => 2,
-        "1-1-2-patrongroup"   => 2,
-        "1-1-2-homebranch"    => 1,
-        "1-1-2-holdingbranch" => 1,
-        "1-1-3-any"           => $all_count,
-        "1-1-3-holdgroup"     => 2,
-        "1-1-3-patrongroup"   => 2,
-        "1-1-3-homebranch"    => 1,
-        "1-1-3-holdingbranch" => 1,
-        "1-4-1-any"           => 0,
-        "1-4-1-holdgroup"     => 0,
-        "1-4-1-patrongroup"   => 0,
-        "1-4-1-homebranch"    => 0,
-        "1-4-1-holdingbranch" => 0,
-        "1-4-2-any"           => $all_count,
-        "1-4-2-holdgroup"     => 2,
-        "1-4-2-patrongroup"   => 1,
-        "1-4-2-homebranch"    => 1,
-        "1-4-2-holdingbranch" => 1,
-        "1-4-3-any"           => 0,
-        "1-4-3-holdgroup"     => 0,
-        "1-4-3-patrongroup"   => 0,
-        "1-4-3-homebranch"    => 0,
-        "1-4-3-holdingbranch" => 0,
-        "3-1-1-any"           => 0,
-        "3-1-1-holdgroup"     => 0,
-        "3-1-1-patrongroup"   => 0,
-        "3-1-1-homebranch"    => 0,
-        "3-1-1-holdingbranch" => 0,
-        "3-1-2-any"           => $all_count,
-        "3-1-2-holdgroup"     => 1,
-        "3-1-2-patrongroup"   => 2,
-        "3-1-2-homebranch"    => 0,
-        "3-1-2-holdingbranch" => 1,
-        "3-1-3-any"           => 0,
-        "3-1-3-holdgroup"     => 0,
-        "3-1-3-patrongroup"   => 0,
-        "3-1-3-homebranch"    => 0,
-        "3-1-3-holdingbranch" => 0,
-        "3-4-1-any"           => 0,
-        "3-4-1-holdgroup"     => 0,
-        "3-4-1-patrongroup"   => 0,
-        "3-4-1-homebranch"    => 0,
-        "3-4-1-holdingbranch" => 0,
-        "3-4-2-any"           => $all_count,
-        "3-4-2-holdgroup"     => 1,
-        "3-4-2-patrongroup"   => 1,
-        "3-4-2-homebranch"    => 0,
-        "3-4-2-holdingbranch" => 1,
-        "3-4-3-any"           => $all_count,
-        "3-4-3-holdgroup"     => 1,
-        "3-4-3-patrongroup"   => 1,
-        "3-4-3-homebranch"    => 0,
-        "3-4-3-holdingbranch" => 1
+        "1-1-from_home_library-any"               => 3,
+        "1-1-from_home_library-holdgroup"         => 2,
+        "1-1-from_home_library-patrongroup"       => 2,
+        "1-1-from_home_library-homebranch"        => 1,
+        "1-1-from_home_library-holdingbranch"     => 1,
+        "1-1-from_any_library-any"                => 3,
+        "1-1-from_any_library-holdgroup"          => 2,
+        "1-1-from_any_library-patrongroup"        => 2,
+        "1-1-from_any_library-homebranch"         => 1,
+        "1-1-from_any_library-holdingbranch"      => 1,
+        "1-1-from_local_hold_group-any"           => 3,
+        "1-1-from_local_hold_group-holdgroup"     => 2,
+        "1-1-from_local_hold_group-patrongroup"   => 2,
+        "1-1-from_local_hold_group-homebranch"    => 1,
+        "1-1-from_local_hold_group-holdingbranch" => 1,
+        "1-4-from_home_library-any"               => 0,
+        "1-4-from_home_library-holdgroup"         => 0,
+        "1-4-from_home_library-patrongroup"       => 0,
+        "1-4-from_home_library-homebranch"        => 0,
+        "1-4-from_home_library-holdingbranch"     => 0,
+        "1-4-from_any_library-any"                => 3,
+        "1-4-from_any_library-holdgroup"          => 2,
+        "1-4-from_any_library-patrongroup"        => 1,
+        "1-4-from_any_library-homebranch"         => 1,
+        "1-4-from_any_library-holdingbranch"      => 1,
+        "1-4-from_local_hold_group-any"           => 0,
+        "1-4-from_local_hold_group-holdgroup"     => 0,
+        "1-4-from_local_hold_group-patrongroup"   => 0,
+        "1-4-from_local_hold_group-homebranch"    => 0,
+        "1-4-from_local_hold_group-holdingbranch" => 0,
+        "3-1-from_home_library-any"               => 0,
+        "3-1-from_home_library-holdgroup"         => 0,
+        "3-1-from_home_library-patrongroup"       => 0,
+        "3-1-from_home_library-homebranch"        => 0,
+        "3-1-from_home_library-holdingbranch"     => 0,
+        "3-1-from_any_library-any"                => 3,
+        "3-1-from_any_library-holdgroup"          => 1,
+        "3-1-from_any_library-patrongroup"        => 2,
+        "3-1-from_any_library-homebranch"         => 0,
+        "3-1-from_any_library-holdingbranch"      => 1,
+        "3-1-from_local_hold_group-any"           => 0,
+        "3-1-from_local_hold_group-holdgroup"     => 0,
+        "3-1-from_local_hold_group-patrongroup"   => 0,
+        "3-1-from_local_hold_group-homebranch"    => 0,
+        "3-1-from_local_hold_group-holdingbranch" => 0,
+        "3-4-from_home_library-any"               => 0,
+        "3-4-from_home_library-holdgroup"         => 0,
+        "3-4-from_home_library-patrongroup"       => 0,
+        "3-4-from_home_library-homebranch"        => 0,
+        "3-4-from_home_library-holdingbranch"     => 0,
+        "3-4-from_any_library-any"                => 3,
+        "3-4-from_any_library-holdgroup"          => 1,
+        "3-4-from_any_library-patrongroup"        => 1,
+        "3-4-from_any_library-homebranch"         => 0,
+        "3-4-from_any_library-holdingbranch"      => 1,
+        "3-4-from_local_hold_group-any"           => 3,
+        "3-4-from_local_hold_group-holdgroup"     => 1,
+        "3-4-from_local_hold_group-patrongroup"   => 1,
+        "3-4-from_local_hold_group-homebranch"    => 0,
+        "3-4-from_local_hold_group-holdingbranch" => 1
     };
 
     sub _doTest {
@@ -291,16 +291,20 @@ subtest 'pickup_locations' => sub {
                 }
             }
         );
-        my @pl = $item->pickup_locations( { patron => $patron} )->as_list;
-        my $ha_value=$ha==3?'holdgroup':($ha==2?'any':'homebranch');
+        my $ha_value =
+          $ha eq 'from_local_hold_group' ? 'holdgroup'
+          : (
+            $ha eq 'from_any_library' ? 'any'
+            : 'homebranch'
+          );
+
+        my @pl = map {
+            my $pickup_location = $_;
+            grep { $pickup_location->branchcode eq $_ } @branchcodes
+        } $item->pickup_locations( { patron => $patron } )->as_list;
 
-        foreach my $pickup_location (@pl) {
-            next
-                unless grep { $pickup_location eq $_ } @branchcodes;
-            is( ref($pickup_location), 'Koha::Library', 'Object type is correct' );
-        }
         ok(
-            scalar(@pl) == $results->{
+            scalar(@pl) eq $results->{
                     $item->copynumber . '-'
                   . $patron->firstname . '-'
                   . $ha . '-'
@@ -331,7 +335,7 @@ subtest 'pickup_locations' => sub {
     foreach my $item ($item1, $item3) {
         foreach my $patron ($patron1, $patron4) {
             #holdallowed 1: homebranch, 2: any, 3: holdgroup
-            foreach my $ha (1, 2, 3) {
+            foreach my $ha ('from_home_library', 'from_any_library', 'from_local_hold_group') {
                 foreach my $hfp ('any', 'holdgroup', 'patrongroup', 'homebranch', 'holdingbranch') {
                     _doTest($item, $patron, $ha, $hfp, $results);
                 }
@@ -356,7 +360,7 @@ subtest 'pickup_locations' => sub {
             branchcode => undef,
             itemtype   => $item1->itype,
             rules      => {
-                holdallowed             => 1,
+                holdallowed             => 'from_home_library',
                 hold_fulfillment_policy => 1,
                 returnbranch            => 'any'
             }
@@ -374,8 +378,12 @@ subtest 'pickup_locations' => sub {
         }
     );
 
-    my $pickup_locations = $item1->pickup_locations( { patron => $patron1 } )->as_list;
-    is( scalar @$pickup_locations, $all_count - 1, "With a transfer limits we get back the libraries that are pickup locations minus 1 limited library");
+    my @pickup_locations = map {
+        my $pickup_location = $_;
+        grep { $pickup_location->branchcode eq $_ } @branchcodes
+    } $item1->pickup_locations( { patron => $patron1 } )->as_list;
+
+    is( scalar @pickup_locations, 3 - 1, "With a transfer limits we get back the libraries that are pickup locations minus 1 limited library");
 
     $builder->build_object(
         {
@@ -389,15 +397,25 @@ subtest 'pickup_locations' => sub {
         }
     );
 
-    $pickup_locations = $item1->pickup_locations( { patron => $patron1 } )->as_list;
-    is( scalar @$pickup_locations, $all_count - 2, "With 2 transfer limits we get back the libraries that are pickup locations minus 2 limited libraries");
+    @pickup_locations = map {
+        my $pickup_location = $_;
+        grep { $pickup_location->branchcode eq $_ } @branchcodes
+    } $item1->pickup_locations( { patron => $patron1 } )->as_list;
 
-    t::lib::Mocks::mock_preference('BranchTransferLimitsType', 'ccode');
-    $pickup_locations = $item1->pickup_locations( { patron => $patron1 } )->as_list;
-    is( scalar @$pickup_locations, $all_count, "With no transfer limits of type ccode we get back the libraries that are pickup locations");
+    is( scalar @pickup_locations, 3 - 2, "With 2 transfer limits we get back the libraries that are pickup locations minus 2 limited libraries");
 
-    $pickup_locations = $item_no_ccode->pickup_locations( { patron => $patron1 } )->as_list;
-    is( scalar @$pickup_locations, $all_count, "With no transfer limits of type ccode and an item with no ccode we get back the libraries that are pickup locations");
+    t::lib::Mocks::mock_preference('BranchTransferLimitsType', 'ccode');
+    @pickup_locations = map {
+        my $pickup_location = $_;
+        grep { $pickup_location->branchcode eq $_ } @branchcodes
+    } $item1->pickup_locations( { patron => $patron1 } )->as_list;
+    is( scalar @pickup_locations, 3, "With no transfer limits of type ccode we get back the libraries that are pickup locations");
+
+    @pickup_locations = map {
+        my $pickup_location = $_;
+        grep { $pickup_location->branchcode eq $_ } @branchcodes
+    } $item_no_ccode->pickup_locations( { patron => $patron1 } )->as_list;
+    is( scalar @pickup_locations, 3, "With no transfer limits of type ccode and an item with no ccode we get back the libraries that are pickup locations");
 
     $builder->build_object(
         {
@@ -411,8 +429,11 @@ subtest 'pickup_locations' => sub {
         }
     );
 
-    $pickup_locations = $item1->pickup_locations( { patron => $patron1 } )->as_list;
-    is( scalar @$pickup_locations, $all_count - 1, "With a transfer limits we get back the libraries that are pickup locations minus 1 limited library");
+    @pickup_locations = map {
+        my $pickup_location = $_;
+        grep { $pickup_location->branchcode eq $_ } @branchcodes
+    } $item1->pickup_locations( { patron => $patron1 } )->as_list;
+    is( scalar @pickup_locations, 3 - 1, "With a transfer limits we get back the libraries that are pickup locations minus 1 limited library");
 
     $builder->build_object(
         {
@@ -426,14 +447,99 @@ subtest 'pickup_locations' => sub {
         }
     );
 
-    $pickup_locations = $item1->pickup_locations( { patron => $patron1 } )->as_list;
-    is( scalar @$pickup_locations, $all_count - 2, "With 2 transfer limits we get back the libraries that are pickup locations minus 2 limited libraries");
+    @pickup_locations = map {
+        my $pickup_location = $_;
+        grep { $pickup_location->branchcode eq $_ } @branchcodes
+    } $item1->pickup_locations( { patron => $patron1 } )->as_list;
+    is( scalar @pickup_locations, 3 - 2, "With 2 transfer limits we get back the libraries that are pickup locations minus 2 limited libraries");
 
     t::lib::Mocks::mock_preference('UseBranchTransferLimits', 0);
 
     $schema->storage->txn_rollback;
 };
 
+subtest 'request_transfer' => sub {
+    plan tests => 13;
+    $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'
+    );
+    my $original_transfer = $transfer->get_from_storage;
+
+    # Transfer already in progress
+    throws_ok { $item->request_transfer( { to => $library2, reason => 'Manual' } ) }
+    'Koha::Exceptions::Item::Transfer::InQueue',
+      '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' );
+
+    # Queue transfer
+    my $queued_transfer = $item->request_transfer(
+        { to => $library2, reason => 'Manual', enqueue => 1 } );
+    is( ref($queued_transfer), 'Koha::Item::Transfer',
+        'Koha::Item->request_transfer allowed when enqueue is set' );
+    my $transfers = $item->get_transfers;
+    is($transfers->count, 2, "There are now 2 live transfers in the queue");
+    $transfer = $transfer->get_from_storage;
+    is_deeply($transfer->unblessed, $original_transfer->unblessed, "Original transfer unchanged");
+    $queued_transfer->datearrived(dt_from_string)->store();
+
+    # Replace transfer
+    my $replaced_transfer = $item->request_transfer(
+        { to => $library2, reason => 'Manual', replace => 1 } );
+    is( ref($replaced_transfer), 'Koha::Item::Transfer',
+        'Koha::Item->request_transfer allowed when replace is set' );
+    $original_transfer->discard_changes;
+    ok($original_transfer->datecancelled, "Original transfer cancelled");
+    $transfers = $item->get_transfers;
+    is($transfers->count, 1, "There is only 1 live transfer in the queue");
+    $replaced_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', ignore_limits => 1 } );
+    is( ref($forced_transfer), 'Koha::Item::Transfer',
+        'Koha::Item->request_transfer allowed when ignore_limits is set'
+    );
+
+    $schema->storage->txn_rollback;
+};
+
 subtest 'deletion' => sub {
     plan tests => 12;
 
@@ -611,3 +717,102 @@ subtest 'Tests for itemtype' => sub {
 
     $schema->storage->txn_rollback;
 };
+
+subtest 'get_transfers' => sub {
+    plan tests => 16;
+    $schema->storage->txn_begin;
+
+    my $item = $builder->build_sample_item();
+
+    my $transfers = $item->get_transfers();
+    is(ref($transfers), 'Koha::Item::Transfers', 'Koha::Item->get_transfer should return a Koha::Item::Transfers object' );
+    is($transfers->count, 0, 'When no transfers exist, the Koha::Item:Transfers object should be empty');
+
+    my $library_to = $builder->build_object( { class => 'Koha::Libraries' } );
+
+    my $transfer_1 = $builder->build_object(
+        {
+            class => 'Koha::Item::Transfers',
+            value => {
+                itemnumber    => $item->itemnumber,
+                frombranch    => $item->holdingbranch,
+                tobranch      => $library_to->branchcode,
+                reason        => 'Manual',
+                datesent      => undef,
+                datearrived   => undef,
+                datecancelled => undef,
+                daterequested => \'NOW()'
+            }
+        }
+    );
+
+    $transfers = $item->get_transfers();
+    is($transfers->count, 1, 'When one transfer has been requested, the Koha::Item:Transfers object should contain one result');
+
+    my $transfer_2 = $builder->build_object(
+        {
+            class => 'Koha::Item::Transfers',
+            value => {
+                itemnumber    => $item->itemnumber,
+                frombranch    => $item->holdingbranch,
+                tobranch      => $library_to->branchcode,
+                reason        => 'Manual',
+                datesent      => undef,
+                datearrived   => undef,
+                datecancelled => undef,
+                daterequested => \'NOW()'
+            }
+        }
+    );
+
+    my $transfer_3 = $builder->build_object(
+        {
+            class => 'Koha::Item::Transfers',
+            value => {
+                itemnumber    => $item->itemnumber,
+                frombranch    => $item->holdingbranch,
+                tobranch      => $library_to->branchcode,
+                reason        => 'Manual',
+                datesent      => undef,
+                datearrived   => undef,
+                datecancelled => undef,
+                daterequested => \'NOW()'
+            }
+        }
+    );
+
+    $transfers = $item->get_transfers();
+    is($transfers->count, 3, 'When there are multiple open transfer requests, the Koha::Item::Transfers object contains them all');
+    my $result_1 = $transfers->next;
+    my $result_2 = $transfers->next;
+    my $result_3 = $transfers->next;
+    is( $result_1->branchtransfer_id, $transfer_1->branchtransfer_id, 'Koha::Item->get_transfers returns the oldest transfer request first');
+    is( $result_2->branchtransfer_id, $transfer_2->branchtransfer_id, 'Koha::Item->get_transfers returns the newer transfer request second');
+    is( $result_3->branchtransfer_id, $transfer_3->branchtransfer_id, 'Koha::Item->get_transfers returns the newest transfer request last');
+
+    $transfer_2->datesent(\'NOW()')->store;
+    $transfers = $item->get_transfers();
+    is($transfers->count, 3, 'When one transfer is set to in_transit, the Koha::Item::Transfers object still contains them all');
+    $result_1 = $transfers->next;
+    $result_2 = $transfers->next;
+    $result_3 = $transfers->next;
+    is( $result_1->branchtransfer_id, $transfer_2->branchtransfer_id, 'Koha::Item->get_transfers returns the active transfer request first');
+    is( $result_2->branchtransfer_id, $transfer_1->branchtransfer_id, 'Koha::Item->get_transfers returns the other transfers oldest to newest');
+    is( $result_3->branchtransfer_id, $transfer_3->branchtransfer_id, 'Koha::Item->get_transfers returns the other transfers oldest to newest');
+
+    $transfer_2->datearrived(\'NOW()')->store;
+    $transfers = $item->get_transfers();
+    is($transfers->count, 2, 'Once a transfer is received, it no longer appears in the list from ->get_transfers()');
+    $result_1 = $transfers->next;
+    $result_2 = $transfers->next;
+    is( $result_1->branchtransfer_id, $transfer_1->branchtransfer_id, 'Koha::Item->get_transfers returns the other transfers oldest to newest');
+    is( $result_2->branchtransfer_id, $transfer_3->branchtransfer_id, 'Koha::Item->get_transfers returns the other transfers oldest to newest');
+
+    $transfer_1->datecancelled(\'NOW()')->store;
+    $transfers = $item->get_transfers();
+    is($transfers->count, 1, 'Once a transfer is cancelled, it no longer appears in the list from ->get_transfers()');
+    $result_1 = $transfers->next;
+    is( $result_1->branchtransfer_id, $transfer_3->branchtransfer_id, 'Koha::Item->get_transfers returns the only transfer that remains');
+
+    $schema->storage->txn_rollback;
+};