! ! logging.f90 ! This file is part of flogging. ! ! Copyright 2016 Chris MacMackin <cmacmackin@gmail.com> ! ! This program is free software; you can redistribute it and/or ! modify it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation; either version 3 of ! the License, or (at your option) any later version. ! ! This program is distributed in the hope that it will be useful, but ! WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ! Lesser General Public License for more details. ! ! You should have received a copy of the GNU Lesser General Public ! License along with this program; if not, write to the Free Software ! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ! 02110-1301, USA. ! module logger_mod !* Author: Christopher MacMackin ! Date: December 2016 ! License: LGPLv3 ! ! Provides routines for printing different types of messages to ! standard out, standard error, and/or a log file. ! use iso_fortran_env, only: i8 => int64, error_unit, output_unit use face, only: colourise => colorize ! Correct the spelling... ;-) implicit none private integer, parameter, public :: debug = 10 !! Priority level for output only useful for debugging integer, parameter, public :: trivia = 20 !! Priority level for output which may be useful but is very !! detailed or not especially important. integer, parameter, public :: info = 30 !! Priority level for output generated by the normal execution of !! the program. integer, parameter, public :: warning = 40 !! Priority level for output which indicates some part of the !! program is not behaving as it ideally should. integer, parameter, public :: error = 50 !! Priority level for output which indicates an error has !! occurred which will affect the continued execution of the !! program. integer, parameter, public :: fatal = 60 !! Priority level for output which notifies the user than a !! serious error has occured which will result in the immediate !! termination of the program. integer, parameter :: default_stderr_threshold = error !! Default priority level needed for a message to be printed to !! standard-error. integer, parameter :: default_stdout_threshold = info !! Default priority level needed for a message to be printed to !! standard out. integer, parameter :: default_logfile_threshold = trivia !! Default priority level needed for a message to be printed to !! the log file. integer, parameter :: closed_unit = -9999 integer, parameter :: infinity = huge(1) character(len=29), parameter :: default_format = "('[',a,']','[',a,']',"// & "*(1x,a))" type, public :: logger !* Author: Chris MacMackinc ! Date: December 2016 ! ! An object to handle output of information about the executing ! program to the terminal and to a log-file. ! private integer :: stdout = output_unit !! Unit corresponding to STDOUT integer :: stderr = error_unit !! Unit corresponding to STDERR integer :: fileunit = closed_unit !! Unit corresponding to log-file character(len=:), allocatable :: logfile !! Name of the log-file integer :: stderr_threshold = infinity !! Cutoff for which messages with greater or equal priority will !! be written to STDERR. integer :: stdout_threshold = infinity !! Cutoff for which messages with greater or equal priority will !! be written to STDOUT. integer :: logfile_threshold = infinity !! Cutoff for which messages with greater or equal priority will !! be written to the log-file. contains procedure :: message => logger_message !! Write a message of a given priority to the appropriate !! location(s) procedure :: debug => logger_debug !! Write debug information procedure :: trivia => logger_trivia !! Write trivial run-time information procedure :: info => logger_info !! Write run-time information procedure :: warning => logger_warning !! Write warning message procedure :: error => logger_error !! Write error message procedure :: fatal => logger_fatal !! Write notification of fatal error procedure :: destroy => logger_destroy !! Closes the log-file procedure :: is_open => logger_is_open !! Return `.true.` if the log-file is open for writing final :: logger_finalize end type logger interface logger module procedure :: constructor end interface type(logger), public :: master_logger !! The main logger object for a program to use. Must be !! initialised in the main program with a call to [[logger_init]]. public :: logger_init contains function constructor(logfile, stderr_threshold, stdout_threshold, & logfile_threshold) result(this) type(logger) :: this character(len=*), intent(in) :: logfile !! Name of the log-file to which output will be written integer, intent(in), optional :: stderr_threshold !! Threshold priority, at and above which messages will be !! written to standard error. Defaults to `error`. integer, intent(in), optional :: stdout_threshold !! Threshold priority, at and above which messages will be !! written to standard out. Defaults to `info`. integer, intent(in), optional :: logfile_threshold !! Threshold priority, at and above which messages will be !! written to the log file. Defaults to `trivia`. integer :: flag this%logfile = logfile open(newunit=this%fileunit,file=this%logfile,action='write', & asynchronous='yes',iostat=flag,status='replace') if (flag /= 0) error stop 'Error opening log file.' if (present(stderr_threshold)) then this%stderr_threshold = stderr_threshold else this%stderr_threshold = default_stderr_threshold end if if (present(stdout_threshold)) then this%stdout_threshold = stdout_threshold else this%stdout_threshold = default_stdout_threshold end if if (present(logfile_threshold)) then this%logfile_threshold = logfile_threshold else this%logfile_threshold = default_logfile_threshold end if end function constructor subroutine logger_finalize(this) !* Author: Chris MacMackin ! Date: December 2016 ! ! Closes the log-file of this logger object. ! type(logger), intent(inout) :: this call this%destroy() end subroutine logger_finalize subroutine logger_init(logfile, stderr_threshold, stdout_threshold, & logfile_threshold) !* Author: Chris MacMackin ! Date: December 2016 ! ! Initalises the master logging object. This subroutine must be ! called before the master logger is used. It should only be ! called once. ! character(len=*), intent(in) :: logfile !! Name of the log-file to which output will be written integer, intent(in), optional :: stderr_threshold !! Threshold priority, at and above which messages will be !! written to standard error. Defaults to `error`. integer, intent(in), optional :: stdout_threshold !! Threshold priority, at and above which messages will be !! written to standard out. Defaults to `info`. integer, intent(in), optional :: logfile_threshold !! Threshold priority, at and above which messages will be !! written to the log file. Defaults to `trivia`. master_logger = logger(logfile, stderr_threshold, stdout_threshold, & logfile_threshold) end subroutine logger_init function get_designator(priority,ansi_colours) result(des) !* Author: Chris MacMackin ! Date: December 2016 ! ! For a given priority, returns the appropriate, optionally ! colourised, designator. ! integer, intent(in) :: priority !! The priority level for which to get the designator logical, intent(in), optional :: ansi_colours !! Whether to colourise the disgnator. This should only be done !! if the designator is printed to the terminal. Defaults to !! `.true.`. character(len=:), allocatable :: des integer :: descriminator logical :: col if (present(ansi_colours)) then col = ansi_colours else col = .true. end if descriminator = priority/10 if (descriminator < 1) then des = '' else if (descriminator < 2) then des = '<debug> ' if (col) des = colourise(des(:len(des)-1),color_fg='cyan',style='bold_on')//' ' else if (descriminator < 3) then des = '<trivia> ' if (col) des = colourise(des(:len(des)-1),color_fg='blue',style='bold_on')//' ' else if (descriminator < 4) then des = '<info> ' if (col) des = colourise(des(:len(des)-1),color_fg='green',style='bold_on')//' ' else if (descriminator < 5) then des = '<warning> ' if (col) des = colourise(des(:len(des)-1),color_fg='yellow',style='bold_on')//' ' else if (descriminator < 6) then des = '<error> ' if (col) des = colourise(des(:len(des)-1),color_fg='red',style='bold_on')//' ' else des = '<fatal> ' if (col) des = colourise(des(:len(des)-1),color_bg='red',style='bold_on')//' ' end if end function get_designator function current_time() !* Author: Chris MacMackin ! Date: November 2016 ! ! Returns the formatted current date and time. ! character(len=20) :: current_time integer(i8), dimension(8) :: time_vals character(len=3), dimension(12), parameter :: months = ['Jan', & 'Feb', & 'Mar', & 'Apr', & 'May', & 'Jun', & 'Jul', & 'Aug', & 'Sep', & 'Oct', & 'Nov', & 'Dec'] character(len=42), parameter :: time_format = '(a3,1x,i2,1x,i4,1x,'// & 'i2.2,":",i2.2,":",i2.2)' call date_and_time(values=time_vals) write(current_time,time_format) months(time_vals(2)), time_vals(3), & time_vals(1), time_vals(5), time_vals(6), & time_vals(7) end function current_time subroutine logger_message(this,source,priority,message) !* Author: Chris MacMackin ! Date: December 2016 ! ! Write the provided message to STDERR, STDOUT, and/or a log-file, ! based on its priority level. ! class(logger), intent(in) :: this character(len=*), intent(in) :: source !! The name of the procedure which produced the error integer, intent(in) :: priority !! The importance of the message, determining where it will be !! written. character(len=*), intent(in) :: message !! The information to be written. character(len=:), allocatable :: output if (priority >= this%stderr_threshold) then output = get_designator(priority)//message write(this%stderr,default_format) current_time(), source, output else if (priority >= this%stdout_threshold) then output = get_designator(priority)//message write(this%stdout,default_format) current_time(), source, output end if if (priority >= this%logfile_threshold) then output = get_designator(priority,.false.)//message write(this%fileunit,default_format) current_time(), source, output end if end subroutine logger_message subroutine logger_debug(this,source,message) !* Author: Chris MacMackin ! Date: December 2016 ! ! Writes debug information to STDERR, STDOUT, and/or a log-file. ! class(logger), intent(in) :: this character(len=*), intent(in) :: source !! The name of the procedure which produced the error character(len=*), intent(in) :: message !! The information to be written. call this%message(source,debug,message) end subroutine logger_debug subroutine logger_trivia(this,source,message) !* Author: Chris MacMackin ! Date: December 2016 ! ! Writes unimportant run-time information to STDERR, STDOUT, ! and/or a log-file. ! class(logger), intent(in) :: this character(len=*), intent(in) :: source !! The name of the procedure which produced the error character(len=*), intent(in) :: message !! The information to be written. call this%message(source,trivia,message) end subroutine logger_trivia subroutine logger_info(this,source,message) !* Author: Chris MacMackin ! Date: December 2016 ! ! Writes run-time information to STDERR, STDOUT, and/or a log-file. ! class(logger), intent(in) :: this character(len=*), intent(in) :: source !! The name of the procedure which produced the error character(len=*), intent(in) :: message !! The information to be written. call this%message(source,info,message) end subroutine logger_info subroutine logger_warning(this,source,message) !* Author: Chris MacMackin ! Date: December 2016 ! ! Writes warning information to STDERR, STDOUT, and/or a log-file. ! class(logger), intent(in) :: this character(len=*), intent(in) :: source !! The name of the procedure which produced the error character(len=*), intent(in) :: message !! The information to be written. call this%message(source,warning,message) end subroutine logger_warning subroutine logger_error(this,source,message) !* Author: Chris MacMackin ! Date: December 2016 ! ! Writes error information to STDERR, STDOUT, and/or a log-file. ! class(logger), intent(in) :: this character(len=*), intent(in) :: source !! The name of the procedure which produced the error character(len=*), intent(in) :: message !! The information to be written. call this%message(source,error,message) end subroutine logger_error subroutine logger_fatal(this,source,message) !* Author: Chris MacMackin ! Date: December 2016 ! ! Writes fatal information to STDERR, STDOUT, and/or a log-file. ! class(logger), intent(in) :: this character(len=*), intent(in) :: source !! The name of the procedure which produced the error character(len=*), intent(in) :: message !! The information to be written. call this%message(source,fatal,message) end subroutine logger_fatal subroutine logger_destroy(this) !* Author: Chris MacMackin ! Date: December 2016 ! ! Closes the log-file of this logger object. Destroys only the ! logger object, *not* the output. ! class(logger), intent(inout) :: this if (this%fileunit == closed_unit) return close(this%fileunit) this%fileunit = closed_unit this%stderr_threshold = infinity this%stdout_threshold = infinity this%logfile_threshold = infinity end subroutine logger_destroy pure function logger_is_open(this) !* Author: Chris MacMackin ! Date: December 2016 ! ! Returns `.true.` if the log-file is open for writing. ! class(logger), intent(in) :: this logical :: logger_is_open logger_is_open = (this%fileunit /= closed_unit) end function logger_is_open end module logger_mod