Koha/Notice/Util.pm

   1 package Koha::Notice::Util;
   2
   3 # Copyright Rijksmuseum 2023
   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 Data::Dumper qw/Dumper/;
  22
  23 use C4::Context;
  24 use Koha::DateUtils qw/dt_from_string/;
  25 use Koha::Notice::Messages;
  26
  27 =head1 NAME
  28
  29 Koha::Notice::Util - Utility class related to Koha notice messages
  30
  31 =head1 CLASS METHODS
  32
  33 =head2 load_domain_limits
  34
  35     my $domain_limits = Koha::Notice::Util->load_domain_limits;
  36
  37 =cut
  38
  39 sub load_domain_limits {
  40     my ( $class ) = @_;
  41
  42     my $domain_limits;
  43     my $entry = C4::Context->config('message_domain_limits');
  44     if( ref($entry) eq 'HASH' ) {
  45         if( exists $entry->{domain} ) {
  46             # Turn single hash entry into array
  47             $domain_limits = ref($entry->{domain}) eq 'HASH'
  48                 ? [ $entry->{domain} ]
  49                 : $entry->{domain};
  50             # Convert to hash structure by domain name
  51             $domain_limits = { map { _init_domain_entry($_); } @$domain_limits };
  52         }
  53     }
  54     return $domain_limits;
  55 }
  56
  57 sub _init_domain_entry {
  58     my ( $config_entry ) = @_;
  59     # Return either a hash like ( name => { limit => , unit =>, count => } ) for regular entries
  60     # or return a hash like ( name => { belongs_to => } ) for a domain that is part of a group
  61
  62     return if ref($config_entry) ne 'HASH' || !exists $config_entry->{name};
  63     my $elements;
  64     if( $config_entry->{belongs_to} ) {
  65         $elements = { belongs_to => lc $config_entry->{belongs_to} };
  66     } else {
  67         $elements = { limit => $config_entry->{limit}, unit => $config_entry->{unit}, count => undef };
  68     }
  69     return ( lc $config_entry->{name}, $elements );
  70 }
  71
  72 =head2 exceeds_limit
  73
  74     my $boolean = Koha::Notice::Util->exceeds_limit({ to => $to_address, limits => $domain_limits, incr => 1|0 });
  75
  76 =cut
  77
  78 sub exceeds_limit {
  79     my ( $class, $params ) = @_;
  80     my $domain_limits = $params->{limits} or return 0; # no limits at all
  81     my $to_address = $params->{to} or return 0; # no address, no limit exceeded
  82     my $incr = $params->{incr} // 1; # by default we increment
  83
  84     my $domain = q{};
  85     $domain = lc $1 if $to_address && $to_address =~ /@(\H+)/;
  86     return 0 if !$domain || !exists $domain_limits->{$domain};
  87
  88     # Keep in mind that domain may be part of group count
  89     my $group = $domain_limits->{$domain}->{belongs_to} // $domain;
  90     _get_domain_count( $domain, $group, $domain_limits ) if !defined $domain_limits->{$group}->{count};
  91     return 1 if $domain_limits->{$group}->{count} >= $domain_limits->{$group}->{limit};
  92
  93     if( $incr ) {
  94         $domain_limits->{$group}->{count}++;
  95         warn "Sending messages: domain $group reached limit of ".
  96           $domain_limits->{$group}->{limit}. '/'. $domain_limits->{$group}->{unit}
  97             if $domain_limits->{$group}->{count} == $domain_limits->{$group}->{limit};
  98     }
  99     return 0;
 100 }
 101
 102 =head1 PRIVATE METHODS
 103
 104 =cut
 105
 106 sub _get_domain_count {
 107     my ( $domain, $group, $limits ) = @_;
 108
 109     # Check if there are group members too
 110     my @domains;
 111     push @domains, $domain if $domain eq $group;
 112     push @domains, map
 113     {
 114         my $belongs = $limits->{$_}->{belongs_to} // q{};
 115         $belongs eq $group ? $_ : ();
 116     } keys %$limits;
 117
 118     my $sum = 0;
 119     my $start_dt = _convert_unit( undef, $limits->{$group}->{unit} );
 120     foreach my $domain ( @domains ) {
 121         $sum += Koha::Notice::Messages->search(
 122             {
 123                 message_transport_type => 'email',
 124                 status                 => 'sent',
 125                 to_address             => { 'LIKE', '%' . $domain },
 126             }
 127         )->filter_by_last_update( { timestamp_column_name => 'updated_on', from => $start_dt } )->count;
 128     }
 129     $limits->{$group}->{count} = $sum;
 130 }
 131
 132 sub _convert_unit { # unit should be like \d+(m|h|d)
 133     my ( $dt, $unit ) = @_;
 134     $dt //= dt_from_string();
 135     if( $unit && $unit =~ /(\d+)([mhd])/ ) {
 136         my $abbrev = { m => 'minutes', h => 'hours', d => 'days' };
 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     }
 141     return $dt;
 142 }
 143
 144 1;