From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
To: guile-devel@gnu.org
Cc: David Pirotte <david@altosw.be>,
Maxim Cournoyer <maxim.cournoyer@gmail.com>
Subject: [Guile-Lib PATCH] logger: Add flush-after-emit? property to <log-handler>.
Date: Fri, 1 Mar 2024 23:15:55 -0500 [thread overview]
Message-ID: <20240302041612.29833-1-maxim.cournoyer@gmail.com> (raw)
* src/logging/logger.scm (<log-handler>): Add new
optional flush-after-each-emit? slot, initialized to #t.
(accept-log) [flush-after-each-emit?]: Flush log when condition is
true.
* unit-tests/logging.logger.scm (call-with-temporary-file): New
procedure.
(test-log-with-flush-after-emit-disabled): New test.
(test-log-with-flush-after-emit): Likewise.
Suggested-by: David Pirotte <david@altosw.be>
---
src/logging/logger.scm | 21 ++++++++++++++++-----
unit-tests/logging.logger.scm | 31 +++++++++++++++++++++++++++++++
2 files changed, 47 insertions(+), 5 deletions(-)
diff --git a/src/logging/logger.scm b/src/logging/logger.scm
index 6e488f6..0bec407 100644
--- a/src/logging/logger.scm
+++ b/src/logging/logger.scm
@@ -309,7 +309,7 @@ message was logged from."
str)))
(define-class-with-docs <log-handler> ()
-"This is the base class for all of the log handlers, and encompasses
+ "This is the base class for all of the log handlers, and encompasses
the basic functionality that all handlers are expected to have.
Keyword arguments recognized by the @code{<log-handler>} at creation
time are:
@@ -328,9 +328,18 @@ output looks like:
\"The servers are melting!\")
==> \"2003/12/29 14:53:02 (CRITICAL): The servers are melting!\"
@end lisp
+@item #:flush-after-emit?
+This optional parameter defaults to @code{#t}, to ensure users can
+tail the logs output in real time. In some cases, such as when
+logging very large output to a file, it may be preferable to set this
+to @code{#f}, to let the default block buffering mode of the
+associated file port reduce write pressure on the file system.
@end table"
- (formatter #:init-value default-log-formatter #:getter log-formatter #:init-keyword #:formatter)
- (levels #:init-form (make-hash-table 17) #:getter levels))
+ (formatter #:init-value default-log-formatter #:getter log-formatter
+ #:init-keyword #:formatter)
+ (levels #:init-form (make-hash-table 17) #:getter levels)
+ (flush-after-emit? #:init-value #t #:getter flush-after-emit?
+ #:init-keyword #:flush-after-emit?))
(define-generic-with-docs add-handler!
"@code{add-handler! lgr handler}. Adds @var{handler} to @var{lgr}'s list of handlers. All subsequent
@@ -364,7 +373,8 @@ override this behavior.")
;; Legacy variant without source-properties argument.
(when (level-enabled? self level)
(emit-log self ((log-formatter self) level time str))
- (flush-log self)))
+ (when (flush-after-emit? self)
+ (flush-log self))))
(define-method (accept-log (self <log-handler>) level time str
source-properties proc-name)
@@ -372,7 +382,8 @@ override this behavior.")
(emit-log self ((log-formatter self) level time str
#:source-properties source-properties
#:proc-name proc-name))
- (flush-log self)))
+ (when (flush-after-emit? self)
+ (flush-log self))))
;; This should be overridden by all log handlers to actually
;; write out a string.
diff --git a/unit-tests/logging.logger.scm b/unit-tests/logging.logger.scm
index 534c65e..2cead80 100644
--- a/unit-tests/logging.logger.scm
+++ b/unit-tests/logging.logger.scm
@@ -21,8 +21,15 @@
(use-modules (unit-test)
(logging logger)
(logging port-log)
+ (ice-9 textual-ports)
(oop goops))
+(define* (call-with-temporary-file proc #:key (mode "w+"))
+ "Open a temporary file name and pass it to PROC, a procedure of one
+argument. The port is automatically closed."
+ (let ((port (mkstemp "file-XXXXXX" mode)))
+ (call-with-port port proc)))
+
(define-class <test-logging> (<test-case>))
(define-method (test-log-to-one-port (self <test-logging>))
@@ -65,4 +72,28 @@
(assert (string-contains (get-output-string strport)
" unit-tests/logging.logger.scm:63:4: "))))
+(define-method (test-log-with-flush-after-emit-disabled (self <test-logging>))
+ "Test the case where flush-after-emit? on the handler is false."
+ (call-with-temporary-file
+ (lambda (port)
+ (setvbuf port 'block 1000000) ;large 1MB buffer
+ (let ((lgr (make <logger>
+ #:handlers (list (make <port-log> #:port port
+ #:flush-after-emit? #f)))))
+ (log-msg lgr 'ERROR "this should be buffered, i.e. not written yet")
+ (assert (string-null?
+ (call-with-input-file (port-filename port) get-string-all)))))))
+
+(define-method (test-log-with-flush-after-emit (self <test-logging>))
+ "Test the default case where flush-after-emit? on the handler is true."
+ (call-with-temporary-file
+ (lambda (port)
+ (setvbuf port 'block 1000000) ;large 1MB buffer
+ (let ((lgr (make <logger>
+ #:handlers (list (make <port-log> #:port port)))))
+ (log-msg lgr 'ERROR "this should be flushed to disk after emit")
+ (assert (string-contains
+ (call-with-input-file (port-filename port) get-string-all)
+ "this should be flushed to disk after emit"))))))
+
(exit-with-summary (run-all-defined-test-cases))
base-commit: af929893752b076f367d9d18d2b5e0e8ac12bf7b
--
2.41.0
next reply other threads:[~2024-03-02 4:15 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-03-02 4:15 Maxim Cournoyer [this message]
2024-03-02 23:28 ` [Guile-Lib PATCH] logger: Add flush-after-emit? property to <log-handler> David Pirotte
2024-03-03 3:26 ` Maxim Cournoyer
2024-03-04 6:19 ` David Pirotte
2024-03-05 17:03 ` Maxim Cournoyer
2024-03-10 1:46 ` David Pirotte
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20240302041612.29833-1-maxim.cournoyer@gmail.com \
--to=maxim.cournoyer@gmail.com \
--cc=david@altosw.be \
--cc=guile-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).