From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Maxim Cournoyer Newsgroups: gmane.lisp.guile.devel Subject: [Guile-Lib PATCH v3 4/7] logging: Allow passing source properties to `log-msg'. Date: Thu, 8 Feb 2024 23:50:45 -0500 Message-ID: <20240209045150.17210-5-maxim.cournoyer@gmail.com> References: <20240206034201.28494-1-maxim.cournoyer@gmail.com> <20240209045150.17210-1-maxim.cournoyer@gmail.com> Mime-Version: 1.0 Content-Transfer-Encoding: 8bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="19949"; mail-complaints-to="usenet@ciao.gmane.io" Cc: David Pirotte , Maxim Cournoyer To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Fri Feb 09 05:53:01 2024 Return-path: Envelope-to: guile-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1rYIsm-0004yu-O6 for guile-devel@m.gmane-mx.org; Fri, 09 Feb 2024 05:53:00 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rYIru-0006ss-Ij; Thu, 08 Feb 2024 23:52:06 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rYIrt-0006sI-9L for guile-devel@gnu.org; Thu, 08 Feb 2024 23:52:05 -0500 Original-Received: from mail-qk1-x735.google.com ([2607:f8b0:4864:20::735]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rYIrr-0000Q9-8B for guile-devel@gnu.org; Thu, 08 Feb 2024 23:52:05 -0500 Original-Received: by mail-qk1-x735.google.com with SMTP id af79cd13be357-783dc658bd9so27850885a.1 for ; Thu, 08 Feb 2024 20:52:02 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1707454322; x=1708059122; darn=gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=6n3oa5eKicEr+UJlKdNdOtZwYqryP2iL/7fbloK2Eh8=; b=eYDYFFIn7FG865jZCDo71PqQOgc2iAkuPqL9IeOOQS7pC3n67P0GKuhNA0ihj6wDq/ CMR4TMnDDTK8bAhZGUgQDEyJ5Pjg7OCJgDCEj4V2r119fSE9sHYjrNHLH4CZzs0FQZ/4 8WEzwBmO6ZUqQ1nKsb50Xy3cLdJW2GnSmyt1Z7WDL0n37i6x5Bs1HejmAJdjL4oVMXoz 8kQyee8QppWz3fQr+SX7CJuzRPQyxoruvRZ8khNuLzL/q+F1sD8mBz/bPDHaAJso0o13 BJ/Eg4mQ2ktipRAO5he6g5ZWgfEdM2WSTYs6I3GgklRLalYick33LtuXnXLT1eNu9ncU bECw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1707454322; x=1708059122; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=6n3oa5eKicEr+UJlKdNdOtZwYqryP2iL/7fbloK2Eh8=; b=o8l6zLeidXz1TLPUbNE3vI94c7otMmobiYOUF58iXBzwV0PhY2Dkov9g0z88FnEvoO FHIC7RmE3YYsiT3nyoei4hpriS6Ciz0mudKVGg4jNqvd7roJLzZhppAUoCNsolQw6vA6 4xxcRiWRHDPqdaL4iyJhdXlSjOXQ9EPVg3J/ZrzIPj3pSu0rvXaR/fzvSvpyEHgMmZht PZgmzhGSJZmGTjd8c8axaNcO7KvdRr1jAisbHzyaJU2eekteyR2id2yB0hplIpKaeu3f p7nqiQm46IZBuUsEXQVX0ONbu1ZgZAWvPI2h4VH2x19yGtd7vmFyVaBkYrFWn52Ye3Sk daQw== X-Gm-Message-State: AOJu0YxaVPO8VjwCRK1wEhnKPDwg92MlZq21+T/7qLodZ2B7hC6P3YxR xt7tW6nJ8aoZguL6UuHNqxV+cwuKxsmg1GZqaQUO5R0GXeZEo+FKXK16uhVu X-Google-Smtp-Source: AGHT+IFC13UItwnH+/zlWoPdnQqJGG4VhuFgPAU2zYivJ3cH6+/CDOds8rgN15Y8xIFv9bc9TBpJMQ== X-Received: by 2002:ae9:e603:0:b0:785:3ca4:cc0c with SMTP id z3-20020ae9e603000000b007853ca4cc0cmr569793qkf.7.1707454321557; Thu, 08 Feb 2024 20:52:01 -0800 (PST) X-Forwarded-Encrypted: i=1; AJvYcCVRNKaBWgWCqWGaak13ZNoNHV7321KszTHZUnXUv5BgwNWKk3LWUhUmqOw30V8+9cgylV7O0wd1O4GvBWr+M7Gdru8BuqBlEVw4 Original-Received: from localhost.localdomain (dsl-10-135-252.b2b2c.ca. [72.10.135.252]) by smtp.gmail.com with ESMTPSA id p3-20020a05620a112300b00785a2d275f0sm426970qkk.41.2024.02.08.20.52.00 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 08 Feb 2024 20:52:01 -0800 (PST) X-Mailer: git-send-email 2.41.0 In-Reply-To: <20240209045150.17210-1-maxim.cournoyer@gmail.com> Received-SPF: pass client-ip=2607:f8b0:4864:20::735; envelope-from=maxim.cournoyer@gmail.com; helo=mail-qk1-x735.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.lisp.guile.devel:22316 Archived-At: Note: this changes the API of the `accept-log' method by adding a new positional argument to it. `accept-log' is a "weak" public interface (mostly intended for internal uses or logging handler implementors), so this is deemed acceptable. * src/logging/logger.scm (log-helper) [source-properties]: New positional argument, which is passed to `accept-log'. * src/logging/logger.scm (log-msg): Update doc. Add two new variants that accept source properties. Annotate more LVL arguments with their type to ensure proper resolution. (default-log-formatter) [source-properties]: New keyword argument, that is formatted as a source location prefix when available. Add #:allow-other-keys to signal users they should use such a signature to ensure forward compatibility. (accept-log): Update doc. Add new source-properties argument, and pass it to the log-formatter procedure. * unit-tests/logging.logger.scm (test-log-with-source-properties): New test. * unit-tests/guile-library.api: Regenerate. --- Changes in v3: - Use (ice-9 format) for the default-log-formatter - Use a keyword argument for the source-properties - Add proc-name argument to default-log-formatter Changes in v2: - Relax log-msg typing on source-properties, as it can also be #f src/logging/logger.scm | 95 ++++++++++++++++++++++------------- unit-tests/guile-library.api | 8 +-- unit-tests/logging.logger.scm | 12 +++++ 3 files changed, 78 insertions(+), 37 deletions(-) diff --git a/src/logging/logger.scm b/src/logging/logger.scm index 7ff4f43..7b32ffe 100644 --- a/src/logging/logger.scm +++ b/src/logging/logger.scm @@ -1,5 +1,6 @@ ;; (logging logger) -- write methods to log files -;; Copyright (C) 2003 Richard Todd +;; Copyright (C) 2003 Richard Todd +;; Copyright (C) 2024 Maxim Cournoyer ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -68,6 +69,7 @@ INFO and WARN-level logs don't get through. (use-modules (logging logger) (logging rotating-log) (logging port-log) + (scheme documentation) (oop goops)) @@ -143,6 +145,7 @@ INFO and WARN-level logs don't get through. close-log! ) #:use-module (oop goops) + #:use-module (ice-9 format) #:use-module (scheme documentation)) ;;; ---------------------------------------------------------------------- @@ -216,17 +219,17 @@ Handlers can always be added later via @code{add-handler!} calls. (levels #:init-form (make-hash-table 17) #:getter levels) (log-handlers #:init-value '() #:accessor handlers #:init-keyword #:handlers)) -(define (log-helper lgr level objs) +(define (log-helper lgr level objs source-properties) ;; the level must be enabled in the logger to proceed... (if (level-enabled? lgr level) (let ((cur-time (current-time))) (for-each (lambda (str) - (if (not (string-null? str)) - - ;; pass the string to each log handler for lgr - (for-each (lambda (handler) - (accept-log handler level cur-time str)) - (handlers lgr)))) + (unless (string-null? str) + ;; pass the string to each log handler for lgr + (for-each (lambda (handler) + (accept-log handler level cur-time str + source-properties)) + (handlers lgr)))) ;; split the string at newlines into different log statements (string-split @@ -234,15 +237,17 @@ Handlers can always be added later via @code{add-handler!} calls. #\nl))))) (define-generic-with-docs log-msg -"@code{log-msg [lgr] lvl arg1 arg2 ...}. Send a log message -made up of the @code{display}'ed representation of the given -arguments. The log is generated at level @var{lvl}, which should -be a symbol. If the @var{lvl} is disabled, the log message is +"@code{log-msg [lgr] [source-properties] lvl arg1 arg2 ...}. Send a +log message made up of the @code{display}'ed representation of the +given arguments. The log is generated at level @var{lvl}, which +should be a symbol. If the @var{lvl} is disabled, the log message is not generated. Generated log messages are sent through each of @var{lgr}'s handlers. -If the @var{lgr} parameter is omitted, then the default logger -is used, if one is set. +If the @var{lgr} parameter is omitted, then the default logger is +used, if one is set. If the @var{source-properties} argument is +provided, it should be a source property alist containing the +filename, line and column keys. As the args are @code{display}'ed, a large string is built up. Then, the string is split at newlines and sent through the log handlers as @@ -262,22 +267,39 @@ timestamps to log statements. (define-method (log-msg (lvl ) . objs) (if default-logger - (log-helper default-logger lvl objs))) + (log-helper default-logger lvl objs #f))) + +(define-method (log-msg source-properties (lvl ) . objs) + (if default-logger + (log-helper default-logger lvl objs source-properties))) + +(define-method (log-msg (lgr ) (lvl ) . objs) + (log-helper lgr lvl objs #f)) -(define-method (log-msg (lgr ) lvl . objs) - (log-helper lgr lvl objs)) +(define-method (log-msg (lgr ) source-properties + (lvl ) . objs) + (log-helper lgr lvl objs source-properties)) ;; the default formatter makes a log statement like: ;; 2003/12/29 14:53:02 (CRITICAL): The servers are melting! -(define (default-log-formatter lvl time str) - (with-output-to-string - (lambda () - (display (strftime "%F %H:%M:%S" (localtime time))) - (display " (") - (display (symbol->string lvl)) - (display "): ") - (display str) - (newline)))) +(define* (default-log-formatter lvl time str + #:key source-properties + #:allow-other-keys) + "Default log formatting procedure. For source properties to be +available, they must be manually provided to @code{log-msg} via a +suitable syntax wrapper (currently left to the user to implement)." + (let ((file-name (assoc-ref source-properties 'filename)) + ;; Note: increment the source property zero-indexed line by 1, + ;; to comply with the GNU Standards guidelines (info + ;; '(standards) Errors'). + (line (and=> (assoc-ref source-properties 'line) 1+)) + (column (assoc-ref source-properties 'column))) + (format #f "~a ~@[~a ~](~a): ~a~%" + (strftime "%F %H:%M:%S" (localtime time)) + (and (or file-name line column) + (format #f "~@[~a:~]~@[~a:~]~@[~a:~]" file-name line column)) + lvl + str))) (define-class-with-docs () "This is the base class for all of the log handlers, and encompasses @@ -314,10 +336,13 @@ registered handlers.") (define-generic-with-docs accept-log "@code{accept-log handler lvl time str}. If @var{lvl} is -enabled for @var{handler}, then @var{str} will be formatted and -sent to the log via the @code{emit-log} method. Formatting is -done via the formatting function given at @var{handler}'s -creation time, or by the default if none was given. +enabled for @var{handler}, then @var{str} will be formatted and sent +to the log via the @code{emit-log} method. @var{source-properties} +can be either @code{#f} or an association list containing the file +name, line, and column source information provided to the +@code{log-msg} call. Formatting is done via the formatting function +given at @var{handler}'s creation time, or by the default if none was +given. This method should not normally need to be overridden by subclasses. This method should not normally be called by users of the logging @@ -326,11 +351,13 @@ override this behavior.") ;; This can be overridden by log handlers if this default behaviour ;; is not desired.. -(define-method (accept-log (self ) level time str) - (if (level-enabled? self level) - (emit-log self ((log-formatter self) level time str)))) +(define-method (accept-log (self ) level time str + source-properties) + (when (level-enabled? self level) + (emit-log self ((log-formatter self) level time str + #:source-properties source-properties)))) -;; This should be overridden by all log handlers to actually +;; This should be overridden by all log handlers to actually ;; write out a string. (define-generic-with-docs emit-log "@code{emit-log handler str}. This method should be implemented diff --git a/unit-tests/guile-library.api b/unit-tests/guile-library.api index b52dd41..594a1ab 100644 --- a/unit-tests/guile-library.api +++ b/unit-tests/guile-library.api @@ -90,7 +90,7 @@ ( class) (accept-log generic - ( )) + ( )) (add-handler! generic ( )) (close-log! generic @@ -114,8 +114,10 @@ ()) (log-msg generic - ( . ) - ( . )) + ( . ) + ( . ) + ( . ) + ( . )) (lookup-logger procedure (arity 1 0 #f)) (open-log! generic diff --git a/unit-tests/logging.logger.scm b/unit-tests/logging.logger.scm index f1084b8..d26587c 100644 --- a/unit-tests/logging.logger.scm +++ b/unit-tests/logging.logger.scm @@ -1,6 +1,7 @@ ;;; ---------------------------------------------------------------------- ;;; unit test ;;; Copyright (C) 2003 Richard Todd +;;; Copyright (C) 2024 Maxim Cournoyer ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -52,6 +53,17 @@ (assert-equal "(CRITICAL): Hello!\n" ;; skip over the time/date, since that will vary! (substring (get-output-string strport) 20)))) + +(define-method (test-log-with-source-properties (self )) + (let* ((strport (open-output-string)) + (lgr (make #:handlers (list (make #:port strport)))) + (source-properties '((filename . "unit-tests/logging.logger.scm") + (line . 62) + (column . 4)))) + (open-log! lgr) + (log-msg lgr source-properties 'ERROR "Hello!") + (string-contains (get-output-string strport) + " unit-tests/logging.logger.scm:63:4: "))) (exit-with-summary (run-all-defined-test-cases)) -- 2.41.0