web.pl

    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:- op(670, yfx, \).   16:- op(200, xfy, ^).   17
   18:- use_module(util(file)).   19:- use_module(util(cgi)).   20:- use_module(util(misc)).   21:- use_module(zdd('zdd-plain')).   22
   23:- set_prolog_flag(allow_variable_name_as_functor, true).   24:- nb_setval(webform, []).   25:- nb_setval(query_op, []).   26
   27/*--------------------------------------------
   28To debug cgi by trace/spy) in emacs or terminal.
   29-	Run cgi query to be debugged from browser,
   30-	then run this.
   31?-	trace, cgi_debug.
   32?-	cgi_debug.
   33--------------------------------------------*/
   34% ?- spy(solve_query).
   35% ?- spy(det_phrase).
   36% ?- spy(cgi_demo).
   37% ?- spy(read_term).
   38% ?- spy(notify_cgi_access).
   39% ?- trace.
   40% ?- cgi_debug.
   41
   42		/**********************************
   43		*     Predicates for Prolog CGI    *
   44		***********************************/

cgi_main is det: main entry for Prolog CGI.

   48cgi_main:- prompt(_,''),
   49	catch((get_request_browser(Form), cgi_in_prolog(Form)),
   50		  Ball,
   51		  (response_form(Ball, R), write_html(R))).
   52%
   53cgi_debug:-
   54	catch((get_request_kept(Form), cgi_in_prolog(Form)),
   55		  Error,
   56		  (response_form(Error, R), write_html(R))).
   57
   58%
   59get_request_browser(Form):- get_eof(S),
   60	parse_form(S, Form),
   61	getenv(http_request, H),   % save input for debugging locally.
   62	put_eof(H, S).
   63%
   64get_request_kept(Form):-
   65	getenv(http_request, H),
   66	get_eof(H, S),
   67	parse_form(S, Form).
   68
   69%
   70cgi_in_prolog(Form) :-
   71	nb_setval(webform, Form),
   72	query_to_answer(Form, Ans),
   73	write_html(Ans),
   74	cgi_log(Form),
   75	access_notification_sendmail.
   76%
   77cgi_log(Form):- getenv(cgi_log, true), !,
   78	getenv(cgi_log_file, Log),
   79	memberchk(expr = Query, Form),
   80	open(Log, append, Stream, [encoding(utf8)]),
   81	current_output(D),
   82	set_output(Stream),
   83	nl,
   84	nl,
   85	pipe_line(date, Date),
   86	smash([Date, "\n", Query]),
   87	close(Stream),
   88	set_output(D).
   89cgi_log(_).

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

   93query_to_answer(X, Y):-
   94	memberchk(expr = C, X),
   95	query_to_html_codes(C, Y0),
   96	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(_).

  108% ?- access_notification_sendmail.
  109% NOT work. Need to know details about /usr/sbin/sendmail.
  110access_notification_sendmail:- getenv(cgi_sendmail, true), !,
  111	getenv(user, User),
  112	qshell('/usr/sbin/sendmail'(
  113				   'From:', User,
  114				   'To:', 'mukai827@mac.com',
  115				   'Subject: cgi in prolog access\n\n')).
  116access_notification_sendmail.
  117
  118% ?- query_to_html_codes(`(peek([b]), append([a]))`, X), smash(X).
  119% ?- query_to_html_codes(`?-append([a],[b], A)`, X), smash(X).
  120% ?- parse_query((?- append([a], [b], _G2170)), ['A'=_G2170], _G2288).
  121% ?- parse_query(`?- append([a], [b], X)`, Y).
  122% ?- parse_query(`(peek([1]), append([2]), set::pow)`, X).
  123% ?- parse_query(`(?-append([a],[b], X))`, V).
  124% ?- parse_query(`append([a],[b])`, V).
  125% ?- parse_query(`(??- member(X, [1,2,3]))`, V).
  126% ?- parse_query(`(peek([b]), append([a]))`, V).
  127% ?- eval(misc:set::pow([1,2]), V).
  128% ?- parse_query(`(peek([a,b]), ([X]\\set::pow(X)))`, V).
  129% ?- expand_basic_phrase(fun([X], misc:set::pow(X)), user, F, P, []).
  130%  parse_query(X, _, _):- var(X), !, throw
  131
  132query_to_html_codes(X, Y):-
  133	herbrand_deref(X, X0, V),
  134	parse_query(X0, V, Y).

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

  138parse_query(X,  Y):-
  139	herbrand_deref(X, X0, V),
  140	parse_query(X0, V, Y).

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

  144parse_query((?-X), V, Y):- !,
  145	must_be(callable, X),	% check_act(X, 0),
  146	once(expand_goal(X, [], G, P, [])),
  147	maplist(assert, P),
  148	(call(G) -> Y = V ; Y = fail).
  149parse_query(??-(X), V, Y):- !,	must_be(callable, X), % check_act(X, 0),
  150	once(expand_goal(X,[],G,P,[])),
  151	maplist(assert, P),
  152	(findall(V, call(G), Y) -> true; Y = []).
  153% parse_query(X, _, Y):-	eval_query(X, Y).
  154parse_query(X, _, Y):-
  155	once(expand_goal(X, [], G, P, [])),
  156	maplist(assert, P),
  157	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).

  162eval_query(X, Y):-
  163	phrase_to_pred(X, [], H:-G, P, []),
  164	maplist(assert, P),
  165	H = [X,Y],
  166	call(G).
  167%
  168codes_string(X, Y):- string_codes(Y, X).
  169
  170% ?- solve_query(true, 1, X).
  171% ?- trace, solve_query(append([a,b]), [c,d], X).
  172% ?- trace, solve_query(append([a,b]), [c,d], X).
  173% ?- solve_query(((append([a,b]), append([c,d])), append([x,y])), [1,2], X).
  174% ?- solve_query((peek([u,v]), ((append([a,b]), append([c,d])), append([x,y]))), [1,2], X).
  175%@ X = [x, y, c, d, a, b, u, v].
  176
  177:- meta_predicate solve_query(:, ?, ?).  178% ! is not allowed to appear in F.
  179solve_query(F, X, Y):- strip_module(F, M, G),
  180	once(solve_query(G, X, Y, M)).
  181%
  182solve_query(true, X, X, _):-!.
  183solve_query(((F, G), H), X, Y, M):-!, solve_query((F, (G, H)), X, Y, M).
  184solve_query((F;G), X, Y, M):-!,
  185	(	solve_query(F, X, Y, M)
  186	;	solve_query(G, X, Y, M)
  187	).
  188solve_query((foldup, _), X, Y, _):-!, is_list(X),
  189	list_www_string(X, Y).
  190solve_query((F, G), X, Y, M):-!,
  191	solve_query(F, X, Z, M),
  192	solve_query(G, Z, Y, M).
  193solve_query(M:G, X, Y, _):-!, solve_query(G, X, Y, M).
  194solve_query(foldup, X, Y, _):-!,
  195	is_list(X),
  196	list_www_string(X, Y).
  197solve_query(once(G), X, Y, M):-!, once(solve_query(G, X, Y, M)).
  198solve_query(G, X, Y, M):- once(call(M:G, X, Y)).
  199
  200%	cgi_phrase(+X, -V) is det.
  201%	Eval cgi-phrase  X to a term V.
  202cgi_phrase(X,  V):- cgi_phrase(X, Head, Rest), !,
  203	phrase_to_pred(Rest, [], H:-G, P, []),
  204	maplist(assert, P),
  205	pac:eval(Head, V0),
  206	H = [V0, V],
  207	call(G).
  208cgi_phrase(X,  V):- call(X, V).
  209
  210% ?- cgi_phrase(((a,b),c), X, Y).
  211cgi_phrase(((X,Y),Z), U, V):- !, cgi_phrase((X,(Y,Z)), U, V).
  212cgi_phrase((X,Y), X, Y).

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

  217response_form(X, Y):-
  218	(	nb_current(webform, W); W = [] ), !,
  219	(	member(buttonid = B, W); B = `dummybuttonid` ), !,
  220	(	member(targetid = R, W); R = `dummytargetid` ), !,
  221	atom_codes(B0, B),
  222	atom_codes(R0, R),
  223	smash(X, E),
  224	Y = [B0, "\n", R0, "\n", E].

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

  228form_encode(X, Y):- atomic(X), !,
  229	www_form_encode(X, Y0),
  230	atom_codes(Y0, Y).
  231form_encode(X, Y):- atomic(Y), !,
  232	www_form_encode(X0, Y),
  233	atom_codes(X0, X).
  234form_encode(X, Y):-
  235	(	nonvar(X) -> atom_codes(A, X),
  236		www_form_encode(A, B),
  237		atom_codes(B, Y)
  238	;	atom_codes(B, Y),
  239		www_form_encode(A, B),
  240		atom_codes(A, X)
  241	).
  242
  243%	list_www_string(?X, ?Y) det.
  244%	bidirectional.
  245%	For a prolog lilst  X = [A1, ..., An]
  246%	Y is a www form string of "B1/B2/.../Bn"
  247%	such that Ai is decoded Bi  (i=1,..., n).
  248%	cf. www_form_encode/2,  uri_encoded/3.
  249
  250% ?- X = ['Automaton', '<img src="automata/am5.svg"/>'],
  251%	list_www_string(X, Y),
  252%	list_www_string(X0, Y).
  253
  254% ?- list_www_string([///, ///], R),
  255%	list_www_string(X, R).
  256
  257list_www_string(L, W):- nonvar(L), !,
  258	maplist(twice_www_form_encode, L, M),
  259	atomics_to_string(M, /, W).
  260list_www_string(L, W):-
  261	atomics_to_string(M, /, W),
  262	maplist(twice_www_form_encode, L, M).
  263%
  264twice_www_form_encode(X, Y):-nonvar(X), !,
  265	www_form_encode(X, Z),
  266	www_form_encode(Z, Y).
  267twice_www_form_encode(X, Y):-
  268	www_form_encode(Z, Y),
  269	www_form_encode(X, Z).

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

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

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

  285herbrand_deref(X, Y, Binds):-
  286	herbrand_web(Binds, X, X1),
  287	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'.

  293expandref(X, Y):-  (var(X); atomic(X)), !, Y = X.
  294expandref(@(X), Y):- !, getcodes(X, Y).
  295expandref(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.

  300% ?- b_setval(webform, [a= hello]), getcodes(a, X).
  301% X = hello
  302getcodes(X, Y):- nb_getval(webform, Env), member(X = Y, Env), !.
  303getcodes(X, _):- throw(error(no_data_for(X))).

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

  308write_html(R):- smash(R, E),
  309	string_length(E, N),
  310	format("Content-type: text/plain; charset=utf-8~n~n"),
  311	format("Content-Length: ~w~n", [N]),
  312	write(E).

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

  316get_eof(S):- get_code(C),
  317	(	C < 0 -> S = []
  318	;	S = [C|S1],
  319		get_eof(S1)
  320	).
  321
  322% ?- absolute_file_name('~/Desktop/xxx', R).
  323% ?- get_eof('/Users/cantor/devel/zdd/prolog/util/web.pl', X),
  324%	 put_eof('/Users/cantor/Desktop/deldel.pl', X).
  325
  326get_eof(F, S):- open(F, read,  U, [encoding(utf8)]),
  327				get_eof_stream(U, S),
  328				close(U).
  329%
  330get_eof_stream(U, S):- get_code(U, C),
  331	(	C < 0 -> S = []
  332	;	S = [C|S1],
  333		get_eof_stream(U, S1)
  334	).
  335%
  336put_eof(F, S):- open(F, write,  U, [encoding(utf8)]),
  337				put_eof_stream(U, S),
  338				close(U).
  339%
  340put_eof_stream(_, []):-!.
  341put_eof_stream(U, [A|As]):-!, put_code(U, A),
  342				put_eof_stream(U, As).

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

  346parse_form(X, Y):- basic:split(`&`, X, L),
  347	maplist(equation_pair, L, Y1),
  348	maplist(decode_pair, Y1, Y2),
  349	maplist(name2atom, Y2, Y).
  350
  351		/***********************
  352		*     tiny helpers.    *
  353		***********************/
  354%
  355equation_pair(E, (A, B)):- append(A, [0'= |B], E), !.   %'
  356%
  357decode_pair((X, []), (X0, "")):-!, form_encode(X0, X).
  358decode_pair((X, Y), (X0, Y0)):- form_encode(X0, X), form_encode(Y0, Y).
  359%
  360name2atom((A,B), A1 = B) :- atom_codes(A1, A).
  361%
  362writeBR(W):- format("~w<br>\n", [W]).
  363%
  364format_codes(F, A, X):-  format(codes(X), F, A).
  365%
  366echo --> [].
  367%
  368create_file(F, C):- file(F, write, smash(C))