/* Copyright (C) 1990 Swedish Institute of Computer Science */

/*

	Modified to use the Aberdeen socket library
	for SICStus, SWI & ECLiPSe.

	31-Jan-2002	1)	I have dropped Quintus as it is
				no longer supported in our dept.
			2)	I also dropped "fast mode" as it is rarely used.

	KH
*/

:- module(linda_client,[	linda_client/1,
				linda_client/2,
				close_client/0,
				in/1,
				in/2,
				in_noblock/1,
				in_noblock/2,
				out/1,
				rd/1,
				rd/2,
				rd_noblock/1,
				rd_noblock/2,
			        bagof_rd_noblock/3,
				linda_timeout/2
			   ]).

:- ['../util/prolog_detect'].
:- ['../util/newline'].

:- prolog_detect:prolog(Prolog),
	(	(Prolog=sicstus,
		!,
		write('***setting up for SICStus...'),
		nl,
		prolog_flag(redefine_warnings,_,off),		%turn off redefine warning
		prolog_flag(character_escapes,_,on),		% allow '\n' notation
		use_module(library(lists))
		);
		(Prolog=pfdm,
		!,
		write('***setting up for P/FDM (SICStus 3.7.1)...'),
		nl,
		prolog_flag(redefine_warnings,_,off),		%turn off redefine warning
		prolog_flag(character_escapes,_,on),		% allow '\n' notation
		use_module(library(lists))
		);
		%
		% modified for ECLiPSe 5.0
		%
		(Prolog=eclipse,
		!,
		write('***setting up for ECLiPSe...'),
		nl,
%		use_module(library(sicstus))
		use_module(library(iso))		%ISO compability for ECLiPSe 5
		);
		(Prolog=swi,
		!,
		write('***setting up for SWI-Prolog...'),
		nl
		);
		(write('***UNSUPPORTED PROLOG SYSTEM***'),
		nl,
		fail
		)
	).


:- ['../socket_lib/a_sockets'].	%use Aberdeen's socket lib
:- ['../util/get_character'].	%load the get_character module

:- dynamic linda_stream/4.	%holding active stream to Linda server
:- dynamic time_out/1.		%storing timeout value
:- assert(time_out(20:0)).	%default timeout value


%
% supported protocol
% Note that "fast mode" is abandoned.
%
linda_protocol(0'p).


%
% connect client to Linda server
%
linda_client(Host,Port) :-
	linda_client(Host:Port).

linda_client(Address) :-
	linda_stream(Address,_,_,_),
	!.

linda_client(Address) :-
	linda_stream(_,_,_,_),
	!,
	write('ERROR: linda_client/1: already client to '),
	write(Address),
	nl,
	fail.

linda_client(Address) :-
	open_client(Address,Socket,R,W),
	assertz(linda_stream(Address,Socket,R,W)),
	ping(Answer),
	ping_answer_ok(Answer).


%
% check if ping is ok
%
ping_answer_ok(pong) :- !.

ping_answer_ok(A) :-
	write('ERROR: linda_client/1: strange answer from server: '),
	write(A),
	nl.



%
% open connection to Linda server
%
open_client(Host:Port,Socket,R,W) :-
	atom(Host),
	integer(Port),
	!,
	a_sockets:a_socket_create('AF_INET',Socket),			%create socket
	a_sockets:a_socket_connect(Socket,'AF_INET'(Host,Port),R,W).	%connect to remote

%
% fail to connect
%
open_client(Addr,_,_) :-
	write('ERROR: open_client/3: Illegal network address: '),
	write(Addr),
	nl,
	fail.


%-----------------------------------------------------------------------------
close_client :-
%	set_input(user_input),
%	set_output(user_output),
	retract(linda_stream(_,Socket,_,_)),
	a_sockets:a_socket_destroy(Socket).					%close socket


ping(Answer) :-	
	to_linda(0'p, ping),
	time_out_select,
	from_linda(Answer).

out(T) :-
	to_linda(0'o, T).

%
% "in" that waits forever
%
in(T) :-
	repeat,			%loop when backtrack
        to_linda(0'i, T),
	from_linda(T).

%
% "in" with a list of templates
%
in(Tuples,Tuple) :-
	Tuples = [_|_],
	repeat,			%loop when backtrack
        to_linda(0'I, Tuples),
	from_linda(Tuple),
	member(Tuple,Tuples).  % for unification of Tuples with answer


%
% "in" without blocking
%
in_noblock(T) :-
	to_linda(0'j, T),
	time_out_select,
	from_linda(0's, T).


%
% in_noblock w/ timeout
%
in_noblock(T,Timeout) :-
	to_linda(0'i, T),		%like an "in"
	time_out_select(Timeout),	%but something must return within "timeout"
	!,
	from_linda(T).			%successfully get result within timeout

in_noblock(_,_) :-
	linda_stream(Address,_,_,_),	%if no result is got within timeout
	close_client,			%destroy this client
	linda_client(Address),		%and create a new one
	!,
	fail.				%make it fail

%
% "rd" without blocking
%
rd_noblock(T) :-
	to_linda(0's, T),
	time_out_select,
	from_linda(0's, T).


%
% rd_noblock/2 w/ timeout
%

rd_noblock(T,Timeout) :-
	to_linda(0'r, T),		%still a "rd"
	time_out_select(Timeout),	%but something must return within timeout
	!,
	from_linda(T).

rd_noblock(_,_) :-
	linda_stream(Address,_,_,_),	%if no result is got within timeout
	close_client,			%close this client
	linda_client(Address),		%create a new one
	!,
	fail.				%force it to fail


rd(T) :-
	to_linda(0'r, T),
	from_linda(T).

rd(Tuples,Tuple) :-
	Tuples = [_|_],
        to_linda(0'R, Tuples),
	from_linda(Tuple), !,
	member(Tuple,Tuples).  % for unification of Tuples with answer

bagof_rd_noblock(Template,Tuple,Bag) :- 
	to_linda(0'b, b(Template,Tuple,Bag)),
	time_out_select,
	from_linda(Bag).

linda_trace(OnOff) :-
	(var(OnOff) ; OnOff=on ; OnOff=off), !,
	to_linda(0't, OnOff),
	time_out_select,
	from_linda(OnOff).

linda_call(Goal) :-
	to_linda(0'c, Goal),
	from_linda(0's, Goal).

%-----------------------------------------------------------------------------

to_linda(Code) :-
	linda_stream(_,_,_,W),				%get the streams
	linda_protocol(P),				%get protocol to use
	write_out(W,P,Code),				%output data
	flush_output(W),				%flush output
	!.


to_linda(Code,Item) :-
	linda_stream(_,_,_,W),				%get the streams
	linda_protocol(P),				%get protocol to use
	write_out(W,P,Code,Item),			%output data
	flush_output(W),				%flush output
	!.


%-----------------------------------------------------------------------------
write_out(W,Protocol,Code) :- 
	member(Protocol,[0'p,0'f]),
	put(W,Code).

write_out(W,0'p,Code,Item) :- 
	put(W,0'p),
	put(W,Code), 
	write_canonical(W,Item),
	write(W,'.'),
	newline:newline(W).		%output newline according to Prolog platform

write_out(_,0'f,_Code,_Item) :-
	write('***fast read/write is NOT supported in ECLiPSe'),
	fail.
%	put(W,0'f), 
%	put(W,Code), 
%	fast_write(Item).

read_in(R,0'p,Item) :-
	read(R,Item).
read_in(_,0'f,_Item) :-
	write('***fast read/write is NOT supported in ECLiPSe'),
	nl,
	fail.
%	nl,fast_read(R,Item).

%-----------------------------------------------------------------------------

%
% read item from Linda
%

from_linda(Item) :-
	linda_stream(_,_,R,_),
	linda_protocol(P),				%get protocol to use
	read_in(R,P,Item),				%read data item
	!.

from_linda(Code,Item) :-
	linda_stream(_,_,R,_),
	get_character:get_character(R,Cl),
	(	(Cl=Code,
		linda_protocol(P),
		read_in(R,P,Item)
		);
		fail
	),
	!.


%-----------------------------------------------------------------------------

%
% see if active connection is ready within timeout value
%

time_out_select :-
	time_out(TimeOut),
	time_out_select1(TimeOut).

time_out_select(Timeout) :-
	time_out_select1(Timeout).

time_out_select1(off) :- !.

time_out_select1(TimeOut) :-
	TimeOut = Sec:Usec,
	linda_stream(_,_Socket,R,_),					%get current active connection
	a_sockets:a_socket_select([],[R],time(Sec,Usec),[_|_]),	%list of ready connection is non empty
%	a_sockets:a_socket_select([Socket],[],[],time(Sec,Usec),[Socket],_,_),	%old version using socket_socket/7
	!.
/*
time_out_select1(_:_) :-
	format(user_error,'{ERROR: wait for linda timed out}~n',[]),
	fail.
*/

%-----------------------------------------------------------------------------

linda_timeout(Old, New) :-
	linda_timeout_arg(Old, New),
	time_out(Old),
	retract(time_out(Old)),
	assert(time_out(New)).

linda_timeout_arg(O, N) :- var(N), !, O==N.
linda_timeout_arg(_, S:M) :- integer(S), integer(M), S>=0, M>=0, !.
linda_timeout_arg(_, off).

