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