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