libsim Versione 7.2.6
log4fortran.F90
1! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2! authors:
3! Davide Cesari <dcesari@arpa.emr.it>
4! Paolo Patruno <ppatruno@arpa.emr.it>
5
6! This program is free software; you can redistribute it and/or
7! modify it under the terms of the GNU General Public License as
8! published by the Free Software Foundation; either version 2 of
9! the License, or (at your option) any later version.
10
11! This program is distributed in the hope that it will be useful,
12! but WITHOUT ANY WARRANTY; without even the implied warranty of
13! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14! GNU General Public License for more details.
15
16! You should have received a copy of the GNU General Public License
17! along with this program. If not, see <http://www.gnu.org/licenses/>.
18#include "config.h"
19
20!> \defgroup log4fortran Libsim package, log4fortran library.
21!! Fortran interface to a basic set of log4c library for performing
22!! logging within a program.
23
24!>\brief classe per la gestione del logging
25!!
26!!Questo modulo permette una semplice, ma potente gestione della messagistica.
27!!E' utile sia in fase di debug che di monitoraggio utente.
28!!
29!!Questo modulo fornisce funzionalità simili, ma non identiche a
30!!seconda che siano disponibili in fase di compilazione le librerie
31!!log4c e cnf.
32!!
33!!There are three fundamental types of object in Log4C: categories,
34!!appenders and layouts. You can think of these objects as
35!!corresponding to the what, where and how of the logging system:
36!!categories describe what sub-system the message relates to,
37!!appenders determine where the message goes and layouts determine how
38!!the message is formatted.
39!!
40!!First, you have to figure out what kind of categories you
41!!want. Maybe you want one logger for GUI code and another one for
42!!memory management and a third one for user access
43!!logging. Okay. That's fine. Me, I like to have a separate logger for
44!!each class or data structure. I've already gone to the trouble of
45!!breaking my code down into such categories. Why not just use those?
46!!Feel free to set it up any way you like. Just don't make the mistake
47!!of using message severity as your categories. That's what the
48!!priority is all about.
49!!
50!! La gestione di appenders e layouts viene demandata in toto al file
51!! di configurazione di log4c (vedere apposita documentazione
52!! http://log4c.cvs.sourceforge.net/\*checkout\*/log4c/log4c/doc/Log4C-DevelopersGuide.odt )
53!!
54!!log4fortran by default can log messages with some standard priority levels:
55!!
56!!Use debug to write debugging messages which should not be printed
57!!when the application is in production.
58!!
59!!Use info for messages similar to the "verbose" mode of many
60!!applications.
61!!
62!!Use warn for warning messages which are logged to some log but the
63!!application is able to carry on without a problem.
64!!
65!!Use error for application error messages which are also logged to
66!!some log but, still, the application can hobble along. Such as when
67!!some administrator-supplied configuration parameter is incorrect and
68!!you fall back to using some hard-coded default value.
69!!
70!!Use fatal for critical messages, after logging of which the
71!!application quits abnormally.
72!!
73!!Configuration syntax:
74!!
75!!The log4crc configuration file uses an XML syntax. The root element
76!!is &lt;log4c&gt; and it can be used to control the configuration file
77!!version interface with the attribute "version". The following 4
78!!elements are supported: &lt;config&gt;, &lt;category&gt;, &lt;appender&gt; and
79!!&lt;layout&gt;.
80!!
81!! The &lt;config&gt; element controls the global log4c
82!! configuration. It has 3 sub elements. The &lt;nocleanup&gt; flag
83!! inhibits the log4c destructors routines. The &lt;bufsize&gt; element
84!! sets the buffer size used to format log4c_logging_event_t
85!! objects. If is set to 0, the allocation is dynamic (the &lt;debug&gt;
86!! element is currently unused).
87!!
88!! The &lt;category&gt; element has 3 possible attributes: the category
89!! "name", the category "priority" and the category
90!! "appender". Future versions will handle multple appenders per
91!! category.
92!!
93!! The &lt;appender&gt; element has 3 possible attributes: the appender
94!! "name", the appender "type", and the appender "layout".
95!!
96!! The &lt;layout&gt; element has 2 possible attributes: the layout
97!! "name" and the layout "type".
98!!
99!!
100!!This initial version of the log4c configuration file syntax is quite
101!!different from log4j. XML seemed the best choice to keep the log4j
102!!configuration power in a C API. Environment variables
103!!
104!! LOG4C_RCPATH holds the path to the main log4crc configuration file
105!! LOG4C_PRIORITY holds the "root" category priority
106!! LOG4C_APPENDER holds the "root" category appender
107!!
108!!
109!!Programma esempio \include log4fortran.f90
110!!Here's one sample log4crc configuration file \include log4crc
111!!
112!!\ingroup log4fortran
113MODULE log4fortran
114USE iso_c_binding
115IMPLICIT NONE
116
117INTEGER(kind=c_int),PARAMETER :: L4F_FATAL = 000 !< standard priority
118INTEGER(kind=c_int),PARAMETER :: L4F_ALERT = 100 !< standard priority
119INTEGER(kind=c_int),PARAMETER :: L4F_CRIT = 200 !< standard priority
120INTEGER(kind=c_int),PARAMETER :: L4F_ERROR = 300 !< standard priority
121INTEGER(kind=c_int),PARAMETER :: L4F_WARN = 400 !< standard priority
122INTEGER(kind=c_int),PARAMETER :: L4F_NOTICE = 500 !< standard priority
123INTEGER(kind=c_int),PARAMETER :: L4F_INFO = 600 !< standard priority
124INTEGER(kind=c_int),PARAMETER :: L4F_DEBUG = 700 !< standard priority
125INTEGER(kind=c_int),PARAMETER :: L4F_TRACE = 800 !< standard priority
126INTEGER(kind=c_int),PARAMETER :: L4F_NOTSET = 900 !< standard priority
127INTEGER(kind=c_int),PARAMETER :: L4F_UNKNOWN = 1000 !< standard priority
128
129!> Default priority value. It is used only when compiled without log4c
130!! since the configuration file is ignored, but it is better to define
131!! it all the time.
132INTEGER(kind=c_int),PUBLIC :: l4f_priority=l4f_notice
133
134!> l4f handle. This type defines an opaque handle
135!! to a l4f category (mapped to a log4c category),
136!! it has to be initialised with the l4f_category_get method.
137TYPE,BIND(C) :: l4f_handle
138 PRIVATE
139 TYPE(c_ptr) :: ptr = c_null_ptr
140END TYPE l4f_handle
141
142#ifdef HAVE_LIBLOG4C
143
144TYPE(l4f_handle),SAVE :: l4f_global_default
145
146! emulation of old cnf behavior returning integer instead of pointer
147#undef ARRAYOF_ORIGEQ
148#undef ARRAYOF_ORIGTYPE
149#undef ARRAYOF_TYPE
150#define ARRAYOF_ORIGTYPE TYPE(l4f_handle)
151#define ARRAYOF_TYPE arrayof_l4f_handle
152#include "arrayof_pre_nodoc.F90"
153
154TYPE(arrayof_l4f_handle) :: l4f_global_ptr
155
156!> Global log4fortran constructor.
157INTERFACE
158 FUNCTION l4f_init() bind(C,name='log4c_init')
159 IMPORT
160 INTEGER(kind=c_int) :: l4f_init
161 END FUNCTION l4f_init
162END INTERFACE
163
164!> Initialize a logging category. This is the C version, please use the
165!! Fortran version l4f_category_get that receives a Fortran character.
166INTERFACE
167 FUNCTION l4f_category_get_c(a_name) bind(C,name='log4c_category_get')
168 IMPORT
169 CHARACTER(kind=c_char),INTENT(in) :: a_name(*) !< category name
170 TYPE(l4f_handle) :: l4f_category_get_c
171 END FUNCTION l4f_category_get_c
172END INTERFACE
173
174!! Delete a logging category. It can receive a C pointer or a
175!! legacy integer value.
176INTERFACE l4f_category_delete
177! SUBROUTINE l4f_category_delete_c(a_category) BIND(C,name='log4c_category_delete')
178! IMPORT
179! TYPE(l4f_handle),VALUE :: a_category !< category as C native pointer
180! END SUBROUTINE l4f_category_delete_c
181 MODULE PROCEDURE l4f_category_delete_legacy, l4f_category_delete_f
182END INTERFACE
183! this function has been disabled because aftere deleting a category
184! the following log4c_fini fails with a double free, we must
185! understand the log4c docs
186
187INTERFACE
188 SUBROUTINE l4f_category_log_c(a_category, a_priority, a_format) bind(C,name='log4c_category_log_c')
189 IMPORT
190 TYPE(l4f_handle),VALUE :: a_category !< category
191 INTEGER(kind=c_int),VALUE :: a_priority !< priority level
192! TYPE(c_ptr),VALUE :: locinfo !< not used
193 CHARACTER(kind=c_char),INTENT(in) :: a_format(*) !< message to emit
194 ! TYPE(c_ptr),VALUE :: a_args
195 END SUBROUTINE l4f_category_log_c
196END INTERFACE
197
198!> Emit log message for a category with specific priority.
199!! It can receive a C pointer or a legacy integer value.
200INTERFACE l4f_category_log
201 MODULE PROCEDURE l4f_category_log_f, l4f_category_log_legacy
202END INTERFACE l4f_category_log
203
204!> Return true if the corresponding category handle exists.
205INTERFACE l4f_category_exist
206 MODULE PROCEDURE l4f_category_exist_f, l4f_category_exist_legacy
207END INTERFACE l4f_category_exist
208
209!> log4fortran destructor
210INTERFACE
211 FUNCTION l4f_fini() bind(C,name='log4c_fini')
212 IMPORT
213 INTEGER(kind=c_int) :: l4f_fini
214 END FUNCTION l4f_fini
215END INTERFACE
216
217!>Ritorna un messaggio caratteristico delle priorità standard
218!interface
219!CHARACTER(len=12) FUNCTION l4f_msg(a_priority)
220!integer,intent(in):: a_priority !< category name
221!end function l4f_msg
222!end interface
223
224#else
225
226CHARACTER(len=510),PRIVATE:: dummy_a_name
227
228#endif
229
230PRIVATE
231PUBLIC l4f_fatal, l4f_alert, l4f_crit, l4f_error, l4f_warn, l4f_notice, &
232 l4f_info, l4f_debug, l4f_trace, l4f_notset, l4f_unknown
233PUBLIC l4f_init, l4f_category_get, l4f_category_delete, l4f_category_log, &
235PUBLIC l4f_launcher
236
237CONTAINS
238
239!> Routine specifica per il SIM. Cattura le variabili di ambiente
240!! LOG4_APPLICATION_NAME,LOG4_APPLICATION_ID e compone il nome univoco
241!! per il logging. Se le variabili di ambiente non sono impostate
242!! ritorna un nome definito dal nome del processo e da un timestamp.
243SUBROUTINE l4f_launcher(a_name, a_name_force, a_name_append)
244CHARACTER(len=*),INTENT(out) :: a_name !< nome univoco per logging
245CHARACTER(len=*),INTENT(in),OPTIONAL :: a_name_force !< forza il valore di a_name
246CHARACTER(len=*),INTENT(in),OPTIONAL :: a_name_append !< valore da appendere a a_name
247
248INTEGER :: tarray(8)
249CHARACTER(len=255) :: LOG4_APPLICATION_NAME,LOG4_APPLICATION_ID,arg
250CHARACTER(len=255),SAVE :: a_name_save=""
251
252IF (PRESENT(a_name_force))THEN
253 a_name=a_name_force
254ELSE IF (a_name_save /= "")THEN
255 a_name=a_name_save
256ELSE
257
258 CALL date_and_time(values=tarray)
259 CALL getarg(0, arg)
260 CALL getenv("LOG4_APPLICATION_NAME", log4_application_name)
261 CALL getenv("LOG4_APPLICATION_ID", log4_application_id)
262
263 IF (log4_application_name == "" .AND. log4_application_id == "") THEN
264 WRITE(a_name,"(a,a,8i5,a)")trim(arg),"[",tarray,"]"
265 ELSE
266 a_name = trim(log4_application_name)//"["//trim(log4_application_id)//"]"
267 END IF
268
269END IF
270
271a_name_save=a_name
272
273IF (PRESENT(a_name_append)) THEN
274 a_name=trim(a_name)//"."//trim(a_name_append)
275END IF
276
277END SUBROUTINE l4f_launcher
278
279#ifndef HAVE_LIBLOG4C
280! definisce delle dummy routine
281
282!> log4fortran constructor
283integer function l4f_init()
284
285character(len=10)::priority
286integer :: iostat
287
288call getenv("LOG4C_PRIORITY",priority)
289if (priority=="") then
290 l4f_priority = l4f_notice
291else
292 read(priority,*,iostat=iostat)l4f_priority
293end if
294
295if (iostat /= 0) then
296 l4f_priority = l4f_notice
297end if
298
299l4f_init = 0
300
301end function l4f_init
302
303
304!>Initialize a logging category.
305integer function l4f_category_get (a_name)
306character (len=*),intent(in) :: a_name !< category name
308dummy_a_name = a_name
309l4f_category_get = 1
311end function l4f_category_get
314!>Delete a logging category.
315subroutine l4f_category_delete(a_category)
316integer,intent(in):: a_category !< category name
317
318if (a_category == 1) dummy_a_name = ""
319
320end subroutine l4f_category_delete
321
322
323!>Emit log message for a category with specific priority
324subroutine l4f_category_log (a_category,a_priority,a_format)
325integer,intent(in):: a_category !< category name
326integer,intent(in):: a_priority !< priority level
327character(len=*),intent(in):: a_format !< message to emit
328
329if (a_category == 1 .and. a_priority <= l4f_priority) then
330 write(*,*)"[dummy] ",l4f_msg(a_priority),trim(dummy_a_name)," - ",trim(a_format)
331end if
332
333end subroutine l4f_category_log
334
335
336!>Emit log message without category with specific priority
337subroutine l4f_log (a_priority,a_format)
338integer,intent(in):: a_priority !< priority level
339character(len=*),intent(in):: a_format !< message to emit
340
341if ( a_priority <= l4f_priority) then
342 write(*,*)"[_default] ",l4f_msg(a_priority),trim(dummy_a_name)," - ",trim(a_format)
343end if
344
345end subroutine l4f_log
346
347
348!>Return True if category exist
349logical function l4f_category_exist (a_category)
350integer,intent(in):: a_category !< category name
351
352if (a_category == 1) then
353 l4f_category_exist= .true.
354else
355 l4f_category_exist= .false.
356end if
357
358end function l4f_category_exist
359
360
361!>log4fortran destructors
362integer function l4f_fini()
363
364l4f_fini= 0
365
366end function l4f_fini
367
368!>Ritorna un messaggio caratteristico delle priorità standard
369character(len=12) function l4f_msg(a_priority)
370
371integer,intent(in):: a_priority !< category name
372
373write(l4f_msg,*)a_priority
374
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"
386
387end function l4f_msg
388
389#else
390
391#include "arrayof_post_nodoc.F90"
392
393!> Initialize a logging category. This is the
394!! Fortran legacy version that receives a Fortran character argument
395!! and returns an integer.
396FUNCTION l4f_category_get(a_name) RESULT(handle)
397CHARACTER(kind=c_char,len=*),INTENT(in) :: a_name !< category name
398INTEGER :: handle
399
400INTEGER :: i
401
402DO i = 1, l4f_global_ptr%arraysize ! look first for a hole
403 IF (.NOT.l4f_category_exist(l4f_global_ptr%array(i))) THEN
404 l4f_global_ptr%array(i) = l4f_category_get_c(trim(a_name)//char(0))
405 handle = i
406 RETURN
407 ENDIF
408ENDDO
409
410handle = append(l4f_global_ptr, l4f_category_get_c(trim(a_name)//char(0)))
411
412END FUNCTION l4f_category_get
413
414
415!> Initialize a logging category. This is the
416!! Fortran version that receives a Fortran character argument
417!! and returns a typed handle.
418FUNCTION l4f_category_get_handle(a_name) RESULT(handle)
419CHARACTER(kind=c_char,len=*),INTENT(in) :: a_name !< category name
420TYPE(l4f_handle) :: handle
421
422handle = l4f_category_get_c(trim(a_name)//char(0))
423
424END FUNCTION l4f_category_get_handle
425
426
427!> Delete a logging category. Legacy version with an integer argument.
428SUBROUTINE l4f_category_delete_legacy(a_category)
429INTEGER,INTENT(in) :: a_category !< category as an integer
430
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)
434ELSE
435 l4f_global_ptr%array(a_category)%ptr = c_null_ptr
436ENDIF
437
438END SUBROUTINE l4f_category_delete_legacy
439
440
441!> Delete a logging category. No-op version with a typed handle.
442SUBROUTINE l4f_category_delete_f(a_category)
443TYPE(l4f_handle),INTENT(inout) :: a_category !< category as C native pointer
444
445a_category%ptr = c_null_ptr ! is it necessary?
446
447END SUBROUTINE l4f_category_delete_f
448
449
450!> Emit log message for a category with specific priority.
451!! Fortran version that receives a Fortran character argument.
452SUBROUTINE l4f_category_log_f(a_category, a_priority, a_format)
453TYPE(l4f_handle),INTENT(in) :: a_category !< category
454INTEGER(kind=c_int),INTENT(in) :: a_priority !< priority level
455CHARACTER(len=*),INTENT(in) :: a_format !< message to emit
456
457CALL l4f_category_log_c(a_category, a_priority, trim(a_format)//char(0))
458
459END SUBROUTINE l4f_category_log_f
460
461
462!> Emit log message for a category with specific priority.
463!! Legacy Fortran version that receives an integer instead of a C
464!! pointer and a Fortran character argument.
465SUBROUTINE l4f_category_log_legacy(a_category, a_priority, a_format)
466INTEGER(kind=c_int),INTENT(in) :: a_category !< category
467INTEGER(kind=c_int),INTENT(in) :: a_priority !< priority level
468CHARACTER(len=*),INTENT(in) :: a_format !< message to emit
469
470CALL l4f_category_log_c(l4f_global_ptr%array(a_category), a_priority, trim(a_format)//char(0))
471
472END SUBROUTINE l4f_category_log_legacy
473
474
475!> Emit log message without category with specific priority.
476!! Fortran version that receives a Fortran character argument.
477SUBROUTINE l4f_log(a_priority, a_format)
478INTEGER(kind=c_int),INTENT(in) :: a_priority !< priority level
479CHARACTER(len=*),INTENT(in) :: a_format !< message to emit
480
481INTEGER :: i
482
483IF (.NOT.l4f_category_exist(l4f_global_default)) THEN
484 i = l4f_init()
485 l4f_global_default = l4f_category_get_handle('_default')
486ENDIF
487CALL l4f_category_log(l4f_global_default, a_priority, a_format)
488
489END SUBROUTINE l4f_log
490
491
492!> Return true if the corresponding category handle exists
493!! (is associated with a category).
494FUNCTION l4f_category_exist_f(a_category) RESULT(exist)
495TYPE(l4f_handle),INTENT(in) :: a_category !< category
496LOGICAL :: exist
497
498exist = c_associated(a_category%ptr)
499
500END FUNCTION l4f_category_exist_f
501
502!> Return true if the corresponding category handle exists
503!! (is associated with a category).
504!! Legacy Fortran version that receives an integer instead of a C
505!! pointer.
506FUNCTION l4f_category_exist_legacy(a_category) RESULT(exist)
507INTEGER,INTENT(in):: a_category !< category
508LOGICAL :: exist
509
510IF (a_category <= 0 .OR. a_category > l4f_global_ptr%arraysize) THEN
511 exist = .false.
512ELSE
513 exist = l4f_category_exist(l4f_global_ptr%array(a_category))
514ENDIF
515
516END FUNCTION l4f_category_exist_legacy
517
518
519#endif
520
521end 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.