libsim Versione 7.2.6

◆ l4f_category_exist_f()

logical function l4f_category_exist_f ( type(l4f_handle), intent(in) a_category)

Return true if the corresponding category handle exists (is associated with a category).

Parametri
[in]a_categorycategory

Definizione alla linea 861 del file log4fortran.F90.

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