%
% AKT-Bus service library
%
:- module(absl,[%
		% message composition
		%
		compose_message/4,		%compose a message
		compose_message/5,		%compose a message, w/ extra name spaces to specify
		decompose_message/8,		%decompose a message
		%
		% message decomposition
		%
		get_receiver_uri/2,		%get receiver's URI from message
		parse_url/2,			%parse a URL into the 3 components
		string_to_xml/2,		%convert between a string & XML tree
		get_env/4,			%get the attribs & value of a environment
%		get_env_attrib_value/3,		%get the attribs & value of a specific environment
		%
		% message sending & receiving
		%
		create_aktbus_receiver/2,	%create an AKT Bus message receiver
		destroy_aktbus_receiver/1,	%destroy receiver
		close_connection/1,		%close a connection

		send_message/1,			%send to default receiver in message
		send_message/3,			%send to somewhere w/ timeout
		send_and_receive/4,		%send to somewhere w/ timeout, and receive a piggy-packed reply

		receive_message/2,		%receive from a receiver w/ timeout
		receive_message/3,		%receive from a receiver, keep connection
		%
		% misc
		%
		print_string/1,			%print a string to stdout
		print_string/2			%print a string to a stream
		]
		).
:- ['../../../kraft/prolog/util/prolog_detect'].		%load the Prolog-detecting module
:- ['../../../kraft/prolog/pillow/pillow'].			%use Pillow's HTTP/XML stuff
:- ['../../../kraft/prolog/socket_lib/a_sockets'].		%use Aberdeen's socket lib
:- ['../../../kraft/prolog/util/flatten'].			%use the flatten module
:- ['../../../kraft/prolog/util/datetime'].			%use the datetime module
:- ['../../../kraft/prolog/util/concat_atoms'].
:- prolog_detect:prolog(Prolog),
	(	(	Prolog=sicstus,			%SICStus & PFDM (SICStus Version 3.7.x)
			use_module(library(lists))	%need to load the lists module
		);
		(	Prolog=pfdm,
			use_module(library(lists))
		);
		true					%SWI & ECLiPSe are fine
	).

%
% known URLs
%
url(rdf,'http://www.w3.org/1999/02/22-rdf-syntax-ns').
url(rdfs,'http://www.w3.org/2000/01/rdf-schema').
url(aktbus_rdfs,'http://www.csd.abdn.ac.uk/~khui/akt/aktbus.xml').

%
% Name space specifications.
% 1st argument = name.
% 2nd argument = object's whose URL will be used, refering to url/2.
%
name_space(rdf,rdf).
name_space(rdfs,rdfs).
name_space(aktbus,aktbus_rdfs).


crlf([13,10]).				%the CR-LF string according to HTTP



%====================
% message composition
%====================

%
% compose_message(+Sender,+Receiver,+Content,-Message)
%
% Sender	=	sender's URI (currently HTTP only)
%			if sender URI is "[]", then no sender URI will be put in
% Receiver	=	receiver's URI
%			if receiver URI is "[]", then no receiver URI will be put in
% Content	=	content to be put into message
% Message	=	the composed message
%
% Compose a message, system will fill in date & time stamps.
% If "Content" is not a term structure, a simple message is assumed.
%
compose_message(Sender,Receiver,Content,Message) :-
	compose_message(Sender,Receiver,_,_,Content,[],Message).

%
% compose_message(+Sender,+Receiver,+Content,+Name_spaces,-Message)
%
% Sender	=	sender's URI (currently HTTP only)
% Receiver	=	receiver's URi
% Content	=	content to be put into message
% Name_spaces	=	extra name space specifications in a list
% Message	=	the composed message
%
% Compose a message, system will fill in date & time stamps.
% If "Content" is not a term structure, a simple message is assumed.
%
compose_message(Sender,Receiver,Content,Name_spaces,Message) :-
	compose_message(Sender,Receiver,_,_,Content,Name_spaces,Message).

%
% compose a message, providing date & time stamps
%
% compose_message(+Sender,+Receiver,?Date,?Time,+Content,+Name_spaces,-Message)
%
% Sender	=	sender's URI (currently HTTP only)
% Receiver	=	receiver's URi
% Date		=	date (if instantiated) in date/3 format
% Time		=	time (if instantiated) in time/3 format
% Content	=	content to be put into message
% Extra		=	extra name space specifications in a list
% Message	=	the composed message
%
compose_message(Sender,Receiver,Date,Time,Content,Extra,Message) :-
	%
	% header & body
	%
	Message=[Xml_header,Xml_body],					%the message
	Xml_header=xmldecl([version='1.0']),    			%XML version in header
	Xml_body=env('rdf:RDF',Name_spaces,[X_container]),		%the body in RDF
	%
	% name space
	%
	Goal=(	name_space(Name,Object),
		url(Object,Url),
		concat_atoms:add_prefix('xmlns:',Name,Attrib_name),
		concat_atoms:add_prefix(Url,'#',Attrib_value)
		),
	findall(Attrib_name=Attrib_value,call(Goal),Default_name_spaces),
	append(Default_name_spaces,Extra,Name_spaces),
	%
	% time stamp
	%
	make_date_time_string(Date,Time,Date_string,Time_string),	%fill in date & time

%	name(Receiver,Receiver_string),

	name(Date_atom,Date_string),
	name(Time_atom,Time_string),
	X_has_date=env('aktbus:hasDateString',[],[Date_atom]),			%aktbus:hasDateString
	X_has_time=env('aktbus:hasTimeString',[],[Time_atom]),			%aktbus:hasTimeString
	%
	% sender & receiver
	%
	sender_receiver_to_atom_string(Sender,Sender_atom,Sender_string),
	sender_receiver_to_atom_string(Receiver,Receiver_atom,_),
	(	(	Sender_atom=null,			%no sender
			X_header_temp=[X_has_date,X_has_time]
		);
		(	X_has_sender_uri=env('aktbus:hasSenderURI',[],[Sender_atom]),		%aktbus:hasSenderURI
			X_header_temp=[X_has_sender_uri,X_has_date,X_has_time]
		)
	),
	!,
	(	(	Receiver_atom=null,			%no receiver
			X_header_temp2=X_header_temp
		);
		(	X_has_receiver_uri=env('aktbus:hasReceiverURI',[],[Receiver_atom]),	%aktbus:hasReceiverURI
			X_header_temp2=[X_has_receiver_uri|X_header_temp]
		)
	),
	!,
	X_simple_header=env('aktbus:SimpleHeader',[],[X_has_sender_uri|X_header_temp2]),	%aktbus:SimpleHeader

	X_container=env('aktbus:Container',Msg_id_attrib,[X_has_header,X_has_content]),			%aktbus:Container
	flatten([Sender_string,"/",Date_string,"/",Time_string,"/prolog-something"],Msg_id_string),	%compose message id
	name(Msg_id,Msg_id_string),
	Msg_id_attrib=['aktbus:id'=Msg_id],
	X_has_header=env('aktbus:hasHeader',[],[X_simple_header]),		%aktbus:hasHeader

%	X_simple_header=env('aktbus:SimpleHeader',[],[X_has_sender_uri,X_has_receiver_uri,X_has_date,X_has_time]),	%aktbus:SimpleHeader

%	X_has_sender_uri=env('aktbus:hasSenderURI',[],[Sender]),		%aktbus:hasSenderURI
%	X_has_receiver_uri=env('aktbus:hasReceiverURI',[],[Receiver]),		%aktbus:hasReceiverURI
%	name(Date_atom,Date_string),
%	name(Time_atom,Time_string),
%	X_has_date=env('aktbus:hasDateString',[],[Date_atom]),			%aktbus:hasDateString
%	X_has_time=env('aktbus:hasTimeString',[],[Time_atom]),			%aktbus:hasTimeString
	X_has_content=env('aktbus:hasContent',[],[X_content]),			%aktbus:hasContent
	compose_content_tree(Content,X_content).



%
% convert sender/receiver to atom & string
%
sender_receiver_to_atom_string(null,null,[]).

sender_receiver_to_atom_string([],null,[]).

sender_receiver_to_atom_string(Someone,Someone,Someone_string) :-
	atom(Someone),
	name(Someone,Someone_string).

sender_receiver_to_atom_string(Someone,Someone_atom,Someone) :-
	Someone=[_|_],
	name(Someone_atom,Someone).
/*

compose_sender(null,null,[],[]) :-
	!.

compose_sender([],null,[],[]) :-
	!.

compose_sender(Sender,Sender,Sender_string,X_has_sender) :-
	atom(Sender),
	name(Sender,Sender_string),
	X_has_sender=env('aktbus:hasSenderURI',[],[Sender]).

compose_sender(Sender_string,Sender,Sender_string,X_has_sender) :-
	Sender_string=[_|_],
	name(Sender,Sender_string),
	X_has_sender=env('aktbus:hasSenderURI',[],[Sender]).

%
% compose receiver
%
compose_receiver(null,null,[],[]) :-
	!.

compose_receiver([],[]) :-
	!.

compose_receiver(Receiver,X_has_receiver) :-
	atom(Receiver),
	X_has_receiver=env('aktbus:hasReceiverURI',[],[Receiver]).

compose_receiver(Receiver_string,X_has_receiver) :-
	Receiver_string=[_|_],
	name(Receiver,Receiver_string),
	X_has_receiver=env('aktbus:hasReceiverURI',[],[Receiver]).
*/


%
% depending on the content, compose a aktbus:SimpleContent
% or use the tree provided by the user
%
compose_content_tree(Content,Content) :-
	Content=env(_,_,_),
	!.

compose_content_tree(Content,Content) :-
	Content=elem(_,_),
	!.
compose_content_tree(Content,X_content) :-
	X_content=env('aktbus:SimpleContent',[],[X_has_simple_message]),				%aktbus:SimpleConent
	X_has_simple_message=env('aktbus:hasSimpleMessage',['rdf:parseType'='Literal'],[Content]).	%aktbus:hasSimpleMessage

%
% compose date & time strings
%
make_date_time_string(Date,Time,Date_string,Time_string) :-
	datetime:get_current_datetime(time_stamp(date(D,M,Y),time(H,Min,S))),
	(	(var(Date),			%if Date is uninstantiated, put in current date
		!,
		Date=date(Y,M,D)
		);
		true
	),
	(	(var(Time),			%if Time is uninstantiated, put in current time
		!,
		Time=time(H,Min,S)
		);
		true
	),
	my_date(Date,Date_string,[]),
	my_time(Time,Time_string,[]).


%================
% message parsing
%================

%
% decompose a message into different components
%
decompose_message(Sender,Receiver,Date,Time,Msg_id,Content,Extra,Message) :-
	%
	% header & body
	%
	Message=[Xml_header,Xml_body],					%match header & body
	Xml_header=xmldecl([version=_]),				%match XML version in header
	Xml_body=env('rdf:RDF',Name_spaces,[X_container]),		%match RDF body
	%
	% find aktbus:Container, aktbus:SimpleHeader & aktbus:Content
	%
	X_container=env('aktbus:Container',X_container_attribs_list,X_container_list),
	X_has_header=env('aktbus:hasHeader',[],[X_header]),		%aktbus:hasHeader template
	X_has_content=env('aktbus:hasContent',[],[X_content]),		%aktbus:hasContent template
	member(X_has_header,X_container_list),				%match aktbus:hasHeader in aktbus:Container
	member(X_has_content,X_container_list),				%match aktbus:hasContent in aktbus:Container
	%
	% find msg id
	%
	(	member('aktbus:id'=Msg_id,X_container_attribs_list);		%match aktbus:id from attribute list
		true
	),
	%
	% decompose header & content
	%
	decompose_header(X_header,Sender,Receiver,Date,Time),
	compose_content_tree(Content,X_content),
	%
	% name space
	%
	Goal=(	name_space(Name,Object),
		url(Object,Url),
		concat_atoms:add_prefix('xmlns:',Name,Attrib_name),
		concat_atoms:add_prefix(Url,'#',Attrib_value)
		),
	findall(Attrib_name=Attrib_value,call(Goal),Default_name_spaces),
	my_subtract(Name_spaces,Default_name_spaces,Extra).

%
% decompose a message header
%

%
% aktbus:SimpleHeader
%
decompose_header(env('aktbus:SimpleHeader',_,[X_header_list]),Sender,Receiver,Date,Time) :-
	%
	% sender & receiver
	%
	X_has_sender_uri=env('aktbus:hasSenderURI',[],Sender),			%aktbus:hasSenderURI template
	X_has_receiver_uri=env('aktbus:hasReceiverURI',[],Receiver),		%aktbus:hasReceiverURI template
	(	member(X_has_sender_uri,X_header_list);				%match aktbus:hasSenderURI
		Sender=[]							%if it doesn't exist, then put in empty list
	),
	(	member(X_has_receiver_uri,X_header_list);			%match aktbus:hasReceiverURI
		Receiver=[]
	),
	!,
	%
	% date & time
	%
	X_has_date=env('aktbus:hasDateString',[],[Date_atom]),			%aktbus:hasDateString template
	X_has_time=env('aktbus:hasTimeString',[],[Time_atom]),			%aktbus:hasTimeString template
	member(X_has_date,X_header_list),					%match aktbus:hasDateString
	member(X_has_time,X_header_list),					%match aktbus:hasTimeString
	name(Date_atom,Date_string),						%convert atoms into strings
	name(Time_atom,Time_string),
	my_date(Date,Date_string,[]),						%parse in terms
	my_time(Time,Time_string,[]).




%
% get a receiver's URI from an AKT message
%
get_receiver_uri(Rdf_msg,Uri) :-
	get_env(Rdf_msg,'rdf:RDF',_,Rdf_body),
	(	get_env(Rdf_body,'aktbus:hasReceiverURI',_,[Uri]);
		Uri=[]
	),
	!.

%
% parse_url(+To_parse,-Url) :-
%
% parse a URL into a url/3 structure
%
% +To_parse	=	an atom or string to parse
% -Url		=	the URL returned as a url/3 structure
%
parse_url(Url_term,Url) :-
	atom(Url),				%URL is an atom
	!,
	name(Url,Url_string),			%convert it to a string
	my_http_url(Url_term,Url_string,[]).	%then parse it

parse_url(Url_term,Url_string) :-
	my_http_url(Url_term,Url_string,[]).


%
% string_to_xml(?String,?Xml)
%
% String	=	a string to parse or generated
% Xml		=	Prolog term structures describing an XML tree
%
% parse a string into a XML tree or convert a XML tree into a string
%
string_to_xml(String,Xml) :-
	xml2terms(String,Xml).	%call Pillow to translate a term to XML & vice versa


%
% get_env(+Tree,+Env,-Attrib,-Value) :-
%
% given a tag namne, extract its attributes & value from an XML tree
%
% Tree		=	the XML tree to search
% Env		=	the tag/environment name to search for
% Attrib	=	the returns attribute list
% Value		=	the enironment value
%
get_env(env(Env,Attrib,Value),Env,Attrib,Value) :-	%env found
	!.

get_env(Xml,Env,Attrib,Value) :-
	member(env(Env,Attrib,Value),Xml),		%env is a member of Xml which is a list
	!.

get_env(env(_,_,Temp_value),Env,Attrib,Value) :-
	!,
	get_env(Temp_value,Env,Attrib,Value).		%env is found in a subtree

get_env(Xml,Env,Attrib,Value) :-
	member(env(_,_,Temp_value),Xml),		%Xml is a list, and env is found in a subtree of a member
	get_env(Temp_value,Env,Attrib,Value).

%get_env_attrib_value(Rdf_msg,Env,Attrib,Value) :-
%	get_env(Rdf_msg,'rdf:RDF',_,Rdf_body),
%	get_env(Rdf_body,Env,Attrib,Value).
	



%============================
% message sending & receiving
%============================
%
% send_message/1
% send_message(+Msg)
%
% send a message to reciever and then close the connection
%
% +Msg	=	message composed by compose_message/4 or /5
%
send_message(Msg) :-
	send_message(Msg,default,0).				%send msg to default receiver & close

%
% send_message/3
% send_message(+Msg,+Where,+Timeout)
%
% send to a URI w/ timeout, then close connection
%
% +Msg		=	message composed
% +Where	=	where to send
%			can be the atom 'default', a URL or a connection
% +Timeout	=	timeout when sending
%

%
% send to default message receiver & close
%
send_message(Msg,default,Timeout) :-
	get_receiver_uri(Msg,Receiver_uri),				%get receiver's URI from msg
	name(Receiver_uri,Receiver_uri_string),				%convert atom to string
	my_http_url(Receiver_uri_term,Receiver_uri_string,[]),		%parse to validate
	send_message(Msg,Receiver_uri_term,Timeout).			%send & close

%
% send to a URL (an atom) & close
%
send_message(Msg,Uri,Timeout) :-
	atom(Uri),
	!,
	name(Uri,Uri_string),
	my_http_url(Uri,Uri_string,[]),		%parse to validate
	send_message(Msg,Uri,Timeout).

%
% send to a URL (url/3) & close
%
send_message(Msg,Uri,Timeout) :-
	Uri=url(_,_,_),
	!,
	xml2terms(String,Msg),						%convert msg term to a string
	send_http_post(Uri,String,Timeout,Connection),
	close_connection(Connection).

%
% send to a connection & keep
%
send_message(Msg,connection(R,W),Timeout) :-
	xml2terms(String,Msg),					%convert msg term to a string
	send_http_post(connection(R,W),String,Timeout,connection(R,W)).


%
% send_and_receive/4
% send_and_receive(+Msg,+Where,+Timeout,-Reply)
%
% send message to somewhere w/ timeout, and receive a piggy-packed reply
%
% +Msg		=	the message to send
% +Where	=	send to where
%			'default' will receiver URI in message
%			or a URL, either as an atom or a string
%			or a "connection" as returned by send_message_keep_connection/4, etc.
% +Timeout	=	the timeout value
% -Reply	=	the received reply
%

%
% default receiver URI in message
%
send_and_receive(_,_,_,_) :-
	write('*** send_and_receive/4 NOT YET IMPLEMENTED***'),
	nl,
	fail.
/*
send_and_receive(Msg,default,Timeout,Reply) :-
	get_receiver_uri(Msg,Receiver_uri),			%get receiver's URI from msg
	name(Receiver_uri,Receiver_uri_string),			%convert atom to string
	my_http_url(Receiver_uri_term,Receiver_uri_string,[]),	%parse to validate
	send_and_receive(Msg,Receiver_uri_term,Timeout,Reply).	%send to location keeping connection

%
% URL as an atom, keep connection
%
send_and_receive(Msg,Url,Timeout,Reply) :-
	atom(Url),
	!,
	name(Url,Url_string),
	my_http_url(Url,Url_string,[]),		%parse to validate
	send_message(Msg,Url_string,Timeout,Reply).

%
%
%
send_and_receive(Msg,Url_term,Timeout,Reply) :-
	Url_term=url(_,_,_),
	xml2terms(String,Msg),				%convert msg term to a string
	send_http_post(Url_term,String,Timeout,Connection),
	receive_message().
*/











%
% create an AKTBus message receiver listening to a port
%
create_aktbus_receiver(Port,Receiver_handle) :-
	integer(Port),
	!,
	a_sockets:a_socket_create('AF_INET',Socket),		%create server socket
	a_sockets:a_socket_bind(Socket,Port),			%bind with port
	a_sockets:a_socket_listen(Socket,5),			%set queue length
	Receiver_handle=aktbus_receiver(server_socket(Socket)).

%
% create an AKTBus message receiver listening to a port
% whose value is extract from a URL
%
create_aktbus_receiver(Url,Receiver_handle) :-
	atom(Url),
	!,
	name(Url,Url_string),
	my_http_url(url(_,Port,_),Url_string,[]),
	create_aktbus_receiver(Port,Receiver_handle).

create_aktbus_receiver(Url_string,Receiver_handle) :-
	my_http_url(url(_,Port,_),Url_string,[]),
	create_aktbus_receiver(Port,Receiver_handle).


%
% destroy an AKTBus message receiver
%
destroy_aktbus_receiver(Receiver_handle) :-
	Receiver_handle=aktbus_receiver(server_socket(Socket)),		%get server socket
	a_sockets:a_socket_destroy(Socket).				%destroy server socket

%
% close_connection/1
%
% close a connection
%

%
% 1 stream for both reading & writing
%
close_connection(connection(S,S)) :-
	(	(	nonvar(S),
			close(S)
		);
		true
	),
	!.

%
% different read & write streams
%
close_connection(connection(R,W)) :-
	(	(	nonvar(R),
			close(R)
		);
		true
	),
	(	(	nonvar(W),
			close(W)
		);
		true
	).

%
% receive_message/2
% receive_message(Port,Message)
%
% receive message from a port, close connection afterward
%
receive_message(Port,Message) :-
	integer(Port),
	!,
	create_aktbus_receiver(Port,Receiver),			%create receiver
	receive_message(Receiver,Message,Connection),		%receive from a receiver handle
	close_connection(Connection),				%close connection
	destroy_aktbus_receiver(Receiver).			%destroy receiver

%
% receive from a URL (which is an atom) (only the port is used),
% close connection afterward
%
receive_message(Url,Message) :-
	atom(Url),					%URL is an atom
	!,
	name(Url,Url_string),
	my_http_url(url(_,Port,_),Url_string,[]),
	receive_message(Port,Message).

%
% receive from a URL (which is a string),
% close connection afterward
%
receive_message(Url_string,Message) :-
	my_http_url(url(_,Port,_),Url_string,[]),	%URL is a string
	receive_message(Port,Message).

%
% receiver from a AKT-Bus receiver, close connection
%
receive_message(aktbus_receiver(server_socket(Socket)),Message) :-
	receive_message(aktbus_receiver(server_socket(Socket)),Message,Connection),
	close_connection(Connection).

%
% receive from a connection, keep connection
%
receive_message(connection(Read,Write),Message) :-
	receive_http_message(connection(Read,Write),Message_string),		%read from stream
	pillow:xml2terms(Message_string,Message).			%parse string into XML tree

%
% receive from a receiver, keep connection
%
receive_message(aktbus_receiver(server_socket(Socket)),Message,connection(Read,Write)) :-
	a_sockets:a_socket_accept(Socket,_,Read,Write),			%accept incoming connection
	receive_message(connection(Read,Write),Message).		%receive from connection

%
% receive a message by HTTP with optional timeout
%
receive_http_message(connection(Read,Write),Body) :-
	crlf(Crlf),
	read_until_lf(Read,Start_line),				%get the request line
%	write('***'),
%	print_string(Start_line),
%	write('***'),
%	nl,
	my_request_line(_Method,_Url,Version,Start_line,[]),	%parse request line
	read_until_blank_line(Read,Lines),			%read until hitting a blank line
	flatten(Lines,F_lines),					%put all header lines into 1
	my_null_or_more_header(Headers,F_lines,Crlf),		%parse list of header
	get_content_length(Headers,Length),			%look for content-length value
	read_number_of_char(Read,Length,Body),			%read body
	send_response(Write,Version).				%send response

get_content_length(Headers,Length) :-
	member(Field_name,[	'Content-Length',
				'content-length',
				'content-Length',
				'Content-length'
				]),
	member(Field_name:Length,Headers).

send_response(W,Version) :-
	Code_string="200",
	Reason_string="OK",
	crlf(Crlf),
	atom_codes(Version,Version_string),
	flatten([	"HTTP/",
			Version_string,
			" ",
			Code_string,
			" ",
			Reason_string,
			Crlf
		],Response_string),
	pillow:write_string(W,Response_string),
	flush_output(W).


read_until_lf(R,[C|Cs]) :-
	get0(R,C),		%read a char
	(	(	C=10,
			!,
			Cs=[]
		);
		(	C>=10,
			!,
			read_until_lf(R,Cs)
		);
		Cs=[]
	).

read_until_blank_line(R,[L|Ls]) :-
	read_until_lf(R,L),
	(	(	L=[13,10],
			!,
			Ls=[]
		);
		read_until_blank_line(R,Ls)
	).


read_until_eof(R,[C|Cs]) :-
	get0(R,C),
	C >= 0,		%not yet EOF
	!,
	read_until_eof(R,Cs).

read_until_eof(_,[]).

read_number_of_char(_,0,[]) :-
	!.

read_number_of_char(R,N,[C|Cs]) :-
	get0(R,C),
	!,
	C>=0,
	M is N-1,
	read_number_of_char(R,M,Cs).

read_number_of_char(_,_,[]).







%
% send an HTTP POST to somewhere
%

%
% send to a URL
%
send_http_post(Uri,String,Timeout,Connection) :-
%	url_info(Uri,http(Host,Port,Doc)),			%get host & port from URI string
	Uri=url(Host,Port,Doc),
	crlf(Crlf_string),					%get the CR-LF string
	Start_line=["POST ",Doc," HTTP/1.1",Crlf_string],	%start-line according to HTTP
	Body_string=String,					%HTTP body in a string
	length(Body_string,Length),
	name(Length,Length_string),
	Header_string=[	"Connection: close",Crlf_string,
			"Content-Length: ",Length_string,Crlf_string
			],					%HTTP header, if any
	flatten([Start_line,			%request line w/ CF-LF
		Header_string,			%header lines w/ CF-LF
		Crlf_string,			%a blank line
		Body_string,			%POST body
		Crlf_string],Request_string),	%and CF-LF
	pillow:http_transaction(Host,Port,Request_string,Timeout,Response_string,Connection),	%send request string to http server
%	print_string(Response_string),nl,
	pillow:http_response(_Response,Response_string,[]).				%parse response string
%	write(Response),nl.

%
% send HTTP POST to a connection
%
send_http_post(connection(Read,Write),String,Timeout,connection(Read,Write)) :-
	crlf(Crlf_string),					%get the CR-LF string
	Start_line=["POST ",_Doc," HTTP/1.1",Crlf_string],	%start-line according to HTTP
	Body_string=String,					%HTTP body in a string
	length(Body_string,Length),
	name(Length,Length_string),
	Header_string=[	"Connection: close",Crlf_string,
			"Content-Length: ",Length_string,Crlf_string
			],					%HTTP header, if any
	flatten([Start_line,			%request line w/ CF-LF
		Header_string,			%header lines w/ CF-LF
		Crlf_string,			%a blank line
		Body_string,			%POST body
		Crlf_string],Request_string),	%and CF-LF
	pillow:http_transaction(connection(Read,Write),Request_string,Timeout,Response_string),	%send request string to http server
%	print_string(Response_string),nl,
	pillow:http_response(_Response,Response_string,[]).				%parse response string
%	write(Response),nl.


%
% prints CR-LF to a stream
%
write_crlf(W) :-
	put(W,13),
	put(W,10).





/*
http_post(Host,Port) :-
	socket('AF_INET',Socket),
	socket_connect(Socket,'AF_INET'(Host,Port),Stream),
	pillow:write_string(Stream,Request),
	flulsh_output(Stream),
	stream_select([Stream],Timeout:0,R),
	R \== [],	%fail if timeout
	stream_to_string(Stream,Response).
*/


my_http_request(request(Method,Url,Http_version,Header_lists,Body)) -->
	my_request_line(Method,Url,Http_version),
	my_null_or_more_header(Header_lists),
	pillow:http_crlf,
	my_message_body(Body).

my_request_line(Method,Url,Http_version) -->
	my_method(Method),
	" ",
	my_request_uri(Url),
%	my_http_url(Url),
	" ",
	my_http_version(Http_version),
	pillow:http_crlf.

my_request_uri(Url) -->
	my_http_url(Url).

my_request_uri(Doc) -->
	my_http_document_name(Doc).

my_request_uri('*') --> "*".
my_request_uri('/') --> "/".


my_http_url(url(Host,Port,Doc)) -->
	"http://",
	my_internet_host(Host),
	pillow:optional_port(Port),
	my_http_document_name(Doc).

my_http_document_name(D) -->
	"/",
	my_one_or_more_document_name_char(D),
	!.

my_http_document_name("/") -->
	"/",
	!.

my_http_document_name(D) -->
	my_one_or_more_document_name_char(D).

my_http_document_name("/") -->
	"".

my_one_or_more_document_name_char([C|D]) -->
	my_document_name_char(C),
	my_one_or_more_document_name_char(D).

my_one_or_more_document_name_char([C]) -->
	my_document_name_char(C).



my_document_name_char(C) -->
	pillow:digit(C).

my_document_name_char(C) -->
	pillow:loalpha(C).

my_document_name_char(C) -->
	pillow:upalpha(C).

my_document_name_char(0'.) -->
	".".

my_document_name_char(0'~) -->
	"~".

my_document_name_char(0'/) -->
	"/".

my_http_version('1.1') --> "HTTP/1.1".
my_http_version('1.0') --> "HTTP/1.0".

my_method(get) --> "GET".
my_method(post) --> "POST".

my_null_or_more_header([Field_name:Value|Rest]) -->
	my_field_name(Field_name),
	":",
	my_optional_space,
	my_field_value(Value),
	pillow:http_crlf,
	my_null_or_more_header(Rest).

my_null_or_more_header([]) -->
	"".

my_message_body(Body) -->
	my_rest(Body).


my_internet_host(Host) -->
	my_one_or_more_internet_token(Host).

my_one_or_more_internet_token(Host) -->
	my_internet_host_token(T1),
	".",
	my_one_or_more_internet_token(T2),
	{	atom_codes(T1,T1_string),
		atom_codes(T2,T2_string),
		flatten([T1_string,".",T2_string],T),
		atom_codes(Host,T)
	}.

my_one_or_more_internet_token(T) -->
	my_internet_host_token(T).

my_internet_host_token(Token) -->
	my_internet_host_char(C),
	my_internet_host_token(T),
	{	atom_codes(T,T_string),
		atom_codes(Token,[C|T_string])
	}.

my_internet_host_token(T) -->
	my_internet_host_char(C),
	{	atom_codes(T,[C])
	}.


my_internet_host_char(C) --> pillow:digit(C).
my_internet_host_char(C) --> pillow:loalpha(C).
my_internet_host_char(C) --> pillow:upalpha(C).
my_internet_host_char(0'-) --> "-".

my_char_in_low(C) --> pillow:digit(C).
my_char_in_low(C) --> pillow:loupalpha(C).
my_char_in_low(0'-) --> "-".

my_symbol_char(0'*) --> "*".
my_symbol_char(0'/) --> "/".
my_symbol_char(0'.) --> ".".
my_symbol_char(0',) --> ",".
my_symbol_char(0'=) --> "=".
my_symbol_char(0'-) --> "-".
my_symbol_char(0':) --> ":".
my_symbol_char(0';) --> ";".



my_field_name(Token) -->
	my_token(Token).


my_field_value(Value) -->
	my_line(Line),
	{	name(Line,S),
		name(Value,S)
	}.

my_line(Line) -->
	my_field_value_char(C),
	my_line(L2),
	{	atom_codes(L2,L2_string),
		atom_codes(Line,[C|L2_string])
	}.

my_line(Token) -->
	my_field_value_char(C),
	{	atom_codes(Token,[C])
	}.

my_field_value_char(C) -->
	pillow:digit(C).

my_field_value_char(C) -->
	pillow:loalpha(C).

my_field_value_char(C) -->
	pillow:upalpha(C).

my_field_value_char(C) -->
	my_symbol_char(C).

my_field_value_char(32) -->
	" ".
/*
my_field_value(Value) -->
	my_token(Token),
	{	name(Token,S),		%convert the atom to a string
		name(Value,S)		%and back to atom (fix 'integer as atom' problem)
	}.
*/
/*
my_token_in_low(Token) -->
	my_char_in_low(C),
	my_token_in_low(T2),
	{	atom_codes(T2,T2_string),
		atom_codes(Token,[C|T2_string])
	}.

my_token_in_low(Token) -->
	my_char_in_low(C),
	{	atom_codes(Token,[C])
	}.
*/

my_token(Token) -->
	my_internet_host_char(C),
	my_token(T2),
	{	atom_codes(T2,T2_string),
		atom_codes(Token,[C|T2_string])
	}.

my_token(Token) -->
	my_internet_host_char(C),
	{	atom_codes(Token,[C])
	}.

my_rest(S,S,[]).


my_date(date(Y,M,D)) -->
	my_parse_integer(Y),
	"-",
	my_parse_integer(M),
	"-",
	my_parse_integer(D).

my_time(time(H,M,S)) -->
	my_parse_integer(H),
	":",
	my_parse_integer(M),
	":",
	my_parse_integer(S).

%
% parsing a string into an integer
% or generating a string from an integer
%
my_parse_integer(Num,String,Rest) :-
	var(String),
	!,
	number_codes(Num,Num_string),
	append(Num_string,Rest,String).

my_parse_integer(Num,String,Rest) :-
	parse_integer(Num,String,Rest).

my_optional_space --> " ".
my_optional_space --> "".



%=====
% misc.
%=====

%
% print a string to stdout
%
print_string([]).
print_string([H|T]) :-
	put(H),
	print_string(T).


