From 68312e24e4a7522b13d58e858a27b0ff20554ce7 Mon Sep 17 00:00:00 2001
From: Marco Pessotto <marco@pessotto.hr>
Date: Sat, 23 Sep 2023 08:47:26 +0200
Subject: [PATCH] Add buffer_max_age and buffer_max_size options to
 Dispatch::Email

In some contexts (in my case: Catalyst processes) it seems to me that
the buffer is never flushed. These two options should amend this, while
retaining the default behaviour if not nothing is specified.
---
 lib/Log/Dispatch/Email.pm | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/lib/Log/Dispatch/Email.pm b/lib/Log/Dispatch/Email.pm
index 30394f6..b7a153c 100644
--- a/lib/Log/Dispatch/Email.pm
+++ b/lib/Log/Dispatch/Email.pm
@@ -30,6 +30,14 @@ use base qw( Log::Dispatch::Output );
                 type    => t('Bool'),
                 default => 1,
             },
+            buffer_max_age => {
+                type => t('Int'),
+                default => 0,
+            },
+            buffer_max_size => {
+                type => t('Int'),
+                default => 0,
+            },
         },
         slurpy => 1,
     );
@@ -43,6 +51,8 @@ use base qw( Log::Dispatch::Output );
             to       => delete $p{to},
             from     => delete $p{from},
             buffered => delete $p{buffered},
+            buffer_max_age => delete $p{buffer_max_age},
+            buffer_max_size => delete $p{buffer_max_size},
         }, $class;
         $self->{buffer} = [] if $self->{buffered};
 
@@ -58,6 +68,16 @@ sub log_message {
 
     if ( $self->{buffered} ) {
         push @{ $self->{buffer} }, $p{message};
+        $self->{buffer_ts} ||= time();
+        my $buffer_age = time() - $self->{buffer_ts};
+        if ( $self->{buffer_max_size} and @{ $self->{buffer} } >= $self->{buffer_max_size} ) {
+            push @{ $self->{buffer} }, "Reached threshold of $self->{buffer_max_size} messages";
+            $self->flush;
+        }
+        elsif ( $self->{buffer_max_age} and $buffer_age > $self->{buffer_max_age} ) {
+            push @{ $self->{buffer} }, "Reached threshold of $self->{buffer_max_age} seconds";
+            $self->flush;
+        }
     }
     else {
         $self->send_email(@_);
@@ -79,6 +99,7 @@ sub flush {
 
         $self->send_email( message => $message );
         $self->{buffer} = [];
+        $self->{buffer_ts} = time();
     }
 }
 
@@ -159,6 +180,17 @@ This determines whether the object sends one email per message it is given or
 whether it stores them up and sends them all at once. The default is to buffer
 messages.
 
+=item * buffer_max_age (integer, defaulting to 0)
+
+Relevant only with buffered option. If not 0, flush the buffer if its
+age in seconds is greater than this value.
+
+=item * buffer_max_size (integer, defaulting to 0)
+
+Relevant only with buffered option. If not 0, flush the buffer if the
+number of messages is greater than this value.
+
+
 =back
 
 =head1 METHODS