web.pl

    1:-module(web, [  op(8,  fy, '`'),
    2	cgi_main/0, cgi_normal/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, get_request/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	sendmail/1,
   10	writeBR/1, write_html/1]).   11
   12:- use_module(pac(basic)).   13:- use_module(pac(op)).   14:- use_module(pac('expand-pac')).   15:- use_module(util('emacs-handler')).   16:- op(670, yfx, \).   17:- op(200, xfy, ^).   18
   19:- use_module(util(file)).   20:- use_module(util(cgi)).   21
   22:- set_prolog_flag(allow_variable_name_as_functor, true).   23:- nb_setval(webform, []).   24:- nb_setval(query_op, []).   25
   26		/***********************************
   27		*     Predicates for Prolog CGI    *
   28		***********************************/

cgi_main is det: main entry for Prolog CGI.

   32cgi_main:- catch(cgi_normal, Ball, (response_form(Ball, R), write_html(R))).

cgi_normal is det: Top level process of Prolog CGI.

   36cgi_normal :- prompt(_,''),
   37	once(get_request(Form)),
   38	nb_setval(webform, Form),
   39	getenv(home, H),
   40	atomic_list_concat([H,'Desktop', http_request], /, Save),
   41	setup_call_cleanup(
   42			open(Save, write, S),
   43			(write(S, Form), write(S, ".\n")),
   44			close(S)),
   45	query_to_answer(Form, Ans),
   46	write_html(Ans),
   47	notify_cgi_access(Form).
   48
   49% Clicking a button on browser, then run the query.
   50cgi_debug:- catch(cgi_debug0, Ball, (response_form(Ball, R), write_html(R))).
   51%
   52cgi_debug0 :- getenv(home, H),
   53	atomic_list_concat([H,'Desktop', http_request], /, Input),
   54	get_request(Input, Form),
   55	nb_getval(webform, Form),
   56	query_to_answer(Form, Ans),
   57    write_html(Ans).

query_to_answer(+X:codes, -Y:codes) is det: Eval query X in codes to cgi response form Y.

   61query_to_answer(X, Y):-
   62	memberchk(expr = C, X),
   63	query_to_html_codes(C, Y0),
   64	response_form(Y0, Y).

notify_cgi_access(+F:codes) is det: Email F to the $USER when notify_cgi_access_by_mail is true.

   68notify_cgi_access(Form):- getenv(notify_cgi_access_by_mail, true), !,
   69	memberchk(expr = Query, Form),
   70	getenv(user, Name),
   71	ignore(sendmail(["From: ", Name,	"\n",
   72		  "Subject: cgi in prolog access\n\n",
   73		  Query, "\n"])).
   74notify_cgi_access(_).
   75
   76%
   77sendmail(X):- getenv(scratchfile, File_tmp), !,
   78	 getenv(user, User),
   79	file(File_tmp, write,
   80	       (  current_output(Out),
   81	          set_stream(Out, encoding(utf8)),
   82	          smash(X),
   83		  flush_output)),
   84	sh( cat(File_tmp) + " | " +  '/usr/sbin/sendmail'(User)).
   85sendmail(_).

query_to_html_codes(+X, -Y) is det: Eval query X into html codes Y. ?- sqc(web). ?- query_to_html_codes(`(peek([b]), append([a]))`, X), smash(X). ?- query_to_html_codes(`?-append([a],[b], A)`, X), smash(X). ?- parse_query((?- append([a], [b], _G2170)), ['A'=_G2170], _G2288). ?- parse_query(`?- append([a], [b], X)`, Y). ?- parse_query(`(peek([1]), append([2]), set::pow)`, X). ?- parse_query(`(?-append([a],[b], X))`, V). ?- parse_query(`append([a],[b])`, V). ?- parse_query(`(??- member(X, [1,2,3]))`, V). ?- parse_query(`(peek([b]), append([a]))`, V). ?- eval(misc:set::pow([1,2]), V). ?- parse_query(`(peek([a,b]), ([X]\\set::pow(X)))`, V). ?- expand_basic_phrase(fun([X], misc:set::pow(X)), user, F, P, []). parse_query(X, _, _):- var(X), !, throw

  104query_to_html_codes(X, Y):-
  105	herbrand_deref(X, X0, V),
  106	parse_query(X0, V, Y).

parse_query(+X, -Y) is det: Parse query X into a term Y.

  111parse_query(X,  Y):-
  112	herbrand_deref(X, X0, V),
  113	parse_query(X0, V, Y).

parse_query(+E, -V, -Y) is det: Parse query E to a term Y and variable_names V.

  117parse_query((?-X), V, Y):- !,
  118	must_be(callable, X),	% check_act(X, 0),
  119	once(expand_goal(X, [], G, P, [])),
  120	maplist(assert, P),
  121	(call(G) -> Y = V ; Y = fail).
  122parse_query(??-(X), V, Y):- !,	must_be(callable, X), % check_act(X, 0),
  123	once(expand_goal(X,[],G,P,[])),
  124	maplist(assert, P),
  125	(findall(V, call(G), Y) -> true; Y = []).
  126parse_query(X, _, Y):-	eval_query(X, 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).

  131eval_query(X, Y):-
  132	phrase_to_pred(X, [], H:-G, P, []),
  133	maplist(assert, P),
  134	H = [X,Y],
  135	call(G).

cgi_phrase(+X, -V) is det: Eval cgi-phrase X to a term V.

  139cgi_phrase(X,  V):- cgi_phrase(X, Head, Rest), !,
  140	phrase_to_pred(Rest, [], H:-G, P, []),
  141	maplist(assert, P),
  142	pac:eval(Head, V0),
  143	H = [V0, V],
  144	call(G).
  145cgi_phrase(X,  V):- call(X, V).
  146
  147% ?- cgi_phrase(((a,b),c), X, Y).
  148cgi_phrase(((X,Y),Z), U, V):- !, cgi_phrase((X,(Y,Z)), U, V).
  149cgi_phrase((X,Y), X, Y).

response_form(+X, -Y) is det: Make term X into webform Y required by httprequest (Ajax) interface.

  154response_form(X, Y):-
  155	(	nb_current(webform, W); W = [] ), !,
  156	(	member(buttonid = B, W); B = `dummybuttonid` ), !,
  157	(	member(targetid = R, W); R = `dummytargetid` ), !,
  158	atom_codes(B0, B),
  159	atom_codes(R0, R),
  160	term_smash0(X, X0),
  161	uri_encoded(path, X0, E),
  162	Y = [B0, "\n", R0, "\n", E].

form_encode(+X, -Y) is det: Bidirectional form encoding/decoding.

  166form_encode(X, Y):- atomic(X), !,
  167	www_form_encode(X, Y0),
  168	atom_codes(Y0, Y).
  169form_encode(X, Y):- atomic(Y), !,
  170	www_form_encode(X0, Y),
  171	atom_codes(X0, X).
  172form_encode(X, Y):-
  173	(	nonvar(X) -> atom_codes(A, X),
  174		www_form_encode(A, B),
  175		atom_codes(B, Y)
  176	;	atom_codes(B, Y),
  177		www_form_encode(A, B),
  178		atom_codes(A, X)
  179	).

get_request(-Form:codes) is det: Get CGI form, and parse it to Form.

  183get_request(Form):- get_eof(S), parse_form(S, Form).
  184
  185%
  186get_request(RFile, Form):-
  187	setup_call_cleanup(
  188		open(RFile, read, U),
  189		read(U, Form),
  190		close(U)),
  191	nb_setval(webform, Form).

herbrand_web(+X, -Y) is det: parse cgi query X to a term Y. ?- herbrand_web(`a(A)`, X).

  196herbrand_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).

  201herbrand_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.

  207herbrand_deref(X, Y, Binds):-
  208	herbrand_web(Binds, X, X1),
  209	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'.

  215expandref(X, Y):-  (var(X); atomic(X)), !, Y = X.
  216expandref(@(X), Y):- !, getcodes(X, Y).
  217expandref(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.

  222% ?- b_setval(webform, [a= hello]), getcodes(a, X).
  223% X = hello
  224getcodes(X, Y):- nb_getval(webform, Env), member(X = Y, Env), !.
  225getcodes(X, _):- throw(error(no_data_for(X))).

write_html(+R) is det: write R back to browsers with some header info.

  230write_html(R):-
  231	(	string(R) -> E = R
  232	;	term_smash0(R, E)
  233	),
  234	string_length(E, N),
  235	format("Content-type: text/plain; charset=utf-8~n~n"),
  236	format("Content-Length: ~w~n", [N]),
  237	write(E).

get_eof(-S) is det: get an input from browsers into S.

  241get_eof(S):- get_code(C),
  242	(C < 0 -> S = []; S = [C|S1], get_eof(S1)).
  243
  244% ?- get_eof('/Users/cantor/Desktop/http_request', R).
  245get_eof(U, S):- get_code(U, C),
  246	(	C < 0 -> S = []
  247	;	S = [C|S1],
  248		get_eof(U, S1)
  249	).

parse_form(+X, -Y) is det: Parse web form text codes X into Y.

  253parse_form(X, Y):- basic:split(`&`, X, L),
  254	maplist(equation_pair, L, Y1),
  255	maplist(decode_pair, Y1, Y2),
  256	maplist(name2atom, Y2, Y).
  257
  258		/***********************
  259		*     tiny helpers.    *
  260		***********************/
  261
  262decode_pair((X, Y), (X0, Y0)):- form_encode(X0, X), form_encode(Y0, Y).
  263%
  264name2atom((A,B), A1 = B) :- atom_codes(A1, A).
  265%
  266writeBR(W):- format("~w<br>\n", [W]).
  267%
  268equation_pair(E, (A, B)):- append(A, [0'=|B], E), !.   %'
  269%
  270format_codes(F, A, X):-  format(codes(X), F, A).
  271%
  272echo --> [].
  273%
  274create_file(F, C):- file(F, write, smash(C))