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

(-)a/C4/Installer.pm (-8 / +9 lines)
Lines 34-40 use vars qw(@ISA @EXPORT); Link Here
34
BEGIN {
34
BEGIN {
35
    require Exporter;
35
    require Exporter;
36
    @ISA = qw( Exporter );
36
    @ISA = qw( Exporter );
37
    push @EXPORT, qw( primary_key_exists unique_key_exists foreign_key_exists index_exists column_exists TableExists table_exists marc_framework_sql_list TransformToNum CheckVersion NewVersion SetVersion sanitize_zero_date update get_db_entries get_atomic_updates run_atomic_updates has_non_dynamic_row_format );
37
    push @EXPORT,
38
        qw( primary_key_exists unique_key_exists foreign_key_exists index_exists column_exists TableExists table_exists marc_framework_sql_list TransformToNum CheckVersion NewVersion SetVersion sanitize_zero_date update get_db_entries get_atomic_updates run_atomic_updates has_non_dynamic_row_format );
38
};
39
};
39
40
40
=head1 NAME
41
=head1 NAME
Lines 692-705 sub column_exists { Link Here
692
693
693
=cut
694
=cut
694
695
695
sub TableExists { # Legacy name
696
sub TableExists {    # Legacy name
696
    my $table = shift;
697
    my $table = shift;
697
    eval {
698
    eval {
698
                my $dbh = C4::Context->dbh;
699
        my $dbh = C4::Context->dbh;
699
                local $dbh->{PrintError} = 0;
700
        local $dbh->{PrintError} = 0;
700
                local $dbh->{RaiseError} = 1;
701
        local $dbh->{RaiseError} = 1;
701
                $dbh->do(qq{SELECT * FROM $table WHERE 1 = 0 });
702
        $dbh->do(qq{SELECT * FROM $table WHERE 1 = 0 });
702
            };
703
    };
703
    return 1 unless $@;
704
    return 1 unless $@;
704
    return 0;
705
    return 0;
705
}
706
}
Lines 710-716 sub TableExists { # Legacy name Link Here
710
711
711
=cut
712
=cut
712
713
713
sub table_exists { # More consistently named alias for TableExists
714
sub table_exists {    # More consistently named alias for TableExists
714
    return TableExists(@_);
715
    return TableExists(@_);
715
}
716
}
716
717
(-)a/Koha/Exceptions/DomainLimit.pm (-4 / +4 lines)
Lines 24-39 use Exception::Class ( Link Here
24
        isa => 'Koha::Exception',
24
        isa => 'Koha::Exception',
25
    },
25
    },
26
    'Koha::Exceptions::DomainLimit::EmptyLimitData' => {
26
    'Koha::Exceptions::DomainLimit::EmptyLimitData' => {
27
        isa => 'Koha::Exceptions::DomainLimit',
27
        isa         => 'Koha::Exceptions::DomainLimit',
28
        description => 'Unexpected empty limit data',
28
        description => 'Unexpected empty limit data',
29
        fields => [ 'parameter' ],
29
        fields      => ['parameter'],
30
    },
30
    },
31
    'Koha::Exceptions::DomainLimit::MemberWithLimit' => {
31
    'Koha::Exceptions::DomainLimit::MemberWithLimit' => {
32
        isa => 'Koha::Exceptions::DomainLimit',
32
        isa         => 'Koha::Exceptions::DomainLimit',
33
        description => 'A group member cannot have individual limit',
33
        description => 'A group member cannot have individual limit',
34
    },
34
    },
35
    'Koha::Exceptions::DomainLimit::NoSelfChaining' => {
35
    'Koha::Exceptions::DomainLimit::NoSelfChaining' => {
36
        isa => 'Koha::Exceptions::DomainLimit',
36
        isa         => 'Koha::Exceptions::DomainLimit',
37
        description => 'Cannot belong to yourself',
37
        description => 'Cannot belong to yourself',
38
    },
38
    },
39
);
39
);
(-)a/Koha/MailDomainLimit.pm (-1 / +1 lines)
Lines 78-84 This method returns the mapping for API object representation. Link Here
78
78
79
sub to_api_mapping {
79
sub to_api_mapping {
80
    return {
80
    return {
81
        id           => 'domain_limit_id',
81
        id => 'domain_limit_id',
82
    };
82
    };
83
}
83
}
84
84
(-)a/Koha/Notice/Util.pm (-18 / +23 lines)
Lines 43-50 sub load_domain_limits { Link Here
43
    my ( $class ) = @_;
43
    my ( $class ) = @_;
44
    my $rs = Koha::MailDomainLimits->search_with_group_domain;
44
    my $rs = Koha::MailDomainLimits->search_with_group_domain;
45
    if ( $rs->count ) {
45
    if ( $rs->count ) {
46
        return { map { _init_domain_entry($_) } @{$rs->unblessed} };
46
        return { map { _init_domain_entry($_) } @{ $rs->unblessed } };
47
    } else { # fall back to koha-conf
47
    } else {    # fall back to koha-conf
48
        return _load_from_file();
48
        return _load_from_file();
49
    }
49
    }
50
}
50
}
Lines 52-65 sub load_domain_limits { Link Here
52
sub _load_from_file {
52
sub _load_from_file {
53
    my $config = C4::Context->config('message_domain_limits');
53
    my $config = C4::Context->config('message_domain_limits');
54
    my $domain_limits;
54
    my $domain_limits;
55
    if( ref($config) eq 'HASH' ) {
55
    if ( ref($config) eq 'HASH' ) {
56
        if( exists $config->{domain} ) {
56
        if ( exists $config->{domain} ) {
57
57
            # Turn single hash entry into array
58
            # Turn single hash entry into array
58
            $domain_limits = ref($config->{domain}) eq 'HASH'
59
            $domain_limits =
60
                ref( $config->{domain} ) eq 'HASH'
59
                ? [ $config->{domain} ]
61
                ? [ $config->{domain} ]
60
                : $config->{domain};
62
                : $config->{domain};
63
61
            # Convert to hash structure by domain name
64
            # Convert to hash structure by domain name
62
            $domain_limits = { map { _init_domain_entry({ %$_ }, 1); } @$domain_limits }; # copy hashes to prevent changes
65
            $domain_limits =
66
                { map { _init_domain_entry( {%$_}, 1 ); } @$domain_limits };    # copy hashes to prevent changes
63
        }
67
        }
64
    }
68
    }
65
    return $domain_limits;
69
    return $domain_limits;
Lines 67-88 sub _load_from_file { Link Here
67
71
68
sub _init_domain_entry {
72
sub _init_domain_entry {
69
    my ( $entry, $old_school ) = @_;
73
    my ( $entry, $old_school ) = @_;
74
70
    # entry comes from table or koha-conf
75
    # entry comes from table or koha-conf
71
    # Return either a hash like ( name => { limit => , units =>, unit_type =>, count => } ) for regular entries
76
    # Return either a hash like ( name => { limit => , units =>, unit_type =>, count => } ) for regular entries
72
    # or return a hash like ( name => { belongs_to => } ) for a domain that is part of a group
77
    # or return a hash like ( name => { belongs_to => } ) for a domain that is part of a group
73
    # We need old_school when passing data from koha-conf.xml
78
    # We need old_school when passing data from koha-conf.xml
74
79
75
    if( $old_school ) {
80
    if ($old_school) {
76
        ( $entry->{units}, $entry->{unit_type} ) = _unit_info( delete $entry->{unit} );
81
        ( $entry->{units}, $entry->{unit_type} ) = _unit_info( delete $entry->{unit} );
77
    } else {
82
    } else {
78
        $entry->{name} = delete $entry->{domain_name};
83
        $entry->{name}       = delete $entry->{domain_name};
79
        $entry->{limit} = delete $entry->{domain_limit};
84
        $entry->{limit}      = delete $entry->{domain_limit};
80
        $entry->{belongs_to} = delete $entry->{group_domain};
85
        $entry->{belongs_to} = delete $entry->{group_domain};
81
    }
86
    }
82
87
83
    return if !exists $entry->{name};
88
    return if !exists $entry->{name};
84
    my $elements;
89
    my $elements;
85
    if( $entry->{belongs_to} ) {
90
    if ( $entry->{belongs_to} ) {
86
        $elements = { belongs_to => lc $entry->{belongs_to} };
91
        $elements = { belongs_to => lc $entry->{belongs_to} };
87
    } else {
92
    } else {
88
        $elements = {
93
        $elements = {
Lines 95-103 sub _init_domain_entry { Link Here
95
    return ( lc $entry->{name}, $elements );
100
    return ( lc $entry->{name}, $elements );
96
}
101
}
97
102
98
sub _unit_info { # Converting old-style unit like '3m' to ( 3, 'minutes' ) etc.
103
sub _unit_info {    # Converting old-style unit like '3m' to ( 3, 'minutes' ) etc.
99
    my ( $unit ) = @_;
104
    my ($unit) = @_;
100
    if( $unit && $unit =~ /(\d+)([mhd])/ ) {
105
    if ( $unit && $unit =~ /(\d+)([mhd])/ ) {
101
        return ( $1, ABBREV->{$2} );
106
        return ( $1, ABBREV->{$2} );
102
    }
107
    }
103
    return;
108
    return;
Lines 111-119 sub _unit_info { # Converting old-style unit like '3m' to ( 3, 'minutes' ) etc. Link Here
111
116
112
sub exceeds_limit {
117
sub exceeds_limit {
113
    my ( $class, $params ) = @_;
118
    my ( $class, $params ) = @_;
114
    my $domain_limits = $params->{limits} or return 0; # no limits at all
119
    my $domain_limits = $params->{limits} or return 0;    # no limits at all
115
    my $to_address = $params->{to} or return 0; # no address, no limit exceeded
120
    my $to_address    = $params->{to}     or return 0;    # no address, no limit exceeded
116
    my $incr = $params->{incr} // 1; # by default we increment
121
    my $incr          = $params->{incr} // 1;             # by default we increment
117
122
118
    my $domain = q{};
123
    my $domain = q{};
119
    $domain = lc $1 if $to_address && $to_address =~ /@(\H+)/;
124
    $domain = lc $1 if $to_address && $to_address =~ /@(\H+)/;
Lines 124-132 sub exceeds_limit { Link Here
124
    _get_domain_count( $domain, $group, $domain_limits ) if !defined $domain_limits->{$group}->{count};
129
    _get_domain_count( $domain, $group, $domain_limits ) if !defined $domain_limits->{$group}->{count};
125
    return 1 if $domain_limits->{$group}->{count} >= $domain_limits->{$group}->{limit};
130
    return 1 if $domain_limits->{$group}->{count} >= $domain_limits->{$group}->{limit};
126
131
127
    if( $incr ) {
132
    if ($incr) {
128
        $domain_limits->{$group}->{count}++;
133
        $domain_limits->{$group}->{count}++;
129
        warn "Sending messages: domain $group reached limit of ". $domain_limits->{$group}->{limit}
134
        warn "Sending messages: domain $group reached limit of " . $domain_limits->{$group}->{limit}
130
            if $domain_limits->{$group}->{count} == $domain_limits->{$group}->{limit};
135
            if $domain_limits->{$group}->{count} == $domain_limits->{$group}->{limit};
131
    }
136
    }
132
    return 0;
137
    return 0;
(-)a/Koha/REST/V1/Config/SMTP/DomainLimits.pm (-32 / +27 lines)
Lines 20-26 package Koha::REST::V1::Config::SMTP::DomainLimits; Link Here
20
use Modern::Perl;
20
use Modern::Perl;
21
use Mojo::Base 'Mojolicious::Controller';
21
use Mojo::Base 'Mojolicious::Controller';
22
use Scalar::Util qw( blessed );
22
use Scalar::Util qw( blessed );
23
use Try::Tiny qw( catch try );
23
use Try::Tiny    qw( catch try );
24
24
25
use Koha::MailDomainLimits;
25
use Koha::MailDomainLimits;
26
26
Lines 39-46 sub list { Link Here
39
    return try {
39
    return try {
40
        my $limits = $c->objects->search( Koha::MailDomainLimits->search_with_group_domain );
40
        my $limits = $c->objects->search( Koha::MailDomainLimits->search_with_group_domain );
41
        return $c->render( _render_helper( 200, undef, result => $limits ) );
41
        return $c->render( _render_helper( 200, undef, result => $limits ) );
42
    }
42
    } catch {
43
    catch {
44
        $c->unhandled_exception($_);
43
        $c->unhandled_exception($_);
45
    };
44
    };
46
}
45
}
Lines 55-64 sub get { Link Here
55
    my $c = shift->openapi->valid_input or return;
54
    my $c = shift->openapi->valid_input or return;
56
    return try {
55
    return try {
57
        my $rec = Koha::MailDomainLimits->search_with_group_domain->find( $c->validation->param('domain_limit_id') );
56
        my $rec = Koha::MailDomainLimits->search_with_group_domain->find( $c->validation->param('domain_limit_id') );
58
        return $c->render( _render_helper( 404, undef, error => "Domain limit not found" ) ) if !$rec;
57
        return $c->render( _render_helper( 404, undef, error  => "Domain limit not found" ) ) if !$rec;
59
        return $c->render( _render_helper( 200, undef, result => $rec->to_api ) );
58
        return $c->render( _render_helper( 200, undef, result => $rec->to_api ) );
60
    }
59
    } catch {
61
    catch {
62
        $c->unhandled_exception($_);
60
        $c->unhandled_exception($_);
63
    }
61
    }
64
}
62
}
Lines 76-92 sub add { Link Here
76
        $limit->store->discard_changes;
74
        $limit->store->discard_changes;
77
        $c->res->headers->location( $c->req->url->to_string . '/' . $limit->id );
75
        $c->res->headers->location( $c->req->url->to_string . '/' . $limit->id );
78
        return $c->render( _render_helper( 201, undef, result => $limit->to_api ) );
76
        return $c->render( _render_helper( 201, undef, result => $limit->to_api ) );
79
    }
77
    } catch {
80
    catch {
78
        if ( blessed($_) ) {
81
        if( blessed($_) ) {
82
            return $c->render( _render_helper( 409, $_ ) )
79
            return $c->render( _render_helper( 409, $_ ) )
83
                if $_->isa('Koha::Exceptions::DomainLimit::NoSelfChaining')
80
                if $_->isa('Koha::Exceptions::DomainLimit::NoSelfChaining')
84
                    || $_->isa('Koha::Exceptions::DomainLimit::MemberWithLimit')
81
                || $_->isa('Koha::Exceptions::DomainLimit::MemberWithLimit')
85
                    || $_->isa('Koha::Exceptions::Object::DuplicateID');
82
                || $_->isa('Koha::Exceptions::Object::DuplicateID');
86
            return $c->render( _render_helper( 400, $_, missing => $_->parameter ) )
83
            return $c->render( _render_helper( 400, $_, missing => $_->parameter ) )
87
                if $_->isa('Koha::Exceptions::DomainLimit::EmptyLimitData');
84
                if $_->isa('Koha::Exceptions::DomainLimit::EmptyLimitData');
88
            return $c->render( _render_helper( 404, $_ ) )
85
            return $c->render( _render_helper( 404, $_ ) )
89
                if $_->isa('Koha::Exceptions::Object::FKConstraint'); # on belongs_to
86
                if $_->isa('Koha::Exceptions::Object::FKConstraint');    # on belongs_to
90
        }
87
        }
91
        $c->unhandled_exception($_);
88
        $c->unhandled_exception($_);
92
    };
89
    };
Lines 99-122 Controller method that handles updating a domain limit Link Here
99
=cut
96
=cut
100
97
101
sub update {
98
sub update {
102
    my $c = shift->openapi->valid_input or return;
99
    my $c     = shift->openapi->valid_input or return;
103
    my $limit = Koha::MailDomainLimits->find( $c->validation->param('domain_limit_id') );
100
    my $limit = Koha::MailDomainLimits->find( $c->validation->param('domain_limit_id') );
104
    return $c->render(  _render_helper( 404, undef, error => "Object not found" ) ) if !$limit;
101
    return $c->render( _render_helper( 404, undef, error => "Object not found" ) ) if !$limit;
105
    return try {
102
    return try {
106
        $limit->set_from_api( $c->validation->param('body') );
103
        $limit->set_from_api( $c->validation->param('body') );
107
        $limit->store->discard_changes;
104
        $limit->store->discard_changes;
108
        return $c->render( _render_helper( 200, undef, result => $limit->to_api ) );
105
        return $c->render( _render_helper( 200, undef, result => $limit->to_api ) );
109
    }
106
    } catch {
110
    catch {
107
        if ( blessed($_) ) {
111
        if( blessed($_) ) {
108
            return $c->render( _render_helper( 409, $_ ) )
112
            return $c->render(_render_helper( 409, $_ ) )
113
                if $_->isa('Koha::Exceptions::DomainLimit::NoSelfChaining')
109
                if $_->isa('Koha::Exceptions::DomainLimit::NoSelfChaining')
114
                    || $_->isa('Koha::Exceptions::DomainLimit::MemberWithLimit')
110
                || $_->isa('Koha::Exceptions::DomainLimit::MemberWithLimit')
115
                    || $_->isa('Koha::Exceptions::Object::DuplicateID');
111
                || $_->isa('Koha::Exceptions::Object::DuplicateID');
116
            return $c->render(_render_helper( 400, $_, missing => $_->parameter ) )
112
            return $c->render( _render_helper( 400, $_, missing => $_->parameter ) )
117
                if $_->isa('Koha::Exceptions::DomainLimit::EmptyLimitData');
113
                if $_->isa('Koha::Exceptions::DomainLimit::EmptyLimitData');
118
            return $c->render(_render_helper( 404, $_ ) )
114
            return $c->render( _render_helper( 404, $_ ) )
119
                if $_->isa('Koha::Exceptions::Object::FKConstraint'); # on belongs_to
115
                if $_->isa('Koha::Exceptions::Object::FKConstraint');    # on belongs_to
120
        }
116
        }
121
        $c->unhandled_exception($_);
117
        $c->unhandled_exception($_);
122
    };
118
    };
Lines 129-142 Controller method that handles deleting a domain limit Link Here
129
=cut
125
=cut
130
126
131
sub delete {
127
sub delete {
132
    my $c = shift->openapi->valid_input or return;
128
    my $c     = shift->openapi->valid_input or return;
133
    my $limit = Koha::MailDomainLimits->find( $c->validation->param('domain_limit_id') );
129
    my $limit = Koha::MailDomainLimits->find( $c->validation->param('domain_limit_id') );
134
    return $c->render(  _render_helper( 404, undef, error => "Domain limit not found" ) ) if !$limit;
130
    return $c->render( _render_helper( 404, undef, error => "Domain limit not found" ) ) if !$limit;
135
    return try {
131
    return try {
136
        $limit->delete;
132
        $limit->delete;
137
        return $c->render( _render_helper( 204, undef, result => q{} ) );
133
        return $c->render( _render_helper( 204, undef, result => q{} ) );
138
    }
134
    } catch {
139
    catch {
140
        $c->unhandled_exception($_);
135
        $c->unhandled_exception($_);
141
    };
136
    };
142
}
137
}
Lines 146-158 sub delete { Link Here
146
=cut
141
=cut
147
142
148
sub _render_helper {
143
sub _render_helper {
149
    my ( $status, $exception, %result ) = @_; # %result can be: result => $result to pass only one result
144
    my ( $status, $exception, %result ) = @_;    # %result can be: result => $result to pass only one result
150
    my $resp = { status => $status };
145
    my $resp          = { status => $status };
151
    my @error_message = $exception ? ( error => ( $exception->message || $exception->description ) ) : ();
146
    my @error_message = $exception ? ( error => ( $exception->message || $exception->description ) ) : ();
152
    if( @error_message ) {
147
    if (@error_message) {
153
        $resp->{openapi} = { @error_message, %result };
148
        $resp->{openapi} = { @error_message, %result };
154
    } elsif( keys %result ) {
149
    } elsif ( keys %result ) {
155
        $resp->{openapi} = $result{result} // { %result };
150
        $resp->{openapi} = $result{result} // {%result};
156
    }
151
    }
157
    return %$resp;
152
    return %$resp;
158
}
153
}
(-)a/admin/domain_limits.pl (-1 / +1 lines)
Lines 20-26 Link Here
20
use Modern::Perl;
20
use Modern::Perl;
21
use CGI qw ( -utf8 );
21
use CGI qw ( -utf8 );
22
22
23
use C4::Auth qw( get_template_and_user );
23
use C4::Auth   qw( get_template_and_user );
24
use C4::Output qw( output_html_with_http_headers );
24
use C4::Output qw( output_html_with_http_headers );
25
25
26
my $input = CGI->new;
26
my $input = CGI->new;
(-)a/installer/data/mysql/atomicupdate/bug33537.pl (-5 / +7 lines)
Lines 1-14 Link Here
1
use Modern::Perl;
1
use Modern::Perl;
2
2
3
return {
3
return {
4
    bug_number => 33537,
4
    bug_number  => 33537,
5
    description => "Add table mail_domain_limits",
5
    description => "Add table mail_domain_limits",
6
    up => sub {
6
    up          => sub {
7
        my ($args) = @_;
7
        my ($args) = @_;
8
        my ($dbh, $out) = @$args{qw(dbh out)};
8
        my ( $dbh, $out ) = @$args{qw(dbh out)};
9
9
10
        if ( !table_exists('mail_domain_limits') ) {
10
        if ( !table_exists('mail_domain_limits') ) {
11
            $dbh->do(q{
11
            $dbh->do(
12
                q{
12
CREATE TABLE `mail_domain_limits` (
13
CREATE TABLE `mail_domain_limits` (
13
  `id` int(11) NOT NULL AUTO_INCREMENT,
14
  `id` int(11) NOT NULL AUTO_INCREMENT,
14
  `domain_name` tinytext COLLATE utf8mb4_unicode_ci NOT NULL,
15
  `domain_name` tinytext COLLATE utf8mb4_unicode_ci NOT NULL,
Lines 21-27 CREATE TABLE `mail_domain_limits` ( Link Here
21
  KEY `mail_domain_limits_fk1` (`belongs_to`),
22
  KEY `mail_domain_limits_fk1` (`belongs_to`),
22
  CONSTRAINT `mail_domain_limits_fk1` FOREIGN KEY (`belongs_to`) REFERENCES `mail_domain_limits` (`id`) ON DELETE CASCADE ON UPDATE CASCADE
23
  CONSTRAINT `mail_domain_limits_fk1` FOREIGN KEY (`belongs_to`) REFERENCES `mail_domain_limits` (`id`) ON DELETE CASCADE ON UPDATE CASCADE
23
) ENGINE=InnoDB DEFAULT CHARSET=utf8mb4 COLLATE=utf8mb4_unicode_ci;
24
) ENGINE=InnoDB DEFAULT CHARSET=utf8mb4 COLLATE=utf8mb4_unicode_ci;
24
            });
25
            }
26
            );
25
            say $out "Added new table 'mail_domain_limits'";
27
            say $out "Added new table 'mail_domain_limits'";
26
        }
28
        }
27
    },
29
    },
(-)a/t/db_dependent/Installer.t (-2 / +2 lines)
Lines 79-86 ok( ! primary_key_exists( 'borrowers', 'email'), 'Borrowers does not have a prim Link Here
79
79
80
subtest 'table_exists' => sub {
80
subtest 'table_exists' => sub {
81
    plan tests => 2;
81
    plan tests => 2;
82
    is( table_exists( 'borrowers' ), 1, 'Table borrowers still exists ;)' );
82
    is( table_exists('borrowers'),                   1, 'Table borrowers still exists ;)' );
83
    is( table_exists( 'this_table_will_never_exist' ), 0, 'This table does not exist, not likely to be created too' );
83
    is( table_exists('this_table_will_never_exist'), 0, 'This table does not exist, not likely to be created too' );
84
};
84
};
85
85
86
subtest 'marc_framework_sql_list' => sub {
86
subtest 'marc_framework_sql_list' => sub {
(-)a/t/db_dependent/Koha/MailDomainLimits.t (-3 / +3 lines)
Lines 47-53 subtest 'store' => sub { Link Here
47
    plan tests => 5;
47
    plan tests => 5;
48
    my $limit01 = $builder->build_object( { class => 'Koha::MailDomainLimits' } );
48
    my $limit01 = $builder->build_object( { class => 'Koha::MailDomainLimits' } );
49
    my $limit02 = $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 };
50
    my $value   = { domain_limit => 1, belongs_to => $limit01->id };
51
    throws_ok { $limit02->set($value)->store } 'Koha::Exceptions::DomainLimit::MemberWithLimit',
51
    throws_ok { $limit02->set($value)->store } 'Koha::Exceptions::DomainLimit::MemberWithLimit',
52
        'Group member with limit raised exception';
52
        'Group member with limit raised exception';
53
    $value = { units => 0, belongs_to => undef };
53
    $value = { units => 0, belongs_to => undef };
Lines 71-81 subtest 'search_with_group_domain, group_domain' => sub { Link Here
71
71
72
    # Check group_domain with and without search_with
72
    # Check group_domain with and without search_with
73
    is( $limit02->_result->has_column_loaded('group_domain'), 0, 'No additional column' );
73
    is( $limit02->_result->has_column_loaded('group_domain'), 0, 'No additional column' );
74
    is( $limit02->group_domain, $limit01->domain_name, 'Check group domain name via relation' );
74
    is( $limit02->group_domain, $limit01->domain_name,           'Check group domain name via relation' );
75
    my $rs_plus      = Koha::MailDomainLimits->search_with_group_domain;
75
    my $rs_plus      = Koha::MailDomainLimits->search_with_group_domain;
76
    my $limit02_plus = $rs_plus->find( $limit02->id );
76
    my $limit02_plus = $rs_plus->find( $limit02->id );
77
    is( $limit02_plus->_result->has_column_loaded('group_domain'), 1, 'Includes additional column' );
77
    is( $limit02_plus->_result->has_column_loaded('group_domain'), 1, 'Includes additional column' );
78
    is( $limit02_plus->group_domain, $limit01->domain_name, 'Check group domain name from search_with' );
78
    is( $limit02_plus->group_domain, $limit01->domain_name,           'Check group domain name from search_with' );
79
    $limit02_plus->belongs_to( $limit03->id )->store->discard_changes;
79
    $limit02_plus->belongs_to( $limit03->id )->store->discard_changes;
80
    is( $limit02_plus->_result->has_column_loaded('group_domain'), 0, 'Column lost by discarding changes' );
80
    is( $limit02_plus->_result->has_column_loaded('group_domain'), 0, 'Column lost by discarding changes' );
81
    is(
81
    is(
(-)a/t/db_dependent/Koha/Notice_Util.t (-39 / +78 lines)
Lines 47-55 subtest 'load_domain_limits' => sub { Link Here
47
    is( Koha::Notice::Util->load_domain_limits, undef, 'koha-conf contains blank entry' );
47
    is( Koha::Notice::Util->load_domain_limits, undef, 'koha-conf contains blank entry' );
48
    t::lib::Mocks::mock_config( 'message_domain_limits', { domain => { name => 'A', limit => 2, unit => '1d' } } );
48
    t::lib::Mocks::mock_config( 'message_domain_limits', { domain => { name => 'A', limit => 2, unit => '1d' } } );
49
    $domain_limits = Koha::Notice::Util->load_domain_limits;
49
    $domain_limits = Koha::Notice::Util->load_domain_limits;
50
    is( keys %$domain_limits, 1, 'koha-conf contains one domain' );
50
    is( keys %$domain_limits,             1,      'koha-conf contains one domain' );
51
    is( $domain_limits->{a}->{limit}, 2, 'check limit of first entry' );
51
    is( $domain_limits->{a}->{limit},     2,      'check limit of first entry' );
52
    is( $domain_limits->{a}->{units}, 1, 'check unit of first entry' );
52
    is( $domain_limits->{a}->{units},     1,      'check unit of first entry' );
53
    is( $domain_limits->{a}->{unit_type}, 'days', 'check unit of first entry' );
53
    is( $domain_limits->{a}->{unit_type}, 'days', 'check unit of first entry' );
54
    t::lib::Mocks::mock_config(
54
    t::lib::Mocks::mock_config(
55
        'message_domain_limits',
55
        'message_domain_limits',
Lines 62-76 subtest 'load_domain_limits' => sub { Link Here
62
        }
62
        }
63
    );
63
    );
64
    $domain_limits = Koha::Notice::Util->load_domain_limits;
64
    $domain_limits = Koha::Notice::Util->load_domain_limits;
65
    is( keys %$domain_limits, 3, 'koha-conf contains two domains' );
65
    is( keys %$domain_limits,              3,     'koha-conf contains two domains' );
66
    is( $domain_limits->{b}->{limit}, 3, 'check limit of second entry' );
66
    is( $domain_limits->{b}->{limit},      3,     'check limit of second entry' );
67
    is( $domain_limits->{b}->{count}, undef, 'check if count still undefined' );
67
    is( $domain_limits->{b}->{count},      undef, 'check if count still undefined' );
68
    is( $domain_limits->{c}->{belongs_to}, 'b', 'check group domain of C' );
68
    is( $domain_limits->{c}->{belongs_to}, 'b',   'check group domain of C' );
69
69
70
    # Test with database
70
    # Test with database
71
    my $limit01 = Koha::MailDomainLimit->new({ domain_name => 'A', domain_limit => 2, units => '2', unit_type => 'days' })->store;
71
    my $limit01 =
72
    my $limit02 = Koha::MailDomainLimit->new({ domain_name => 'B', domain_limit => 3, units => '3', unit_type => 'hours' })->store;
72
        Koha::MailDomainLimit->new( { domain_name => 'A', domain_limit => 2, units => '2', unit_type => 'days' } )
73
    my $limit03 = Koha::MailDomainLimit->new({ domain_name => 'C', belongs_to => $limit02->id })->store;
73
        ->store;
74
    my $limit02 =
75
        Koha::MailDomainLimit->new( { domain_name => 'B', domain_limit => 3, units => '3', unit_type => 'hours' } )
76
        ->store;
77
    my $limit03          = Koha::MailDomainLimit->new( { domain_name => 'C', belongs_to => $limit02->id } )->store;
74
    my $domain_limits_db = Koha::Notice::Util->load_domain_limits;
78
    my $domain_limits_db = Koha::Notice::Util->load_domain_limits;
75
    is_deeply( $domain_limits_db, $domain_limits, 'Same results for limits in database' );
79
    is_deeply( $domain_limits_db, $domain_limits, 'Same results for limits in database' );
76
};
80
};
Lines 79-102 subtest 'counting in exceeds_limit' => sub { Link Here
79
    plan tests => 3;
83
    plan tests => 3;
80
84
81
    my $domain_limits;
85
    my $domain_limits;
86
82
    # Check counting
87
    # Check counting
83
    my @values = ( message_transport_type => 'email', status => 'sent' );
88
    my @values = ( message_transport_type => 'email', status => 'sent' );
84
    my $today = dt_from_string();
89
    my $today  = dt_from_string();
90
85
    #FIXME Why are the three following build calls so slow?
91
    #FIXME Why are the three following build calls so slow?
86
    $builder->build_object({ class => 'Koha::Notice::Messages',
92
    $builder->build_object(
87
        value => { @values, to_address => 'a@A', updated_on => $today->clone->subtract( hours => 36 ) }});
93
        {
88
    $builder->build_object({ class => 'Koha::Notice::Messages',
94
            class => 'Koha::Notice::Messages',
89
        value => { @values, to_address => 'b@A', updated_on => $today->clone->subtract( hours => 49 ) }});
95
            value => { @values, to_address => 'a@A', updated_on => $today->clone->subtract( hours => 36 ) }
90
    $builder->build_object({ class => 'Koha::Notice::Messages',
96
        }
91
        value => { @values, to_address => 'c@A', updated_on => $today->clone->subtract( days => 3 ) }});
97
    );
92
98
    $builder->build_object(
93
    $domain_limits = Koha::Notice::Util->load_domain_limits; # still using last config for A: 2/2d
99
        {
94
    Koha::Notice::Util->exceeds_limit({ to => '@A', limits => $domain_limits, incr => 0 }); # force counting
100
            class => 'Koha::Notice::Messages',
101
            value => { @values, to_address => 'b@A', updated_on => $today->clone->subtract( hours => 49 ) }
102
        }
103
    );
104
    $builder->build_object(
105
        {
106
            class => 'Koha::Notice::Messages',
107
            value => { @values, to_address => 'c@A', updated_on => $today->clone->subtract( days => 3 ) }
108
        }
109
    );
110
111
    $domain_limits = Koha::Notice::Util->load_domain_limits;    # still using last config for A: 2/2d
112
    Koha::Notice::Util->exceeds_limit( { to => '@A', limits => $domain_limits, incr => 0 } );    # force counting
95
    is( $domain_limits->{a}->{count}, 1, '1 message to A within unit of 2d' );
113
    is( $domain_limits->{a}->{count}, 1, '1 message to A within unit of 2d' );
96
    Koha::MailDomainLimits->search({ domain_name => 'A' })->next->set({ domain_limit => 2, units => '50', unit_type => 'hours' })->store;
114
    Koha::MailDomainLimits->search( { domain_name => 'A' } )
115
        ->next->set( { domain_limit => 2, units => '50', unit_type => 'hours' } )->store;
97
    $domain_limits = Koha::Notice::Util->load_domain_limits;
116
    $domain_limits = Koha::Notice::Util->load_domain_limits;
98
    Koha::Notice::Util->exceeds_limit({ to => 'x@A ', limits => $domain_limits, incr => 0 }); # force counting
117
    Koha::Notice::Util->exceeds_limit( { to => 'x@A ', limits => $domain_limits, incr => 0 } );    # force counting
99
    is( $domain_limits->{a}->{count}, 2, '2 messages to A within unit of 50h' );
118
    is( $domain_limits->{a}->{count}, 2, '2 messages to A within unit of 50h' );
119
100
    # Check count for B; if counted, there would be 0 or higher, otherwise undef
120
    # Check count for B; if counted, there would be 0 or higher, otherwise undef
101
    ok( !defined $domain_limits->{b}->{count}, 'Prove that we did not count b if not asked for' );
121
    ok( !defined $domain_limits->{b}->{count}, 'Prove that we did not count b if not asked for' );
102
};
122
};
Lines 106-115 subtest '_calc_startdate' => sub { Link Here
106
126
107
    # Date subtraction - edge case (start of summer time)
127
    # Date subtraction - edge case (start of summer time)
108
    my $mock_context = Test::MockModule->new('C4::Context');
128
    my $mock_context = Test::MockModule->new('C4::Context');
109
    $mock_context->mock( 'tz', sub { return DateTime::TimeZone->new( name => 'Europe/Amsterdam' )} );
129
    $mock_context->mock( 'tz', sub { return DateTime::TimeZone->new( name => 'Europe/Amsterdam' ) } );
110
    my $dt = dt_from_string( '2023-03-31 02:30:00', 'iso', '+02:00' );
130
    my $dt = dt_from_string( '2023-03-31 02:30:00', 'iso', '+02:00' );
111
    is( Koha::Notice::Util::_calc_startdate( $dt, 4, 'days')->stringify, '2023-03-27T02:30:00', '02:30 is fine' );
131
    is( Koha::Notice::Util::_calc_startdate( $dt, 4, 'days' )->stringify, '2023-03-27T02:30:00', '02:30 is fine' );
112
    is( Koha::Notice::Util::_calc_startdate( $dt, 1, 'days')->stringify, '2023-03-26T01:30:00', 'Moved 02:30 to 01:30' );
132
    is(
133
        Koha::Notice::Util::_calc_startdate( $dt, 1, 'days' )->stringify, '2023-03-26T01:30:00',
134
        'Moved 02:30 to 01:30'
135
    );
113
    $mock_context->unmock('tz');
136
    $mock_context->unmock('tz');
114
};
137
};
115
138
Lines 120-144 subtest 'exceeds_limit with group domains' => sub { Link Here
120
    Koha::MailDomainLimits->delete;
143
    Koha::MailDomainLimits->delete;
121
    t::lib::Mocks::mock_config( 'message_domain_limits', undef );
144
    t::lib::Mocks::mock_config( 'message_domain_limits', undef );
122
    $domain_limits = Koha::Notice::Util->load_domain_limits;
145
    $domain_limits = Koha::Notice::Util->load_domain_limits;
123
    is( Koha::Notice::Util->exceeds_limit({ to => 'marcel@koha.nl', limits => $domain_limits }), 0, 'False when having no limits' );
146
    is(
147
        Koha::Notice::Util->exceeds_limit( { to => 'marcel@koha.nl', limits => $domain_limits } ), 0,
148
        'False when having no limits'
149
    );
124
150
125
    my $limit01 = Koha::MailDomainLimit->new({ domain_name => 'A', domain_limit => 3, units => 5, unit_type => 'minutes' })->store;
151
    my $limit01 =
126
    my $limit02 = Koha::MailDomainLimit->new({ domain_name => 'B', domain_limit => 2, units => 5, unit_type => 'minutes' })->store;
152
        Koha::MailDomainLimit->new( { domain_name => 'A', domain_limit => 3, units => 5, unit_type => 'minutes' } )
127
    my $limit03 = Koha::MailDomainLimit->new({ domain_name => 'C', belongs_to => $limit01->id })->store;
153
        ->store;
154
    my $limit02 =
155
        Koha::MailDomainLimit->new( { domain_name => 'B', domain_limit => 2, units => 5, unit_type => 'minutes' } )
156
        ->store;
157
    my $limit03 = Koha::MailDomainLimit->new( { domain_name => 'C', belongs_to => $limit01->id } )->store;
128
    $domain_limits = Koha::Notice::Util->load_domain_limits;
158
    $domain_limits = Koha::Notice::Util->load_domain_limits;
129
    my $result;
159
    my $result;
130
    is( Koha::Notice::Util->exceeds_limit({ to => '1@A', limits => $domain_limits }), 0, 'First message to A' );
160
    is( Koha::Notice::Util->exceeds_limit( { to => '1@A', limits => $domain_limits } ), 0, 'First message to A' );
131
    is( Koha::Notice::Util->exceeds_limit({ to => '2@C', limits => $domain_limits }), 0, 'Second message to A (via C)' );
161
    is(
162
        Koha::Notice::Util->exceeds_limit( { to => '2@C', limits => $domain_limits } ), 0,
163
        'Second message to A (via C)'
164
    );
132
    ok( !exists $domain_limits->{c}->{count}, 'No count exists for grouped domain' );
165
    ok( !exists $domain_limits->{c}->{count}, 'No count exists for grouped domain' );
133
    warning_like { $result = Koha::Notice::Util->exceeds_limit({ to => '3@A', limits => $domain_limits }) }
166
    warning_like { $result = Koha::Notice::Util->exceeds_limit( { to => '3@A', limits => $domain_limits } ) }
134
        qr/Sending messages: domain a reached limit/, 'Check warn for reaching limit A';
167
    qr/Sending messages: domain a reached limit/, 'Check warn for reaching limit A';
135
    is( $result, 0, 'Limit for A reached, not exceeded' );
168
    is( $result, 0, 'Limit for A reached, not exceeded' );
136
    is( Koha::Notice::Util->exceeds_limit({ to => '4@C', limits => $domain_limits }), 1, 'Limit for A exceeded (via C)' );
169
    is(
137
    is( Koha::Notice::Util->exceeds_limit({ to => '5@B', limits => $domain_limits }), 0, 'First message to B' );
170
        Koha::Notice::Util->exceeds_limit( { to => '4@C', limits => $domain_limits } ), 1,
138
    is( $domain_limits->{b}->{count}, 1, 'Count B updated' );
171
        'Limit for A exceeded (via C)'
139
    is( Koha::Notice::Util->exceeds_limit({ to => '5@B', limits => $domain_limits, incr => 0 }), 0, 'Test incr flag' );
172
    );
140
    is( $domain_limits->{b}->{count}, 1, 'Count B still 1' );
173
    is( Koha::Notice::Util->exceeds_limit( { to => '5@B', limits => $domain_limits } ), 0, 'First message to B' );
141
    is( Koha::Notice::Util->exceeds_limit({ to => '6@D', limits => $domain_limits }), 0, 'No limits for D' );
174
    is( $domain_limits->{b}->{count},                                                   1, 'Count B updated' );
175
    is(
176
        Koha::Notice::Util->exceeds_limit( { to => '5@B', limits => $domain_limits, incr => 0 } ), 0,
177
        'Test incr flag'
178
    );
179
    is( $domain_limits->{b}->{count},                                                   1, 'Count B still 1' );
180
    is( Koha::Notice::Util->exceeds_limit( { to => '6@D', limits => $domain_limits } ), 0, 'No limits for D' );
142
};
181
};
143
182
144
$schema->storage->txn_rollback;
183
$schema->storage->txn_rollback;
(-)a/t/db_dependent/api/v1/domain_limits.t (-7 / +11 lines)
Lines 38-50 subtest 'Few CRUD tests' => sub { Link Here
38
    $schema->storage->txn_begin;
38
    $schema->storage->txn_begin;
39
39
40
    Koha::MailDomainLimits->delete;
40
    Koha::MailDomainLimits->delete;
41
    my $user     = $builder->build_object({ class => 'Koha::Patrons' });
41
    my $user     = $builder->build_object( { class => 'Koha::Patrons' } );
42
    my $userid   = $user->userid;
42
    my $userid   = $user->userid;
43
    my $password = '2345';
43
    my $password = '2345';
44
    $user->set_password( { password => $password, skip_validation => 1 } );
44
    $user->set_password( { password => $password, skip_validation => 1 } );
45
45
46
    # Test GET ALL, 403 Unauthorized
46
    # Test GET ALL, 403 Unauthorized
47
    $t->get_ok("//$userid:$password@/api/v1/smtp/domain_limits")->status_is(403);
47
    $t->get_ok("//$userid:$password@/api/v1/smtp/domain_limits")->status_is(403);
48
48
    # Change flags
49
    # Change flags
49
    $user->flags(8)->store;
50
    $user->flags(8)->store;
50
    $t->get_ok("//$userid:$password@/api/v1/smtp/domain_limits")->status_is(200)->json_is( [] );
51
    $t->get_ok("//$userid:$password@/api/v1/smtp/domain_limits")->status_is(200)->json_is( [] );
Lines 53-75 subtest 'Few CRUD tests' => sub { Link Here
53
    my $data = { domain_name => 'test.nl', domain_limit => 1, units => 2, unit_type => 'minutes' };
54
    my $data = { domain_name => 'test.nl', domain_limit => 1, units => 2, unit_type => 'minutes' };
54
    $t->post_ok( "//$userid:$password@/api/v1/smtp/domain_limits" => json => $data )->status_is(201);
55
    $t->post_ok( "//$userid:$password@/api/v1/smtp/domain_limits" => json => $data )->status_is(201);
55
    is( Koha::MailDomainLimits->count, 1, 'Added record' );
56
    is( Koha::MailDomainLimits->count, 1, 'Added record' );
56
    my $limit = Koha::MailDomainLimits->search->next;
57
    my $limit    = Koha::MailDomainLimits->search->next;
57
    my $limit_id = $limit->id;
58
    my $limit_id = $limit->id;
58
    is( $limit->domain_name, 'test.nl', 'Check a field' );
59
    is( $limit->domain_name, 'test.nl', 'Check a field' );
60
59
    # Add member
61
    # Add member
60
    $t->post_ok( "//$userid:$password@/api/v1/smtp/domain_limits" => json => { domain_name => 'test.be', belongs_to => $limit_id } )
62
    $t->post_ok( "//$userid:$password@/api/v1/smtp/domain_limits" => json =>
61
    ->status_is(201);
63
            { domain_name => 'test.be', belongs_to => $limit_id } )->status_is(201);
62
64
63
    # Single GET, check joined column for member just added
65
    # Single GET, check joined column for member just added
64
    $t->get_ok("//$userid:$password@/api/v1/smtp/domain_limits/0")->status_is(404);
66
    $t->get_ok("//$userid:$password@/api/v1/smtp/domain_limits/0")->status_is(404);
65
    my $member_id = $limit_id + 1;
67
    my $member_id = $limit_id + 1;
66
    $t->get_ok("//$userid:$password@/api/v1/smtp/domain_limits/$member_id")->status_is(200)->json_has('/group_domain', 'test.nl');
68
    $t->get_ok("//$userid:$password@/api/v1/smtp/domain_limits/$member_id")->status_is(200)
69
        ->json_has( '/group_domain', 'test.nl' );
67
70
68
    # Modify with PUT
71
    # Modify with PUT
69
    $data->{units} = 3;
72
    $data->{units} = 3;
70
    $t->put_ok( "//$userid:$password@/api/v1/smtp/domain_limits/$limit_id" => json => $data )->status_is(200);
73
    $t->put_ok( "//$userid:$password@/api/v1/smtp/domain_limits/$limit_id" => json => $data )->status_is(200);
71
    $limit->discard_changes;
74
    $limit->discard_changes;
72
    is( $limit->units, 3, 'PUT changed a field' );
75
    is( $limit->units, 3, 'PUT changed a field' );
76
73
    # Try to set belongs_to, triggers exception
77
    # Try to set belongs_to, triggers exception
74
    $data->{belongs_to} = $limit->id;
78
    $data->{belongs_to} = $limit->id;
75
    $t->put_ok( "//$userid:$password@/api/v1/smtp/domain_limits/$limit_id" => json => $data )->status_is(409);
79
    $t->put_ok( "//$userid:$password@/api/v1/smtp/domain_limits/$limit_id" => json => $data )->status_is(409);
Lines 78-86 subtest 'Few CRUD tests' => sub { Link Here
78
    $t->post_ok( "//$userid:$password@/api/v1/smtp/domain_limits" => json => $data )->status_is(409);
82
    $t->post_ok( "//$userid:$password@/api/v1/smtp/domain_limits" => json => $data )->status_is(409);
79
83
80
    # Try DELETE
84
    # Try DELETE
81
    $t->delete_ok( "//$userid:$password@/api/v1/smtp/domain_limits/$limit_id" )->status_is(204);
85
    $t->delete_ok("//$userid:$password@/api/v1/smtp/domain_limits/$limit_id")->status_is(204);
82
    is( Koha::MailDomainLimits->count, 0, 'Removed record' );
86
    is( Koha::MailDomainLimits->count, 0, 'Removed record' );
83
    $t->delete_ok( "//$userid:$password@/api/v1/smtp/domain_limits/$limit_id" )->status_is(404);
87
    $t->delete_ok("//$userid:$password@/api/v1/smtp/domain_limits/$limit_id")->status_is(404);
84
88
85
    $schema->storage->txn_rollback;
89
    $schema->storage->txn_rollback;
86
};
90
};
(-)a/t/lib/TestBuilder.pm (-4 / +3 lines)
Lines 661-670 sub _gen_default_values { Link Here
661
            closure_reason   => undef,
661
            closure_reason   => undef,
662
            renewal_priority => undef,
662
            renewal_priority => undef,
663
            vendor_id        => undef,
663
            vendor_id        => undef,
664
            },
664
        },
665
        MailDomainLimit => {
665
        MailDomainLimit => {
666
            belongs_to => undef,
666
            belongs_to       => undef,
667
            },
667
        },
668
    };
668
    };
669
}
669
}
670
670
671
- 

Return to bug 33537