1 % (c) 2009-2026 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2 % Heinrich Heine Universitaet Duesseldorf
3 % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5 :- module(logger, [set_log_file/1, get_log_file/1, set_logging_mode/1,
6 writeln_log/1,
7 writeln_log_time/1,
8 force_writeln_log/2,
9 write_xml_element_to_log/2,
10 write_prolog_term_as_xml_to_log/1,
11 write_bstate_to_log/1, write_bstate_to_log/2,
12 start_xml_group_in_log/1, start_xml_group_in_log/3,
13 stop_xml_group_in_log/1, stop_xml_group_in_log_no_statistics/1,
14 close_all_xml_groups_in_log_until/1,
15 logging_is_enabled/0,
16 read_xml_log_file/2]).
17
18 :- use_module(module_information).
19
20 :- module_info(group,infrastructure).
21 :- module_info(description,'This module is responsible for (xml and prolog) logging.').
22
23
24 :- use_module(self_check).
25 :- use_module(error_manager).
26 :- use_module(probsrc(xml_prob),[xml_parse/3, xml_parse/2]).
27 :- use_module(library(lists)).
28
29 :- set_prolog_flag(double_quotes, codes).
30
31 :- dynamic logfile/1.
32 set_log_file(F) :- retractall(logfile(_)), assertz(logfile(F)).
33 get_log_file(F) :- logfile(F).
34
35 :- dynamic logging_mode/1.
36 logging_mode(prolog).
37 % valid modes: prolog and xml
38 set_logging_mode(Mode) :- retractall(logging_mode(_)), assertz(logging_mode(Mode)),
39 (Mode=xml -> format_log_header(reset,'<?xml version="1.0" encoding="UTF-8"?>~n',[]) ; true).
40
41 % TO DO: use:
42 %get_preference(xml_encoding,EncodingPref),
43
44 logging_is_enabled :- logfile(_),!.
45
46 prolog_log_file(F) :- logfile(F), logging_mode(prolog).
47
48 reset_logger :- retractall(open_xml_group(_,_)),
49 retractall(logfile(_)), set_logging_mode(prolog).
50
51 % TO DO: try and move most writeln_log calls to write_xml_element_to_log format
52 writeln_log(Term) :-
53 (prolog_log_file(F)
54 -> open(F,append,S,[encoding(utf8)]),
55 write_term(S,Term,[quoted(true)]), write(S,'.'),nl(S),
56 close(S)
57 ; true
58 ).
59
60 % for debugging: use logfile if provided, otherwise force logging using default file
61 force_writeln_log(_DefaultFile,Term) :- logfile(_),!,
62 writeln_log(Term).
63 force_writeln_log(DefaultFile,Term) :-
64 set_log_file(DefaultFile),
65 set_logging_mode(prolog),
66 writeln_log(Term).
67
68 open_logfile(Stream) :- logfile(F), open(F,append,Stream,[encoding(utf8)]).
69
70 format_log(FormatString,Args) :- %format(FormatString,Args),nl,
71 (logfile(F)
72 -> open(F,append,S,[encoding(utf8)]),
73 format(S,FormatString,Args),
74 close(S)
75 ; true
76 ).
77
78 writeln_log_time(Term) :-
79 (prolog_log_file(_) ->
80 statistics(runtime,[Time,_]),
81 statistics(walltime,[WTime,_]),
82 statistics(memory_used,M), MB is M / 1000000, % used instead of deprecated 1048576
83 Term=..[H|Args],
84 append(Args,[Time,WTime,mb(MB)],NArgs),
85 NT =.. [H|NArgs],
86 writeln_log(NT)
87 ; true).
88
89 :- use_module(library(file_systems),[file_exists/1]).
90 format_log_header(reset,FormatString,Args) :- !, % reset means we want to start with a fresh log file
91 (logfile(F)
92 -> open(F,write,S,[encoding(utf8)]),
93 format(S,FormatString,Args),
94 close(S)
95 ; true
96 ).
97 format_log_header(_,FormatString,Args) :-
98 % like format_log, but only writes if the file does not exist yet
99 (logfile(F), \+ file_exists(F)
100 -> open(F,append,S,[encoding(utf8)]),
101 format(S,FormatString,Args),
102 close(S)
103 ; true
104 ).
105
106 :- assert_must_succeed((logger:xml_encode_text("b<>c",R),R=="b<>c")).
107 xml_encode_text(Codes,Res) :- XML = xml([],[pcdata(Codes)]), xml_parse(Encoded,XML),!,Res=Encoded.
108 xml_encode_text(Codes,Encoded) :- format(user_error,'Could not encode for XML: ~s~n',[Codes]),
109 Encoded=Codes.
110 % we could also use xml:pcdata_generation(Codes, Encoded, []).
111
112
113
114 :- assert_must_succeed((logger:xml_encode_element(check_goal,[true/1],R),R=="<check_goal true=\"1\" />")).
115 xml_encode_element(Tag,Attributes,Encoded2) :-
116 maplist(prepare_attribute,Attributes,XMLAttr),
117 XML = xml([],[element(Tag,XMLAttr,[])]),
118 xml_parse(Encoded,XML),
119 peel_off_leading_newline(Encoded,Encoded2).
120
121 peel_off_leading_newline([10|T],R) :- !, peel_off_leading_newline(T,R).
122 peel_off_leading_newline([13|T],R) :- !, peel_off_leading_newline(T,R).
123 peel_off_leading_newline(R,R).
124
125 % write a tag with attributes to the log file
126 write_xml_element_to_log(_,_) :- \+ logfile(_), !.
127 write_xml_element_to_log(Tag,Attributes) :- logging_mode(xml),!,
128 (xml_encode_element(Tag,Attributes,Encoded) -> true
129 ; add_internal_error('Could not encode xml: ',Tag),
130 Encoded = "<error/>"
131 ),
132 indent_log(WS),
133 format_log("~s~s~n",[WS,Encoded]).
134 write_xml_element_to_log(Tag,Attributes) :-
135 Term =.. [Tag,Attributes],
136 format_log("~w.~n",[Term]).
137
138 % write a Prolog Term either as Prolog Term in Prolog mode or in nested XML form
139 %write_term_to_log(Term) :- logging_mode(xml),!,
140 % write_prolog_term_as_xml_to_log(Term).
141 %write_term_to_log(Term) :- writeln_log(Term).
142
143 write_prolog_term_as_xml_to_log(A) :- number(A),!,
144 indent_log(WS),
145 format_log("~s<number>~w</number>~n",[WS,A]).
146 write_prolog_term_as_xml_to_log(A) :- var(A),!,
147 indent_log(WS),
148 format_log("~s<variable>~w</variable>~n",[WS,A]).
149 write_prolog_term_as_xml_to_log(A) :- atomic(A),!, convert_to_codes(A,Codes),
150 xml_encode_text(Codes,Encoded),
151 indent_log(WS),
152 ? (is_a_file_path(Encoded) -> format_log("~s<path>~s</path>~n",[WS,Encoded])
153 ; format_log("~s<atom>~s</atom>~n",[WS,Encoded])).
154 write_prolog_term_as_xml_to_log(A/B) :- !,
155 start_xml_group_in_log(bind),
156 write_prolog_term_as_xml_to_log(A),
157 write_prolog_term_as_xml_to_log(B),
158 stop_xml_group_in_log_no_statistics(bind).
159 write_prolog_term_as_xml_to_log([H|T]) :- !, % Note: we assume we have a proper list !
160 start_xml_group_in_log(list),
161 maplist(write_prolog_term_as_xml_to_log,[H|T]),
162 stop_xml_group_in_log_no_statistics(list).
163 write_prolog_term_as_xml_to_log(T) :- T =.. [Functor|Args],
164 %TO DO, something like: escape / xml_encode_text(Functor,EFunc),
165 encode_functor(Functor,XML_Functor),
166 start_xml_group_in_log(XML_Functor),
167 maplist(write_prolog_term_as_xml_to_log,Args),
168 stop_xml_group_in_log_no_statistics(XML_Functor).
169
170 encode_functor('-',R) :- !, R='prolog-'.
171 encode_functor(X,X).
172
173 write_bstate_to_log(State) :- write_bstate_to_log(State,'').
174
175 % in response to logxml_write_vars
176 write_bstate_to_log(State,Prefix) :- logging_mode(xml),!,
177 start_xml_group_in_log(state),
178 atom_codes(Prefix,PrefixCodes),
179 (State=root -> start_xml_group_in_log(root), stop_xml_group_in_log_no_statistics(root)
180 ; maplist(write_b_binding_as_xml_to_log(PrefixCodes),State) -> true
181 ; add_internal_error('Could not write state to xml logfile: ',write_bstate_to_log(State))),
182 stop_xml_group_in_log_no_statistics(state).
183 write_bstate_to_log(_,_Prefix).
184
185 write_b_binding_as_xml_to_log(Prefix,bind(VarName,Value)) :-
186 atom_codes(VarName,Codes),
187 append(Prefix,_,Codes), % check that variable name starts with prefix
188 !,
189 start_xml_group_in_log(variable,name,VarName), % Not: already escapes for XML;
190 % TODO: distinguish between constants/variables
191 xml_write_b_value_to_log(Value),
192 stop_xml_group_in_log_no_statistics(variable).
193 write_b_binding_as_xml_to_log(_,_).
194
195 xml_write_b_value_to_log(Value) :-
196 open_logfile(Stream),
197 indent_log(WS),format(Stream,'~s ',[WS]),
198 xml_write_b_value(Value,Stream),
199 format(Stream,'~n',[]),
200 close(Stream).
201
202 :- use_module(probsrc(custom_explicit_sets),[expand_custom_set_to_list/2]).
203 :- use_module(probsrc(translate),[translate_bvalue_to_codes/2]).
204 xml_write_b_value_map(Stream,O) :- xml_write_b_value(O,Stream).
205 xml_write_b_value(Var,Stream) :- var(Var),!,
206 add_internal_error('Illegal variable value:',xml_write_b_value(Var,Stream)),
207 format(Stream,'<value>~w</value>',[Var]).
208 xml_write_b_value((Fst,Snd),Stream) :- !,
209 write(Stream,'<pair><fst>'),
210 xml_write_b_value(Fst,Stream),
211 write(Stream,'</fst><snd>'),
212 xml_write_b_value(Snd,Stream),
213 write(Stream,'</snd></pair> ').
214 xml_write_b_value([],Stream) :- !,write(Stream,'<empty_set></empty_set> ').
215 xml_write_b_value(CS,Stream) :- custom_set_to_expand(CS),!,
216 expand_custom_set_to_list(CS,Elements),
217 write(Stream,'<set>'),
218 maplist(xml_write_b_value_map(Stream),Elements),
219 write(Stream,'</set> ').
220 xml_write_b_value([H|T],Stream) :- !,
221 write(Stream,'<set>'),
222 maplist(xml_write_b_value_map(Stream),[H|T]),
223 write(Stream,'</set> ').
224 xml_write_b_value(rec(Fields),Stream) :- !,
225 write(Stream,'<record>'),
226 maplist(xml_write_b_field_value(Stream),Fields),
227 write(Stream,'</record> ').
228 xml_write_b_value(string(S),Stream) :- !,
229 atom_codes(S,Codes),
230 xml_encode_text(Codes,Encoded),
231 format(Stream,'<string>~s</string>',[Encoded]).
232 xml_write_b_value(int(N),Stream) :- !,
233 format(Stream,'<integer>~w</integer>',[N]).
234 xml_write_b_value(pred_true,Stream) :- !,
235 format(Stream,'<bool>TRUE</bool>',[]).
236 xml_write_b_value(pred_false,Stream) :- !,
237 format(Stream,'<bool>FALSE</bool>',[]).
238 xml_write_b_value(fd(Nr,Type),Stream) :- !,
239 translate_bvalue_to_codes(fd(Nr,Type),SValue),
240 format(Stream,"<enum type=\"~w\" nr=\"~w\">~s</enum>",[Type,Nr,SValue]).
241 xml_write_b_value(Value,Stream) :-
242 is_custom_explicit_set(Value,xml_write),
243 is_interval_closure(Value,Low,Up),
244 !,
245 write(Stream,'<interval_set><from>'),
246 xml_write_b_value(int(Low),Stream),
247 write(Stream,'</from><to>'),
248 xml_write_b_value(int(Up),Stream),
249 write(Stream,'</to></interval_set>').
250 xml_write_b_value(Value,Stream) :- % other value, freetype, freeval, closure, ...
251 is_custom_explicit_set(Value,xml_write),
252 !,
253 translate_bvalue_to_codes(Value,SValue),
254 xml_encode_text(SValue,Encoded),
255 format(Stream,'<symbolic_set>~s</symbolic_set>',[Encoded]).
256 xml_write_b_value(Value,Stream) :- % other value freeval, ...
257 translate_bvalue_to_codes(Value,SValue),
258 xml_encode_text(SValue,Encoded),
259 format(Stream,'<value>~s</value>',[Encoded]).
260 % TO DO: check if there are uncovered values, e.g., freeval(ID,Case,Value)
261
262 :- use_module(custom_explicit_sets,[is_interval_closure/3,
263 is_custom_explicit_set/2, dont_expand_this_explicit_set/2]).
264 custom_set_to_expand(avl_set(_)).
265 custom_set_to_expand(CS) :- nonvar(CS),
266 is_custom_explicit_set(CS,xml_write),
267 \+ dont_expand_this_explicit_set(CS,1000).
268
269 xml_write_b_field_value(Stream,field(Name,Val)) :-
270 atom_codes(Name,Codes), xml_attribute_escape(Codes,Encoded),
271 format(Stream,'<field name=\"~s\">',[Encoded]),
272 xml_write_b_value(Val,Stream), write(Stream,'</field>').
273
274 % ---------------------------
275
276 :- use_module(tools_platform, [host_platform/1]).
277 ?is_a_file_path(Codes) :- member(47,Codes).
278 is_a_file_path(Codes) :- host_platform(windows), member(92,Codes). % windows
279
280 prepare_attribute('='(Tag,Atom),'='(Tag,Codes)) :- convert_to_codes(Atom,Codes).
281 prepare_attribute('/'(Tag,Atom),'='(Tag,Codes)) :- convert_to_codes(Atom,Codes).
282
283 :- use_module(library(codesio),[write_to_codes/2]).
284 convert_to_codes(V,Codes) :- var(V),!,Codes="_".
285 convert_to_codes([H|T],Codes) :- number(H),!, Codes=[H|T].
286 convert_to_codes(N,Codes) :- number(N),!, number_codes(N,Codes).
287 convert_to_codes(A,Codes) :- atom(A),!,atom_codes(A,Codes).
288 convert_to_codes(A,Codes) :- write_to_codes(A,Codes).
289
290 :- dynamic open_xml_group/2, nesting_level/1.
291 nesting_level(0).
292 update_nesting_level(X) :- retract(nesting_level(Y)),
293 New is Y+X, assertz(nesting_level(New)).
294
295 space(32).
296 indent_log(WS) :- nesting_level(Lvl), length(WS,Lvl),
297 maplist(space,WS).
298
299 ?check_and_generate_group_stats(Group,Stats) :- open_xml_group(A,_),!,
300 (A=Group
301 -> retract(open_xml_group(Group,WTimeStart)),
302 (Stats=no_statistics -> true
303 ; statistics(walltime,[WTimeEnd,_]),
304 Delta is WTimeEnd - WTimeStart,
305 statistics(memory_used,M),
306 write_xml_element_to_log(statistics,[walltime/Delta,walltime_since_start/WTimeEnd,memory_used/M])
307 ),
308 update_nesting_level(-1)
309 ; add_internal_error('XML closing tag mismatch: ', Group/A),
310 stop_xml_group_in_log(A,Stats), % close offending group and try again
311 check_and_generate_group_stats(Group,Stats)
312 ).
313 check_and_generate_group_stats(Group,_) :-
314 add_internal_error('XML closing tag error, no tag open: ', Group).
315
316 start_xml_group_in_log(Group) :- logging_mode(xml),!,
317 statistics(walltime,[WTime,_]),
318 indent_log(WS),
319 asserta(open_xml_group(Group,WTime)),
320 update_nesting_level(1),
321 format_log("~s<~w>~n",[WS,Group]).
322 start_xml_group_in_log(_).
323
324 :- use_module(tools, [xml_attribute_escape/2]). % attribute values have a less stringent encoding than xml_encode_text
325 % we currently only support a single attribute and value
326 start_xml_group_in_log(_,_,_) :- \+ logging_mode(xml),!.
327 start_xml_group_in_log(Group,Attr,Value) :-
328 statistics(walltime,[WTime,_]),
329 indent_log(WS),
330 asserta(open_xml_group(Group,WTime)),
331 update_nesting_level(1),
332 convert_to_codes(Value,ValueC),
333 xml_attribute_escape(ValueC,EValueC),
334 format_log("~s<~w ~w=\"~s\">~n",[WS,Group,Attr,EValueC]),!.
335 start_xml_group_in_log(Group,Attr,Value) :-
336 add_internal_error('Call failed: ', start_xml_group_in_log(Group,Attr,Value)).
337
338 stop_xml_group_in_log(_,_) :- \+ logging_mode(xml),!.
339 stop_xml_group_in_log(Group,Stats) :-
340 check_and_generate_group_stats(Group,Stats),
341 indent_log(WS),
342 format_log("~s</~w>~n",[WS,Group]),!.
343 stop_xml_group_in_log(Group,Stats) :-
344 add_internal_error('Call failed: ', stop_xml_group_in_log(Group,Stats)).
345
346
347 stop_xml_group_in_log(Group) :- stop_xml_group_in_log(Group,statistics).
348 stop_xml_group_in_log_no_statistics(Group) :- stop_xml_group_in_log(Group,no_statistics).
349
350 % call if you need to prematurely exit probcli
351 %close_all_xml_groups_in_log :- close_all_xml_groups_in_log_until('probcli-run').
352 close_all_xml_groups_in_log_until(Until) :- open_xml_group(Group,_), Until \== Group,
353 !,
354 stop_xml_group_in_log(Group),
355 close_all_xml_groups_in_log_until(Until).
356 close_all_xml_groups_in_log_until(_).
357
358
359
360 :- use_module(tools, [safe_read_string_from_file/3]).
361 :- use_module(debug, [formatsilent/2]).
362
363 read_xml_log_file(File,[errors/NrErrors,warnings/NrWarnings,expected_errors/NrExpErrors]) :-
364 Encoding=auto, % (must be "auto", "UTF-8", "UTF-16", "ISO-8859-1",...)
365 statistics(walltime,_),
366 absolute_file_name(File,AFile),
367 safe_read_string_from_file(AFile,Encoding,Codes),
368 (xml_parse(Codes,xml(_Atts,Content),[format(true)]) -> true
369 ; add_error(read_xml,'Converting file contents to XML failed: ',AFile),fail),
370 statistics(walltime,[_,W2]),
371 formatsilent('% Walltime ~w ms to parse and convert XML in ~w~n',[W2,AFile]),
372 Content = [element('probcli-run',[],InnerContent)|_],
373 check_log(InnerContent,0),
374 member(element('probcli-errors',[errors=EC,warnings=WC|TErrs],[]),InnerContent),
375 number_codes(NrErrors,EC),
376 number_codes(NrWarnings,WC),
377 (member(expected_errors=ExpE,TErrs),number_codes(NrExpErrors,ExpE) -> true ; NrExpErrors=0).
378
379 %extract_xml_log_file([element('probcli-run',[],Cont],Entries) :-
380 %extract_entry(element(Name,Attrs,Content)
381
382 extract_attribute(Attr=Codes,Attr=Atom) :- atom_codes(Atom,Codes).
383
384 % TO DO: extract interesting information, e.g., for test_runner
385 check_log([],_) :- !.
386 check_log([H|T],Level) :- !, L1 is Level+1, check_log(H,L1),
387 check_log(T,Level).
388 check_log(element(Name,Attrs,Cont),Level) :- maplist(extract_attribute,Attrs,EAttrs),
389 !,
390 indentws(Level), format('<~w ~w>~n',[Name,EAttrs]),
391 L1 is Level + 1,
392 check_log(Cont,L1).
393 check_log(pcdata(L),Level) :- !, indentws(Level), format('~s~n',[L]).
394 check_log(X,Level) :- indentws(Level),print(X),nl.
395
396 indentws(0) :- !.
397 indentws(X) :- X>0, print(' '), X1 is X-1, indentws(X1).
398
399 /*
400 <?xml version="1.0" encoding="ASCII"?>
401
402 | ?- xml_parse("<PT ID=\"2\" stID=\"3\"/>",R).
403 R = xml([],[element('PT',['ID'=[50],stID=[51]],[])]) ?
404
405 <PointsTelegram elementID="W90" stationID="FR" interlockingID="FR" interlockingElementID="W90"/>
406
407
408 */
409
410 % -------------------------------------------
411
412 :- use_module(eventhandling,[register_event_listener/3]).
413 :- register_event_listener(reset_prob,reset_logger,
414 'Reset Logger just like after starup_prob').
415