From 00b6bd868c406e1a4af37504359fdc54dc6ed660 Mon Sep 17 00:00:00 2001
From: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
Date: Tue, 28 Apr 2020 14:37:43 +0200
Subject: [PATCH] Bug 25303: Make Koha::Objects->delete loop on the object set

If we call Koha::Libraries->delete but Koha::Library->delete exists
(ie. Koha::Object->delete is overridden), then we Koha::Objects->delete
will be called and the overridden will not be executed.

This patch suggests to test if the method is overridden (using
Class::Inspector->function_exists). If so we loop on the different
objects of the set in a transaction and call the overridden ->delete method.

Existing tests widely cover this change.
t/db_dependent/Koha/Objects.t
    subtest 'Return same values as DBIx::Class' => sub {
---
 Koha/Objects.pm | 26 ++++++++++++++++++++++++--
 1 file changed, 24 insertions(+), 2 deletions(-)

diff --git a/Koha/Objects.pm b/Koha/Objects.pm
index 9184a235a8..cf7626ecc6 100644
--- a/Koha/Objects.pm
+++ b/Koha/Objects.pm
@@ -21,6 +21,7 @@ use Modern::Perl;
 
 use Carp;
 use List::MoreUtils qw( none );
+use Class::Inspector;
 
 use Koha::Database;
 
@@ -171,6 +172,27 @@ sub search_related {
     }
 }
 
+=head3 delete
+
+=cut
+
+sub delete {
+    my ($self) = @_;
+
+    if ( Class::Inspector->function_exists( $self->object_class, 'delete' ) ) {
+        my $objects_deleted;
+        $self->_resultset->result_source->schema->txn_do( sub {
+            while ( my $o = $self->next ) {
+                $o->delete;
+                $objects_deleted++;
+            }
+        });
+        return $objects_deleted;
+    }
+
+    return $self->_resultset->delete;
+}
+
 =head3 single
 
 my $object = Koha::Objects->search({}, { rows => 1 })->single
@@ -431,14 +453,14 @@ The autoload method is used call DBIx::Class method on a resultset.
 
 Important: If you plan to use one of the DBIx::Class methods you must provide
 relevant tests in t/db_dependent/Koha/Objects.t
-Currently count, pager, update and delete are covered.
+Currently count, is_paged, pager, update, result_class, single and slice are covered.
 
 =cut
 
 sub AUTOLOAD {
     my ( $self, @params ) = @_;
 
-    my @known_methods = qw( count is_paged pager update delete result_class single slice );
+    my @known_methods = qw( count is_paged pager update result_class single slice );
     my $method = our $AUTOLOAD;
     $method =~ s/.*:://;
 
-- 
2.20.1