1:-module(web, [  op(8,  fy, '`'),
    2	cgi_main/0, cgi_debug/0,
    3	cgi_phrase/2,cgi_phrase/3,
    4	create_file/2, decode_pair/2, echo/2, equation_pair/2,
    5	eval_query/2, expandref/2,
    6	form_encode/2, format_codes/3, get_eof/1, getcodes/2,
    7	parse_form/2, parse_query/2, parse_query/3,
    8	query_to_answer/2, query_to_html_codes/2, response_form/2,
    9	writeBR/1, write_html/1]).   10
   11:- use_module(pac(basic)).   12:- use_module(pac(op)).   13:- use_module(pac('expand-pac')).   14:- use_module(util('emacs-handler')).   15
   16:- op(670, yfx, \).   17:- op(200, xfy, ^).   18
   19:- use_module(util(file)).   20:- use_module(util(cgi)).   21:- use_module(util(misc)).   22:- use_module(zdd('zdd-plain')).   23
   24:- set_prolog_flag(allow_variable_name_as_functor, true).   25:- nb_setval(webform, []).   26:- nb_setval(query_op, []).   27
   28/*--------------------------------------------
   29To debug cgi by trace/spy) in emacs or terminal.
   30-	Run cgi query to be debugged from browser,
   31-	then run this.
   32?-	trace, cgi_debug.
   33?-	cgi_debug.
   34--------------------------------------------*/
   35% ?- spy(solve_query).
   36% ?- spy(det_phrase).
   37% ?- spy(cgi_demo).
   38% ?- spy(read_term).
   39% ?- spy(notify_cgi_access).
   40% ?- trace.
   41% ?- cgi_debug.
   42
   43		/**********************************
   44		*     Predicates for Prolog CGI    *
   45		***********************************/
 cgi_main is det
main entry for Prolog CGI.
   50cgi_main:- prompt(_,''),
   51	catch((get_request_browser(Form), cgi_in_prolog(Form)),
   52		  Ball,
   53		  (response_form(Ball, R), write_html(R))).
   54%
   55cgi_debug:-
   56	catch((get_request_kept(Form), cgi_in_prolog(Form)),
   57		  Error,
   58		  (response_form(Error, R), write_html(R))).
   59
   60%
   61get_request_browser(Form):- get_eof(S),
   62	parse_form(S, Form),
   63	getenv(http_request, H),   % save input for debugging locally.
   64	put_eof(H, S).
   65%
   66get_request_kept(Form):-
   67	getenv(http_request, H),
   68	get_eof(H, S),
   69	parse_form(S, Form).
   70
   71%
   72cgi_in_prolog(Form) :-
   73	nb_setval(webform, Form),
   74	query_to_answer(Form, Ans),
   75	write_html(Ans),
   76	cgi_log(Form),
   77	access_notification_sendmail.
   78%
   79cgi_log(Form):- getenv(cgi_log, true), !,
   80	getenv(cgi_log_file, Log),
   81	memberchk(expr = Query, Form),
   82	open(Log, append, Stream, [encoding(utf8)]),
   83	current_output(D),
   84	set_output(Stream),
   85	nl,
   86	nl,
   87	pipe_line(date, Date),
   88	smash([Date, "\n", Query]),
   89	close(Stream),
   90	set_output(D).
   91cgi_log(_).
 query_to_answer(+X:codes, -Y:codes) is det
Eval query X in codes to cgi response form Y.
   95query_to_answer(X, Y):-
   96	memberchk(expr = C, X),
   97	query_to_html_codes(C, Y0),
   98	response_form(Y0, Y).
 notify_cgi_access(+F:codes) is det
Email F to the $USER when notify_cgi_access_by_mail is true. notify_cgi_access(Form):- getenv(notify_cgi_access_by_mail, true), !, memberchk(expr = Query, Form), getenv(user, Name), ignore(sendmail(["From: ", Name, "\n", "Subject: cgi in prolog access\n\n", Query, "\n"])). notify_cgi_access(_). 
  110% ?- access_notification_sendmail.
  111% NOT work. Need to know details about /usr/sbin/sendmail.
  112access_notification_sendmail:- getenv(cgi_sendmail, true), !,
  113	getenv(user, User),
  114	qshell('/usr/sbin/sendmail'(
  115				   'From:', User,
  116				   'To:', 'mukai827@mac.com',
  117				   'Subject: cgi in prolog access\n\n')).
  118access_notification_sendmail.
  119
  120% ?- query_to_html_codes(`(peek([b]), append([a]))`, X), smash(X).
  121% ?- query_to_html_codes(`?-append([a],[b], A)`, X), smash(X).
  122% ?- parse_query((?- append([a], [b], _G2170)), ['A'=_G2170], _G2288).
  123% ?- parse_query(`?- append([a], [b], X)`, Y).
  124% ?- parse_query(`(peek([1]), append([2]), set::pow)`, X).
  125% ?- parse_query(`(?-append([a],[b], X))`, V).
  126% ?- parse_query(`append([a],[b])`, V).
  127% ?- parse_query(`(??- member(X, [1,2,3]))`, V).
  128% ?- parse_query(`(peek([b]), append([a]))`, V).
  129% ?- eval(misc:set::pow([1,2]), V).
  130% ?- parse_query(`(peek([a,b]), ([X]\\set::pow(X)))`, V).
  131% ?- expand_basic_phrase(fun([X], misc:set::pow(X)), user, F, P, []).
  132%  parse_query(X, _, _):- var(X), !, throw
  133
  134query_to_html_codes(X, Y):-
  135	herbrand_deref(X, X0, V),
  136	parse_query(X0, V, Y).
 parse_query(+X, -Y) is det
Parse query X into a term Y.
  140parse_query(X,  Y):-
  141	herbrand_deref(X, X0, V),
  142	parse_query(X0, V, Y).
 parse_query(+E, -V, -Y) is det
Parse query E to a term Y and variable_names V.
  146parse_query((?-X), V, Y):- !,
  147	must_be(callable, X),	% check_act(X, 0),
  148	once(expand_goal(X, [], G, P, [])),
  149	maplist(assert, P),
  150	(call(G) -> Y = V ; Y = fail).
  151parse_query(??-(X), V, Y):- !,	must_be(callable, X), % check_act(X, 0),
  152	once(expand_goal(X,[],G,P,[])),
  153	maplist(assert, P),
  154	(findall(V, call(G), Y) -> true; Y = []).
  155% parse_query(X, _, Y):-	eval_query(X, Y).
  156parse_query(X, _, Y):-
  157	once(expand_goal(X, [], G, P, [])),
  158	maplist(assert, P),
  159	once(solve_query(G, [], Y)).
 eval_query(+E, -V) is det
Eval query E to a term V. ?- let(F, ([X]\ (set::pow@ X))), web:eval_query((peek([[1], [2]]), eh:apply(append), F), X).
  164eval_query(X, Y):-
  165	phrase_to_pred(X, [], H:-G, P, []),
  166	maplist(assert, P),
  167	H = [X,Y],
  168	call(G).
  169%
  170codes_string(X, Y):- string_codes(Y, X).
  171
  172% ?- solve_query(true, 1, X).
  173% ?- trace, solve_query(append([a,b]), [c,d], X).
  174% ?- trace, solve_query(append([a,b]), [c,d], X).
  175% ?- solve_query(((append([a,b]), append([c,d])), append([x,y])), [1,2], X).
  176% ?- solve_query((peek([u,v]), ((append([a,b]), append([c,d])), append([x,y]))), [1,2], X).
  177%@ X = [x, y, c, d, a, b, u, v].
  178
  179:- meta_predicate solve_query(:, ?, ?).  180% ! is not allowed to appear in F.
  181solve_query(F, X, Y):- strip_module(F, M, G),
  182	once(solve_query(G, X, Y, M)).
  183%
  184solve_query(true, X, X, _):-!.
  185solve_query(((F, G), H), X, Y, M):-!, solve_query((F, (G, H)), X, Y, M).
  186solve_query((F;G), X, Y, M):-!,
  187	(	solve_query(F, X, Y, M)
  188	;	solve_query(G, X, Y, M)
  189	).
  190solve_query((foldup, _), X, Y, _):-!, is_list(X),
  191	list_www_string(X, Y).
  192solve_query((F, G), X, Y, M):-!,
  193	solve_query(F, X, Z, M),
  194	solve_query(G, Z, Y, M).
  195solve_query(M:G, X, Y, _):-!, solve_query(G, X, Y, M).
  196solve_query(foldup, X, Y, _):-!,
  197	is_list(X),
  198	list_www_string(X, Y).
  199solve_query(once(G), X, Y, M):-!, once(solve_query(G, X, Y, M)).
  200solve_query(G, X, Y, M):- once(call(M:G, X, Y)).
  201
  202%	cgi_phrase(+X, -V) is det.
  203%	Eval cgi-phrase  X to a term V.
  204cgi_phrase(X,  V):- cgi_phrase(X, Head, Rest), !,
  205	phrase_to_pred(Rest, [], H:-G, P, []),
  206	maplist(assert, P),
  207	pac:eval(Head, V0),
  208	H = [V0, V],
  209	call(G).
  210cgi_phrase(X,  V):- call(X, V).
  211
  212% ?- cgi_phrase(((a,b),c), X, Y).
  213cgi_phrase(((X,Y),Z), U, V):- !, cgi_phrase((X,(Y,Z)), U, V).
  214cgi_phrase((X,Y), X, Y).
 response_form(+X, -Y) is det
Make term X into webform Y required by httprequest (Ajax) interface.
  219response_form(X, Y):-
  220	(	nb_current(webform, W); W = [] ), !,
  221	(	member(buttonid = B, W); B = `dummybuttonid` ), !,
  222	(	member(targetid = R, W); R = `dummytargetid` ), !,
  223	atom_codes(B0, B),
  224	atom_codes(R0, R),
  225	basic:smash(X, E),
  226	Y = [B0, "\n", R0, "\n", E].
 form_encode(+X, -Y) is det
Bidirectional form encoding/decoding.
  230form_encode(X, Y):- atomic(X), !,
  231	www_form_encode(X, Y0),
  232	atom_codes(Y0, Y).
  233form_encode(X, Y):- atomic(Y), !,
  234	www_form_encode(X0, Y),
  235	atom_codes(X0, X).
  236form_encode(X, Y):-
  237	(	nonvar(X) -> atom_codes(A, X),
  238		www_form_encode(A, B),
  239		atom_codes(B, Y)
  240	;	atom_codes(B, Y),
  241		www_form_encode(A, B),
  242		atom_codes(A, X)
  243	).
  244
  245%	list_www_string(?X, ?Y) det.
  246%	bidirectional.
  247%	For a prolog lilst  X = [A1, ..., An]
  248%	Y is a www form string of "B1/B2/.../Bn"
  249%	such that Ai is decoded Bi  (i=1,..., n).
  250%	cf. www_form_encode/2,  uri_encoded/3.
  251
  252% ?- X = ['Automaton', '<img src="automata/am5.svg"/>'],
  253%	list_www_string(X, Y),
  254%	list_www_string(X0, Y).
  255
  256% ?- list_www_string([///, ///], R),
  257%	list_www_string(X, R).
  258
  259list_www_string(L, W):- nonvar(L), !,
  260	maplist(twice_www_form_encode, L, M),
  261	atomics_to_string(M, /, W).
  262list_www_string(L, W):-
  263	atomics_to_string(M, /, W),
  264	maplist(twice_www_form_encode, L, M).
  265%
  266twice_www_form_encode(X, Y):-nonvar(X), !,
  267	www_form_encode(X, Z),
  268	www_form_encode(Z, Y).
  269twice_www_form_encode(X, Y):-
  270	www_form_encode(Z, Y),
  271	www_form_encode(X, Z).
 herbrand_web(+X, -Y) is det
parse cgi query X to a term Y. ?- herbrand_web(`a(A)`, X).
  276herbrand_web(X, Y):-  herbrand(web, _ , X, Y).
 herbrand_web(?B, +X, -Y) is det
Parse cgi query X to a term Y with variable_names B. ?- herbrand_web(B, `a(A)`, X).
  281herbrand_web(Bindings, X, Y):- herbrand(web, Bindings, X, Y).
 herbrand_deref(+X, -Y, -B) is det
Parse cgi query X to a term Y with variable_names B, expanding @-symbol by deref-ing.
  287herbrand_deref(X, Y, Binds):-
  288	herbrand_web(Binds, X, X1),
  289	expandref(X1, Y).
 expandref(+X, Y) is det
Expand all @-symbol in X referring to an assoc list, which was in a global variable 'webform'.
  295expandref(X, Y):-  (var(X); atomic(X)), !, Y = X.
  296expandref(@(X), Y):- !, getcodes(X, Y).
  297expandref(X, Y):-  X=..[F|A], maplist(expandref, A, B), Y=..[F|B].
 getcodes(+X, -Y) is det
Get codes of @-symbol X, and unify Y with the value.
  302% ?- b_setval(webform, [a= hello]), getcodes(a, X).
  303% X = hello
  304getcodes(X, Y):- nb_getval(webform, Env), member(X = Y, Env), !.
  305getcodes(X, _):- throw(error(no_data_for(X))).
 write_html(+R) is det
write R back to browsers with some header info.
  310write_html(R):- smash(R, E),
  311	string_length(E, N),
  312	format("Content-type: text/plain; charset=utf-8~n~n"),
  313	format("Content-Length: ~w~n", [N]),
  314	write(E).
 get_eof(-S) is det
get an input from browsers into S.
  318get_eof(S):- get_code(C),
  319	(	C < 0 -> S = []
  320	;	S = [C|S1],
  321		get_eof(S1)
  322	).
  323
  324% ?- absolute_file_name('~/Desktop/xxx', R).
  325% ?- get_eof('/Users/cantor/devel/zdd/prolog/util/web.pl', X),
  326%	 put_eof('/Users/cantor/Desktop/deldel.pl', X).
  327
  328get_eof(F, S):- open(F, read,  U, [encoding(utf8)]),
  329				get_eof_stream(U, S),
  330				close(U).
  331%
  332get_eof_stream(U, S):- get_code(U, C),
  333	(	C < 0 -> S = []
  334	;	S = [C|S1],
  335		get_eof_stream(U, S1)
  336	).
  337%
  338put_eof(F, S):- open(F, write,  U, [encoding(utf8)]),
  339				put_eof_stream(U, S),
  340				close(U).
  341%
  342put_eof_stream(_, []):-!.
  343put_eof_stream(U, [A|As]):-!, put_code(U, A),
  344				put_eof_stream(U, As).
 parse_form(+X, -Y) is det
Parse web form text codes X into Y.
  348parse_form(X, Y):- basic:split(`&`, X, L),
  349	maplist(equation_pair, L, Y1),
  350	maplist(decode_pair, Y1, Y2),
  351	maplist(name2atom, Y2, Y).
  352
  353		/***********************
  354		*     tiny helpers.    *
  355		***********************/
  356%
  357equation_pair(E, (A, B)):- append(A, [0'= |B], E), !.   %'
  358%
  359decode_pair((X, []), (X0, "")):-!, form_encode(X0, X).
  360decode_pair((X, Y), (X0, Y0)):- form_encode(X0, X), form_encode(Y0, Y).
  361%
  362name2atom((A,B), A1 = B) :- atom_codes(A1, A).
  363%
  364writeBR(W):- format("~w<br>\n", [W]).
  365%
  366format_codes(F, A, X):-  format(codes(X), F, A).
  367%
  368echo --> [].
  369%
  370create_file(F, C):- file(F, write, smash(C))