From d1c689b5aa6c27924c8aef140e6f730d779496c3 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 {
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>
---
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