From b30f49d5780b68ec8ce4968a76570ff387928a50 Mon Sep 17 00:00:00 2001 From: Marcel de Rooy Date: Mon, 3 Apr 2023 16:29:22 +0200 Subject: [PATCH] Bug 33360: Extend Koha::Notice::Util with domain groups Content-Type: text/plain; charset=utf-8 The functionality is extended a bit here by: [1] Allowing to combine domains in a shared count. [2] Only counting sent messages for the specified domains when it is really needed. Test plan: Run t/db_dependent/Koha/Notice_Util.t Signed-off-by: Marcel de Rooy --- Koha/Notice/Util.pm | 73 +++++++++++++++++++++++-------- t/db_dependent/Koha/Notice_Util.t | 59 +++++++++++++++++-------- 2 files changed, 95 insertions(+), 37 deletions(-) diff --git a/Koha/Notice/Util.pm b/Koha/Notice/Util.pm index 401a155548..98f6182cf5 100644 --- a/Koha/Notice/Util.pm +++ b/Koha/Notice/Util.pm @@ -48,29 +48,54 @@ sub load_domain_limits { ? [ $entry->{domain} ] : $entry->{domain}; # Convert to hash structure by domain name - $domain_limits = { map { lc $_->{name}, { limit => $_->{limit}, unit => $_->{unit}, count => 0 }} @$domain_limits }; + $domain_limits = { map { _init_domain_entry($_); } @$domain_limits }; } } - return _fill_domain_counts($domain_limits); + return $domain_limits; +} + +sub _init_domain_entry { + my ( $config_entry ) = @_; + # Return either a hash like ( name => { limit => , unit =>, count => } ) for regular entries + # or return a hash like ( name => { belongs_to => } ) for a domain that is part of a group + + return if ref($config_entry) ne 'HASH' || !exists $config_entry->{name}; + my $elements; + if( $config_entry->{belongs_to} ) { + $elements = { belongs_to => lc $config_entry->{belongs_to} }; + } else { + $elements = { limit => $config_entry->{limit}, unit => $config_entry->{unit}, count => undef }; + } + return ( lc $config_entry->{name}, $elements ); } =head2 exceeds_limit - my $boolean = Koha::Notice::Util->exceeds_limit( $to_address, $domain_limits ); + my $boolean = Koha::Notice::Util->exceeds_limit({ to => $to_address, limits => $domain_limits, incr => 1|0 }); =cut sub exceeds_limit { - my ( $class, $to_address, $domain_limits ) = @_; - return 0 if !$domain_limits; + my ( $class, $params ) = @_; + my $domain_limits = $params->{limits} or return 0; # no limits at all + my $to_address = $params->{to} or return 0; # no address, no limit exceeded + my $incr = $params->{incr} // 1; # by default we increment + my $domain = q{}; - $domain = lc $1 if $to_address && $to_address =~ /@(.*)/; - return 0 if !exists $domain_limits->{$domain}; - return 1 if $domain_limits->{$domain}->{count} >= $domain_limits->{$domain}->{limit}; - $domain_limits->{$domain}->{count}++; - warn "Sending messages: domain $domain reached limit of ". - $domain_limits->{$domain}->{limit}. '/'. $domain_limits->{$domain}->{unit} - if $domain_limits->{$domain}->{count} == $domain_limits->{$domain}->{limit}; + $domain = lc $1 if $to_address && $to_address =~ /@(\H+)/; + return 0 if !$domain || !exists $domain_limits->{$domain}; + + # Keep in mind that domain may be part of group count + my $group = $domain_limits->{$domain}->{belongs_to} // $domain; + _get_domain_count( $domain, $group, $domain_limits ) if !defined $domain_limits->{$group}->{count}; + return 1 if $domain_limits->{$group}->{count} >= $domain_limits->{$group}->{limit}; + + if( $incr ) { + $domain_limits->{$group}->{count}++; + warn "Sending messages: domain $group reached limit of ". + $domain_limits->{$group}->{limit}. '/'. $domain_limits->{$group}->{unit} + if $domain_limits->{$group}->{count} == $domain_limits->{$group}->{limit}; + } return 0; } @@ -78,20 +103,30 @@ sub exceeds_limit { =cut -sub _fill_domain_counts { - my ( $limits ) = @_; - return $limits if !$limits; +sub _get_domain_count { + my ( $domain, $group, $limits ) = @_; + + # Check if there are group members too + my @domains; + push @domains, $domain if $domain eq $group; + push @domains, map + { + my $belongs = $limits->{$_}->{belongs_to} // q{}; + $belongs eq $group ? $_ : (); + } keys %$limits; + + my $sum = 0; my $dt_parser = Koha::Database->new->schema->storage->datetime_parser; - foreach my $domain ( keys %$limits ) { - my $start_dt = _convert_unit( undef, $limits->{$domain}->{unit} ); - $limits->{$domain}->{count} = Koha::Notice::Messages->search({ + my $start_dt = _convert_unit( undef, $limits->{$group}->{unit} ); + foreach my $domain ( @domains ) { + $sum += Koha::Notice::Messages->search({ message_transport_type => 'email', status => 'sent', to_address => { 'LIKE', '%'.$domain }, updated_on => { '>=', $dt_parser->format_datetime($start_dt) }, # FIXME Would be nice if possible via filter_by_last_update })->count; } - return $limits; + $limits->{$group}->{count} = $sum; } sub _convert_unit { # unit should be like \d+(m|h|d) diff --git a/t/db_dependent/Koha/Notice_Util.t b/t/db_dependent/Koha/Notice_Util.t index 0129fe65c1..805d6313ad 100755 --- a/t/db_dependent/Koha/Notice_Util.t +++ b/t/db_dependent/Koha/Notice_Util.t @@ -19,7 +19,7 @@ use Modern::Perl; #use Data::Dumper qw/Dumper/; -use Test::More tests => 2; +use Test::More tests => 4; use Test::MockModule; use Test::Warn; @@ -37,7 +37,7 @@ $schema->storage->txn_begin; my $builder = t::lib::TestBuilder->new; subtest 'load_domain_limits' => sub { - plan tests => 12; + plan tests => 8; my $domain_limits; t::lib::Mocks::mock_config( 'message_domain_limits', undef ); @@ -55,23 +55,39 @@ subtest 'load_domain_limits' => sub { $domain_limits = Koha::Notice::Util->load_domain_limits; is( keys %$domain_limits, 2, 'koha-conf contains two domains' ); is( $domain_limits->{b}->{limit}, 3, 'check limit of second entry' ); + is( $domain_limits->{b}->{count}, undef, 'check if count still undefined' ); +}; + +subtest 'counting in exceeds_limit' => sub { + plan tests => 3; + my $domain_limits; # Check counting my @values = ( message_transport_type => 'email', status => 'sent' ); my $today = dt_from_string(); + #FIXME Why are the three following build calls so slow? $builder->build_object({ class => 'Koha::Notice::Messages', value => { @values, to_address => 'a@A', updated_on => $today->clone->subtract( hours => 36 ) }}); $builder->build_object({ class => 'Koha::Notice::Messages', value => { @values, to_address => 'b@A', updated_on => $today->clone->subtract( hours => 49 ) }}); $builder->build_object({ class => 'Koha::Notice::Messages', value => { @values, to_address => 'c@A', updated_on => $today->clone->subtract( days => 3 ) }}); - $domain_limits = Koha::Notice::Util->load_domain_limits; - is( $domain_limits->{a}->{count}, 1, 'Three messages to A, 1 within unit of 2d' ); + + $domain_limits = Koha::Notice::Util->load_domain_limits; # still using last mocked config A:2/2d + Koha::Notice::Util->exceeds_limit({ to => '@A', limits => $domain_limits, incr => 0 }); # force counting + is( $domain_limits->{a}->{count}, 1, '1 message to A within unit of 2d' ); t::lib::Mocks::mock_config( 'message_domain_limits', { domain => [ { name => 'A', limit => 2, unit => '50h' }, { name => 'B', limit => 3, unit => '3h' } ] }, ); $domain_limits = Koha::Notice::Util->load_domain_limits; - is( $domain_limits->{a}->{count}, 2, 'Three messages to A, 2 within unit of 50h' ); + Koha::Notice::Util->exceeds_limit({ to => 'x@A ', limits => $domain_limits, incr => 0 }); # force counting + is( $domain_limits->{a}->{count}, 2, '2 messages to A within unit of 50h' ); + # Check count for B; if counted, there would be 0 or higher, otherwise undef + ok( !defined $domain_limits->{b}->{count}, 'Prove that we did not count b if not asked for' ); +}; + +subtest '_convert_unit' => sub { + plan tests => 3; # Date subtraction - edge case (start of summer time) my $mock_context = Test::MockModule->new('C4::Context'); @@ -84,26 +100,33 @@ subtest 'load_domain_limits' => sub { $mock_context->unmock('tz'); }; -subtest 'exceeds_limit' => sub { - plan tests => 6; +subtest 'exceeds_limit with group domains' => sub { + plan tests => 12; my $domain_limits; - t::lib::Mocks::mock_config( 'message_domain_limits', undef ); $domain_limits = Koha::Notice::Util->load_domain_limits; - is( Koha::Notice::Util->exceeds_limit( 'marcel@koha.nl', $domain_limits ), 0, 'False when having no limits' ); + is( Koha::Notice::Util->exceeds_limit({ to => 'marcel@koha.nl', limits => $domain_limits }), 0, 'False when having no limits' ); - t::lib::Mocks::mock_config( 'message_domain_limits', - { domain => [ { name => 'A', limit => 0, unit => '1d' }, { name => 'B', limit => 1, unit => '5h' } ] }, - ); + t::lib::Mocks::mock_config( 'message_domain_limits', { domain => [ + { name => 'A', limit => 3, unit => '5m' }, + { name => 'B', limit => 2, unit => '5m' }, + { name => 'C', belongs_to => 'A' }, + ]}); $domain_limits = Koha::Notice::Util->load_domain_limits; - is( Koha::Notice::Util->exceeds_limit( '1@A', $domain_limits ), 1, 'Limit for A already reached' ); my $result; - warning_like { $result = Koha::Notice::Util->exceeds_limit( '2@B', $domain_limits ) } - qr/Sending messages: domain b reached limit/, 'Check warn for reaching limit'; - is( $result, 0, 'Limit for B not yet exceeded' ); - is( Koha::Notice::Util->exceeds_limit( '3@B', $domain_limits ), 1, 'Limit for B already reached' ); - is( Koha::Notice::Util->exceeds_limit( '4@C', $domain_limits ), 0, 'No limits for C' ); + is( Koha::Notice::Util->exceeds_limit({ to => '1@A', limits => $domain_limits }), 0, 'First message to A' ); + is( Koha::Notice::Util->exceeds_limit({ to => '2@C', limits => $domain_limits }), 0, 'Second message to A (via C)' ); + ok( !exists $domain_limits->{c}->{count}, 'No count exists for grouped domain' ); + warning_like { $result = Koha::Notice::Util->exceeds_limit({ to => '3@A', limits => $domain_limits }) } + qr/Sending messages: domain a reached limit/, 'Check warn for reaching limit A'; + is( $result, 0, 'Limit for A reached, not exceeded' ); + is( Koha::Notice::Util->exceeds_limit({ to => '4@C', limits => $domain_limits }), 1, 'Limit for A exceeded (via C)' ); + is( Koha::Notice::Util->exceeds_limit({ to => '5@B', limits => $domain_limits }), 0, 'First message to B' ); + is( $domain_limits->{b}->{count}, 1, 'Count B updated' ); + is( Koha::Notice::Util->exceeds_limit({ to => '5@B', limits => $domain_limits, incr => 0 }), 0, 'Test incr flag' ); + is( $domain_limits->{b}->{count}, 1, 'Count B still 1' ); + is( Koha::Notice::Util->exceeds_limit({ to => '6@D', limits => $domain_limits }), 0, 'No limits for D' ); }; $schema->storage->txn_rollback; -- 2.30.2