1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3%  FILE   : lib/tools_swi.pl
    4%
    5%	Library of tools for SWI Prolog (sockets, strings, OS tools, others)
    6%
    7%  AUTHOR : Sebastian Sardina (2003)
    8%  EMAIL  : ssardina@cs.toronto.edu
    9%  WWW    : www.cs.toronto.edu/~ssardina
   10%  TYPE   : system dependent code
   11%  TESTED : SWI Prolog 5.0.4 on Linux 7.1-8.0
   12%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   13:- module(tools_swi,[
   14           % STRINGS
   15           string_to_term/2,
   16           string_to_number/2,
   17           replace_char_string/4,
   18           % OS TOOLS
   19           thread_kill/1,
   20           thread_wait/2,
   21           call_to_exec/3,           
   22           proc_kill/1,
   23           proc_wait/2,
   24    	   file_exists/1,
   25%           register_stream_sigio/2,
   26%           unregister_stream_sigio/1,
   27           % OTHER TOOLS
   28           turn_on_gc/0,
   29           turn_off_gc/0,
   30           set_backquoted_string/0,
   31           reset_backquoted_string/0,
   32	       catch_fail/2,
   33    	   catch_succ/2,
   34           %
   35	   % FROM 'common.pl' file
   36	   subv/4,
   37	   sublist/2,
   38	   extract_substring/6,
   39	   get_integer/3,
   40	   extract_option/4,
   41	   extract_option/3,
   42       any_to_number/2,
   43       any_to_string/2,
   44	   lany_to_string/2,
   45 	   emptyString/1,
   46	   build_string/2,
   47	   string_replace/4,
   48	   join_atom/3,
   49	   split_atom/4,
   50	   proc_term/1,            % Check if process is terminated
   51	   proc_exists/1,          % Check if process exists
   52	   send_data_socket/2,
   53	   receive_list_data_socket/2,
   54	   receive_data_socket/2,
   55	   report_message/2,
   56           get_argument/2,
   57	   get_list_arguments/1,
   58           set_debug_level/1
   59          ]). % +SocketId
   60
   61:- style_check(-discontiguous).     % Clauses may be not together
   62:- set_prolog_flag(backquoted_string, true).   63
   64:- use_module(library(socket)).		% Load socket library
   65:- use_module(eclipse_swi).         % Load compatibility library with ECLIPSE
   66:- init_eclipse_lib.   67
   68% Common tools for any Prolog
   69:- include(common).   70
   71%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   72%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   73% 2 - STRINGS
   74%
   75% -- string_to_term(?String, ?Term)
   76% -- string_to_number(?String, ?Term)
   77% -- replace_char_string(+String, +E1, +E2, -String2) 
   78%       String2 is string String with all chars E1 replaced by E2
   79%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   80%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   81
   82% string_to_term/2 
   83string_to_term(S, T):- var(T), !,    % S ---> T
   84                       string_to_atom(S, A), term_to_atom(T, A). 
   85string_to_term(S, T):- \+ var(T),    % T ---> S
   86                       term_to_atom(T, A), string_to_atom(S, A).
   87
   88% string_to_number/2 
   89string_to_number(S, N):- ground(N),
   90                         number_chars(N, L), string_to_list(S, L).
   91string_to_number(S, N):- ground(S),
   92                         string_to_atom(S, A), 
   93                         atom_codes(A, CA), 
   94                         number_codes(N, CA).
   95
   96% replace_char_string/4
   97replace_char_string(S, E1, E2, S2) :- 
   98        atom_codes(E1,[CE1]),
   99        atom_codes(E2,[CE2]),
  100        string_to_list(S,SL),
  101        replace_element_list(SL,CE1,CE2,SL2),
  102        string_to_list(S2,SL2).
  103
  104
  105%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  106%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  107% 3 - OPERATING SYSTEM TOOLS
  108%
  109%
  110% -- call_to_exec(+System, +Command, -Command2)
  111%      Command2 executes Command in plataform System
  112% -- thread_kill(+ThreadId)
  113% -- thread_wait(+ThreadId, -Status)
  114% -- proc_kill(+Pid)
  115% -- proc_wait(+Pid, -Status)
  116% -- file_exists(+File)
  117%      Succeeds if File exists
  118%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  119%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  120
  121% call_to_exec/3
  122call_to_exec(unix, Command, sh('-c',Command2)) :-
  123	string_concat(Command,' ; exit',Command2).
  124
  125% Killing a thread means signal it with an "abort" event
  126thread_kill(ThreadId) :- thread_signal(ThreadId, throw(abort)),
  127                         wait(ThreadId, _).
  128thread_wait(ThreadId, Status) :- 
  129        current_thread(ThreadId, _) -> thread_join(ThreadId, Status) ; true.
  130
  131proc_kill(Pid)    :- kill(Pid, 9).
  132proc_wait(Pid, S) :- repeat, wait(Pid, S).
  133file_exists(File) :- exists_file(File).
  134
  135
  136%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  137%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  138% 4 - OTHER TOOLS
  139%
  140% -- turn_on_gc/0
  141% -- turn_off_gc/0
  142%       Turn on/off garbage collection
  143% -- set_backquoted_string/0
  144%       Set the backquoted_string flag to true (transparent predicate)
  145% -- catch_succ(+Call,+Message)
  146% -- catch_fail(+Call,+Message)
  147%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  148%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  149
  150% Turn on/off the automatic garbage collector
  151turn_on_gc  :- set_prolog_flag(gc, true).
  152turn_off_gc :- set_prolog_flag(gc, false).
  153
  154% Set string construct to be ` to the calling module
  155:- module_transparent set_backquoted_string/0.  156set_backquoted_string :- set_prolog_flag(backquoted_string, true). 
  157:- module_transparent reset_backquoted_string/0.  158reset_backquoted_string :- set_prolog_flag(backquoted_string, false). 
  159
  160
  161
  162% Perform a call catching it if there is an exception
  163% If so, print message and then either fail or succeed
  164catch_fail(Call, Message) :-
  165	catch(Call,E,
  166		(report_message(warning,[Message, ' ---> ', E]),
  167	     fail)
  168	    ).
  169catch_succ(Call, Message) :-
  170	catch(Call,E,
  171		(report_message(warning,[Message, ' ---> ', E]),
  172	     true)
  173	    ).
  174
  175
  176
  177
  178
  179
  180%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  181% EOF: lib/tools_swi.pl
  182%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%