libsim Versione 7.2.6

◆ l4f_category_exist_legacy()

logical function l4f_category_exist_legacy ( integer, intent(in) a_category)
private

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_categorycategory

Definizione alla linea 873 del file log4fortran.F90.

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