View | Details | Raw Unified | Return to bug 33537
Collapse All | Expand All

(-)a/Koha/Exceptions/DomainLimit.pm (+69 lines)
Line 0 Link Here
1
package Koha::Exceptions::DomainLimit;
2
3
# Copyright 2023 Rijksmuseum, Koha Development Team
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
use Koha::Exception;
22
use Exception::Class (
23
    'Koha::Exceptions::DomainLimit' => {
24
        isa => 'Koha::Exception',
25
    },
26
    'Koha::Exceptions::DomainLimit::EmptyLimitData' => {
27
        isa => 'Koha::Exceptions::DomainLimit',
28
        description => 'Unexpected empty limit data',
29
        fields => [ 'parameter' ],
30
    },
31
    'Koha::Exceptions::DomainLimit::MemberWithLimit' => {
32
        isa => 'Koha::Exceptions::DomainLimit',
33
        description => 'A group member cannot have individual limit',
34
    },
35
    'Koha::Exceptions::DomainLimit::NoSelfChaining' => {
36
        isa => 'Koha::Exceptions::DomainLimit',
37
        description => 'Cannot belong to yourself',
38
    },
39
);
40
41
=head1 NAME
42
43
Koha::Exceptions::DomainLimit - Base class for DomainLimit exceptions
44
45
=head1 DESCRIPTION
46
47
Defines exceptions for domain limits
48
49
=head1 Exceptions
50
51
=head2 Koha::Exceptions::DomainLimit
52
53
Generic DomainLimit exception.
54
55
=head2 Koha::Exceptions::DomainLimit::EmptyLimitData
56
57
Exception for empty limit data
58
59
=head2 Koha::Exceptions::DomainLimit::MemberWithLimit
60
61
Exception for a group member with limit data
62
63
=head2 Koha::Exceptions::DomainLimit::NoSelfChaining
64
65
Exception for setting belongs_to to id
66
67
=cut
68
69
1;
(-)a/Koha/MailDomainLimit.pm (+93 lines)
Line 0 Link Here
1
package Koha::MailDomainLimit;
2
3
# Copyright 2023 Rijksmuseum, Koha development team
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use base qw(Koha::Object);
23
use Koha::Exceptions::DomainLimit;
24
25
=head1 NAME
26
27
Koha::MailDomainLimit - Koha object class for mail domain limits
28
29
=head1 API
30
31
=head2 Class Methods
32
33
=cut
34
35
=head3 store
36
37
    Overrides Koha::Object->store for raising few specific exceptions
38
39
=cut
40
41
sub store {
42
    my $self = shift;
43
44
    # Raise exception if belongs_to is combined with limit data, or the other way around
45
    if ( $self->belongs_to ) {
46
        Koha::Exceptions::DomainLimit::NoSelfChaining->throw if $self->id && $self->id == $self->belongs_to;
47
        Koha::Exceptions::DomainLimit::MemberWithLimit->throw
48
            if $self->domain_limit || $self->units || $self->unit_type;
49
    } else {
50
        Koha::Exceptions::DomainLimit::EmptyLimitData->throw( parameter => 'domain_limit' ) if !$self->domain_limit;
51
        Koha::Exceptions::DomainLimit::EmptyLimitData->throw( parameter => 'units' )        if !$self->units;
52
        Koha::Exceptions::DomainLimit::EmptyLimitData->throw( parameter => 'unit_type' )    if !$self->unit_type;
53
    }
54
    $self->SUPER::store;
55
}
56
57
=head3 group_domain
58
59
    Returns group_domain column added by search_with_group_domain or follows relation for belongs_to
60
61
=cut
62
63
sub group_domain {
64
    my $self = shift;
65
    return if !$self->belongs_to;
66
    if ( $self->_result->has_column_loaded('group_domain') ) {
67
        return $self->_result->get_column('group_domain');
68
    } else {
69
        return $self->_result->belongs_to_rel->domain_name;
70
    }
71
}
72
73
=head3 to_api_mapping
74
75
This method returns the mapping for API object representation.
76
77
=cut
78
79
sub to_api_mapping {
80
    return {
81
        id           => 'domain_limit_id',
82
    };
83
}
84
85
=head3 _type
86
87
=cut
88
89
sub _type {
90
    return 'MailDomainLimit';
91
}
92
93
1;
(-)a/Koha/MailDomainLimits.pm (+65 lines)
Line 0 Link Here
1
package Koha::MailDomainLimits;
2
3
# Copyright 2023 Rijksmuseum, Koha development team
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
use Koha::MailDomainLimit;
22
23
use base qw(Koha::Objects);
24
25
=head1 NAME
26
27
Koha::MailDomainLimits - Koha objects class for mail domain limits
28
29
=head1 API
30
31
=head2 Class Methods
32
33
=cut
34
35
=head3 search_with_group_domain
36
37
    Include domain name for belongs_to by self join
38
39
=cut
40
41
sub search_with_group_domain {
42
    my ( $self, $params, $attributes ) = @_;
43
    $attributes //= {};
44
    $attributes->{join}       = 'belongs_to_rel';
45
    $attributes->{'+columns'} = [ { 'group_domain' => 'belongs_to_rel.domain_name' } ];
46
    return Koha::MailDomainLimits->search( $params, $attributes );
47
}
48
49
=head3 _type
50
51
=cut
52
53
sub _type {
54
    return 'MailDomainLimit';
55
}
56
57
=head3 object_class
58
59
=cut
60
61
sub object_class {
62
    return 'Koha::MailDomainLimit';
63
}
64
65
1;
(-)a/t/db_dependent/Koha/MailDomainLimits.t (-1 / +80 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Copyright 2023 Rijksmuseum, Koha development team
4
#
5
# This file is part of Koha
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
use Test::More tests => 3;
22
use Test::Exception;
23
24
use t::lib::TestBuilder;
25
use t::lib::Mocks;
26
27
use Koha::MailDomainLimits;
28
use Koha::Database;
29
30
my $builder = t::lib::TestBuilder->new;
31
my $schema  = Koha::Database->new->schema;
32
33
$schema->storage->txn_begin;
34
35
subtest 'Some trivial tests' => sub {
36
    plan tests => 3;
37
38
    my $count = Koha::MailDomainLimits->count;
39
    my $limit01 = $builder->build_object( { class => 'Koha::MailDomainLimits' } );
40
    is( Koha::MailDomainLimits->count, $count + 1, 'Check if record has been added' );
41
    is( $limit01->belongs_to, undef, 'Check default for belongs_to' );
42
    $limit01->delete;
43
    is( Koha::MailDomainLimits->count, $count, 'Back to original count' );
44
};
45
46
subtest 'store' => sub {
47
    plan tests => 5;
48
    my $limit01 = $builder->build_object( { class => 'Koha::MailDomainLimits' } );
49
    my $limit02 = $builder->build_object( { class => 'Koha::MailDomainLimits' } );
50
    my $value = { domain_limit => 1, belongs_to => $limit01->id };
51
    throws_ok { $limit02->set($value)->store } 'Koha::Exceptions::DomainLimit::MemberWithLimit', 'Group member with limit raised exception';
52
    $value = { units => 0, belongs_to => undef };
53
    throws_ok { $limit02->set($value)->store } 'Koha::Exceptions::DomainLimit::EmptyLimitData', 'Not possible to store 0 units';
54
    is( $@->parameter, 'units', 'Correct column name passed in exception' );
55
    $value = { domain_limit => undef, units => undef, unit_type => undef, belongs_to => $limit02->id + 1 };
56
    throws_ok { local *STDERR; open STDERR, '>', '/dev/null'; $limit02->set($value)->store } 'Koha::Exceptions::Object::FKConstraint', 'Trigger FK constraint for bad group id';
57
    $value = { domain_limit => undef, units => undef, unit_type => undef, belongs_to => $limit02->id };
58
    throws_ok { $limit02->set($value)->store } 'Koha::Exceptions::DomainLimit::NoSelfChaining', 'Not possible to store id in belongs_to';
59
};
60
61
subtest 'search_with_group_domain, group_domain' => sub {
62
    plan tests => 6;
63
    my $limit01 = $builder->build_object( { class => 'Koha::MailDomainLimits' } );
64
    my $value = { domain_limit => undef, units => undef, unit_type => undef, belongs_to => $limit01->id };
65
    my $limit02 = $builder->build_object( { class => 'Koha::MailDomainLimits', value => $value } );
66
    my $limit03 = $builder->build_object( { class => 'Koha::MailDomainLimits' } );
67
68
    # Check group_domain with and without search_with
69
    is( $limit02->_result->has_column_loaded('group_domain'), 0, 'No additional column' );
70
    is( $limit02->group_domain, $limit01->domain_name, 'Check group domain name via relation' );
71
    my $rs_plus = Koha::MailDomainLimits->search_with_group_domain;
72
    my $limit02_plus = $rs_plus->find( $limit02->id );
73
    is( $limit02_plus->_result->has_column_loaded('group_domain'), 1, 'Includes additional column' );
74
    is( $limit02_plus->group_domain, $limit01->domain_name, 'Check group domain name from search_with' );
75
    $limit02_plus->belongs_to( $limit03->id )->store->discard_changes;
76
    is( $limit02_plus->_result->has_column_loaded('group_domain'), 0, 'Column lost by discarding changes' );
77
    is( $limit02_plus->group_domain, $limit03->domain_name, 'Check group domain name again after store (via relation)' );
78
};
79
80
$schema->storage->txn_rollback;

Return to bug 33537