From 54e74894b359a305849deba0e8e0c91c600b4f47 Mon Sep 17 00:00:00 2001
From: Tomas Cohen Arazi <tomascohen@theke.io>
Date: Mon, 29 Jul 2024 09:16:56 -0300
Subject: [PATCH] Bug 37510: Make Koha::Object->delete throw Koha::Exception

This patch makes Koha::Object->delete wrap DBIC exceptions on FK
constraints and throw a Koha::Exception::Object::FKConstraint exception
instead. This will allow us better handling it from the callers.

To test:
1. Apply the unit tests patch
2. Run:
   $ ktd --shell
  k$ prove t/db_dependent/Koha/Object.t
=> FAIL: A DBIC exception is thrown instead, tests fail
3. Apply this patch
4. Repeat 2
=> SUCCESS: Tests pass!
5. Sign off :-D

Signed-off-by: David Nind <david@davidnind.com>
---
 Koha/Exceptions/Object.pm |  5 +++++
 Koha/Object.pm            | 25 +++++++++++++++++++++++--
 2 files changed, 28 insertions(+), 2 deletions(-)

diff --git a/Koha/Exceptions/Object.pm b/Koha/Exceptions/Object.pm
index dd79cee90c..4181675826 100644
--- a/Koha/Exceptions/Object.pm
+++ b/Koha/Exceptions/Object.pm
@@ -33,6 +33,11 @@ use Exception::Class (
         description => "Foreign key constraint broken",
         fields      =>  ['broken_fk', 'value'],
     },
+    'Koha::Exceptions::Object::FKConstraintDeletion' => {
+        isa         => 'Koha::Exceptions::Object',
+        description => "Foreign key constraint broken on deleting resource",
+        fields      => [ 'column', 'fk', 'table', 'constraint' ],
+    },
     'Koha::Exceptions::Object::MethodNotFound' => {
         isa => 'Koha::Exceptions::Object',
         description => "Invalid method",
diff --git a/Koha/Object.pm b/Koha/Object.pm
index a833f30580..ad34bbc948 100644
--- a/Koha/Object.pm
+++ b/Koha/Object.pm
@@ -233,11 +233,32 @@ Returns:
 sub delete {
     my ($self) = @_;
 
-    my $deleted = $self->_result()->delete;
+    my $deleted;
+
+    try {
+        $deleted = $self->_result()->delete;
+    } catch {
+        if ( ref($_) eq 'DBIx::Class::Exception' ) {
+            if ( $_->{msg} =~
+                /Cannot delete or update a parent row\: a foreign key constraint fails \(\`(?<database>.*?)\`\.\`(?<table>.*?)\`, CONSTRAINT \`(?<constraint>.*?)\` FOREIGN KEY \(\`(?<fk>.*?)\`\) REFERENCES \`.*\` \(\`(?<column>.*?)\`\)/
+                )
+            {
+                Koha::Exceptions::Object::FKConstraintDeletion->throw(
+                    column     => $+{column},
+                    constraint => $+{constraint},
+                    fk         => $+{fk},
+                    table      => $+{table},
+                );
+            }
+            $_->rethrow();
+        }
+    };
+
     if ( ref $deleted ) {
-        my $object_class  = Koha::Object::_get_object_class( $self->_result->result_class );
+        my $object_class = Koha::Object::_get_object_class( $self->_result->result_class );
         $deleted = $object_class->_new_from_dbic($deleted);
     }
+
     return $deleted;
 }
 
-- 
2.39.2