Bug 30933: (follow-up) Consolidate transfer checks

Adding shelf->cannot_be_transferred with unit tests.

Note: This follow-up actually refers to comment42 on the
preceding report 25498.
Furthermore, we could still improve later on using error code
more effectively (adding codes). Here we concentrate on moving
the checks to module level.

Test plan:
Run t/db_dependent/Virtualshelves.t

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Signed-off-by: David Nind <david@davidnind.com>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>

Koha/Virtualshelf.pm

@@ -265,6 +265,72 @@ sub can_biblios_be_removed {
     # Same answer since bug 18228
 }
 
+=head3 cannot_be_transferred
+
+    $shelf->cannot_be_transferred({
+        by => $p1, to => $p2, interface => opac|intranet|undef,
+            # p1 and p2 are borrowernumbers
+    });
+
+    This routine has two main goals:
+    [1] Decide if patron may transfer a shared list to another
+        sharee (patron).
+    [2] Decide if staff member may transfer a public list.
+
+    If you pass interface, we'll check if it supports transfer too.
+    NOTE: The explicit passing is still more reliable than via context,
+    since we could switch interface after login in the same session.
+
+    Returns a true value (read: error_code) when not allowed.
+    The following error codes are possible:
+        unauthorized_transfer, missing_by_parameter, new_owner_not_found,
+        new_owner_has_no_share, missing_to_parameter.
+    Otherwise returns false (zero).
+
+=cut
+
+sub cannot_be_transferred {
+    my ( $self, $params ) = @_;
+    my $to = $params->{to};
+    my $by = $params->{by};
+    my $interface = $params->{interface};
+
+    # Check on interface: currently we don't support transfer shared on intranet, transfer public on OPAC
+    if( $interface ) {
+        return 'unauthorized_transfer'
+            if ( $self->public && $interface eq 'opac' ) or
+               ( $self->is_private && $interface eq 'intranet' );
+                   # is_private call is enough here, get_shares tested below
+    }
+
+    my $shares = $self->public ? undef : $self->get_shares->search({ borrowernumber => { '!=' => undef } });
+    return 'unauthorized_transfer' if $self->is_private && !$shares->count;
+
+    if( $by ) {
+        if( $self->public ) {
+            my $by_patron = Koha::Patrons->find($by);
+            return 'unauthorized_transfer'
+                if !$by_patron || !haspermission( $by_patron->userid, { lists => 'edit_public_lists' });
+        } else {
+            return 'unauthorized_transfer' if !$self->can_be_managed($by);
+        }
+    } else {
+        return 'missing_by_parameter';
+    }
+
+    if( $to ) {
+        if( !Koha::Patrons->find($to) ) {
+            return 'new_owner_not_found';
+        }
+        if( !$self->public && !$shares->search({ borrowernumber => $to })->count ) {
+            return 'new_owner_has_no_share';
+        }
+    } else {
+        return 'missing_to_parameter';
+    }
+    return 0; # serving as green light
+}
+
 =head2 Internal methods
 
 =head3 _type

t/db_dependent/Virtualshelves.t

@@ -1,7 +1,7 @@
 #!/usr/bin/perl
 
 use Modern::Perl;
-use Test::More tests => 6;
+use Test::More tests => 7;
 use DateTime::Duration;
 
 use C4::Context;
@@ -591,6 +591,49 @@ subtest 'Get shelves containing biblios' => sub {
     teardown();
 };
 
+subtest 'cannot_be_transferred' => sub {
+    plan tests => 12;
+
+    # Three patrons and a deleted one
+    my $staff = $builder->build_object({ class => 'Koha::Patrons', value => { flags => undef } });
+    my $listowner = $builder->build_object({ class => 'Koha::Patrons' });
+    my $receiver = $builder->build_object({ class => 'Koha::Patrons' });
+    my $removed_patron = $builder->build_object({ class => 'Koha::Patrons' });
+    $removed_patron->delete;
+
+    # Create three lists
+    my $private_list = Koha::Virtualshelf->new({ shelfname => "A", owner => $listowner->id })->store;
+    my $public_list = Koha::Virtualshelf->new({ shelfname => "B", public => 1, owner => $listowner->id })->store;
+    my $shared_list = Koha::Virtualshelf->new({ shelfname => "C", owner => $listowner->id })->store;
+    $shared_list->share("key")->accept( "key", $receiver->id );
+
+    # Test on private list
+    is( $private_list->cannot_be_transferred, 'unauthorized_transfer', 'Private list can never be transferred' );
+
+    # Test on public list
+    is( $public_list->cannot_be_transferred, 'missing_by_parameter', 'Public list, no parameters' );
+    is( $public_list->cannot_be_transferred({ by => $staff->id, to => $receiver->id }), 'unauthorized_transfer', 'Lacks permission' );
+    my $perms = $builder->build({ source => 'UserPermission', value  => {
+        borrowernumber => $staff->id, module_bit => 20, code => 'edit_public_lists',
+    }});
+    is( $public_list->cannot_be_transferred({ by => $staff->id, to => $receiver->id }), 0, 'Minimum permission passes' );
+    $staff->flags(1)->store;
+    is( $public_list->cannot_be_transferred({ by => $staff->id, to => $receiver->id }), 0, 'Superlibrarian permission passes' );
+    is( $public_list->cannot_be_transferred({ by => $staff->id, to => $receiver->id, interface => 'opac' }), 'unauthorized_transfer',
+        'Not supported on OPAC' );
+    is( $public_list->cannot_be_transferred({ by => $staff->id, to => $removed_patron->id }), 'new_owner_not_found', 'Removed patron cannot own' );
+
+    # Test on shared list
+    is( $shared_list->cannot_be_transferred({ by => $staff->id }), 'unauthorized_transfer', 'Shared list, transfer limited to owner' );
+    is( $shared_list->cannot_be_transferred({ by => $receiver->id }), 'unauthorized_transfer', 'Shared list, transfer still limited to owner' );
+    is( $shared_list->cannot_be_transferred({ by => $listowner->id, to => $receiver->id }), 0, 'sharee could become owner' );
+    is( $shared_list->cannot_be_transferred({ by => $listowner->id, to => $receiver->id, interface => 'intranet' }), 'unauthorized_transfer',
+        'Intranet not supported' );
+    is( $shared_list->cannot_be_transferred({ by => $listowner->id, to => $staff->id }), 'new_owner_has_no_share', 'staff has no share' );
+};
+
+$schema->storage->txn_rollback;
+
 sub teardown {
     $dbh->do(q|DELETE FROM virtualshelfshares|);
     $dbh->do(q|DELETE FROM virtualshelfcontents|);