l4f_category_exist_f l4f_category_exist_legacy

l4f_category_exist_legacy() logical function l4f_category_exist_legacy ( integer, intent(in) a_category ) 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. Parametri [in] a_category category Definizione alla linea 867 del file 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