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

(-)a/Koha/Notice/Util.pm (-24 / +54 lines)
Lines 22-29 use Data::Dumper qw/Dumper/; Link Here
22
22
23
use C4::Context;
23
use C4::Context;
24
use Koha::DateUtils qw/dt_from_string/;
24
use Koha::DateUtils qw/dt_from_string/;
25
use Koha::MailDomainLimits;
25
use Koha::Notice::Messages;
26
use Koha::Notice::Messages;
26
27
28
use constant ABBREV => { m => 'minutes', h => 'hours', d => 'days' };
29
27
=head1 NAME
30
=head1 NAME
28
31
29
Koha::Notice::Util - Utility class related to Koha notice messages
32
Koha::Notice::Util - Utility class related to Koha notice messages
Lines 38-72 Koha::Notice::Util - Utility class related to Koha notice messages Link Here
38
41
39
sub load_domain_limits {
42
sub load_domain_limits {
40
    my ( $class ) = @_;
43
    my ( $class ) = @_;
44
    my $rs = Koha::MailDomainLimits->search_with_group_domain;
45
    if ( $rs->count ) {
46
        return { map { _init_domain_entry($_) } @{$rs->unblessed} };
47
    } else { # fall back to koha-conf
48
        return _load_from_file();
49
    }
50
}
41
51
52
sub _load_from_file {
53
    my $config = C4::Context->config('message_domain_limits');
42
    my $domain_limits;
54
    my $domain_limits;
43
    my $entry = C4::Context->config('message_domain_limits');
55
    if( ref($config) eq 'HASH' ) {
44
    if( ref($entry) eq 'HASH' ) {
56
        if( exists $config->{domain} ) {
45
        if( exists $entry->{domain} ) {
46
            # Turn single hash entry into array
57
            # Turn single hash entry into array
47
            $domain_limits = ref($entry->{domain}) eq 'HASH'
58
            $domain_limits = ref($config->{domain}) eq 'HASH'
48
                ? [ $entry->{domain} ]
59
                ? [ $config->{domain} ]
49
                : $entry->{domain};
60
                : $config->{domain};
50
            # Convert to hash structure by domain name
61
            # Convert to hash structure by domain name
51
            $domain_limits = { map { _init_domain_entry($_); } @$domain_limits };
62
            $domain_limits = { map { _init_domain_entry({ %$_ }, 1); } @$domain_limits }; # copy hashes to prevent changes
52
        }
63
        }
53
    }
64
    }
54
    return $domain_limits;
65
    return $domain_limits;
55
}
66
}
56
67
57
sub _init_domain_entry {
68
sub _init_domain_entry {
58
    my ( $config_entry ) = @_;
69
    my ( $entry, $old_school ) = @_;
59
    # Return either a hash like ( name => { limit => , unit =>, count => } ) for regular entries
70
    # entry comes from table or koha-conf
71
    # Return either a hash like ( name => { limit => , units =>, unit_type =>, count => } ) for regular entries
60
    # or return a hash like ( name => { belongs_to => } ) for a domain that is part of a group
72
    # 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
74
75
    if( $old_school ) {
76
        ( $entry->{units}, $entry->{unit_type} ) = _unit_info( delete $entry->{unit} );
77
    } else {
78
        $entry->{name} = delete $entry->{domain_name};
79
        $entry->{limit} = delete $entry->{domain_limit};
80
        $entry->{belongs_to} = delete $entry->{group_domain};
81
    }
61
82
62
    return if ref($config_entry) ne 'HASH' || !exists $config_entry->{name};
83
    return if !exists $entry->{name};
63
    my $elements;
84
    my $elements;
64
    if( $config_entry->{belongs_to} ) {
85
    if( $entry->{belongs_to} ) {
65
        $elements = { belongs_to => lc $config_entry->{belongs_to} };
86
        $elements = { belongs_to => lc $entry->{belongs_to} };
66
    } else {
87
    } else {
67
        $elements = { limit => $config_entry->{limit}, unit => $config_entry->{unit}, count => undef };
88
        $elements = {
89
            limit     => $entry->{limit},
90
            units     => $entry->{units},
91
            unit_type => $entry->{unit_type},
92
            count     => undef,
93
        };
68
    }
94
    }
69
    return ( lc $config_entry->{name}, $elements );
95
    return ( lc $entry->{name}, $elements );
96
}
97
98
sub _unit_info { # Converting old-style unit like '3m' to ( 3, 'minutes' ) etc.
99
    my ( $unit ) = @_;
100
    if( $unit && $unit =~ /(\d+)([mhd])/ ) {
101
        return ( $1, ABBREV->{$2} );
102
    }
103
    return;
70
}
104
}
71
105
72
=head2 exceeds_limit
106
=head2 exceeds_limit
Lines 92-99 sub exceeds_limit { Link Here
92
126
93
    if( $incr ) {
127
    if( $incr ) {
94
        $domain_limits->{$group}->{count}++;
128
        $domain_limits->{$group}->{count}++;
95
        warn "Sending messages: domain $group reached limit of ".
129
        warn "Sending messages: domain $group reached limit of ". $domain_limits->{$group}->{limit}
96
          $domain_limits->{$group}->{limit}. '/'. $domain_limits->{$group}->{unit}
97
            if $domain_limits->{$group}->{count} == $domain_limits->{$group}->{limit};
130
            if $domain_limits->{$group}->{count} == $domain_limits->{$group}->{limit};
98
    }
131
    }
99
    return 0;
132
    return 0;
Lines 117-123 sub _get_domain_count { Link Here
117
150
118
    my $sum = 0;
151
    my $sum = 0;
119
    my $dt_parser = Koha::Database->new->schema->storage->datetime_parser;
152
    my $dt_parser = Koha::Database->new->schema->storage->datetime_parser;
120
    my $start_dt = _convert_unit( undef, $limits->{$group}->{unit} );
153
    my $start_dt = _calc_startdate( undef, $limits->{$group}->{units}, $limits->{$group}->{unit_type} );
121
    foreach my $domain ( @domains ) {
154
    foreach my $domain ( @domains ) {
122
        $sum += Koha::Notice::Messages->search({
155
        $sum += Koha::Notice::Messages->search({
123
            message_transport_type => 'email',
156
            message_transport_type => 'email',
Lines 129-142 sub _get_domain_count { Link Here
129
    $limits->{$group}->{count} = $sum;
162
    $limits->{$group}->{count} = $sum;
130
}
163
}
131
164
132
sub _convert_unit { # unit should be like \d+(m|h|d)
165
sub _calc_startdate {
133
    my ( $dt, $unit ) = @_;
166
    my ( $dt, $units, $unit_type ) = @_;
134
    $dt //= dt_from_string();
167
    $dt //= dt_from_string();
135
    if( $unit && $unit =~ /(\d+)([mhd])/ ) {
168
    foreach my $h ( 0, 1 ) { # try hour before too when subtract fails (like: change to summertime)
136
        my $abbrev = { m => 'minutes', h => 'hours', d => 'days' };
169
        eval { $dt->subtract( hours => $h )->subtract( $unit_type => $units ) } and last;
137
        foreach my $h ( 0, 1 ) { # try hour before too when subtract fails (like: change to summertime)
138
            eval { $dt->subtract( hours => $h )->subtract( $abbrev->{$2} => $1 ) } and last;
139
        }
140
    }
170
    }
141
    return $dt;
171
    return $dt;
142
}
172
}
(-)a/t/db_dependent/Koha/Notice_Util.t (-23 / +34 lines)
Lines 18-24 Link Here
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
#use Data::Dumper qw/Dumper/;
22
use Test::More tests => 4;
21
use Test::More tests => 4;
23
use Test::MockModule;
22
use Test::MockModule;
24
use Test::Warn;
23
use Test::Warn;
Lines 26-31 use Test::Warn; Link Here
26
use C4::Context;
25
use C4::Context;
27
use Koha::Database;
26
use Koha::Database;
28
use Koha::DateUtils qw/dt_from_string/;
27
use Koha::DateUtils qw/dt_from_string/;
28
use Koha::MailDomainLimits;
29
use Koha::Notice::Util;
29
use Koha::Notice::Util;
30
30
31
use t::lib::TestBuilder;
31
use t::lib::TestBuilder;
Lines 33-44 use t::lib::Mocks; Link Here
33
33
34
my $schema = Koha::Database->new->schema;
34
my $schema = Koha::Database->new->schema;
35
$schema->storage->txn_begin;
35
$schema->storage->txn_begin;
36
37
my $builder = t::lib::TestBuilder->new;
36
my $builder = t::lib::TestBuilder->new;
38
37
39
subtest 'load_domain_limits' => sub {
38
subtest 'load_domain_limits' => sub {
40
    plan tests => 8;
39
    plan tests => 11;
41
40
41
    # Starting testing without limits in database
42
    Koha::MailDomainLimits->delete;
42
    my $domain_limits;
43
    my $domain_limits;
43
    t::lib::Mocks::mock_config( 'message_domain_limits', undef );
44
    t::lib::Mocks::mock_config( 'message_domain_limits', undef );
44
    is( Koha::Notice::Util->load_domain_limits, undef, 'koha-conf does not contain entry' );
45
    is( Koha::Notice::Util->load_domain_limits, undef, 'koha-conf does not contain entry' );
Lines 48-61 subtest 'load_domain_limits' => sub { Link Here
48
    $domain_limits = Koha::Notice::Util->load_domain_limits;
49
    $domain_limits = Koha::Notice::Util->load_domain_limits;
49
    is( keys %$domain_limits, 1, 'koha-conf contains one domain' );
50
    is( keys %$domain_limits, 1, 'koha-conf contains one domain' );
50
    is( $domain_limits->{a}->{limit}, 2, 'check limit of first entry' );
51
    is( $domain_limits->{a}->{limit}, 2, 'check limit of first entry' );
51
    is( $domain_limits->{a}->{unit}, '1d', 'check unit of first entry' );
52
    is( $domain_limits->{a}->{units}, 1, 'check unit of first entry' );
52
    t::lib::Mocks::mock_config( 'message_domain_limits',
53
    is( $domain_limits->{a}->{unit_type}, 'days', 'check unit of first entry' );
53
        { domain => [ { name => 'A', limit => 2, unit => '2d' }, { name => 'B', limit => 3, unit => '3h' } ] },
54
    t::lib::Mocks::mock_config(
55
        'message_domain_limits',
56
        {
57
            domain => [
58
                { name => 'A', limit      => 2, unit => '2d' },
59
                { name => 'B', limit      => 3, unit => '3h' },
60
                { name => 'C', belongs_to => 'B' },
61
            ],
62
        }
54
    );
63
    );
55
    $domain_limits = Koha::Notice::Util->load_domain_limits;
64
    $domain_limits = Koha::Notice::Util->load_domain_limits;
56
    is( keys %$domain_limits, 2, 'koha-conf contains two domains' );
65
    is( keys %$domain_limits, 3, 'koha-conf contains two domains' );
57
    is( $domain_limits->{b}->{limit}, 3, 'check limit of second entry' );
66
    is( $domain_limits->{b}->{limit}, 3, 'check limit of second entry' );
58
    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' );
69
70
    # Test with database
71
    my $limit01 = Koha::MailDomainLimit->new({ domain_name => 'A', domain_limit => 2, units => '2', unit_type => 'days' })->store;
72
    my $limit02 = Koha::MailDomainLimit->new({ domain_name => 'B', domain_limit => 3, units => '3', unit_type => 'hours' })->store;
73
    my $limit03 = Koha::MailDomainLimit->new({ domain_name => 'C', belongs_to => $limit02->id })->store;
74
    my $domain_limits_db = Koha::Notice::Util->load_domain_limits;
75
    is_deeply( $domain_limits_db, $domain_limits, 'Same results for limits in database' );
59
};
76
};
60
77
61
subtest 'counting in exceeds_limit' => sub {
78
subtest 'counting in exceeds_limit' => sub {
Lines 73-84 subtest 'counting in exceeds_limit' => sub { Link Here
73
    $builder->build_object({ class => 'Koha::Notice::Messages',
90
    $builder->build_object({ class => 'Koha::Notice::Messages',
74
        value => { @values, to_address => 'c@A', updated_on => $today->clone->subtract( days => 3 ) }});
91
        value => { @values, to_address => 'c@A', updated_on => $today->clone->subtract( days => 3 ) }});
75
92
76
    $domain_limits = Koha::Notice::Util->load_domain_limits; # still using last mocked config A:2/2d
93
    $domain_limits = Koha::Notice::Util->load_domain_limits; # still using last config for A: 2/2d
77
    Koha::Notice::Util->exceeds_limit({ to => '@A', limits => $domain_limits, incr => 0 }); # force counting
94
    Koha::Notice::Util->exceeds_limit({ to => '@A', limits => $domain_limits, incr => 0 }); # force counting
78
    is( $domain_limits->{a}->{count}, 1, '1 message to A within unit of 2d' );
95
    is( $domain_limits->{a}->{count}, 1, '1 message to A within unit of 2d' );
79
    t::lib::Mocks::mock_config( 'message_domain_limits',
96
    Koha::MailDomainLimits->search({ domain_name => 'A' })->next->set({ domain_limit => 2, units => '50', unit_type => 'hours' })->store;
80
        { domain => [ { name => 'A', limit => 2, unit => '50h' }, { name => 'B', limit => 3, unit => '3h' } ] },
81
    );
82
    $domain_limits = Koha::Notice::Util->load_domain_limits;
97
    $domain_limits = Koha::Notice::Util->load_domain_limits;
83
    Koha::Notice::Util->exceeds_limit({ to => 'x@A ', limits => $domain_limits, incr => 0 }); # force counting
98
    Koha::Notice::Util->exceeds_limit({ to => 'x@A ', limits => $domain_limits, incr => 0 }); # force counting
84
    is( $domain_limits->{a}->{count}, 2, '2 messages to A within unit of 50h' );
99
    is( $domain_limits->{a}->{count}, 2, '2 messages to A within unit of 50h' );
Lines 86-102 subtest 'counting in exceeds_limit' => sub { Link Here
86
    ok( !defined $domain_limits->{b}->{count}, 'Prove that we did not count b if not asked for' );
101
    ok( !defined $domain_limits->{b}->{count}, 'Prove that we did not count b if not asked for' );
87
};
102
};
88
103
89
subtest '_convert_unit' => sub {
104
subtest '_calc_startdate' => sub {
90
    plan tests => 3;
105
    plan tests => 2;
91
106
92
    # Date subtraction - edge case (start of summer time)
107
    # Date subtraction - edge case (start of summer time)
93
    my $mock_context = Test::MockModule->new('C4::Context');
108
    my $mock_context = Test::MockModule->new('C4::Context');
94
    $mock_context->mock( 'tz', sub { return DateTime::TimeZone->new( name => 'Europe/Amsterdam' )} );
109
    $mock_context->mock( 'tz', sub { return DateTime::TimeZone->new( name => 'Europe/Amsterdam' )} );
95
    my $dt = dt_from_string( '2023-03-31 02:30:00', 'iso', '+02:00' );
110
    my $dt = dt_from_string( '2023-03-31 02:30:00', 'iso', '+02:00' );
96
    is( Koha::Notice::Util::_convert_unit( $dt, '4d')->stringify, '2023-03-27T02:30:00', '02:30 is fine' );
111
    is( Koha::Notice::Util::_calc_startdate( $dt, 4, 'days')->stringify, '2023-03-27T02:30:00', '02:30 is fine' );
97
    is( Koha::Notice::Util::_convert_unit( $dt, '1d')->stringify, '2023-03-26T01:30:00', 'Moved 02:30 to 01:30' );
112
    is( Koha::Notice::Util::_calc_startdate( $dt, 1, 'days')->stringify, '2023-03-26T01:30:00', 'Moved 02:30 to 01:30' );
98
    # Test bad unit
99
    is( Koha::Notice::Util::_convert_unit( $dt, 'y')->stringify, '2023-03-26T01:30:00', 'No further shift for bad unit' );
100
    $mock_context->unmock('tz');
113
    $mock_context->unmock('tz');
101
};
114
};
102
115
Lines 104-118 subtest 'exceeds_limit with group domains' => sub { Link Here
104
    plan tests => 12;
117
    plan tests => 12;
105
118
106
    my $domain_limits;
119
    my $domain_limits;
120
    Koha::MailDomainLimits->delete;
107
    t::lib::Mocks::mock_config( 'message_domain_limits', undef );
121
    t::lib::Mocks::mock_config( 'message_domain_limits', undef );
108
    $domain_limits = Koha::Notice::Util->load_domain_limits;
122
    $domain_limits = Koha::Notice::Util->load_domain_limits;
109
    is( Koha::Notice::Util->exceeds_limit({ to => 'marcel@koha.nl', limits => $domain_limits }), 0, 'False when having no limits' );
123
    is( Koha::Notice::Util->exceeds_limit({ to => 'marcel@koha.nl', limits => $domain_limits }), 0, 'False when having no limits' );
110
124
111
    t::lib::Mocks::mock_config( 'message_domain_limits', { domain => [
125
    my $limit01 = Koha::MailDomainLimit->new({ domain_name => 'A', domain_limit => 3, units => 5, unit_type => 'minutes' })->store;
112
        { name => 'A', limit => 3, unit => '5m' },
126
    my $limit02 = Koha::MailDomainLimit->new({ domain_name => 'B', domain_limit => 2, units => 5, unit_type => 'minutes' })->store;
113
        { name => 'B', limit => 2, unit => '5m' },
127
    my $limit03 = Koha::MailDomainLimit->new({ domain_name => 'C', belongs_to => $limit01->id })->store;
114
        { name => 'C', belongs_to => 'A' },
115
    ]});
116
    $domain_limits = Koha::Notice::Util->load_domain_limits;
128
    $domain_limits = Koha::Notice::Util->load_domain_limits;
117
    my $result;
129
    my $result;
118
    is( Koha::Notice::Util->exceeds_limit({ to => '1@A', limits => $domain_limits }), 0, 'First message to A' );
130
    is( Koha::Notice::Util->exceeds_limit({ to => '1@A', limits => $domain_limits }), 0, 'First message to A' );
119
- 

Return to bug 33537