1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * Author: G�nter Kniesel, Frank M�hlschlegel (among others)
    5 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    6 * Mail: pdt@lists.iai.uni-bonn.de
    7 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    8 * 
    9 * All rights reserved. This program is  made available under the terms
   10 * of the Eclipse Public License v1.0 which accompanies this distribution,
   11 * and is available at http://www.eclipse.org/legal/epl-v10.html
   12 * 
   13 ****************************************************************************/
   14
   15% Date: 13.02.2006, 04.02.2009
   16
   17% TODO: Move all logging primitives here.
   18
   19:- module(logging, [
   20	ctc_warning/2,
   21	ctc_error/2,
   22	log_on_stdout/1,
   23	log_on_stdout/2,
   24	do_if_logging_enabled/1
   25]).   26   
   27:- use_module(library(lists)).   28:- use_module(files).   29
   30consult_silent_if_logging_disabled(FileOrFiles) :-
   31    (  not(loggingEnabled) 
   32    -> consult_silent(FileOrFiles)          % load without printing a  message.
   33    ;  consult(FileOrFiles)                 % report filename, size, etc.
   34    ).
   35    
   36consult_silent(FileOrFiles) :-              % used for loading test data.
   37    load_files(FileOrFiles, [silent(true)]).
   38  
   39/*
   40 * Execute Goal and redirect all output to a file. For enforcing 
   41 * logging during execution of Goal wrap calls to this predicate   
   42 * as "do_with_logging_enabled(log_once_to_file(File,Goal))".
   43 */
   44log_once_to_file(File,Goal) :- 
   45   with_output_to_file( File, do_with_logging_enabled(Goal) ).
   46
   47/* ======================================================================== 
   48 * Control of logging
   49 * ======================================================================== */
   50:- dynamic loggingEnabled/0.   51
   52:- if(pdt_support:pdt_support(last_call_optimisation)).   53enable_logging :- 
   54   retractall(loggingEnabled),                    % prevent accidental backtracking(!)
   55   set_prolog_flag(last_call_optimisation,false), % important for retrieval of parentmodule
   56   assertz(loggingEnabled).
   57
   58disable_logging :- 
   59   set_prolog_flag(last_call_optimisation,true),
   60   retractall(loggingEnabled).
   61:- else.   62enable_logging :- 
   63   retractall(loggingEnabled),      % prevent accidental backtracking(!)
   64   assert(loggingEnabled).
   65
   66disable_logging :- 
   67   retractall(loggingEnabled).
   68   
   69:- endif.   
   70:- enable_logging.                  % default: logging
   71
   72/*
   73 * Only call a goal (that produces console output) if logging is enabled.
   74 * Indended for use with 'listing' and friends.
   75 */
   76 
   77:- meta_predicate( do_if_logging_enabled(0) ).   78 
   79do_if_logging_enabled(Goal) :-
   80   (
   81   	(clause(loggingEnabled,_),check_logging_module)
   82   		-> call(Goal) ; true 
   83   ). 
   84    
   85/*
   86 * Do with logging ENABLED and reset logging status afterwards.
   87 */
   88verbose(Goal) :- 
   89   do_with_logging_enabled(Goal).
   90   
   91do_with_logging_enabled(Goal) :-
   92   ( loggingEnabled 
   93      -> (               enable_ignore_logging_in_module, call(Goal),                  disable_ignore_logging_in_module) 
   94       ; (enable_logging,enable_ignore_logging_in_module, call(Goal), disable_logging, disable_ignore_logging_in_module)
   95   ).
   96
   97/*
   98 * Do with logging DISABLED and reset logging status afterwards.
   99 */
  100silent(Goal) :- 
  101   do_with_logging_disabled(Goal).
  102   
  103do_with_logging_disabled(Goal) :-
  104   ( loggingEnabled 
  105      -> (disable_logging, call(Goal), enable_logging)
  106       ; call(Goal) 
  107   ).
  108
  109
  110/* ======================================================================== 
  111 * Control of module
  112 * ======================================================================== */
  113/*
  114 *  Disables / Enables logging for an specific module
  115 */
  116:- dynamic mod_is_disabled/1.  117:- dynamic mod_is_enabled/1. 
  118 
  119disable_logging_in_module(Module):- 
  120	current_module(Module),
  121	retractall(mod_is_enabled(Module)),
  122	assertz(mod_is_disabled(Module)).
  123
  124is_logging_in_module_disabled(Module):-
  125    current_module(Module),
  126    not(mod_is_enabled(Module)),
  127    mod_is_disabled(Module).
  128
  129enable_logging_in_module(Module):-
  130	current_module(Module),
  131	assertz(mod_is_enabled(Module)),
  132	retractall(mod_is_disabled(Module)).
  133
  134:- dynamic(mod_ignore_is_enabled/0).  135
  136enable_ignore_logging_in_module:-
  137    retractall(mod_ignore_is_enabled),
  138    assertz(mod_ignore_is_enabled).
  139    
  140disable_ignore_logging_in_module:-
  141    retractall(mod_ignore_is_enabled).
  142
  143is_ignore_logging_in_module:-
  144	clause(mod_ignore_is_enabled,_).    
  145	
  146/*
  147 *  Enables logging for all  modules
  148 */
  149reset_logging_all_modules:-
  150	retractall(mod_is_enabled(Module)),
  151	retractall(mod_is_disabled(Module)).
  152
  153:- dynamic(showContextModules_enabled/0).  154/*
  155 *  Disables / Enables the out of the hierachie of the contextmodule 
  156 */
  157disable_showLoggingContextModules:-retractall(showContextModules_enabled).
  158enable_showLoggingContextModules:-
  159	assertz(showContextModules_enabled),
  160	format('WARNING: === ShowContextModules enabled =========================~n'),
  161    format('WARNING: This function will double your output and will slow down your console~n'),
  162    format('WARNING: ==============================================~n').
  163	
  164
  165/*
  166 *  check if the call-context-module is disabled 
  167 */
  168check_logging_module:-
  169    getContextModules(ContextModules),
  170    member_logging_enabled(ContextModules).
  171%    forall(
  172%    	member(Module,ContextModules),
  173%    	not(clause(mod_is_disabled(Module),true))
  174%    ).
  175
  176member_logging_enabled([]) :-
  177    loggingEnabled.
  178member_logging_enabled([Module|T]) :-
  179   ( mod_is_disabled(Module) 
  180     -> fail 
  181     ; ( mod_is_enabled(Module) -> true ; member_logging_enabled(T) )
  182   ).
  183   
  184/*
  185 *  Rekusive predicate to get the list of context-modules 
  186 */
  187getContextModules(ParentModules):-   
  188    prolog_current_frame(Self),
  189    getParentContextModule(Self, ParentModules).
  190     	
  191getParentContextModule(Frame, ParentModules):-   
  192    prolog_frame_attribute(Frame,parent,Parent),
  193    prolog_frame_attribute(Parent,context_module,Module),    
  194    (  prolog_frame_attribute(Parent,top,false)
  195     -> ( getParentContextModule(Parent, ParentParentModules),    
  196          ( not(member(Module,ParentParentModules))
  197      		-> (append([Module],ParentParentModules,ParentModules))
  198      		 ;
  199      		ParentModules=ParentParentModules
  200      	  )
  201        )     
  202     ;
  203       ParentModules = [Module]
  204    ).   
  205showContextModules:-
  206    clause(showContextModules_enabled,true)->
  207    (
  208    	getContextModules(Modules),
  209    	format('INFO: context-modules are ~w~n',[Modules]))
  210    	;
  211    true. 
  212     
  213/* ======================================================================== 
  214 * Controlled logging
  215 * ======================================================================== */
  216
  217/*
  218 * Printing of errors and warnings and logging of assert operations.
  219 */   
  220ctc_error(Formatterm,Atomlist) :-
  221    atom_concat('~n *** ERROR: ',Formatterm,Formatterm2),
  222    atom_concat(Formatterm2,'~n',NewFormatterm),
  223    write_on_stdout(NewFormatterm,Atomlist).
  224 
  225ctc_warning(Formatterm,Atomlist) :-
  226    atom_concat('~n *** WARNING: ',Formatterm,Formatterm2),
  227    atom_concat(Formatterm2,'~n',NewFormatterm),
  228    log_on_stdout(NewFormatterm,Atomlist).
  229
  230 
  231ctc_info(Formatterm,Atomlist) :-
  232    atom_concat('~n *** INFO: ',Formatterm,Formatterm2),
  233    atom_concat(Formatterm2,'~n',NewFormatterm),
  234    log_on_stdout(NewFormatterm,Atomlist).
  235
  236assert_logging(Fact) :-
  237    log_on_stdout(' --- Asserting: ~k.~n', Fact ),
  238    assertz(Fact).
  239
  240
  241/*
  242 * Basic output predicates including conditional logging to stdout 
  243 * and to any stream. 
  244 */               
  245
  246write_on_stdout(Formatterm) :-
  247    write_on_stdout(Formatterm,[]).
  248    
  249write_on_stdout(Formatterm,Atomlist) :-
  250    current_output(Stream),
  251    format(Stream,Formatterm,Atomlist). 
  252
  253log_on_stdout(Formatterm) :-
  254    log_on_stdout(Formatterm,[]).
  255         
  256log_on_stdout(Formatterm,Atomlist) :-
  257    current_output(Stream),
  258    log(Stream,Formatterm,Atomlist).    
  259
  260log(Stream,Formatterm,Atomlist) :-
  261    (loggingEnabled,(check_logging_module;is_ignore_logging_in_module)) 
  262      -> (showContextModules,format(Stream,Formatterm,Atomlist))
  263       ; true.  
  264    
  265     
  266
  267% Unneeded generality for condor.pl:
  268%
  269%switchOffLoggingIfDesired(_uniqueNr,_what) :-  % Don't ask if < 100 results.
  270%      _uniqueNr <100,
  271%      !.
  272%switchOffLoggingIfDesired(_uniqueNr,_what) :-  % Ask whether to disable logging.
  273%      loggingEnabled,
  274%      !,
  275%      log(_stream,'~n --- Printing ~a different ~a might take a while... ', 
  276%          [_uniqueNr, _what]),
  277%      log('Skip logging for the rest of this analysis? [yes. / no.]:~n', 
  278%          []),
  279%      read(Answer),
  280%      ( ( Answer='yes') -> 
  281%         (log(_stream, 'Logging disabled...~n', []), disable_logging)
  282%        ; true ).
  283%switchOffLoggingIfDesired(_uniqueNr,_what) .  % Go on logging if in batch mode.
  284%