| 1 | % (c) 2009-2019 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, reset_logger/0, | |
| 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/0, | |
| 14 | logging_is_enabled/0]). | |
| 15 | ||
| 16 | :- use_module(module_information). | |
| 17 | ||
| 18 | :- module_info(group,infrastructure). | |
| 19 | :- module_info(description,'This module is responsible for (xml and prolog) logging.'). | |
| 20 | ||
| 21 | ||
| 22 | :- use_module(self_check). | |
| 23 | :- use_module(error_manager). | |
| 24 | :- use_module(library(xml)). | |
| 25 | :- use_module(library(lists)). | |
| 26 | ||
| 27 | :- dynamic logfile/1. | |
| 28 | set_log_file(F) :- retractall(logfile(_)), assert(logfile(F)). | |
| 29 | get_log_file(F) :- logfile(F). | |
| 30 | ||
| 31 | :- dynamic logging_mode/1. | |
| 32 | logging_mode(prolog). | |
| 33 | % valid modes: prolog and xml | |
| 34 | set_logging_mode(Mode) :- retractall(logging_mode(_)), assert(logging_mode(Mode)), | |
| 35 | (Mode=xml -> format_log_header(reset,'<?xml version="1.0" encoding="ASCII"?>~n',[]) ; true). | |
| 36 | ||
| 37 | % TO DO: use: | |
| 38 | %get_preference(xml_encoding,EncodingPref), | |
| 39 | ||
| 40 | logging_is_enabled :- logfile(_),!. | |
| 41 | ||
| 42 | prolog_log_file(F) :- logfile(F), logging_mode(prolog). | |
| 43 | ||
| 44 | reset_logger :- retractall(open_xml_group(_,_)), | |
| 45 | retractall(logfile(_)), set_logging_mode(prolog). | |
| 46 | ||
| 47 | % TO DO: try and move most writeln_log calls to write_xml_element_to_log format | |
| 48 | writeln_log(Term) :- | |
| 49 | (prolog_log_file(F) | |
| 50 | -> (open(F,append,S), | |
| 51 | write_term(S,Term,[quoted(true)]), write(S,'.'),nl(S), | |
| 52 | close(S)) | |
| 53 | ; true | |
| 54 | ). | |
| 55 | ||
| 56 | open_logfile(Stream) :- logfile(F), open(F,append,Stream). | |
| 57 | ||
| 58 | format_log(FormatString,Args) :- %format(FormatString,Args),nl, | |
| 59 | (logfile(F) | |
| 60 | -> (open(F,append,S), | |
| 61 | format(S,FormatString,Args), | |
| 62 | close(S)) | |
| 63 | ; true | |
| 64 | ). | |
| 65 | ||
| 66 | writeln_log_time(Term) :- | |
| 67 | (prolog_log_file(_) -> | |
| 68 | statistics(runtime,[Time,_]), | |
| 69 | statistics(walltime,[WTime,_]), | |
| 70 | statistics(memory_used,M), MB is M / 1048576, | |
| 71 | Term=..[H|Args], | |
| 72 | append(Args,[Time,WTime,mb(MB)],NArgs), | |
| 73 | NT =.. [H|NArgs], | |
| 74 | writeln_log(NT) | |
| 75 | ; true). | |
| 76 | ||
| 77 | :- use_module(library(file_systems),[file_exists/1]). | |
| 78 | format_log_header(reset,FormatString,Args) :- !, % reset means we want to start with a fresh log file | |
| 79 | (logfile(F) | |
| 80 | -> (open(F,write,S), | |
| 81 | format(S,FormatString,Args), | |
| 82 | close(S)) | |
| 83 | ; true | |
| 84 | ). | |
| 85 | format_log_header(_,FormatString,Args) :- | |
| 86 | % like format_log, but only writes if the file does not exist yet | |
| 87 | (logfile(F), \+ file_exists(F) | |
| 88 | -> (open(F,append,S), | |
| 89 | format(S,FormatString,Args), | |
| 90 | close(S)) | |
| 91 | ; true | |
| 92 | ). | |
| 93 | ||
| 94 | :- assert_must_succeed((logger:xml_encode_text("b<>c",R),R=="b<>c")). | |
| 95 | xml_encode_text(Codes,Res) :- XML = xml([],[pcdata(Codes)]), xml_parse(Encoded,XML),!,Res=Encoded. | |
| 96 | xml_encode_text(Codes,Encoded) :- format(user_error,'Could not encode for XML: ~s~n',[Codes]), | |
| 97 | Encoded=Codes. | |
| 98 | % we could also use xml:pcdata_generation(Codes, Encoded, []). | |
| 99 | ||
| 100 | :- assert_must_succeed((logger:xml_encode_element(check_goal,[true/1],R),R=="<check_goal true=\"1\" />")). | |
| 101 | xml_encode_element(Tag,Attributes,Encoded2) :- | |
| 102 | maplist(prepare_attribute,Attributes,XMLAttr), | |
| 103 | XML = xml([],[element(Tag,XMLAttr,[])]), | |
| 104 | xml_parse(Encoded,XML), | |
| 105 | peel_off_leading_newline(Encoded,Encoded2). | |
| 106 | ||
| 107 | peel_off_leading_newline([10|T],R) :- !, peel_off_leading_newline(T,R). | |
| 108 | peel_off_leading_newline([13|T],R) :- !, peel_off_leading_newline(T,R). | |
| 109 | peel_off_leading_newline(R,R). | |
| 110 | ||
| 111 | % write a tag with attributes to the log file | |
| 112 | write_xml_element_to_log(_,_) :- \+ logfile(_), !. | |
| 113 | write_xml_element_to_log(Tag,Attributes) :- logging_mode(xml),!, | |
| 114 | xml_encode_element(Tag,Attributes,Encoded), | |
| 115 | indent_log(WS), | |
| 116 | format_log("~s~s~n",[WS,Encoded]). | |
| 117 | write_xml_element_to_log(Tag,Attributes) :- | |
| 118 | Term =.. [Tag,Attributes], | |
| 119 | format_log("~w.~n",[Term]). | |
| 120 | ||
| 121 | % write a Prolog Term either as Prolog Term in Prolog mode or in nested XML form | |
| 122 | %write_term_to_log(Term) :- logging_mode(xml),!, | |
| 123 | % write_prolog_term_as_xml_to_log(Term). | |
| 124 | %write_term_to_log(Term) :- writeln_log(Term). | |
| 125 | ||
| 126 | write_prolog_term_as_xml_to_log(A) :- number(A),!, | |
| 127 | indent_log(WS), | |
| 128 | format_log("~s<number>~w</number>~n",[WS,A]). | |
| 129 | write_prolog_term_as_xml_to_log(A) :- var(A),!, | |
| 130 | indent_log(WS), | |
| 131 | format_log("~s<variable>~w</variable>~n",[WS,A]). | |
| 132 | write_prolog_term_as_xml_to_log(A) :- atomic(A),!, convert_to_codes(A,Codes), | |
| 133 | xml_encode_text(Codes,Encoded), | |
| 134 | indent_log(WS), | |
| 135 | (is_a_file_path(Encoded) -> format_log("~s<path>~s</path>~n",[WS,Encoded]) | |
| 136 | ; format_log("~s<atom>~s</atom>~n",[WS,Encoded])). | |
| 137 | write_prolog_term_as_xml_to_log(A/B) :- !, | |
| 138 | start_xml_group_in_log(bind), | |
| 139 | write_prolog_term_as_xml_to_log(A), | |
| 140 | write_prolog_term_as_xml_to_log(B), | |
| 141 | stop_xml_group_in_log_no_statistics(bind). | |
| 142 | write_prolog_term_as_xml_to_log([H|T]) :- !, % Note: we assume we have a proper list ! | |
| 143 | start_xml_group_in_log(list), | |
| 144 | maplist(write_prolog_term_as_xml_to_log,[H|T]), | |
| 145 | stop_xml_group_in_log_no_statistics(list). | |
| 146 | write_prolog_term_as_xml_to_log(T) :- T =.. [Functor|Args], | |
| 147 | %TO DO, something like: escape / xml_encode_text(Functor,EFunc), | |
| 148 | start_xml_group_in_log(Functor), | |
| 149 | maplist(write_prolog_term_as_xml_to_log,Args), | |
| 150 | stop_xml_group_in_log_no_statistics(Functor). | |
| 151 | ||
| 152 | write_bstate_to_log(State) :- write_bstate_to_log(State,''). | |
| 153 | ||
| 154 | % in response to logxml_write_vars | |
| 155 | write_bstate_to_log(State,Prefix) :- logging_mode(xml),!, | |
| 156 | start_xml_group_in_log(state), | |
| 157 | atom_codes(Prefix,PrefixCodes), | |
| 158 | (State=root -> start_xml_group_in_log(root), stop_xml_group_in_log_no_statistics(root) | |
| 159 | ; maplist(write_b_binding_as_xml_to_log(PrefixCodes),State) -> true | |
| 160 | ; add_internal_error('Could not write state to xml logfile: ',write_bstate_to_log(State))), | |
| 161 | stop_xml_group_in_log_no_statistics(state). | |
| 162 | write_bstate_to_log(_,_Prefix). | |
| 163 | ||
| 164 | write_b_binding_as_xml_to_log(Prefix,bind(VarName,Value)) :- % TO DO: encode VarName | |
| 165 | atom_codes(VarName,Codes), | |
| 166 | append(Prefix,_,Codes), % check that variable name starts with prefix | |
| 167 | !, | |
| 168 | xml_encode_text(Codes,ECodes), | |
| 169 | atom_codes(EVarName,ECodes), | |
| 170 | start_xml_group_in_log(variable,name,EVarName), | |
| 171 | xml_write_b_value_to_log(Value), | |
| 172 | stop_xml_group_in_log_no_statistics(variable). | |
| 173 | write_b_binding_as_xml_to_log(_,_). | |
| 174 | ||
| 175 | xml_write_b_value_to_log(Value) :- | |
| 176 | open_logfile(Stream), | |
| 177 | indent_log(WS),format(Stream,'~s ',[WS]), | |
| 178 | xml_write_b_value(Value,Stream), | |
| 179 | format(Stream,'~n',[]), | |
| 180 | close(Stream). | |
| 181 | ||
| 182 | :- use_module(probsrc(custom_explicit_sets),[expand_custom_set_to_list/2]). | |
| 183 | :- use_module(probsrc(translate),[translate_bvalue_to_codes/2]). | |
| 184 | xml_write_b_value_map(Stream,O) :- xml_write_b_value(O,Stream). | |
| 185 | xml_write_b_value(Var,Stream) :- var(Var),!, | |
| 186 | add_internal_error('Illegal variable value:',xml_write_b_value(Var,Stream)), | |
| 187 | format(Stream,'<value>~w</value>',[Var]). | |
| 188 | xml_write_b_value((Fst,Snd),Stream) :- !, | |
| 189 | write(Stream,'<pair><fst>'), | |
| 190 | xml_write_b_value(Fst,Stream), | |
| 191 | write(Stream,'</fst><snd>'), | |
| 192 | xml_write_b_value(Snd,Stream), | |
| 193 | write(Stream,'</snd></pair> '). | |
| 194 | xml_write_b_value([],Stream) :- !,write(Stream,'<empty_set></empty_set> '). | |
| 195 | xml_write_b_value(CS,Stream) :- custom_set_to_expand(CS),!, | |
| 196 | expand_custom_set_to_list(CS,Elements), | |
| 197 | write(Stream,'<set>'), | |
| 198 | maplist(xml_write_b_value_map(Stream),Elements), | |
| 199 | write(Stream,'</set> '). | |
| 200 | xml_write_b_value([H|T],Stream) :- !, | |
| 201 | write(Stream,'<set>'), | |
| 202 | maplist(xml_write_b_value_map(Stream),[H|T]), | |
| 203 | write(Stream,'</set> '). | |
| 204 | xml_write_b_value(rec(Fields),Stream) :- !, | |
| 205 | write(Stream,'<record>'), | |
| 206 | maplist(xml_write_b_field_value(Stream),Fields), | |
| 207 | write(Stream,'</record> '). | |
| 208 | xml_write_b_value(string(S),Stream) :- !, | |
| 209 | atom_codes(S,Codes), | |
| 210 | xml_encode_text(Codes,Encoded), | |
| 211 | format(Stream,'<string>~s</string>',[Encoded]). | |
| 212 | xml_write_b_value(int(N),Stream) :- !, | |
| 213 | format(Stream,'<integer>~w</integer>',[N]). | |
| 214 | xml_write_b_value(pred_true,Stream) :- !, | |
| 215 | format(Stream,'<bool>TRUE</bool>',[]). | |
| 216 | xml_write_b_value(pred_false,Stream) :- !, | |
| 217 | format(Stream,'<bool>FALSE</bool>',[]). | |
| 218 | xml_write_b_value(fd(Nr,Type),Stream) :- !, | |
| 219 | translate_bvalue_to_codes(fd(Nr,Type),SValue), | |
| 220 | format(Stream,"<enum type=\"~w\" nr=\"~w\">~s</enum>",[Type,Nr,SValue]). | |
| 221 | xml_write_b_value(Value,Stream) :- | |
| 222 | is_custom_explicit_set(Value,xml_write), | |
| 223 | is_interval_closure(Value,Low,Up), | |
| 224 | !, | |
| 225 | write(Stream,'<interval_set><from>'), | |
| 226 | xml_write_b_value(int(Low),Stream), | |
| 227 | write(Stream,'</from><to>'), | |
| 228 | xml_write_b_value(int(Up),Stream), | |
| 229 | write(Stream,'</to></interval_set>'). | |
| 230 | xml_write_b_value(Value,Stream) :- % other value, freetype, freeval, closure, ... | |
| 231 | is_custom_explicit_set(Value,xml_write), | |
| 232 | !, | |
| 233 | translate_bvalue_to_codes(Value,SValue), | |
| 234 | xml_encode_text(SValue,Encoded), | |
| 235 | format(Stream,'<symbolic_set>~s</symbolic_set>',[Encoded]). | |
| 236 | xml_write_b_value(Value,Stream) :- % other value freeval, ... | |
| 237 | translate_bvalue_to_codes(Value,SValue), | |
| 238 | xml_encode_text(SValue,Encoded), | |
| 239 | format(Stream,'<value>~s</value>',[Encoded]). | |
| 240 | % TO DO: check if there are uncovered values, e.g., freeval(ID,Case,Value) | |
| 241 | ||
| 242 | :- use_module(custom_explicit_sets,[is_interval_closure/3, | |
| 243 | is_custom_explicit_set/2, dont_expand_this_explicit_set/2]). | |
| 244 | custom_set_to_expand(avl_set(_)). | |
| 245 | custom_set_to_expand(CS) :- nonvar(CS), | |
| 246 | is_custom_explicit_set(CS,xml_write), | |
| 247 | \+ dont_expand_this_explicit_set(CS,1000). | |
| 248 | ||
| 249 | xml_write_b_field_value(Stream,field(Name,Val)) :- | |
| 250 | atom_codes(Name,Codes), xml_encode_text(Codes,Encoded), | |
| 251 | format(Stream,'<field name=\"~s\">',[Encoded]), | |
| 252 | xml_write_b_value(Val,Stream), write(Stream,'</field>'). | |
| 253 | ||
| 254 | % --------------------------- | |
| 255 | ||
| 256 | :- use_module(tools,[host_platform/1]). | |
| 257 | is_a_file_path(Codes) :- member(47,Codes). | |
| 258 | is_a_file_path(Codes) :- host_platform(windows), member(92,Codes). % windows | |
| 259 | ||
| 260 | prepare_attribute('='(Tag,Atom),'='(Tag,Codes)) :- convert_to_codes(Atom,Codes). | |
| 261 | prepare_attribute('/'(Tag,Atom),'='(Tag,Codes)) :- convert_to_codes(Atom,Codes). | |
| 262 | ||
| 263 | :- use_module(library(codesio),[write_to_codes/2]). | |
| 264 | convert_to_codes(V,Codes) :- var(V),!,Codes="_". | |
| 265 | convert_to_codes([H|T],Codes) :- number(H),!, Codes=[H|T]. | |
| 266 | convert_to_codes(N,Codes) :- number(N),!, number_codes(N,Codes). | |
| 267 | convert_to_codes(A,Codes) :- atom(A),!,atom_codes(A,Codes). | |
| 268 | convert_to_codes(A,Codes) :- write_to_codes(A,Codes). | |
| 269 | ||
| 270 | :- dynamic open_xml_group/2, nesting_level/1. | |
| 271 | nesting_level(0). | |
| 272 | update_nesting_level(X) :- retract(nesting_level(Y)), | |
| 273 | New is Y+X, assert(nesting_level(New)). | |
| 274 | ||
| 275 | space(32). | |
| 276 | indent_log(WS) :- nesting_level(Lvl), length(WS,Lvl), | |
| 277 | maplist(space,WS). | |
| 278 | ||
| 279 | check_and_generate_group_stats(Group,Stats) :- open_xml_group(A,_),!, | |
| 280 | (A=Group | |
| 281 | -> retract(open_xml_group(Group,WTimeStart)), | |
| 282 | (Stats=no_statistics -> true | |
| 283 | ; statistics(walltime,[WTimeEnd,_]), | |
| 284 | Delta is WTimeEnd - WTimeStart, | |
| 285 | statistics(memory_used,M), | |
| 286 | write_xml_element_to_log(statistics,[walltime/Delta,walltime_since_start/WTimeEnd,memory_used/M]) | |
| 287 | ), | |
| 288 | update_nesting_level(-1) | |
| 289 | ; add_internal_error('XML closing tag mismatch: ', Group/A)). | |
| 290 | check_and_generate_group_stats(Group,_) :- | |
| 291 | add_internal_error('XML closing tag error, no tag open: ', Group). | |
| 292 | ||
| 293 | start_xml_group_in_log(Group) :- logging_mode(xml),!, | |
| 294 | statistics(walltime,[WTime,_]), | |
| 295 | indent_log(WS), | |
| 296 | asserta(open_xml_group(Group,WTime)), | |
| 297 | update_nesting_level(1), | |
| 298 | format_log("~s<~w>~n",[WS,Group]). | |
| 299 | start_xml_group_in_log(_). | |
| 300 | ||
| 301 | % we currently only support a single attribute and value | |
| 302 | start_xml_group_in_log(Group,Attr,Value) :- logging_mode(xml),!, | |
| 303 | statistics(walltime,[WTime,_]), | |
| 304 | indent_log(WS), | |
| 305 | asserta(open_xml_group(Group,WTime)), | |
| 306 | update_nesting_level(1), | |
| 307 | convert_to_codes(Value,ValueC), | |
| 308 | xml_encode_text(ValueC,EValueC), | |
| 309 | format_log("~s<~w ~w=\"~s\">~n",[WS,Group,Attr,EValueC]). | |
| 310 | start_xml_group_in_log(_,_,_). | |
| 311 | ||
| 312 | stop_xml_group_in_log(Group,Stats) :- logging_mode(xml),!, | |
| 313 | check_and_generate_group_stats(Group,Stats), | |
| 314 | indent_log(WS), | |
| 315 | format_log("~s</~w>~n",[WS,Group]). | |
| 316 | stop_xml_group_in_log(_,_). | |
| 317 | ||
| 318 | ||
| 319 | stop_xml_group_in_log(Group) :- stop_xml_group_in_log(Group,statistics). | |
| 320 | stop_xml_group_in_log_no_statistics(Group) :- stop_xml_group_in_log(Group,no_statistics). | |
| 321 | ||
| 322 | % call if you need to prematurely exit probcli | |
| 323 | close_all_xml_groups_in_log :- open_xml_group(Group,_), !, | |
| 324 | stop_xml_group_in_log(Group), | |
| 325 | close_all_xml_groups_in_log. | |
| 326 | close_all_xml_groups_in_log. | |
| 327 | ||
| 328 | ||
| 329 | ||
| 330 | ||
| 331 | /* | |
| 332 | <?xml version="1.0" encoding="ASCII"?> | |
| 333 | ||
| 334 | | ?- xml_parse("<PT ID=\"2\" stID=\"3\"/>",R). | |
| 335 | R = xml([],[element('PT',['ID'=[50],stID=[51]],[])]) ? | |
| 336 | ||
| 337 | <PointsTelegram elementID="W90" stationID="FR" interlockingID="FR" interlockingElementID="W90"/> | |
| 338 | ||
| 339 | ||
| 340 | */ | |
| 341 |