117 INTEGER(kind=c_int),
PARAMETER :: L4F_FATAL = 000
118 INTEGER(kind=c_int),
PARAMETER :: L4F_ALERT = 100
119 INTEGER(kind=c_int),
PARAMETER :: L4F_CRIT = 200
120 INTEGER(kind=c_int),
PARAMETER :: L4F_ERROR = 300
121 INTEGER(kind=c_int),
PARAMETER :: L4F_WARN = 400
122 INTEGER(kind=c_int),
PARAMETER :: L4F_NOTICE = 500
123 INTEGER(kind=c_int),
PARAMETER :: L4F_INFO = 600
124 INTEGER(kind=c_int),
PARAMETER :: L4F_DEBUG = 700
125 INTEGER(kind=c_int),
PARAMETER :: L4F_TRACE = 800
126 INTEGER(kind=c_int),
PARAMETER :: L4F_NOTSET = 900
127 INTEGER(kind=c_int),
PARAMETER :: L4F_UNKNOWN = 1000
132 INTEGER(kind=c_int),
PUBLIC :: l4f_priority=l4f_notice
137 TYPE,BIND(C) :: l4f_handle
139 TYPE(c_ptr) :: ptr = c_null_ptr
144 TYPE(l4f_handle),
SAVE :: l4f_global_default
147 #undef ARRAYOF_ORIGEQ 148 #undef ARRAYOF_ORIGTYPE 150 #define ARRAYOF_ORIGTYPE TYPE(l4f_handle) 151 #define ARRAYOF_TYPE arrayof_l4f_handle 152 #include "arrayof_pre_nodoc.F90" 154 TYPE(arrayof_l4f_handle) :: l4f_global_ptr
158 FUNCTION l4f_init() bind(C,name='log4c_init')
160 INTEGER(kind=c_int) :: l4f_init
169 CHARACTER(kind=c_char),
INTENT(in) :: a_name(*)
170 TYPE(l4f_handle) :: l4f_category_get_c
176 INTERFACE l4f_category_delete
181 MODULE PROCEDURE l4f_category_delete_legacy, l4f_category_delete_f
188 SUBROUTINE l4f_category_log_c(a_category, a_priority, a_format) bind(C,name='log4c_category_log_c')
190 TYPE(l4f_handle),
VALUE :: a_category
191 INTEGER(kind=c_int),
VALUE :: a_priority
193 CHARACTER(kind=c_char),
INTENT(in) :: a_format(*)
195 END SUBROUTINE l4f_category_log_c
201 MODULE PROCEDURE l4f_category_log_f, l4f_category_log_legacy
206 MODULE PROCEDURE l4f_category_exist_f, l4f_category_exist_legacy
211 FUNCTION l4f_fini() bind(C,name='log4c_fini')
213 INTEGER(kind=c_int) :: l4f_fini
226 CHARACTER(len=510),
PRIVATE:: dummy_a_name
231 PUBLIC l4f_fatal, l4f_alert, l4f_crit, l4f_error, l4f_warn, l4f_notice, &
232 l4f_info, l4f_debug, l4f_trace, l4f_notset, l4f_unknown
243 SUBROUTINE l4f_launcher(a_name, a_name_force, a_name_append)
244 CHARACTER(len=*),
INTENT(out) :: a_name
245 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: a_name_force
246 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: a_name_append
249 CHARACTER(len=255) :: LOG4_APPLICATION_NAME,LOG4_APPLICATION_ID,arg
250 CHARACTER(len=255),
SAVE :: a_name_save=
"" 252 IF (
PRESENT(a_name_force))
THEN 254 ELSE IF (a_name_save /=
"")
THEN 258 CALL date_and_time(values=tarray)
260 CALL getenv(
"LOG4_APPLICATION_NAME", log4_application_name)
261 CALL getenv(
"LOG4_APPLICATION_ID", log4_application_id)
263 IF (log4_application_name ==
"" .AND. log4_application_id ==
"")
THEN 264 WRITE(a_name,
"(a,a,8i5,a)")trim(arg),
"[",tarray,
"]" 266 a_name = trim(log4_application_name)//
"["//trim(log4_application_id)//
"]" 273 IF (
PRESENT(a_name_append))
THEN 274 a_name=trim(a_name)//
"."//trim(a_name_append)
277 END SUBROUTINE l4f_launcher
279 #ifndef HAVE_LIBLOG4C 285 character(len=10)::priority
288 call getenv(
"LOG4C_PRIORITY",priority)
289 if (priority==
"")
then 290 l4f_priority = l4f_notice
292 read(priority,*,iostat=iostat)l4f_priority
295 if (iostat /= 0)
then 296 l4f_priority = l4f_notice
305 integer function l4f_category_get (a_name)
306 character (len=*),
intent(in) :: a_name
308 dummy_a_name = a_name
311 end function l4f_category_get
315 subroutine l4f_category_delete(a_category)
316 integer,
intent(in):: a_category
318 if (a_category == 1) dummy_a_name =
"" 320 end subroutine l4f_category_delete
325 integer,
intent(in):: a_category
326 integer,
intent(in):: a_priority
327 character(len=*),
intent(in):: a_format
329 if (a_category == 1 .and. a_priority <= l4f_priority)
then 330 write(*,*)
"[dummy] ",l4f_msg(a_priority),trim(dummy_a_name),
" - ",trim(a_format)
337 subroutine l4f_log (a_priority,a_format)
338 integer,
intent(in):: a_priority
339 character(len=*),
intent(in):: a_format
341 if ( a_priority <= l4f_priority)
then 342 write(*,*)
"[_default] ",l4f_msg(a_priority),trim(dummy_a_name),
" - ",trim(a_format)
345 end subroutine l4f_log
350 integer,
intent(in):: a_category
352 if (a_category == 1)
then 369 character(len=12) function l4f_msg(a_priority)
371 integer,
intent(in):: a_priority
373 write(l4f_msg,*)a_priority
375 if (a_priority == l4f_fatal) l4f_msg=
"FATAL" 376 if (a_priority == l4f_alert) l4f_msg=
"ALERT" 377 if (a_priority == l4f_crit) l4f_msg=
"CRIT" 378 if (a_priority == l4f_error) l4f_msg=
"ERROR" 379 if (a_priority == l4f_warn) l4f_msg=
"WARN" 380 if (a_priority == l4f_notice) l4f_msg=
"NOTICE" 381 if (a_priority == l4f_info) l4f_msg=
"INFO" 382 if (a_priority == l4f_debug) l4f_msg=
"DEBUG" 383 if (a_priority == l4f_trace) l4f_msg=
"TRACE" 384 if (a_priority == l4f_notset) l4f_msg=
"NOTSET" 385 if (a_priority == l4f_unknown) l4f_msg=
"UNKNOWN" 391 #include "arrayof_post_nodoc.F90" 396 FUNCTION l4f_category_get(a_name)
RESULT(handle)
397 CHARACTER(kind=c_char,len=*),
INTENT(in) :: a_name
402 DO i = 1, l4f_global_ptr%arraysize
412 END FUNCTION l4f_category_get
418 FUNCTION l4f_category_get_handle(a_name)
RESULT(handle)
419 CHARACTER(kind=c_char,len=*),
INTENT(in) :: a_name
420 TYPE(l4f_handle) :: handle
424 END FUNCTION l4f_category_get_handle
428 SUBROUTINE l4f_category_delete_legacy(a_category)
429 INTEGER,
INTENT(in) :: a_category
431 IF (a_category <= 0 .OR. a_category > l4f_global_ptr%arraysize)
RETURN 432 IF (a_category == l4f_global_ptr%arraysize)
THEN 433 CALL remove(l4f_global_ptr, pos=a_category)
435 l4f_global_ptr%array(a_category)%ptr = c_null_ptr
438 END SUBROUTINE l4f_category_delete_legacy
442 SUBROUTINE l4f_category_delete_f(a_category)
445 a_category%ptr = c_null_ptr
447 END SUBROUTINE l4f_category_delete_f
452 SUBROUTINE l4f_category_log_f(a_category, a_priority, a_format)
454 INTEGER(kind=c_int),
INTENT(in) :: a_priority
455 CHARACTER(len=*),
INTENT(in) :: a_format
457 CALL l4f_category_log_c(a_category, a_priority, trim(a_format)//char(0))
459 END SUBROUTINE l4f_category_log_f
465 SUBROUTINE l4f_category_log_legacy(a_category, a_priority, a_format)
466 INTEGER(kind=c_int),
INTENT(in) :: a_category
467 INTEGER(kind=c_int),
INTENT(in) :: a_priority
468 CHARACTER(len=*),
INTENT(in) :: a_format
470 CALL l4f_category_log_c(l4f_global_ptr%array(a_category), a_priority, trim(a_format)//char(0))
472 END SUBROUTINE l4f_category_log_legacy
477 SUBROUTINE l4f_log(a_priority, a_format)
478 INTEGER(kind=c_int),
INTENT(in) :: a_priority
479 CHARACTER(len=*),
INTENT(in) :: a_format
485 l4f_global_default = l4f_category_get_handle(
'_default')
489 END SUBROUTINE l4f_log
494 FUNCTION l4f_category_exist_f(a_category)
RESULT(exist)
495 TYPE(l4f_handle),
INTENT(in) :: a_category
498 exist = c_associated(a_category%ptr)
500 END FUNCTION l4f_category_exist_f
506 FUNCTION l4f_category_exist_legacy(a_category)
RESULT(exist)
507 INTEGER,
INTENT(in):: a_category
510 IF (a_category <= 0 .OR. a_category > l4f_global_ptr%arraysize)
THEN 516 END FUNCTION l4f_category_exist_legacy
Initialize a logging category.
Return true if the corresponding category handle exists.
classe per la gestione del logging
Global log4fortran constructor.
Emit log message for a category with specific priority.