From f2f41ec02354d72b86c6025b8a325ef716cb4dd9 Mon Sep 17 00:00:00 2001 From: Michele Guerini Rocco Date: Fri, 17 Dec 2021 23:18:50 +0100 Subject: [PATCH] src/logger.f90: init MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This change adds a minimal logging system. The log messages carry a timestamp in μs, the identifier of the emitter (fortran module + procedure) and a log level. For simplicity the format is hardcoded. --- src/logger.f90 | 188 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 188 insertions(+) create mode 100644 src/logger.f90 diff --git a/src/logger.f90 b/src/logger.f90 new file mode 100644 index 0000000..29c3ebf --- /dev/null +++ b/src/logger.f90 @@ -0,0 +1,188 @@ +! This module provides a minimal logging framework +! +! There are 4 logging levels, controlled via `set_log_level`, of increasing +! verbosity. If the logging level is lower than the level of a message, +! it will be discarded, otherwise it will be written to the standard error. +! +! Messages are emitted using `log_message(msg, level, mod, proc)` or one +! of the specialised subroutine (`log_error`, `log_warning`, etc.). +! +! The format of the log is: [time] [module:procedure] [level] +module logger + + ! Log levels + enum, bind(C) + enumerator :: log_level = -1 + enumerator :: ERROR = 0 ! errors, critical + enumerator :: WARNING = 1 ! warnings, non-critical + enumerator :: INFO = 2 ! user informational messages + enumerator :: DEBUG = 3 ! debugging messages + end enum + + ! ANSI escape sequences for colors + type ansi_colors + character(8) :: red = achar(27) // '[1;31m' + character(8) :: green = achar(27) // '[0;32m' + character(8) :: yellow = achar(27) // '[1;33m' + character(8) :: white = achar(27) // '[1;39m' + character(8) :: blue = achar(27) // '[0;34m' + character(8) :: reset = achar(27) // '[0m' + end type + + integer(kind(log_level)), save :: current_level = WARNING + type(ansi_colors), parameter :: colors = ansi_colors() + + private + public log_message, set_log_level + public log_error, log_warning, log_info, log_debug + public log_level, ERROR, WARNING, INFO, DEBUG + +contains + + subroutine log_message(msg, level, mod, proc) + ! Logs a message to the standard error where: + ! msg: message to log + ! level: log level of the message + ! mod: module emitting the message + ! proc: procedure emitting the message + + use, intrinsic :: iso_fortran_env, only : error_unit + + implicit none + + ! subroutine argument + character(*), intent(in) :: msg + integer(kind(log_level)), intent(in) :: level + character(*), intent(in) :: mod + character(*), intent(in), optional :: proc + + ! local variables + character(512) :: id, kind, time + real :: now + + if (level > current_level) return + + ! execution time in μs (eg. [0571258]) + call cpu_time(now) + write (time, '("[",i0.7,"]")') int(now * 1e6) + time = trim(colors%blue) // trim(time) // trim(colors%reset) + + ! id of the emitter (eg. [program:main]) + id = mod + if (present(proc)) id = trim(id) // ':' // trim(proc) + + ! kind of message (eg. [warning]) + kind = trim(level_color(level)) // & + trim(level_name(level)) // & + trim(colors%reset) + + write (error_unit, '(a, 2(x,"[",a,"]"), x,a)') & + trim(time), trim(id), trim(kind), trim(msg) + + end subroutine log_message + + + ! Specialised log_message variants + + subroutine log_error(msg, mod, proc) + ! Logs an error + implicit none + character(*), intent(in) :: msg + character(*), intent(in) :: mod + character(*), intent(in), optional :: proc + call log_message(msg, ERROR, mod, proc) + end subroutine log_error + + subroutine log_warning(msg, mod, proc) + ! Logs a warning + implicit none + character(*), intent(in) :: msg + character(*), intent(in) :: mod + character(*), intent(in), optional :: proc + call log_message(msg, WARNING, mod, proc) + end subroutine log_warning + + subroutine log_info(msg, mod, proc) + ! Logs an informational message + implicit none + character(*), intent(in) :: msg + character(*), intent(in) :: mod + character(*), intent(in), optional :: proc + call log_message(msg, INFO, mod, proc) + end subroutine log_info + + subroutine log_debug(msg, mod, proc) + ! Logs a debugging message + implicit none + character(*), intent(in) :: msg + character(*), intent(in) :: mod + character(*), intent(in), optional :: proc + call log_message(msg, DEBUG, mod, proc) + end subroutine log_debug + + + subroutine set_log_level(level) + ! Set the current logging level + ! + ! Only messages with a lower level than the current + ! one will be actually logged. + + implicit none + + ! subroutine arguments + integer(kind(log_level)), intent(in) :: level + character(25) :: msg + + current_level = level + msg = 'changed level to ' // trim(level_name(level)) + call log_debug(msg, mod='logger', proc='set_log_level') + + end subroutine set_log_level + + + pure function level_color(level) result(escape) + ! The color associated to a log level + + implicit none + + ! function arguments + integer(kind(log_level)), intent(in) :: level + character(8) :: escape + + select case (level) + case (ERROR) + escape = colors%red + case (WARNING) + escape = colors%yellow + case (INFO) + escape = colors%green + case (DEBUG) + escape = colors%white + end select + + end function level_color + + + pure function level_name(level) result(name) + ! The human readable name of a log level + + implicit none + + ! function arguments + integer(kind(log_level)), intent(in) :: level + character(7) :: name + + select case (level) + case (ERROR) + name = "error" + case (WARNING) + name = "warning" + case (INFO) + name = "info" + case (DEBUG) + name = "debug" + end select + + end function level_name + +end module logger