log4fortran.F90

! Copyright (C) 2010  ARPA-SIM <urpsim@smr.arpa.emr.it>
! authors:
! Davide Cesari <dcesari@arpa.emr.it>
! Paolo Patruno <ppatruno@arpa.emr.it>
 
! 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 the Free Software Foundation; either version 2 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 General Public License for more details.
 
! You should have received a copy of the GNU General Public License
! along with this program.  If not, see <http://www.gnu.org/licenses/>.
#include "config.h"
 
!> \defgroup log4fortran Libsim package, log4fortran library.
!! Fortran interface to a basic set of log4c library for performing
!! logging within a program.
 
!>\brief classe per la gestione del logging
!!
!!Questo modulo permette una semplice, ma potente gestione della messagistica.
!!E' utile sia in fase di debug che di monitoraggio utente.
!!
!!Questo modulo fornisce funzionalità simili, ma non identiche a
!!seconda che siano disponibili in fase di compilazione le librerie
!!log4c e cnf.
!!
!!There are three fundamental types of object in Log4C: categories,
!!appenders and layouts. You can think of these objects as
!!corresponding to the what, where and how of the logging system:
!!categories describe what sub-system the message relates to,
!!appenders determine where the message goes and layouts determine how
!!the message is formatted.  
!!
!!First, you have to figure out what kind of categories you
!!want. Maybe you want one logger for GUI code and another one for
!!memory management and a third one for user access
!!logging. Okay. That's fine. Me, I like to have a separate logger for
!!each class or data structure. I've already gone to the trouble of
!!breaking my code down into such categories. Why not just use those?
!!Feel free to set it up any way you like. Just don't make the mistake
!!of using message severity as your categories. That's what the
!!priority is all about.
!!
!! La gestione di appenders e layouts viene demandata in toto al file
!! di configurazione di log4c (vedere apposita documentazione
!! http://log4c.cvs.sourceforge.net/\*checkout\*/log4c/log4c/doc/Log4C-DevelopersGuide.odt )
!!
!!log4fortran by default can log messages with some standard priority levels:
!!
!!Use debug to write debugging messages which should not be printed
!!when the application is in production.
!!
!!Use info for messages similar to the "verbose" mode of many
!!applications.
!!
!!Use warn for warning messages which are logged to some log but the
!!application is able to carry on without a problem.
!!
!!Use error for application error messages which are also logged to
!!some log but, still, the application can hobble along. Such as when
!!some administrator-supplied configuration parameter is incorrect and
!!you fall back to using some hard-coded default value.
!!
!!Use fatal for critical messages, after logging of which the
!!application quits abnormally.
!!
!!Configuration syntax:
!!
!!The log4crc configuration file uses an XML syntax. The root element
!!is &lt;log4c&gt; and it can be used to control the configuration file
!!version interface with the attribute "version". The following 4
!!elements are supported: &lt;config&gt;, &lt;category&gt;, &lt;appender&gt; and
!!&lt;layout&gt;.
!!
!!     The &lt;config&gt; element controls the global log4c
!!     configuration. It has 3 sub elements. The &lt;nocleanup&gt; flag
!!     inhibits the log4c destructors routines. The &lt;bufsize&gt; element
!!     sets the buffer size used to format log4c_logging_event_t
!!     objects. If is set to 0, the allocation is dynamic (the &lt;debug&gt;
!!     element is currently unused).
!!
!!     The &lt;category&gt; element has 3 possible attributes: the category
!!     "name", the category "priority" and the category
!!     "appender". Future versions will handle multple appenders per
!!     category.
!!
!!     The &lt;appender&gt; element has 3 possible attributes: the appender
!!     "name", the appender "type", and the appender "layout".
!!
!!     The &lt;layout&gt; element has 2 possible attributes: the layout
!!     "name" and the layout "type".
!!
!!
!!This initial version of the log4c configuration file syntax is quite
!!different from log4j. XML seemed the best choice to keep the log4j
!!configuration power in a C API.  Environment variables
!!
!!     LOG4C_RCPATH holds the path to the main log4crc configuration file
!!     LOG4C_PRIORITY holds the "root" category priority
!!     LOG4C_APPENDER holds the "root" category appender
!!
!!
!!Programma esempio \include log4fortran.f90
!!Here's one sample log4crc configuration file \include log4crc
!!
!!\ingroup log4fortran
MODULE log4fortran
USE iso_c_binding
IMPLICIT NONE
 
INTEGER(kind=c_int),PARAMETER :: L4F_FATAL    = 000  !< standard priority
INTEGER(kind=c_int),PARAMETER :: L4F_ALERT    = 100  !< standard priority
INTEGER(kind=c_int),PARAMETER :: L4F_CRIT     = 200  !< standard priority
INTEGER(kind=c_int),PARAMETER :: L4F_ERROR    = 300  !< standard priority
INTEGER(kind=c_int),PARAMETER :: L4F_WARN     = 400  !< standard priority
INTEGER(kind=c_int),PARAMETER :: L4F_NOTICE   = 500  !< standard priority
INTEGER(kind=c_int),PARAMETER :: L4F_INFO     = 600  !< standard priority
INTEGER(kind=c_int),PARAMETER :: L4F_DEBUG    = 700  !< standard priority
INTEGER(kind=c_int),PARAMETER :: L4F_TRACE    = 800  !< standard priority
INTEGER(kind=c_int),PARAMETER :: L4F_NOTSET   = 900  !< standard priority
INTEGER(kind=c_int),PARAMETER :: L4F_UNKNOWN  = 1000 !< standard priority
 
!> Default priority value. It is used only when compiled without log4c
!! since the configuration file is ignored, but it is better to define
!! it all the time.
INTEGER(kind=c_int),PUBLIC :: l4f_priority=l4f_notice
 
#ifdef HAVE_LIBLOG4C
 
!> l4f handle. This type defines an opaque handle
!! to a l4f category (mapped to a log4c category),
!! it has to be initialised with the l4f_category_get_handle method.
TYPE,BIND(C) :: l4f_handle
  PRIVATE
  TYPE(c_ptr) :: ptr = c_null_ptr
END TYPE l4f_handle
 
 
TYPE(l4f_handle),SAVE :: l4f_global_default
 
#undef ARRAYOF_ORIGEQ
#undef ARRAYOF_ORIGTYPE
#undef ARRAYOF_TYPE
#define ARRAYOF_ORIGTYPE TYPE(l4f_handle)
#define ARRAYOF_TYPE arrayof_l4f_handle
#include "arrayof_pre_nodoc.F90"
 
TYPE(arrayof_l4f_handle) :: l4f_global_ptr
 
!> Global log4fortran constructor. It can be called by Fortran.
INTERFACE 
  FUNCTION l4f_init() bind(C,name='log4c_init')
  IMPORT
  INTEGER(kind=c_int) :: l4f_init
  END FUNCTION l4f_init
END INTERFACE
 
! Internal C interface not to be used by user Fortran code
INTERFACE
  FUNCTION l4f_category_get_c(a_name) bind(C,name='log4c_category_get')
  IMPORT
  CHARACTER(kind=c_char),INTENT(in) :: a_name(*) !< category name
  TYPE(l4f_handle) :: l4f_category_get_c
  END FUNCTION l4f_category_get_c
END INTERFACE
 
! Internal C interface not to be used by user Fortran code
! this function has been disabled because after deleting a category
! the following log4c_fini fails with a double free, we must
! understand the log4c docs
INTERFACE
  SUBROUTINE l4f_category_delete_c(a_category) bind(C,name='log4c_category_delete')
  IMPORT
  TYPE(l4f_handle),VALUE :: a_category !< category as C native pointer
  END SUBROUTINE l4f_category_delete_c
END INTERFACE
 
!! Delete a logging category. It can receive a l4f_handle pointer or a
!! legacy integer value.
INTERFACE l4f_category_delete
  MODULE PROCEDURE l4f_category_delete_legacy, l4f_category_delete_f
END INTERFACE
 
! Internal C interface not to be used by user Fortran code
INTERFACE
  SUBROUTINE l4f_category_log_c(a_category, a_priority, a_format) bind(C,name='log4c_category_log_c')
  IMPORT
  TYPE(l4f_handle),VALUE :: a_category !< category
  INTEGER(kind=c_int),VALUE :: a_priority !< priority level
!  TYPE(c_ptr),VALUE :: locinfo !< not used
  CHARACTER(kind=c_char),INTENT(in) :: a_format(*) !< message to emit
 ! TYPE(c_ptr),VALUE :: a_args
  END SUBROUTINE l4f_category_log_c
END INTERFACE
 
!> Emit log message for a category with specific priority.
!! It can receive a l4f_handle or a legacy integer value.
INTERFACE l4f_category_log
  MODULE PROCEDURE l4f_category_log_f, l4f_category_log_legacy
END INTERFACE l4f_category_log
 
!> Return true if the corresponding category handle exists.
INTERFACE l4f_category_exist
  MODULE PROCEDURE l4f_category_exist_f, l4f_category_exist_legacy
END INTERFACE l4f_category_exist
 
!> Global log4fortran destructor. It can be called by Fortran.
INTERFACE
  FUNCTION l4f_fini() bind(C,name='log4c_fini')
  IMPORT
  INTEGER(kind=c_int) :: l4f_fini
  END FUNCTION l4f_fini
END INTERFACE
 
!>Ritorna un messaggio caratteristico delle priorità standard
!interface
!CHARACTER(len=12) FUNCTION l4f_msg(a_priority)
!integer,intent(in):: a_priority !< category name
!end function l4f_msg
!end interface
 
#else
 
CHARACTER(len=510),PRIVATE:: dummy_a_name
 
!> l4f handle. Dummy handle.
TYPE :: l4f_handle
  PRIVATE
  INTEGER :: ptr = 0
END TYPE l4f_handle
 
#endif
 
PRIVATE
PUBLIC l4f_fatal, l4f_alert, l4f_crit, l4f_error, l4f_warn, l4f_notice, &
 l4f_info, l4f_debug, l4f_trace, l4f_notset, l4f_unknown
PUBLIC l4f_handle, l4f_init, l4f_category_get_handle, l4f_category_get, l4f_category_delete, l4f_category_log, &
 l4f_log, l4f_category_exist, l4f_fini
PUBLIC l4f_launcher
 
CONTAINS
 
!> Routine specifica per il SIM. Cattura le variabili di ambiente
!! LOG4_APPLICATION_NAME,LOG4_APPLICATION_ID e compone il nome univoco
!! per il logging.  Se le variabili di ambiente non sono impostate
!! ritorna un nome definito dal nome del processo e da un timestamp.
SUBROUTINE l4f_launcher(a_name, a_name_force, a_name_append)
CHARACTER(len=*),INTENT(out) :: a_name !< nome univoco per logging
CHARACTER(len=*),INTENT(in),OPTIONAL :: a_name_force !< forza il valore di a_name
CHARACTER(len=*),INTENT(in),OPTIONAL :: a_name_append !< valore da appendere a a_name
 
INTEGER :: tarray(8)
CHARACTER(len=255) :: LOG4_APPLICATION_NAME,LOG4_APPLICATION_ID,arg
CHARACTER(len=255),SAVE :: a_name_save=""
 
IF (PRESENT(a_name_force))THEN
  a_name=a_name_force
ELSE IF (a_name_save /= "")THEN
  a_name=a_name_save
ELSE
  
  CALL date_and_time(values=tarray)
  CALL getarg(0, arg)
  CALL getenv("LOG4_APPLICATION_NAME", log4_application_name)
  CALL getenv("LOG4_APPLICATION_ID", log4_application_id)
  
  IF (log4_application_name == "" .AND. log4_application_id == "") THEN
    WRITE(a_name,"(a,a,8i5,a)")trim(arg),"[",tarray,"]"
  ELSE
    a_name = trim(log4_application_name)//"["//trim(log4_application_id)//"]"
  END IF
 
END IF
 
a_name_save=a_name
 
IF (PRESENT(a_name_append)) THEN
  a_name=trim(a_name)//"."//trim(a_name_append)
END IF
  
END SUBROUTINE l4f_launcher
 
#ifndef HAVE_LIBLOG4C
! define dummy function to replace log4c interface
 
!> log4fortran global constructor
INTEGER FUNCTION l4f_init()
CHARACTER(len=10) :: priority
INTEGER :: iostat
 
CALL getenv("LOG4C_PRIORITY",priority)
IF (priority=="") THEN
  l4f_priority = l4f_notice
ELSE
  READ(priority,*,iostat=iostat)l4f_priority
END IF
 
IF (iostat /= 0) THEN
  l4f_priority = l4f_notice
END IF
 
l4f_init = 0
 
END FUNCTION l4f_init
 
 
!>Initialize a logging category.
FUNCTION l4f_category_get(a_name) RESULT(handle)
CHARACTER(len=*),INTENT(in) :: a_name !< category name
 
TYPE(l4f_handle) :: handle
 
handle%ptr = 1
dummy_a_name = a_name
 
END FUNCTION l4f_category_get
 
 
!>Delete a logging category.
SUBROUTINE l4f_category_delete(a_category)
TYPE(l4f_handle),INTENT(in) :: a_category !< category
 
a_category%ptr = 0
dummy_a_name = ""
 
END SUBROUTINE l4f_category_delete
 
 
!> Emit log message for a category with specific priority
SUBROUTINE l4f_category_log(a_category,a_priority,a_format)
TYPE(l4f_handle),INTENT(in) :: a_category !< category
INTEGER,INTENT(in):: a_priority !< priority level
CHARACTER(len=*),INTENT(in):: a_format !< message to emit
 
IF (a_category%ptr == 1 .AND. a_priority <= l4f_priority) THEN
  WRITE(*,*)"[dummy] ",l4f_msg(a_priority),trim(dummy_a_name)," - ",trim(a_format)
ENDIF
 
END SUBROUTINE l4f_category_log
 
 
!> Emit log message without category with specific priority
SUBROUTINE l4f_log(a_priority,a_format)
INTEGER,INTENT(in):: a_priority !< priority level
CHARACTER(len=*),INTENT(in):: a_format !< message to emit
 
IF (a_priority <= l4f_priority) THEN
  WRITE(*,*)"[_default] ",l4f_msg(a_priority),trim(dummy_a_name)," - ",trim(a_format)
ENDIF
 
END SUBROUTINE l4f_log
 
 
!> Return True if category exist
LOGICAL FUNCTION l4f_category_exist(a_category)
TYPE(l4f_handle),INTENT(in) :: a_category !< category
 
l4f_category_exist = a_category%ptr == 1
 
END FUNCTION l4f_category_exist
 
 
!>log4fortran destructors
INTEGER FUNCTION l4f_fini()
 
l4f_fini= 0
 
END FUNCTION l4f_fini
 
!>Ritorna un messaggio caratteristico delle priorità standard
CHARACTER(len=12) FUNCTION l4f_msg(a_priority)
INTEGER,INTENT(in):: a_priority !< priority level
 
write(l4f_msg,*)a_priority
 
if (a_priority == l4f_fatal)   l4f_msg="FATAL"
if (a_priority == l4f_alert)   l4f_msg="ALERT"
if (a_priority == l4f_crit)    l4f_msg="CRIT"
if (a_priority == l4f_error)   l4f_msg="ERROR"
if (a_priority == l4f_warn)    l4f_msg="WARN"
if (a_priority == l4f_notice)  l4f_msg="NOTICE"
if (a_priority == l4f_info)    l4f_msg="INFO"
if (a_priority == l4f_debug)   l4f_msg="DEBUG"
if (a_priority == l4f_trace)   l4f_msg="TRACE"
if (a_priority == l4f_notset)  l4f_msg="NOTSET"
if (a_priority == l4f_unknown) l4f_msg="UNKNOWN"
 
END FUNCTION l4f_msg
 
#else
 
#include "arrayof_post_nodoc.F90"
 
!> Initialize a logging category. This is the 
!! Fortran legacy version that receives a Fortran character argument
!! and returns an integer.
FUNCTION l4f_category_get(a_name) RESULT(handle)
CHARACTER(kind=c_char,len=*),INTENT(in) :: a_name !< category name
INTEGER :: handle
 
handle = append(l4f_global_ptr, l4f_category_get_c(trim(a_name)//char(0)))
 
END FUNCTION l4f_category_get
 
 
!> Initialize a logging category. This is the 
!! Fortran version that receives a Fortran character argument
!! and returns a typed handle.
FUNCTION l4f_category_get_handle(a_name) RESULT(handle)
CHARACTER(kind=c_char,len=*),INTENT(in) :: a_name !< category name
TYPE(l4f_handle) :: handle
 
handle = l4f_category_get_c(trim(a_name)//char(0))
 
END FUNCTION l4f_category_get_handle
 
 
!> Delete a logging category. Legacy version with an integer argument.
SUBROUTINE l4f_category_delete_legacy(a_category)
INTEGER,INTENT(in) :: a_category !< category as an integer
 
IF (a_category <= 0 .OR. a_category > l4f_global_ptr%arraysize) RETURN
CALL remove(l4f_global_ptr, pos=a_category)
 
END SUBROUTINE l4f_category_delete_legacy
 
 
!> Delete a logging category. No-op version with a typed handle.
SUBROUTINE l4f_category_delete_f(a_category)
TYPE(l4f_handle),INTENT(inout) :: a_category !< category as C native pointer
 
! hee the C function should be called, see comment above
! CALL l4f_category_delete_c(a_category)
a_category%ptr = c_null_ptr
 
END SUBROUTINE l4f_category_delete_f
 
 
!> Emit log message for a category with specific priority.
!! Fortran version that receives a Fortran character argument.
SUBROUTINE l4f_category_log_f(a_category, a_priority, a_format)
TYPE(l4f_handle),INTENT(in) :: a_category !< category
INTEGER(kind=c_int),INTENT(in) :: a_priority !< priority level
CHARACTER(len=*),INTENT(in) :: a_format !< message to emit
 
CALL l4f_category_log_c(a_category, a_priority, trim(a_format)//char(0))
 
END SUBROUTINE l4f_category_log_f
 
 
!> Emit log message for a category with specific priority.
!! Legacy Fortran version that receives an integer instead of a C
!! pointer and a Fortran character argument.
SUBROUTINE l4f_category_log_legacy(a_category, a_priority, a_format)
INTEGER(kind=c_int),INTENT(in) :: a_category !< category
INTEGER(kind=c_int),INTENT(in) :: a_priority !< priority level
CHARACTER(len=*),INTENT(in) :: a_format !< message to emit
 
CALL l4f_category_log_c(l4f_global_ptr%array(a_category), l4f_warn, &
 'You are using the legacy log4fortran interface!'//char(0))
CALL l4f_category_log_c(l4f_global_ptr%array(a_category), l4f_warn, &
 'Please, upgrade your code by defining category as `TYPE(l4f_handle)`'//char(0))
CALL l4f_category_log_c(l4f_global_ptr%array(a_category), l4f_warn, &
 'and replacing `l4f_category_get` with `l4f_category_get_handle`'//char(0))
CALL l4f_category_log_c(l4f_global_ptr%array(a_category), a_priority, trim(a_format)//char(0))
 
END SUBROUTINE l4f_category_log_legacy
 
 
!> Emit log message without category with specific priority.
!! Fortran version that receives a Fortran character argument.
SUBROUTINE l4f_log(a_priority, a_format)
INTEGER(kind=c_int),INTENT(in) :: a_priority !< priority level
CHARACTER(len=*),INTENT(in) :: a_format !< message to emit
 
INTEGER :: i
 
IF (.NOT.l4f_category_exist(l4f_global_default)) THEN
  i = l4f_init()
  l4f_global_default = l4f_category_get_handle('_default')
ENDIF
CALL l4f_category_log(l4f_global_default, a_priority, a_format)
 
END SUBROUTINE l4f_log
 
 
!> Return true if the corresponding category handle exists
!! (is associated with a category).
FUNCTION l4f_category_exist_f(a_category) RESULT(exist)
TYPE(l4f_handle),INTENT(in) :: a_category !< category
LOGICAL :: exist
 
exist = c_associated(a_category%ptr)
 
END FUNCTION l4f_category_exist_f
 
!> Return true if the corresponding category handle exists
!! (is associated with a category).
!! Legacy Fortran version that receives an integer instead of a C
!! pointer.
FUNCTION l4f_category_exist_legacy(a_category) RESULT(exist)
INTEGER,INTENT(in):: a_category !< category
LOGICAL :: exist
 
IF (a_category <= 0 .OR. a_category > l4f_global_ptr%arraysize) THEN
  exist = .false.
ELSE
  exist = l4f_category_exist(l4f_global_ptr%array(a_category))
ENDIF
 
END FUNCTION l4f_category_exist_legacy
 
#endif
 
END MODULE log4fortran