%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Prolog CGI TopLevel & Utility    T.Inaba  2004.2.1〜  %%
%% Prolog CGI TopLevel & Utility    T.Inaba  2008.1.8〜  %%
%% Prolog CGI TopLevel & Utility    T.Inaba  2010.2.4〜  %%
%%
%% >cd  %AZ-Prolog%\system\pl 
%% >set AZOBJ=%AZ-Prolog%\obj
%% >azpc -p isopred.pl prologcgi.pl utility.pl grammar.pl setof.pl /e prologcgi /lib $(AZOBJ)\prolog.res /no /i /dcurses
%% >del *.c & del *.obj & del mkaz.bat
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% CGI UTILITY %%%
%% 公開述語 
%%
%%  html_call/1       引数：リスト　要素を標準出力する。要素がcall(項)の場合、項を評価する
%%  get_param/2       第一引数: CGIコールの際のタグ名 　第二引数：その値
%%  html_tmplate/2    第一引数: テンプレートファイル名　第二引数：変数名=値 の並びリスト
%%  html_tmplate/1    第一引数: テンプレートファイル名

:- s_mode(_,on).
:- op(1200,fx,#).
:- run:op(1200,fx,#).

/* 起動：  > prologcgi xxxx.cgi?a=aho&b=baka */

top_level:- 
	fileerrors(_,fail),
	errormode(_,0),
	prompt(_,''),
	(get_parameter([CGI_AND_PARAM])->true;CGI_AND_PARAM=''),
	divide_rule(CGI_AND_PARAM,CGI,PARAM),
	s_get_param(PARAM),
	load_cgi(CGI),
	go_top.

go_top:- clause(top_call(X),true),!,call(X).
go_top:- call(top_call(X)),!,call(X).			% bytecall
go_top:- call(top_call).

%%% 引数からファイル名などのパラメータを取り出す
divide_rule(X,'',L):-
	current_pred(top_call,0),!,name(X,L).

divide_rule(X,C,P):-
	D is "?",name(X,XList),divide_rule2(D,XList,CL,P),name(C,CL).

divide_rule2(_,[],[],[]):-!.
divide_rule2(D,[D|P],[],P):-!.
divide_rule2(D,[A|L],[A|R],P):- divide_rule2(D,L,R,P).

%%% 連想文字変換
cgi_assoc(X,Y,[X,Y|_]):-!.
cgi_assoc(X,Y,[_,_|L]):- cgi_assoc(X,Y,L).

%%%%% 起動ＣＧＩのパラメータを取得する %%%%

s_get_param(_):-      % Apach からGET,POST メソッドで呼ばれたとき
	getenv('REQUEST_METHOD',RM),!,s_get_param2(RM).
s_get_param(Param):-  % 直接呼ばれたとき
	!,ss_get_param2(Param).
s_get_param(_).

s_get_param2('GET'):-
	!,getenv('QUERY_STRING',QSA),name(QSA,QSS),ss_get_param2(QSS).
s_get_param2('POST'):-
	getenv('CONTENT_LENGTH',CL), term_atom(CLN,CL),
	getenv('CONTENT_TYPE',CT),
	s_get_param3(CT,CLN).

:- extern rexpl/4.
:- extern rexpl/5.
:- extern rexpl/6.	

s_get_param3(CT,CLN):-
	rexpl(CT,"multipart/form-data; boundary=",_,Bound0),
	Bound=[31,45,45|Bound0],
	read_strings2end(QSS),
	rexpl([31|QSS],Bound,_,QSSAfter),
	!,
	qss2param(QSSAfter,Bound,GetParam),
	ss_get_param_assert(GetParam).
	
s_get_param3(CT,CLN):-
	read_strings(CLN,QSS),
	ss_get_param2(QSS).

qss2param(QSS,Bound,[X,Y|GetParam]):-
	rexpl(QSS,Bound,_,QSSAfter,QSSBefore),!,
	string2xy(QSSBefore,X,Y),
	qss2param(QSSAfter,Bound,GetParam).

qss2param(QSS,Bound,[]).

string2xy(QSS,X,Y):-
	rexpl(QSS,'name="(.+?)"',_,After,_,[Name]),!,
	name(X,Name),
	string2y(After,Y).

string2y(Str,{File,Type,ContentA}):-
	rexpl(Str,'filename="(.*?)"',_,After,_,[FName]),name(File,FName),
	rexpl(After,'Content-Type: (.*?)$',_,[_,_|Content],_,[TypeName]),name(Type,TypeName),!,
	if_can_atom(Content,ContentA).

string2y([_,_|After],Atom):- if_can_atom(After,Atom).

if_can_atom(After,Atom):- length(After,Lng),Lng<256,!,name(Atom,After).
if_can_atom(After,After).

%% 引数を正規化する
ss_get_param2(QSS):-
	to_check(QSS,QSS2),
	conv_get_param(QSS2,L-L,GetParam),
	ss_get_param_assert(GetParam).

ss_get_param_assert(GetParam):-
	s_mode(SMODE,on),asserta((param_assoc_list(GetParam):-!)),s_mode(_,SMODE).

conv_get_param([],L-[],X):-!,to_name_p(L,X-[]).
conv_get_param([0|E],L-[],X):-!,to_name_p(L,X-Y),conv_get_param(E,S-S,Y).
conv_get_param([A|E],L-[A|S],X):-conv_get_param(E,L-S,X).

to_name_p([],[''|L]-L):-!.					% 2006.09.25
to_name_p(X,[A|L]-L):- if_can_atom(X,A).

% 2007.12.13 
read_strings2end(X):- errorset_get1(A),read_strings2end(A,X).
read_strings2end(4,[]):-!.
read_strings2end(26,[]):-!.
read_strings2end(A,[A|L]):- read_strings2end(L).

errorset_get1(A):-errorset(get1(A),succ),!.

read_strings(0,[]):-!.
read_strings(X,[A|L]):-errorset_get1(A),!,XX is X-1,read_strings(XX,L).
read_strings(_,[]):-!.

to_check([],[]):-!.
to_check([37,48,68,37,48,65|L],[31|M]):-!,to_check(L,M).      %  %0D%0A ->\n
to_check([37,48,68|L],[31|M]):-!,to_check(L,M).               %  %0D    ->\n
to_check([37,48,65|L],[31|M]):-!,to_check(L,M).               %  %0A    ->\n
to_check([13,10|L],[31|M]):-!,to_check(L,M).                  %  \n
to_check([13|L],[31|M]):-!,to_check(L,M).                     %  \n
to_check([10|L],[31|M]):-!,to_check(L,M).                     %  \n
to_check([92,92|L],[92|M]):-!,to_check(L,M).                  %  \\ -> \
to_check([43|L],[32|M]):-!,to_check(L,M).                     %  +  -> " "
to_check([37,A,B|L],[C|M]):-!,to_charm(A,B,C),to_check(L,M).  %  %AB -> C 
to_check([92|L],P):-!,to_check(L,P).                          %  \
to_check([38|L],[0|P]):-!,to_check(L,P).                      %  & -> 0 パラメータ区切り
to_check([61|L],[0|P]):-!,to_check(L,P).                      %  = -> 1 タグ＝値
to_check([A|L],[A|P]):-to_check(L,P).

%% %OD%0A ==> 0'd,0'A ２ケタの１６進数へ変換
to_charm(A,B,X):-to_charm2(A,AA),to_charm2(B,BB),X is AA*16+BB.
to_charm2(X,Y):- X>=48,X=<57,!,Y is X-48.                     % 0-9
to_charm2(X,Y):- X>=65,X=<70,!,Y is X-55.                     % A-F.

%%%%%% File のロード %%%%%
load_cgi(''):- !.
load_cgi(File):- 
	s_mode(SM,on),assert(my_cgi_name(File)),s_mode(_,SM),
	s_new,
	see(File),
	  get_header,    % ヘッダ読み飛ばし
	  cgi_read_loop,
	seen.

%%% ヘッダ読み飛ばし
get_header:- get0(X), get_header(X).
get_header(10):-!.              % 2012.4.11 T.Inaba !!! Linux is LF Only !! %
get_header(13):-!.              % 2012.4.11 T.Inaba !!! Apple is CR Only !! %
get_header(31):-!.
get_header(_):- get_header.

%%% 本体読み込み
cgi_read_loop:- errorset_read(X),cgi_read_loop(X).

errorset_read(X):-errorset(read(X),_),!.

cgi_read_loop(module(Md,AtomS,CodeS,HeapS,IndexS,ExternS,Preds)):-
	list(Preds),!,
	b_load(Md,AtomS,CodeS,HeapS,IndexS,ExternS,Preds,add,Next),
	cgi_read_loop(Next).
cgi_read_loop(#(bytecode)):-!,b_load.
cgi_read_loop(end_of_file):-!.
cgi_read_loop(':-'(X))    :- errorset(X,_),!, cgi_read_loop.
cgi_read_loop(#(program)) :- !,cgi_read_loop.
cgi_read_loop(X)          :- !,assertz(X),cgi_read_loop.

%%%%%%%%%%%%%%%%%%%%%
%% ByteCode Loader %%
%%%%%%%%%%%%%%%%%%%%%
:- extern det:b_load/9.

b_load:- read(module(Md,AtomS,CodeS,HeapS,IndexS,ExternS,Preds)),
		 b_load(Md,AtomS,CodeS,HeapS,IndexS,ExternS,Preds,add,ReadEnd),
		 cgi_read_loop(ReadEnd).

%%%%%%%%%%%%%%%%%%%
%%% パラメータの参照 
%%%%%%%%%%%%%%%%%%%

:- public get_param/2.
get_param(A,B):- param_assoc_list(L),!,cgi_assoc(A,B,L).

%%%%%%%%%%%%%%%%%%%
%%% リスト内容を出力する。Prologのコードを呼び出す。
%%%%%%%%%%%%%%%%%%%

:- public html_call/1.
html_call([]):-!,nl.
html_call([ call(X) |L]):-!,call(X),html_call(L).
html_call([X|L]):- list(X),!,s_puts(X),html_call(L).
html_call([X|L]):- write(X),html_call(L).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% テンプレートファイルを利用してのHTML出力
%
% 文字列置き換え
% <TMPL_VAR NAME=image_modem>   ==> Replaced_Letters に置き換え
% tmp_name(image_modem,'Replaced_Letters').
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%<TMPL_IF NAME="ServiceADSL">
%    <img style="position:absolute;top:5px;left:380px;width:100px;height:70px" src="/cs/images/pc.gif">
%    <img style="position:absolute;top:40px;left:175px" src="/cs/images/line_down.gif" WIDTH="205px" HEIGHT="5px">
%    <img style="position:absolute;top:40px;left:175px;display=<TMPL_VAR NAME=disp_line2>" src="/cs/images/line.gif" WIDTH="205px" HEIGHT="5px">
%</TMPL_IF>

%%%
:- public html_tmplate/2.
:- public html_tmplate/1.

html_tmplate(File,List_or_File):-
	abolish(tmp_name,2),
	errorset( ( atom(List_or_File) -> reconsult(List_or_File) ; asserts_all(List_or_File) ),_),!,
	html_tmplate(File).

asserts_all([]):-!.
asserts_all([A=B|L]):- 
	assert(tmp_name(A,B)),
	asserts_all(L).

:- extern  get_chars_list/4.

html_tmplate(File):-
	temppattern_comp(IFComp),
	see(File),
		get_chars_list(con,31,Eof,Line),
		tmplif_replace([1],Line,IFComp,Eof),
	seen.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% テンプレート上のＩＦ−・ＥＮＤＩＦ %%%
tmplif_replace(Flag,Line,[IFbegin,IFend,P],Eof):-
	rexpl_memberc(Line,IFbegin,_,Else,Before,[Part]),!,    % IFがあったとき
	tmplvar_replace(Flag,Before,P),                        % その行ＩＦ前全ての変数置き換え
	if_flag(Flag,NewFlag,Part),
	tmplif_replace(NewFlag,Else,[IFbegin,IFend,P],Eof).

tmplif_replace([F|NewFlag],Line,[IFbegin,IFend,P],Eof):-
	rexpl_memberc(Line,IFend,_,Else,Before,_),!,           % /IFがあったとき Stack POP
	tmplvar_replace([F],Before,P),                         % その行ＩＦ前全ての変数置き換え
	tmplif_replace(NewFlag,Else,[IFbegin,IFend,P],Eof).

tmplif_replace(Flag,Line,[IFbegin,IFend,P],Eof):-          % IFも/IFもないとき
	tmplvar_replace(Flag,Line,P),                          % その行全ての変数置き換え
	Eof==cont,!,                                           % 後続行あり
	nl,get_chars_list(con,31,Eof2,Line2),                  % 次の行読込
	tmplif_replace(Flag,Line2,[IFbegin,IFend,P],Eof2).     % 次の行

tmplif_replace(_,_,_,end).                                 % FileEndのとき

if_flag([0|L],[0,0|L],_):-!.                               % IF NotDefのとき
if_flag([1|L],[1,1|L],Part):- name(APart,Part),tmp_name(APart,_),!.
if_flag([1|L],[0,1|L],_).

%%% TMPL_VAR の置き換え %%%
tmplvar_replace([1|_],L,P):- !,tmplvar_replace(L,P).       % IF Def のとき
tmplvar_replace(_,_,_).                                    % IF Not Def のとき

tmplvar_replace([],_):-!.
tmplvar_replace(Line,P):- 
	rexpl_memberc(Line,P,_,Else,Before,[Part]),!,
	get_tmp_name(Part,Replaced),
	s_puts(Before),write_listoratomic(Replaced),
	tmplvar_replace(Else,P).
tmplvar_replace(Line,_):-s_puts(Line). 

get_tmp_name(Part,Replaced):- name(Namae,Part),tmp_name(Namae,Replaced),!.
get_tmp_name(_,'').

write_listoratomic(L):-list(L),!,s_puts(L).
write_listoratomic(L):-write(L).

s_puts([A|L]):-!,put(A),s_puts(L).
s_puts([]).

:- extern det:pattern_compile/2.
:- extern rexpl_search/6.

%%%%  <TMPL_IF></TMPL_IF><TMPL_VAR = What> の正規表現パターンコンパイル
temppattern_comp([P1,P2,P3]):-
	pattern_compile("<[\t ]*(T|t)(M|m)(P|p)(L|l)_(I|i)(F|f)[\t ]?(N|n)(A|a)(M|m)(E|e)[\t ]*=[\t ""]*([^ ^\t^>^""]+)[\t ""]*>",P1),
	pattern_compile("<[\t ]*\/(T|t)(M|m)(P|p)(L|l)_(I|i)(F|f)[\t ]*>",P2),
	pattern_compile("<[\t ]*(T|t)(M|m)(P|p)(L|l)_(V|v)(A|a)(R|r)[\t ]?(N|n)(A|a)(M|m)(E|e)[\t ]*=[\t ""]*([^ ^\t^>^""]+)[\t ""]*>",P3).

%%% 正規表現パターンサーチの決定性化
rexpl_memberc(A,B,C,D,E,F):- rexpl_search(A,B,C,D,E,F),!.

:- s_mode(_,off).
