libsim Versione 7.2.6

◆ l4f_category_log_f()

subroutine l4f_category_log_f ( type(l4f_handle), intent(in) a_category,
integer(kind=c_int), intent(in) a_priority,
character(len=*), intent(in) a_format )

Emit log message for a category with specific priority.

Fortran version that receives a Fortran character argument.

Parametri
[in]a_categorycategory
[in]a_prioritypriority level
[in]a_formatmessage to emit

Definizione alla linea 819 del file log4fortran.F90.

820! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
821! authors:
822! Davide Cesari <dcesari@arpa.emr.it>
823! Paolo Patruno <ppatruno@arpa.emr.it>
824
825! This program is free software; you can redistribute it and/or
826! modify it under the terms of the GNU General Public License as
827! published by the Free Software Foundation; either version 2 of
828! the License, or (at your option) any later version.
829
830! This program is distributed in the hope that it will be useful,
831! but WITHOUT ANY WARRANTY; without even the implied warranty of
832! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
833! GNU General Public License for more details.
834
835! You should have received a copy of the GNU General Public License
836! along with this program. If not, see <http://www.gnu.org/licenses/>.
837#include "config.h"
838
839!> \defgroup log4fortran Libsim package, log4fortran library.
840!! Fortran interface to a basic set of log4c library for performing
841!! logging within a program.
842
843!>\brief classe per la gestione del logging
844!!
845!!Questo modulo permette una semplice, ma potente gestione della messagistica.
846!!E' utile sia in fase di debug che di monitoraggio utente.
847!!
848!!Questo modulo fornisce funzionalità simili, ma non identiche a
849!!seconda che siano disponibili in fase di compilazione le librerie
850!!log4c e cnf.
851!!
852!!There are three fundamental types of object in Log4C: categories,
853!!appenders and layouts. You can think of these objects as
854!!corresponding to the what, where and how of the logging system:
855!!categories describe what sub-system the message relates to,
856!!appenders determine where the message goes and layouts determine how
857!!the message is formatted.
858!!
859!!First, you have to figure out what kind of categories you
860!!want. Maybe you want one logger for GUI code and another one for
861!!memory management and a third one for user access
862!!logging. Okay. That's fine. Me, I like to have a separate logger for
863!!each class or data structure. I've already gone to the trouble of
864!!breaking my code down into such categories. Why not just use those?
865!!Feel free to set it up any way you like. Just don't make the mistake
866!!of using message severity as your categories. That's what the
867!!priority is all about.
868!!
869!! La gestione di appenders e layouts viene demandata in toto al file
870!! di configurazione di log4c (vedere apposita documentazione
871!! http://log4c.cvs.sourceforge.net/\*checkout\*/log4c/log4c/doc/Log4C-DevelopersGuide.odt )
872!!
873!!log4fortran by default can log messages with some standard priority levels:
874!!
875!!Use debug to write debugging messages which should not be printed
876!!when the application is in production.
877!!
878!!Use info for messages similar to the "verbose" mode of many
879!!applications.
880!!
881!!Use warn for warning messages which are logged to some log but the
882!!application is able to carry on without a problem.
883!!
884!!Use error for application error messages which are also logged to
885!!some log but, still, the application can hobble along. Such as when
886!!some administrator-supplied configuration parameter is incorrect and
887!!you fall back to using some hard-coded default value.
888!!
889!!Use fatal for critical messages, after logging of which the
890!!application quits abnormally.
891!!
892!!Configuration syntax:
893!!
894!!The log4crc configuration file uses an XML syntax. The root element
895!!is &lt;log4c&gt; and it can be used to control the configuration file
896!!version interface with the attribute "version". The following 4
897!!elements are supported: &lt;config&gt;, &lt;category&gt;, &lt;appender&gt; and
898!!&lt;layout&gt;.
899!!
900!! The &lt;config&gt; element controls the global log4c
901!! configuration. It has 3 sub elements. The &lt;nocleanup&gt; flag
902!! inhibits the log4c destructors routines. The &lt;bufsize&gt; element
903!! sets the buffer size used to format log4c_logging_event_t
904!! objects. If is set to 0, the allocation is dynamic (the &lt;debug&gt;
905!! element is currently unused).
906!!
907!! The &lt;category&gt; element has 3 possible attributes: the category
908!! "name", the category "priority" and the category
909!! "appender". Future versions will handle multple appenders per
910!! category.
911!!
912!! The &lt;appender&gt; element has 3 possible attributes: the appender
913!! "name", the appender "type", and the appender "layout".
914!!
915!! The &lt;layout&gt; element has 2 possible attributes: the layout
916!! "name" and the layout "type".
917!!
918!!
919!!This initial version of the log4c configuration file syntax is quite
920!!different from log4j. XML seemed the best choice to keep the log4j
921!!configuration power in a C API. Environment variables
922!!
923!! LOG4C_RCPATH holds the path to the main log4crc configuration file
924!! LOG4C_PRIORITY holds the "root" category priority
925!! LOG4C_APPENDER holds the "root" category appender
926!!
927!!
928!!Programma esempio \include log4fortran.f90
929!!Here's one sample log4crc configuration file \include log4crc
930!!
931!!\ingroup log4fortran
932MODULE log4fortran
933USE iso_c_binding
934IMPLICIT NONE
935
936INTEGER(kind=c_int),PARAMETER :: L4F_FATAL = 000 !< standard priority
937INTEGER(kind=c_int),PARAMETER :: L4F_ALERT = 100 !< standard priority
938INTEGER(kind=c_int),PARAMETER :: L4F_CRIT = 200 !< standard priority
939INTEGER(kind=c_int),PARAMETER :: L4F_ERROR = 300 !< standard priority
940INTEGER(kind=c_int),PARAMETER :: L4F_WARN = 400 !< standard priority
941INTEGER(kind=c_int),PARAMETER :: L4F_NOTICE = 500 !< standard priority
942INTEGER(kind=c_int),PARAMETER :: L4F_INFO = 600 !< standard priority
943INTEGER(kind=c_int),PARAMETER :: L4F_DEBUG = 700 !< standard priority
944INTEGER(kind=c_int),PARAMETER :: L4F_TRACE = 800 !< standard priority
945INTEGER(kind=c_int),PARAMETER :: L4F_NOTSET = 900 !< standard priority
946INTEGER(kind=c_int),PARAMETER :: L4F_UNKNOWN = 1000 !< standard priority
947
948!> Default priority value. It is used only when compiled without log4c
949!! since the configuration file is ignored, but it is better to define
950!! it all the time.
951INTEGER(kind=c_int),PUBLIC :: l4f_priority=l4f_notice
952
953!> l4f handle. This type defines an opaque handle
954!! to a l4f category (mapped to a log4c category),
955!! it has to be initialised with the l4f_category_get method.
956TYPE,BIND(C) :: l4f_handle
957 PRIVATE
958 TYPE(c_ptr) :: ptr = c_null_ptr
959END TYPE l4f_handle
960
961#ifdef HAVE_LIBLOG4C
962
963TYPE(l4f_handle),SAVE :: l4f_global_default
964
965! emulation of old cnf behavior returning integer instead of pointer
966#undef ARRAYOF_ORIGEQ
967#undef ARRAYOF_ORIGTYPE
968#undef ARRAYOF_TYPE
969#define ARRAYOF_ORIGTYPE TYPE(l4f_handle)
970#define ARRAYOF_TYPE arrayof_l4f_handle
971#include "arrayof_pre_nodoc.F90"
972
973TYPE(arrayof_l4f_handle) :: l4f_global_ptr
974
975!> Global log4fortran constructor.
976INTERFACE
977 FUNCTION l4f_init() bind(C,name='log4c_init')
978 IMPORT
979 INTEGER(kind=c_int) :: l4f_init
980 END FUNCTION l4f_init
981END INTERFACE
982
983!> Initialize a logging category. This is the C version, please use the
984!! Fortran version l4f_category_get that receives a Fortran character.
985INTERFACE
986 FUNCTION l4f_category_get_c(a_name) bind(C,name='log4c_category_get')
987 IMPORT
988 CHARACTER(kind=c_char),INTENT(in) :: a_name(*) !< category name
989 TYPE(l4f_handle) :: l4f_category_get_c
990 END FUNCTION l4f_category_get_c
991END INTERFACE
992
993!! Delete a logging category. It can receive a C pointer or a
994!! legacy integer value.
995INTERFACE l4f_category_delete
996! SUBROUTINE l4f_category_delete_c(a_category) BIND(C,name='log4c_category_delete')
997! IMPORT
998! TYPE(l4f_handle),VALUE :: a_category !< category as C native pointer
999! END SUBROUTINE l4f_category_delete_c
1000 MODULE PROCEDURE l4f_category_delete_legacy, l4f_category_delete_f
1001END INTERFACE
1002! this function has been disabled because aftere deleting a category
1003! the following log4c_fini fails with a double free, we must
1004! understand the log4c docs
1005
1006INTERFACE
1007 SUBROUTINE l4f_category_log_c(a_category, a_priority, a_format) bind(C,name='log4c_category_log_c')
1008 IMPORT
1009 TYPE(l4f_handle),VALUE :: a_category !< category
1010 INTEGER(kind=c_int),VALUE :: a_priority !< priority level
1011! TYPE(c_ptr),VALUE :: locinfo !< not used
1012 CHARACTER(kind=c_char),INTENT(in) :: a_format(*) !< message to emit
1013 ! TYPE(c_ptr),VALUE :: a_args
1014 END SUBROUTINE l4f_category_log_c
1015END INTERFACE
1016
1017!> Emit log message for a category with specific priority.
1018!! It can receive a C pointer or a legacy integer value.
1019INTERFACE l4f_category_log
1020 MODULE PROCEDURE l4f_category_log_f, l4f_category_log_legacy
1021END INTERFACE l4f_category_log
1022
1023!> Return true if the corresponding category handle exists.
1024INTERFACE l4f_category_exist
1025 MODULE PROCEDURE l4f_category_exist_f, l4f_category_exist_legacy
1026END INTERFACE l4f_category_exist
1027
1028!> log4fortran destructor
1029INTERFACE
1030 FUNCTION l4f_fini() bind(C,name='log4c_fini')
1031 IMPORT
1032 INTEGER(kind=c_int) :: l4f_fini
1033 END FUNCTION l4f_fini
1034END INTERFACE
1035
1036!>Ritorna un messaggio caratteristico delle priorità standard
1037!interface
1038!CHARACTER(len=12) FUNCTION l4f_msg(a_priority)
1039!integer,intent(in):: a_priority !< category name
1040!end function l4f_msg
1041!end interface
1042
1043#else
1044
1045CHARACTER(len=510),PRIVATE:: dummy_a_name
1046
1047#endif
1048
1049PRIVATE
1050PUBLIC l4f_fatal, l4f_alert, l4f_crit, l4f_error, l4f_warn, l4f_notice, &
1051 l4f_info, l4f_debug, l4f_trace, l4f_notset, l4f_unknown
1052PUBLIC l4f_init, l4f_category_get, l4f_category_delete, l4f_category_log, &
1054PUBLIC l4f_launcher
1055
1056CONTAINS
1057
1058!> Routine specifica per il SIM. Cattura le variabili di ambiente
1059!! LOG4_APPLICATION_NAME,LOG4_APPLICATION_ID e compone il nome univoco
1060!! per il logging. Se le variabili di ambiente non sono impostate
1061!! ritorna un nome definito dal nome del processo e da un timestamp.
1062SUBROUTINE l4f_launcher(a_name, a_name_force, a_name_append)
1063CHARACTER(len=*),INTENT(out) :: a_name !< nome univoco per logging
1064CHARACTER(len=*),INTENT(in),OPTIONAL :: a_name_force !< forza il valore di a_name
1065CHARACTER(len=*),INTENT(in),OPTIONAL :: a_name_append !< valore da appendere a a_name
1066
1067INTEGER :: tarray(8)
1068CHARACTER(len=255) :: LOG4_APPLICATION_NAME,LOG4_APPLICATION_ID,arg
1069CHARACTER(len=255),SAVE :: a_name_save=""
1070
1071IF (PRESENT(a_name_force))THEN
1072 a_name=a_name_force
1073ELSE IF (a_name_save /= "")THEN
1074 a_name=a_name_save
1075ELSE
1076
1077 CALL date_and_time(values=tarray)
1078 CALL getarg(0, arg)
1079 CALL getenv("LOG4_APPLICATION_NAME", log4_application_name)
1080 CALL getenv("LOG4_APPLICATION_ID", log4_application_id)
1081
1082 IF (log4_application_name == "" .AND. log4_application_id == "") THEN
1083 WRITE(a_name,"(a,a,8i5,a)")trim(arg),"[",tarray,"]"
1084 ELSE
1085 a_name = trim(log4_application_name)//"["//trim(log4_application_id)//"]"
1086 END IF
1087
1088END IF
1089
1090a_name_save=a_name
1091
1092IF (PRESENT(a_name_append)) THEN
1093 a_name=trim(a_name)//"."//trim(a_name_append)
1094END IF
1095
1096END SUBROUTINE l4f_launcher
1097
1098#ifndef HAVE_LIBLOG4C
1099! definisce delle dummy routine
1100
1101!> log4fortran constructor
1102integer function l4f_init()
1103
1104character(len=10)::priority
1105integer :: iostat
1106
1107call getenv("LOG4C_PRIORITY",priority)
1108if (priority=="") then
1109 l4f_priority = l4f_notice
1110else
1111 read(priority,*,iostat=iostat)l4f_priority
1112end if
1113
1114if (iostat /= 0) then
1115 l4f_priority = l4f_notice
1116end if
1117
1118l4f_init = 0
1119
1120end function l4f_init
1121
1122
1123!>Initialize a logging category.
1124integer function l4f_category_get (a_name)
1125character (len=*),intent(in) :: a_name !< category name
1126
1127dummy_a_name = a_name
1128l4f_category_get = 1
1129
1130end function l4f_category_get
1131
1132
1133!>Delete a logging category.
1134subroutine l4f_category_delete(a_category)
1135integer,intent(in):: a_category !< category name
1136
1137if (a_category == 1) dummy_a_name = ""
1138
1139end subroutine l4f_category_delete
1140
1141
1142!>Emit log message for a category with specific priority
1143subroutine l4f_category_log (a_category,a_priority,a_format)
1144integer,intent(in):: a_category !< category name
1145integer,intent(in):: a_priority !< priority level
1146character(len=*),intent(in):: a_format !< message to emit
1147
1148if (a_category == 1 .and. a_priority <= l4f_priority) then
1149 write(*,*)"[dummy] ",l4f_msg(a_priority),trim(dummy_a_name)," - ",trim(a_format)
1150end if
1151
1152end subroutine l4f_category_log
1153
1154
1155!>Emit log message without category with specific priority
1156subroutine l4f_log (a_priority,a_format)
1157integer,intent(in):: a_priority !< priority level
1158character(len=*),intent(in):: a_format !< message to emit
1159
1160if ( a_priority <= l4f_priority) then
1161 write(*,*)"[_default] ",l4f_msg(a_priority),trim(dummy_a_name)," - ",trim(a_format)
1162end if
1163
1164end subroutine l4f_log
1165
1166
1167!>Return True if category exist
1168logical function l4f_category_exist (a_category)
1169integer,intent(in):: a_category !< category name
1170
1171if (a_category == 1) then
1172 l4f_category_exist= .true.
1173else
1174 l4f_category_exist= .false.
1175end if
1176
1177end function l4f_category_exist
1178
1179
1180!>log4fortran destructors
1181integer function l4f_fini()
1182
1183l4f_fini= 0
1184
1185end function l4f_fini
1186
1187!>Ritorna un messaggio caratteristico delle priorità standard
1188character(len=12) function l4f_msg(a_priority)
1189
1190integer,intent(in):: a_priority !< category name
1191
1192write(l4f_msg,*)a_priority
1193
1194if (a_priority == l4f_fatal) l4f_msg="FATAL"
1195if (a_priority == l4f_alert) l4f_msg="ALERT"
1196if (a_priority == l4f_crit) l4f_msg="CRIT"
1197if (a_priority == l4f_error) l4f_msg="ERROR"
1198if (a_priority == l4f_warn) l4f_msg="WARN"
1199if (a_priority == l4f_notice) l4f_msg="NOTICE"
1200if (a_priority == l4f_info) l4f_msg="INFO"
1201if (a_priority == l4f_debug) l4f_msg="DEBUG"
1202if (a_priority == l4f_trace) l4f_msg="TRACE"
1203if (a_priority == l4f_notset) l4f_msg="NOTSET"
1204if (a_priority == l4f_unknown) l4f_msg="UNKNOWN"
1205
1206end function l4f_msg
1207
1208#else
1209
1210#include "arrayof_post_nodoc.F90"
1211
1212!> Initialize a logging category. This is the
1213!! Fortran legacy version that receives a Fortran character argument
1214!! and returns an integer.
1215FUNCTION l4f_category_get(a_name) RESULT(handle)
1216CHARACTER(kind=c_char,len=*),INTENT(in) :: a_name !< category name
1217INTEGER :: handle
1218
1219INTEGER :: i
1220
1221DO i = 1, l4f_global_ptr%arraysize ! look first for a hole
1222 IF (.NOT.l4f_category_exist(l4f_global_ptr%array(i))) THEN
1223 l4f_global_ptr%array(i) = l4f_category_get_c(trim(a_name)//char(0))
1224 handle = i
1225 RETURN
1226 ENDIF
1227ENDDO
1228
1229handle = append(l4f_global_ptr, l4f_category_get_c(trim(a_name)//char(0)))
1230
1231END FUNCTION l4f_category_get
1232
1233
1234!> Initialize a logging category. This is the
1235!! Fortran version that receives a Fortran character argument
1236!! and returns a typed handle.
1237FUNCTION l4f_category_get_handle(a_name) RESULT(handle)
1238CHARACTER(kind=c_char,len=*),INTENT(in) :: a_name !< category name
1239TYPE(l4f_handle) :: handle
1240
1241handle = l4f_category_get_c(trim(a_name)//char(0))
1242
1243END FUNCTION l4f_category_get_handle
1244
1245
1246!> Delete a logging category. Legacy version with an integer argument.
1247SUBROUTINE l4f_category_delete_legacy(a_category)
1248INTEGER,INTENT(in) :: a_category !< category as an integer
1249
1250IF (a_category <= 0 .OR. a_category > l4f_global_ptr%arraysize) RETURN
1251IF (a_category == l4f_global_ptr%arraysize) THEN
1252 CALL remove(l4f_global_ptr, pos=a_category)
1253ELSE
1254 l4f_global_ptr%array(a_category)%ptr = c_null_ptr
1255ENDIF
1256
1257END SUBROUTINE l4f_category_delete_legacy
1258
1259
1260!> Delete a logging category. No-op version with a typed handle.
1261SUBROUTINE l4f_category_delete_f(a_category)
1262TYPE(l4f_handle),INTENT(inout) :: a_category !< category as C native pointer
1263
1264a_category%ptr = c_null_ptr ! is it necessary?
1265
1266END SUBROUTINE l4f_category_delete_f
1267
1268
1269!> Emit log message for a category with specific priority.
1270!! Fortran version that receives a Fortran character argument.
1271SUBROUTINE l4f_category_log_f(a_category, a_priority, a_format)
1272TYPE(l4f_handle),INTENT(in) :: a_category !< category
1273INTEGER(kind=c_int),INTENT(in) :: a_priority !< priority level
1274CHARACTER(len=*),INTENT(in) :: a_format !< message to emit
1275
1276CALL l4f_category_log_c(a_category, a_priority, trim(a_format)//char(0))
1277
1278END SUBROUTINE l4f_category_log_f
1279
1280
1281!> Emit log message for a category with specific priority.
1282!! Legacy Fortran version that receives an integer instead of a C
1283!! pointer and a Fortran character argument.
1284SUBROUTINE l4f_category_log_legacy(a_category, a_priority, a_format)
1285INTEGER(kind=c_int),INTENT(in) :: a_category !< category
1286INTEGER(kind=c_int),INTENT(in) :: a_priority !< priority level
1287CHARACTER(len=*),INTENT(in) :: a_format !< message to emit
1288
1289CALL l4f_category_log_c(l4f_global_ptr%array(a_category), a_priority, trim(a_format)//char(0))
1290
1291END SUBROUTINE l4f_category_log_legacy
1292
1293
1294!> Emit log message without category with specific priority.
1295!! Fortran version that receives a Fortran character argument.
1296SUBROUTINE l4f_log(a_priority, a_format)
1297INTEGER(kind=c_int),INTENT(in) :: a_priority !< priority level
1298CHARACTER(len=*),INTENT(in) :: a_format !< message to emit
1299
1300INTEGER :: i
1301
1302IF (.NOT.l4f_category_exist(l4f_global_default)) THEN
1303 i = l4f_init()
1304 l4f_global_default = l4f_category_get_handle('_default')
1305ENDIF
1306CALL l4f_category_log(l4f_global_default, a_priority, a_format)
1307
1308END SUBROUTINE l4f_log
1309
1310
1311!> Return true if the corresponding category handle exists
1312!! (is associated with a category).
1313FUNCTION l4f_category_exist_f(a_category) RESULT(exist)
1314TYPE(l4f_handle),INTENT(in) :: a_category !< category
1315LOGICAL :: exist
1316
1317exist = c_associated(a_category%ptr)
1318
1319END FUNCTION l4f_category_exist_f
1320
1321!> Return true if the corresponding category handle exists
1322!! (is associated with a category).
1323!! Legacy Fortran version that receives an integer instead of a C
1324!! pointer.
1325FUNCTION l4f_category_exist_legacy(a_category) RESULT(exist)
1326INTEGER,INTENT(in):: a_category !< category
1327LOGICAL :: exist
1328
1329IF (a_category <= 0 .OR. a_category > l4f_global_ptr%arraysize) THEN
1330 exist = .false.
1331ELSE
1332 exist = l4f_category_exist(l4f_global_ptr%array(a_category))
1333ENDIF
1334
1335END FUNCTION l4f_category_exist_legacy
1336
1337
1338#endif
1339
1340end module log4fortran
Return true if the corresponding category handle exists.
Initialize a logging category.
Emit log message for a category with specific priority.
log4fortran destructor
Global log4fortran constructor.
classe per la gestione del logging

Generated with Doxygen.