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