libsim Versione 7.2.6

◆ l4f_category_delete_f()

subroutine l4f_category_delete_f ( type(l4f_handle), intent(inout) a_category)
private

Delete a logging category.

No-op version with a typed handle.

Parametri
[in,out]a_categorycategory as C native pointer

Definizione alla linea 809 del file log4fortran.F90.

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