Line data Source code
1 : #include "logging.h"
2 : !> \file mo_logging.F90
3 : !> \brief \copybrief mo_logging
4 : !> \details \copydetails mo_logging
5 :
6 : !> \brief Module providing a logging framework.
7 : !> \version 0.1
8 : !> \authors Daan van Vugt, Sebastian Mueller, Robert Schweppe
9 : !> \date Sep 2022
10 : !> \copyright flogging was originally released under the MIT license.
11 : !> \details A simple logging framework derived from flogging (https://github.com/DaanVanVugt/flogging).
12 : !! To use logging you need to include `logging.h` at the top of your fortran file.
13 : !!
14 : !! \note The file needs to processed by the pre-processor.
15 : !!
16 : !! Afterwards you have a list of logging routines that could be used instead of `write`:
17 : !! - `log_fatal(format)`: level 1
18 : !! - `log_error(format)`: level 2
19 : !! - `log_warn(format)`: level 3
20 : !! - `log_info(format)`: level 4
21 : !! - `log_debug(format)`: level 5
22 : !! - `log_trace(format)`: level 6
23 : !! - `log_subtrace(format)`: level 7
24 : !! as required.
25 : !!
26 : !! The following example demonstrates the functionality. The `mo_cli` module incorporates logger settings:
27 : !! \code{.f90}
28 : !! #include "logging.h"
29 : !! program test_log
30 : !! use mo_logging
31 : !! use mo_cli, only : cli_parser
32 : !! implicit none
33 : !! type(cli_parser) :: parser
34 : !! parser = cli_parser( &
35 : !! description="Program with cli and logger.", &
36 : !! add_help_option=.true., &
37 : !! add_logger_options=.true.)
38 : !! call parser%parse()
39 : !! log_fatal(*) "fatal"
40 : !! log_error(*) "error"
41 : !! log_warn(*) "warn"
42 : !! log_info(*) "info"
43 : !! log_debug(*) "debug"
44 : !! log_trace(*) "trace"
45 : !! log_subtrace(*) "subtrace"
46 : !! end program test_log
47 : !! \endcode
48 : !! You can call the program with:
49 : !! \code{.sh}
50 : !! $ ./prog --quiet
51 : !! test.F90:12 FATAL fatal
52 : !! test.F90:13 ERROR error
53 : !! test.F90:14 WARN warn
54 : !! \endcode
55 : !! You can see all cli logger options with:
56 : !! \code{.sh}
57 : !! $ ./prog -h
58 : !! \endcode
59 : !> \copyright Copyright 2005-\today, the CHS Developers, Sabine Attinger: All rights reserved.
60 : !! FORCES is released under the LGPLv3+ license \license_note
61 : module mo_logging
62 : ! Copyright (c) 2016 Daan van Vugt
63 : !
64 : ! Permission is hereby granted, free of charge, to any person
65 : ! obtaining a copy of this software and associated documentation
66 : ! files (the "Software"), to deal in the Software without
67 : ! restriction, including without limitation the rights to use,
68 : ! copy, modify, merge, publish, distribute, sublicense, and/or sell
69 : ! copies of the Software, and to permit persons to whom the
70 : ! Software is furnished to do so, subject to the following
71 : ! conditions:
72 : !
73 : ! The above copyright notice and this permission notice shall be
74 : ! included in all copies or substantial portions of the Software.
75 : !
76 : ! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
77 : ! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
78 : ! OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
79 : ! NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
80 : ! HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
81 : ! WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
82 : ! FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
83 : ! OTHER DEALINGS IN THE SOFTWARE.
84 :
85 : #ifdef NAG
86 : use f90_unix_env, only: isatty
87 : use f90_unix_env, only: gethostname
88 : #endif
89 : #ifdef INTEL
90 : use ifport, only: isatty
91 : use ifport, only: hostnm
92 : #endif
93 : use mo_constants, only: stdout=>nout, stderr=>nerr
94 :
95 : implicit none
96 : ! Log levels
97 : integer, public, parameter :: NUM_LOG_LEVELS = 7 !< 1 through 7 (fatal through trace)
98 : integer, public, parameter :: LOG_FATAL = LOG_LEVEL_FATAL_DEF !< = 1, Runtime error causing termination
99 : integer, public, parameter :: LOG_ERROR = LOG_LEVEL_ERROR_DEF !< = 2, Runtime error
100 : integer, public, parameter :: LOG_WARN = LOG_LEVEL_WARN_DEF !< = 3, Warning, but we can continue
101 : integer, public, parameter :: LOG_INFO = LOG_LEVEL_INFO_DEF !< = 4, Interesting events
102 : integer, public, parameter :: LOG_DEBUG = LOG_LEVEL_DEBUG_DEF !< = 5, Detailed debug output, disable by compiling your program with -DDISABLE_LOG_DEBUG
103 : integer, public, parameter :: LOG_TRACE = LOG_LEVEL_TRACE_DEF !< = 6, Extremely detailed output, compile your program with -DENABLE_LOG_TRACE to enable
104 : integer, public, parameter :: LOG_SUBTRACE = LOG_LEVEL_SUBTRACE_DEF !< = 7, More Extremely detailed output, compile your program with -DENABLE_LOG_TRACE to enable
105 :
106 : integer, public, save :: log_unit = stdout !< By default, log to stdout for level > 2
107 : integer, public, save :: log_unit_error = stderr !< By default, log to stderr for level <= 2
108 : integer, public, save :: minimum_log_level = LOG_INFO !< Note that more critical means a lower number
109 : logical, public, save :: show_file_and_line = .true. !< show file name and line number in log output
110 :
111 : public :: log_set_output_hostname
112 : public :: log_set_output_severity
113 : public :: log_set_output_date
114 : public :: log_set_output_time
115 : public :: log_set_output_fileline
116 : public :: log_set_skip_terminal_check
117 : public :: log_set_disable_colors
118 : public :: log_set_disable_format
119 : public :: log_set_config
120 :
121 : public :: logu, logp, logl, stput
122 :
123 : private
124 : !> Control start character
125 : character(len=*), parameter :: start = achar(27)
126 : !> Control reset character
127 : character(len=*), parameter :: reset = "0"
128 : !> Styles
129 : character(len=*), parameter :: bold = "1", dimmed = "2", &
130 : underline = "4", blink = "5", invert = "7", hidden = "8"
131 :
132 : ! Default settings for hostname and severity output
133 : logical, save :: output_hostname = .false.
134 : logical, save :: output_severity = .true.
135 : logical, save :: output_date = .false.
136 : logical, save :: output_time = .false.
137 : logical, save :: output_fileline = .true.
138 : logical, save :: skip_terminal_check = .false.
139 : logical, save :: disable_colors = .false.
140 : logical, save :: disable_format = .false.
141 :
142 : !> These are the color codes corresponding to the loglevels above
143 : character(len=*), dimension(NUM_LOG_LEVELS), parameter :: color_codes = &
144 : ["31", "31", "33", "32", "35", "36", "36"]
145 : !> These are the styles corresponding to the loglevels above
146 : character(len=*), dimension(NUM_LOG_LEVELS), parameter :: style_codes = &
147 : [bold, reset, reset, reset, reset, reset, reset]
148 :
149 : !> Colors for other output
150 : character(len=*), parameter :: level_color = "20"
151 :
152 : contains
153 : !> \brief write format string to given unit
154 0 : subroutine tput(lu, code)
155 : implicit none
156 : integer, intent(in) :: lu !< unit
157 : character(len=*), intent(in) :: code !< format code
158 : if (.not. disable_format) write(lu, '(a,"[",a,"m")', advance="no") start, code
159 : end subroutine tput
160 :
161 : !> \brief generate format string
162 0 : subroutine stput(str, code)
163 : implicit none
164 : character(len=*), intent(inout) :: str !< pre string
165 : character(len=*), intent(in) :: code !< format code
166 0 : if (.not. disable_format) str = trim(str) // start // "[" // trim(code) // "m"
167 0 : end subroutine stput
168 :
169 : !> \brief Set the default for hostname output
170 0 : subroutine log_set_output_hostname(bool)
171 : logical, intent(in) :: bool
172 0 : output_hostname = bool
173 0 : end subroutine log_set_output_hostname
174 :
175 : !> \brief Set the default for severity output
176 0 : subroutine log_set_output_severity(bool)
177 : logical, intent(in) :: bool
178 0 : output_severity = bool
179 0 : end subroutine log_set_output_severity
180 :
181 : !> \brief Set the default for date output
182 0 : subroutine log_set_output_date(bool)
183 : logical, intent(in) :: bool
184 0 : output_date = bool
185 0 : end subroutine log_set_output_date
186 :
187 : !> \brief Set time-only date format
188 0 : subroutine log_set_output_time(bool)
189 : logical, intent(in) :: bool
190 0 : output_time = bool
191 0 : end subroutine log_set_output_time
192 :
193 : !> \brief Set the default for file/line output
194 0 : subroutine log_set_output_fileline(bool)
195 : logical, intent(in) :: bool
196 0 : output_fileline = bool
197 0 : end subroutine log_set_output_fileline
198 :
199 : !> \brief Whether or not to skip the terminal check
200 0 : subroutine log_set_skip_terminal_check(bool)
201 : logical, intent(in) :: bool
202 0 : skip_terminal_check = bool
203 0 : end subroutine log_set_skip_terminal_check
204 :
205 : !> \brief Disable colors altogether
206 0 : subroutine log_set_disable_colors(bool)
207 : logical, intent(in) :: bool
208 0 : disable_colors = bool
209 0 : end subroutine log_set_disable_colors
210 :
211 : !> \brief Disable formatting altogether
212 0 : subroutine log_set_disable_format(bool)
213 : logical, intent(in) :: bool
214 0 : disable_format = bool
215 0 : end subroutine log_set_disable_format
216 :
217 : !> \brief Output unit to log.
218 : !> \return unit number.
219 0 : function logu(level)
220 : integer, intent(in) :: level !< The log level of the current message
221 : integer :: logu !< unit to log to (stderr for level <=2 else stdout by default)
222 :
223 0 : if (level .le. LOG_ERROR) then
224 0 : logu = log_unit_error
225 : else
226 0 : logu = log_unit
227 : endif
228 0 : end function logu
229 :
230 : !> \brief Output this log statement or not.
231 : !> \return true if this log message can be printed.
232 0 : function logp(level, only_n)
233 : #ifdef USE_MPI
234 : use mpi
235 : #endif
236 : integer, intent(in) :: level !< The log level of the current message
237 : integer, intent(in), optional :: only_n !< Show only if the current mpi rank equals only_n
238 : logical :: logp !< Output: true if this log message can be printed
239 : #ifdef USE_MPI
240 : integer :: rank, ierr
241 : #endif
242 :
243 0 : if (level .le. minimum_log_level) then
244 : logp = .true.
245 : else
246 0 : logp = .false.
247 : endif
248 : #ifdef USE_MPI
249 : if (logp .and. present(only_n)) then
250 : call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr)
251 : if (rank .ne. only_n) logp = .false.
252 : endif
253 : #endif
254 0 : end function logp
255 :
256 : !> \brief Write a log lead containing level and optional info.
257 : !> \details The name is shortened to allow for longer log messages without needing continuations.
258 : !> \return The output log leader.
259 0 : function logl(level, filename, linenum)
260 : implicit none
261 : ! Input parameters
262 : integer :: level !< The log level
263 : character(len=*), optional :: filename !< An optional filename to add to the log lead
264 : integer, optional :: linenum !< With line number
265 : character(len=300) :: logl !< The output log leader
266 :
267 : ! Internal parameters
268 : character(len=50), dimension(6) :: log_tmp !< The different parts of the log lead
269 : integer :: fn_len !< Add extra spaces after part i
270 : integer :: i, j, space_cnt !< The counter for the different parts
271 : character(4) :: linenum_lj ! left-justified line number
272 : character(len=50) :: basename ! basename stripped from filename
273 :
274 : logical :: show_colors = .false.
275 : logical :: is_terminal = .false.
276 0 : i = 1
277 :
278 : ! Set level to 1 if it is too low, skip if too high
279 0 : if (level .lt. 1) level = 1
280 0 : if (level .gt. minimum_log_level .or. level .gt. NUM_LOG_LEVELS) return
281 :
282 : ! only show colors if we are outputting to a terminal
283 0 : if (skip_terminal_check) then
284 0 : show_colors = .not. disable_colors
285 : else
286 : #ifdef NAG
287 : call isatty(stdout, is_terminal)
288 : #else
289 0 : is_terminal = isatty(stdout)
290 : #endif
291 0 : show_colors = is_terminal .and. .not. disable_colors
292 : endif
293 : ! This works in ifort and gfortran (log_unit is stdout here because log_lead is an internal string)
294 :
295 : ! Initialize log_tmp
296 0 : log_tmp = ""
297 0 : fn_len = 0
298 :
299 : ! Reset the colors if needed
300 0 : if (show_colors) call stput(log_tmp(i), reset) ! Do not increment i to add it before the next space
301 :
302 : ! Write date and time if wanted
303 0 : if (output_date .or. output_time) then
304 0 : log_tmp(i) = trim(log_tmp(i)) // log_datetime()
305 0 : i = i + 1
306 : endif
307 :
308 : ! Write hostname if requested
309 0 : if (output_hostname) then
310 0 : log_tmp(i) = trim(log_tmp(i)) // log_hostname()
311 0 : i = i + 1
312 : endif
313 :
314 : #ifdef USE_MPI
315 : ! Write mpi id
316 : log_tmp(i) = trim(log_tmp(i)) // log_mpi_id()
317 : i = i + 1
318 : #endif
319 :
320 0 : if (present(filename) .and. output_fileline .and. show_file_and_line) then
321 0 : call strip_path(filename, basename)
322 0 : log_tmp(i) = trim(log_tmp(i)) // trim(basename)
323 0 : if (present(linenum)) then
324 : ! Left-justify the line number and cap it to 4 characters
325 0 : write(linenum_lj, '(i4)') linenum
326 0 : log_tmp(i) = trim(log_tmp(i)) // ":" // adjustl(linenum_lj)
327 : endif
328 : ! How many extra spaces are needed to fill out to multiple of n characters
329 0 : fn_len = fn_len + len_trim(log_tmp(i))
330 0 : i = i+1
331 : endif
332 :
333 : ! Output severity level
334 0 : if (output_severity) then
335 0 : fn_len = fn_len + len_trim(log_severity(level, .false.))
336 : ! correctly set spaces when skipping filename/line
337 0 : space_cnt = mod(7-fn_len,8)+8
338 0 : if (space_cnt >= 8) space_cnt = space_cnt - 8
339 0 : log_tmp(i) = trim(log_tmp(i)) // spaces(space_cnt) // log_severity(level, show_colors)
340 : endif
341 :
342 : ! Set color based on severity level
343 0 : if (show_colors) then
344 : ! Set bold for errors (must go first, resets the color code otherwise)
345 0 : call stput(log_tmp(i), style_codes(level))
346 0 : call stput(log_tmp(i), color_codes(level))
347 : endif
348 :
349 : ! Concatenate trim(log_tmp(i)) with spaces in between
350 0 : logl = log_tmp(1)
351 0 : do j=2,i
352 0 : logl = trim(logl) // " " // trim(log_tmp(j))
353 : enddo
354 0 : end function logl
355 :
356 : !> \brief Get base name of a file path.
357 0 : subroutine strip_path(filepath, basename)
358 : ! keeping this subroutine to prevent circular dependencies: mo_os -> mo_message -> mo_logging -> mo_os
359 : character(len=*), intent(in) :: filepath !< The path to be stripped
360 : character(len=*), intent(out) :: basename !< The basename of the filepath
361 : integer :: last_sep_idx
362 0 : last_sep_idx = index(filepath, "/", .true.)
363 0 : basename = filepath(last_sep_idx+1:)
364 0 : end subroutine
365 :
366 : !> \brief Return the hostname in a 50 character string
367 : !> \return hostname.
368 0 : function log_hostname()
369 : character(len=50) log_hostname
370 : #ifdef INTEL
371 : integer :: iError
372 : #endif
373 : #ifdef NAG
374 : call gethostname(log_hostname)
375 : #endif
376 : #ifdef INTEL
377 : iError = hostnm(log_hostname)
378 : #endif
379 : #ifdef GFORTRAN
380 0 : call hostnm(log_hostname)
381 : #endif
382 0 : end function log_hostname
383 :
384 : !> \brief Return n spaces
385 : !> \return n spaces.
386 0 : function spaces(n)
387 : integer, intent(in) :: n !< Maximum is 30
388 : character(len=n) :: spaces
389 0 : spaces = " "
390 0 : end function spaces
391 :
392 : !> \brief Return the severity level with colors etc in a 50 char string
393 : !> \return severity level.
394 0 : function log_severity(level, show_colors)
395 : integer, intent(in) :: level
396 : logical, intent(in) :: show_colors
397 : character(len=50) log_severity
398 :
399 0 : log_severity = ""
400 0 : if (show_colors) call stput(log_severity, level_color)
401 0 : if (level .eq. LOG_FATAL) then
402 0 : if (show_colors) then
403 0 : call stput(log_severity, bold)
404 0 : call stput(log_severity, color_codes(level)) ! error has the same color, for reading convenience
405 : endif
406 0 : log_severity = trim(log_severity) // "FATAL"
407 : elseif (level .eq. LOG_ERROR) then
408 0 : if (show_colors) call stput(log_severity, bold)
409 0 : log_severity = trim(log_severity) // "ERROR"
410 : elseif (level .eq. LOG_WARN) then
411 0 : log_severity = trim(log_severity) // "WARN"
412 : elseif (level .eq. LOG_INFO) then
413 0 : log_severity = trim(log_severity) // "INFO"
414 : elseif (level .eq. LOG_DEBUG) then
415 0 : log_severity = trim(log_severity) // "DEBUG"
416 : elseif (level .eq. LOG_TRACE) then
417 0 : log_severity = trim(log_severity) // "TRACE"
418 : elseif (level .eq. LOG_SUBTRACE) then
419 0 : log_severity = trim(log_severity) // "FINE"
420 : endif
421 0 : if (show_colors) call stput(log_severity, reset)
422 0 : end function log_severity
423 :
424 : #ifdef USE_MPI
425 : !> \brief Return the mpi id of the current process
426 : !> \return MPI id.
427 : function log_mpi_id()
428 : use mpi
429 : character(50) :: log_mpi_id !< The mpi id part of a log
430 : character(6) :: mpi_id_lj !< MPI id in string
431 : character(4) :: id_fmt !< The forhmat to print mpi_id_lj in
432 : integer :: rank, n_cpu, ierr
433 :
434 : call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr)
435 : call MPI_COMM_SIZE(MPI_COMM_WORLD, n_cpu, ierr)
436 : if (n_cpu .eq. 1) then
437 : log_mpi_id = ""
438 : else
439 : write(id_fmt, '(A,i1,A)') "(i", ceiling(log10(real(n_cpu))), ")"
440 : write(mpi_id_lj,id_fmt) rank
441 : write(log_mpi_id, '("#",a)') trim(adjustl(mpi_id_lj))
442 : endif
443 : end function log_mpi_id
444 : #endif
445 :
446 : !> \brief Return the current date, formatted nicely
447 : !> \return date.
448 0 : function log_datetime()
449 : character(50) :: log_datetime !< Output the date here
450 :
451 : character(8) :: date
452 : character(10) :: time
453 : character(5) :: zone
454 :
455 0 : call date_and_time(date, time, zone)
456 0 : if (output_date .and. output_time) then
457 0 : write(log_datetime, '(a,"/",a,"/",a," ",a,":",a,":",a,".",a," ")') date(1:4), date(5:6), date(7:8), &
458 0 : time(1:2), time(3:4), time(5:6), time(8:10)
459 : else
460 0 : if (output_time) then
461 0 : write(log_datetime, '(a,":",a,":",a,".",a," ")') time(1:2), time(3:4), time(5:6), time(8:10)
462 : endif
463 0 : if (output_date) then
464 0 : write(log_datetime, '(a,"/",a,"/",a," ")') date(1:4), date(5:6), date(7:8)
465 : endif
466 : endif
467 0 : end function log_datetime
468 :
469 : !> \brief Set logging configuration
470 0 : subroutine log_set_config( &
471 : verbose, quiet, log_output_hostname, log_force_colors, log_no_colors, log_output_date, log_output_time, log_no_format)
472 0 : use mo_kind, only: i4
473 : implicit none
474 : integer(i4), optional, intent(in) :: verbose !< increase verbosity level
475 : integer(i4), optional, intent(in) :: quiet !< decrease verbosity level
476 : logical, optional, intent(in) :: log_output_hostname !< show hostname
477 : logical, optional, intent(in) :: log_force_colors !< force colors in output
478 : logical, optional, intent(in) :: log_no_colors !< disable colors
479 : logical, optional, intent(in) :: log_output_date !< add date to output
480 : logical, optional, intent(in) :: log_output_time !< add time to output
481 : logical, optional, intent(in) :: log_no_format !< disable formatting
482 :
483 0 : if ( present(verbose) ) minimum_log_level = min(NUM_LOG_LEVELS, minimum_log_level + verbose)
484 0 : if ( present(quiet) ) minimum_log_level = min(NUM_LOG_LEVELS, minimum_log_level - quiet)
485 0 : if ( present(log_output_hostname) ) output_hostname = log_output_hostname
486 0 : if ( present(log_force_colors) ) skip_terminal_check = log_force_colors
487 0 : if ( present(log_no_colors) ) disable_colors = log_no_colors
488 0 : if ( present(log_output_date) ) output_date = log_output_date
489 0 : if ( present(log_output_time) ) output_time = log_output_time
490 0 : if ( present(log_no_format) ) disable_format = log_no_format
491 0 : end subroutine log_set_config
492 :
493 : end module mo_logging
|
