From c24b46b403b51162d582b856d79914509661d26a Mon Sep 17 00:00:00 2001
From: Tomas Cohen Arazi <tomascohen@theke.io>
Date: Fri, 19 Nov 2021 09:55:15 -0300
Subject: [PATCH] Bug 29523: Add Koha::Object->accessible

This patch introduces a method for checking if an object can be
retrieved by the current user. It depends on the plural class
implementation of the ->search_limited method.

To test:
1. Apply this patch
2. Run:
   $ kshell
  k$ prove t/db_dependent/Koha/Object.t
=> SUCCESS: Tests pass!
3. Sign off :-D

Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
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>

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

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
---
 Koha/Object.pm               | 35 +++++++++++++++++++++++++++++++++++
 t/db_dependent/Koha/Object.t | 36 +++++++++++++++++++++++++++++++++++-
 2 files changed, 70 insertions(+), 1 deletion(-)

diff --git a/Koha/Object.pm b/Koha/Object.pm
index 97ae3494fd..2b1d2e2938 100644
--- a/Koha/Object.pm
+++ b/Koha/Object.pm
@@ -893,6 +893,19 @@ sub _get_object_class {
     return ${type};
 }
 
+sub _get_objects_class {
+    my ( $self ) = @_;
+    return unless $self;
+
+    if ( $self->_result->can('koha_objects_class') ) {
+        return $self->_result->koha_objects_class;
+    }
+    my $type = ref($self);
+
+    $type =~ s|Schema::Result::||;
+    return $type . "s";
+}
+
 =head3 AUTOLOAD
 
 The autoload method is used only to get and set values for an objects properties.
@@ -977,6 +990,28 @@ sub _handle_to_api_child {
     return $res;
 }
 
+=head3 accessible
+
+    if ( $object->accessible ) { ... }
+
+Whether the object should be accessible in the current context (requesting user).
+It relies on the plural class properly implementing the I<search_limited> method.
+
+=cut
+
+sub accessible {
+    my ($self) = @_;
+
+    return $self->_get_objects_class->search_limited(
+        {
+            map { $_ => $self->$_ }
+              $self->_result->result_source->primary_columns
+        }
+      )->count > 0
+      ? 1
+      : 0;
+}
+
 sub DESTROY { }
 
 =head1 AUTHOR
diff --git a/t/db_dependent/Koha/Object.t b/t/db_dependent/Koha/Object.t
index 056dbbdfbc..a18c6e1276 100755
--- a/t/db_dependent/Koha/Object.t
+++ b/t/db_dependent/Koha/Object.t
@@ -17,7 +17,7 @@
 
 use Modern::Perl;
 
-use Test::More tests => 21;
+use Test::More tests => 22;
 use Test::Exception;
 use Test::Warn;
 
@@ -1120,3 +1120,37 @@ subtest 'messages() and add_message() tests' => sub {
 
     $schema->storage->txn_rollback;
 };
+
+subtest 'accessible() tests' => sub {
+
+    plan tests => 2;
+
+    $schema->storage->txn_begin;
+
+    my $library_1 = $builder->build_object( { class => 'Koha::Libraries' } );
+    my $library_2 = $builder->build_object( { class => 'Koha::Libraries' } );
+
+    my $patron = $builder->build_object(
+        {
+            class => 'Koha::Patrons',
+            value => {
+                flags      => 2**2,            # only has catalogue permissions
+                branchcode => $library_1->id
+            }
+        }
+    );
+
+    my $patron_1 = $builder->build_object(
+        { class => 'Koha::Patrons', value => { branchcode => $library_1->id } }
+    );
+    my $patron_2 = $builder->build_object(
+        { class => 'Koha::Patrons', value => { branchcode => $library_2->id } }
+    );
+
+    t::lib::Mocks::mock_userenv( { patron => $patron } );
+
+    ok( $patron_1->accessible,  'Has access to the patron' );
+    ok( !$patron_2->accessible, 'Does not have access to the patron' );
+
+    $schema->storage->txn_rollback;
+};
-- 
2.39.5