From 490ca51d65c6b42d816fbd2ae22536485b6027c9 Mon Sep 17 00:00:00 2001
From: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Date: Wed, 28 Jun 2023 13:49:36 +0000
Subject: [PATCH] Bug 33537: Add Koha objects

Test plan:
Run t/db_dependent/Koha/MailDomainLimits.t

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
[EDIT] Run perltidy on MailDomainLimits.t
Signed-off-by: Pedro Amorim <pedro.amorim@ptfs-europe.com>
---
 Koha/Exceptions/DomainLimit.pm         | 69 +++++++++++++++++++
 Koha/MailDomainLimit.pm                | 93 ++++++++++++++++++++++++++
 Koha/MailDomainLimits.pm               | 65 ++++++++++++++++++
 t/db_dependent/Koha/MailDomainLimits.t | 87 ++++++++++++++++++++++++
 4 files changed, 314 insertions(+)
 create mode 100644 Koha/Exceptions/DomainLimit.pm
 create mode 100644 Koha/MailDomainLimit.pm
 create mode 100644 Koha/MailDomainLimits.pm
 create mode 100755 t/db_dependent/Koha/MailDomainLimits.t

diff --git a/Koha/Exceptions/DomainLimit.pm b/Koha/Exceptions/DomainLimit.pm
new file mode 100644
index 0000000000..8ec30badf1
--- /dev/null
+++ b/Koha/Exceptions/DomainLimit.pm
@@ -0,0 +1,69 @@
+package Koha::Exceptions::DomainLimit;
+
+# Copyright 2023 Rijksmuseum, Koha Development Team
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+use Koha::Exception;
+use Exception::Class (
+    'Koha::Exceptions::DomainLimit' => {
+        isa => 'Koha::Exception',
+    },
+    'Koha::Exceptions::DomainLimit::EmptyLimitData' => {
+        isa => 'Koha::Exceptions::DomainLimit',
+        description => 'Unexpected empty limit data',
+        fields => [ 'parameter' ],
+    },
+    'Koha::Exceptions::DomainLimit::MemberWithLimit' => {
+        isa => 'Koha::Exceptions::DomainLimit',
+        description => 'A group member cannot have individual limit',
+    },
+    'Koha::Exceptions::DomainLimit::NoSelfChaining' => {
+        isa => 'Koha::Exceptions::DomainLimit',
+        description => 'Cannot belong to yourself',
+    },
+);
+
+=head1 NAME
+
+Koha::Exceptions::DomainLimit - Base class for DomainLimit exceptions
+
+=head1 DESCRIPTION
+
+Defines exceptions for domain limits
+
+=head1 Exceptions
+
+=head2 Koha::Exceptions::DomainLimit
+
+Generic DomainLimit exception.
+
+=head2 Koha::Exceptions::DomainLimit::EmptyLimitData
+
+Exception for empty limit data
+
+=head2 Koha::Exceptions::DomainLimit::MemberWithLimit
+
+Exception for a group member with limit data
+
+=head2 Koha::Exceptions::DomainLimit::NoSelfChaining
+
+Exception for setting belongs_to to id
+
+=cut
+
+1;
diff --git a/Koha/MailDomainLimit.pm b/Koha/MailDomainLimit.pm
new file mode 100644
index 0000000000..e3c23e438b
--- /dev/null
+++ b/Koha/MailDomainLimit.pm
@@ -0,0 +1,93 @@
+package Koha::MailDomainLimit;
+
+# Copyright 2023 Rijksmuseum, Koha development team
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use base qw(Koha::Object);
+use Koha::Exceptions::DomainLimit;
+
+=head1 NAME
+
+Koha::MailDomainLimit - Koha object class for mail domain limits
+
+=head1 API
+
+=head2 Class Methods
+
+=cut
+
+=head3 store
+
+    Overrides Koha::Object->store for raising few specific exceptions
+
+=cut
+
+sub store {
+    my $self = shift;
+
+    # Raise exception if belongs_to is combined with limit data, or the other way around
+    if ( $self->belongs_to ) {
+        Koha::Exceptions::DomainLimit::NoSelfChaining->throw if $self->id && $self->id == $self->belongs_to;
+        Koha::Exceptions::DomainLimit::MemberWithLimit->throw
+            if $self->domain_limit || $self->units || $self->unit_type;
+    } else {
+        Koha::Exceptions::DomainLimit::EmptyLimitData->throw( parameter => 'domain_limit' ) if !$self->domain_limit;
+        Koha::Exceptions::DomainLimit::EmptyLimitData->throw( parameter => 'units' )        if !$self->units;
+        Koha::Exceptions::DomainLimit::EmptyLimitData->throw( parameter => 'unit_type' )    if !$self->unit_type;
+    }
+    $self->SUPER::store;
+}
+
+=head3 group_domain
+
+    Returns group_domain column added by search_with_group_domain or follows relation for belongs_to
+
+=cut
+
+sub group_domain {
+    my $self = shift;
+    return if !$self->belongs_to;
+    if ( $self->_result->has_column_loaded('group_domain') ) {
+        return $self->_result->get_column('group_domain');
+    } else {
+        return $self->_result->belongs_to_rel->domain_name;
+    }
+}
+
+=head3 to_api_mapping
+
+This method returns the mapping for API object representation.
+
+=cut
+
+sub to_api_mapping {
+    return {
+        id           => 'domain_limit_id',
+    };
+}
+
+=head3 _type
+
+=cut
+
+sub _type {
+    return 'MailDomainLimit';
+}
+
+1;
diff --git a/Koha/MailDomainLimits.pm b/Koha/MailDomainLimits.pm
new file mode 100644
index 0000000000..b9236944cf
--- /dev/null
+++ b/Koha/MailDomainLimits.pm
@@ -0,0 +1,65 @@
+package Koha::MailDomainLimits;
+
+# Copyright 2023 Rijksmuseum, Koha development team
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+use Koha::MailDomainLimit;
+
+use base qw(Koha::Objects);
+
+=head1 NAME
+
+Koha::MailDomainLimits - Koha objects class for mail domain limits
+
+=head1 API
+
+=head2 Class Methods
+
+=cut
+
+=head3 search_with_group_domain
+
+    Include domain name for belongs_to by self join
+
+=cut
+
+sub search_with_group_domain {
+    my ( $self, $params, $attributes ) = @_;
+    $attributes //= {};
+    $attributes->{join}       = 'belongs_to_rel';
+    $attributes->{'+columns'} = [ { 'group_domain' => 'belongs_to_rel.domain_name' } ];
+    return Koha::MailDomainLimits->search( $params, $attributes );
+}
+
+=head3 _type
+
+=cut
+
+sub _type {
+    return 'MailDomainLimit';
+}
+
+=head3 object_class
+
+=cut
+
+sub object_class {
+    return 'Koha::MailDomainLimit';
+}
+
+1;
diff --git a/t/db_dependent/Koha/MailDomainLimits.t b/t/db_dependent/Koha/MailDomainLimits.t
new file mode 100755
index 0000000000..73eda368cb
--- /dev/null
+++ b/t/db_dependent/Koha/MailDomainLimits.t
@@ -0,0 +1,87 @@
+#!/usr/bin/perl
+
+# Copyright 2023 Rijksmuseum, Koha development team
+#
+# This file is part of Koha
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+use Test::More tests => 3;
+use Test::Exception;
+
+use t::lib::TestBuilder;
+use t::lib::Mocks;
+
+use Koha::MailDomainLimits;
+use Koha::Database;
+
+my $builder = t::lib::TestBuilder->new;
+my $schema  = Koha::Database->new->schema;
+
+$schema->storage->txn_begin;
+
+subtest 'Some trivial tests' => sub {
+    plan tests => 3;
+
+    my $count   = Koha::MailDomainLimits->count;
+    my $limit01 = $builder->build_object( { class => 'Koha::MailDomainLimits' } );
+    is( Koha::MailDomainLimits->count, $count + 1, 'Check if record has been added' );
+    is( $limit01->belongs_to,          undef,      'Check default for belongs_to' );
+    $limit01->delete;
+    is( Koha::MailDomainLimits->count, $count, 'Back to original count' );
+};
+
+subtest 'store' => sub {
+    plan tests => 5;
+    my $limit01 = $builder->build_object( { class => 'Koha::MailDomainLimits' } );
+    my $limit02 = $builder->build_object( { class => 'Koha::MailDomainLimits' } );
+    my $value = { domain_limit => 1, belongs_to => $limit01->id };
+    throws_ok { $limit02->set($value)->store } 'Koha::Exceptions::DomainLimit::MemberWithLimit',
+        'Group member with limit raised exception';
+    $value = { units => 0, belongs_to => undef };
+    throws_ok { $limit02->set($value)->store } 'Koha::Exceptions::DomainLimit::EmptyLimitData',
+        'Not possible to store 0 units';
+    is( $@->parameter, 'units', 'Correct column name passed in exception' );
+    $value = { domain_limit => undef, units => undef, unit_type => undef, belongs_to => $limit02->id + 1 };
+    throws_ok { local *STDERR; open STDERR, '>', '/dev/null'; $limit02->set($value)->store }
+    'Koha::Exceptions::Object::FKConstraint', 'Trigger FK constraint for bad group id';
+    $value = { domain_limit => undef, units => undef, unit_type => undef, belongs_to => $limit02->id };
+    throws_ok { $limit02->set($value)->store } 'Koha::Exceptions::DomainLimit::NoSelfChaining',
+        'Not possible to store id in belongs_to';
+};
+
+subtest 'search_with_group_domain, group_domain' => sub {
+    plan tests => 6;
+    my $limit01 = $builder->build_object( { class => 'Koha::MailDomainLimits' } );
+    my $value   = { domain_limit => undef, units => undef, unit_type => undef, belongs_to => $limit01->id };
+    my $limit02 = $builder->build_object( { class => 'Koha::MailDomainLimits', value => $value } );
+    my $limit03 = $builder->build_object( { class => 'Koha::MailDomainLimits' } );
+
+    # Check group_domain with and without search_with
+    is( $limit02->_result->has_column_loaded('group_domain'), 0, 'No additional column' );
+    is( $limit02->group_domain, $limit01->domain_name, 'Check group domain name via relation' );
+    my $rs_plus      = Koha::MailDomainLimits->search_with_group_domain;
+    my $limit02_plus = $rs_plus->find( $limit02->id );
+    is( $limit02_plus->_result->has_column_loaded('group_domain'), 1, 'Includes additional column' );
+    is( $limit02_plus->group_domain, $limit01->domain_name, 'Check group domain name from search_with' );
+    $limit02_plus->belongs_to( $limit03->id )->store->discard_changes;
+    is( $limit02_plus->_result->has_column_loaded('group_domain'), 0, 'Column lost by discarding changes' );
+    is(
+        $limit02_plus->group_domain, $limit03->domain_name,
+        'Check group domain name again after store (via relation)'
+    );
+};
+
+$schema->storage->txn_rollback;
-- 
2.30.2