%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% ODBC OPEN/CLOSE/SELECT Utility   T.Inaba  2002.7.1〜  %%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/*
	ODBC64のインストール
	http://www.microsoft.com/downloads/ja-jp/details.aspx?FamilyID=C06B8369-60DD-4B64-A44B-84B371EDE16D&displaylang=ja
*/

:- public odbc_open/3.
:- public odbc_close/0.
:- public select_each/3.
:- public select_each/4.
:- public select_each/6.
:- public fetch_one/4.
% :- public reset_counter/2.
:- public is_null/1.
:- public sql_cancels/1.
:- public exec_direct/2.
:- public exec_directs/3.

:- public exec_directs_pre/4.
:- public exec_directs_post/2.
:- public exec_directs_main/4.

:-extern det:sql_alloc_env/1.
:-extern det:sql_alloc_connect/2.
:-extern det:sql_connect/4.
:-extern det:sql_free_handle/2.
:-extern det:sql_free_params/1.
:-extern det:sql_disconnect/1.
:-extern det:sql_free_connect/1.
:-extern det:sql_free_handle/2.
:-extern det:sql_alloc_handle/3.
:-extern det:sql_prepare/2.
:-extern det:sql_cancel/1.
:-extern det:sql_execute/1.
:-extern det:sql_exec_direct/2.
:-extern det:sql_fetch/2.
:-extern det:sql_bind_col/5.
:-extern det:sql_get_param/2.

exec_directs(No, Params,Errors):-
  exec_directs_pre(No,DBC,Stmt,SQLINI),
		exec_directs_main(Stmt,SQLINI,Params,Errors),
  exec_directs_post(DBC,Stmt).

exec_directs_pre(No,DBC,Stmt,SQLINI):-
	sql_connect_data(No,DSN,USR,PSWD),
	sql_statement(No,[],SQLINI),!,
	get_direct_env(Env),
	sql_alloc_connect(Env, DBC),
	sql_connect(DBC, DSN, USR, PSWD),
	sql_alloc_handle(sql_handle_stmt, DBC, Stmt).

exec_directs_post(DBC,Stmt):-
	sql_cancel(Stmt),
	sql_free_handle(sql_handle_stmt, Stmt),
	sql_disconnect(DBC),
	sql_free_connect(DBC).

exec_directs_main(_,_,[],[]):-!.
exec_directs_main(Stmt,SQLINI,[Params|L],Errors):-
	sql_flat(SQLINI,SQLString,Params),
	errorset_cut(sql_exec_direct(Stmt, SQLString),succ),!,
	exec_directs_main(Stmt,SQLINI,L,Errors).
exec_directs_main(Stmt,SQLINI,[Params|L],[Params|Errors]):-
	exec_directs_main(Stmt,SQLINI,L,Errors).

exec_direct(No, Params):-
	sql_connect_data(No,DSN,USR,PSWD),
	sql_statement(No,[],SQLINI),!,
	get_direct_env(Env),
	sql_flat(SQLINI,SQLString,Params),
	sql_alloc_connect(Env, DBC),
	sql_connect(DBC, DSN, USR, PSWD),
	sql_alloc_handle(sql_handle_stmt, DBC, Stmt),
	errorset_cut(sql_exec_direct(Stmt, SQLString),Error),
	sql_cancel(Stmt),
	sql_free_handle(sql_handle_stmt, Stmt),
	sql_disconnect(DBC),
	sql_free_connect(DBC),
	Error=succ.

get_direct_env(Env):- odbc_env(Env,_),!.
get_direct_env(Env):- sql_alloc_env(Env),odbc_assert(Env,L-L).

errorset_cut(X,Y):-errorset(X,YY),!,Y=YY.

%%%%%%%%%%%%%%%%%%
%% *** OPEN *** %%
%%%%%%%%%%%%%%%%%%

odbc_open(DSN, USER, PASSWORD):- 
	odbc_member([_,DSN,USER,_]),!.
odbc_open(DSN-No, USER, PASSWORD):-
	odbc_env(Env,_),!,
	sql_alloc_connect(Env, DBC),
	sql_connect(DBC, DSN, USER, PASSWORD),
	odbc_replace(DBCS-[[DBC,DSN-No,USER,[]]|Q], DBCS-Q).
odbc_open(DSN, USER, PASSWORD):-
	sql_alloc_env(Env),odbc_assert(Env,L-L),
	odbc_open(DSN, USER, PASSWORD).

%%%%%%%%%%%%%%%%%%%
%% *** Close *** %% 
%%%%%%%%%%%%%%%%%%%

odbc_close:-
  odbc_retract(Env,DBCS-[]),!,
  close_dbcs(DBCS),
  sql_free_handle(sql_handle_env, Env).
odbc_close.

close_dbcs([]):-!.
close_dbcs([[DBC,_,_,Stmts]|DBCS]):-
  close_stmts(Stmts),
  sql_disconnect(DBC),
  sql_free_connect(DBC),
  close_dbcs(DBCS).

close_stmts([]):-!.
close_stmts([No/Stmt-Param|Stmts]):-
    sql_free_handle(sql_handle_stmt, Stmt),
    sql_free_params(Param),
	close_stmts(Stmts).

%%%%%%%%%%%%%%%%%%%%
%% *** Select *** %%
%%%%%%%%%%%%%%%%%%%%
/* 

定義節：
sql_connect_data(
	SQL_ID,
	DB,
	ACCOUNT,
	PASSWORD).


%% 常用ＳＥＬＥＣＴ述語 
select_each(Items,
            From,
            Where)

*/

select_each(Items,From,Where):-
	catch(tag,select_each(From,Where,tag,Items)),Items=[A|_],nonvar(A).

/* Default は先頭のＤＢＣを利用 */
select_each(No,Cond,Tag,List):-
	sql_connect_data(No,DNS,USR,PSWD),!,    /* 接続情報取得 */
	select_each(DNS,USR,No,Cond,Tag,List).
select_each(No,Cond,Tag,List):-
	select_each(_,_,No,Cond,Tag,List).

/* DNS,USR を指定されたときは、その接続ＤＢＣを利用 */
select_each(DNS,USR,No,Cond,Tag,List):-
	odbc_member([DBC,DNS-No,USR,Stmts]),!,
	select_each_with_dbc(DBC,No,Stmts,Cond,Stmt,Cols), 
	fetch_one(Stmt,Tag,Cols,List).

			/* Open されていなければ、自動Ｏｐｅｎ */
select_each(DNS,USR,No,Cond,Tag,List):-
	sql_connect_data(No,DNS,USR,PSWD),!,    /* 接続情報取得 */
	odbc_open(DNS-No,USR,PSWD),
	select_each(DNS,USR,No,Cond,Tag,List).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/* 
	Stmtの束から、同一ＳＱＬ番号のStmtを取り出す
	存在しなければ、生成する
*/
get_stmts(DBC,No,[],[No/Stmt-Cols],Stmt,Cols):- 
	!,sql_alloc_handle(sql_handle_stmt, DBC, Stmt).
get_stmts(DBC,No,[No/Stmt-Param|L],[No/Stmt-Cols|L],Stmt,Cols):-
	!,sql_cancel(Stmt), sql_free_params(Param).
get_stmts(DBC,No,[A|L],[A|R],Stmt,Cols):-
	get_stmts(DBC,No,L,R,Stmt,Cols).

replace_stmts(A,_,_,_):- var(A),!,fail.
replace_stmts([[DBC,Dsn,Usr,_]|L],DBC,Stmts,[[DBC,Dsn,Usr,Stmts]|L]):-!.
replace_stmts([A|L],DBC,Stmts,[A|R]):-replace_stmts(L,DBC,Stmts,R).

sql_cancels(N):-odbc_env0(_,[[_,_,_,L]|_]-_),cancels(N,L).

cancels(N,[]):-!.
cancels(N,[N/Stmt-Para|_]):-!,sql_cancel(Stmt),sql_free_params(Para).
cancels(N,[_|L]):- cancels(N,L).

%%%% SUB %%%%
select_each_with_dbc(DBC,No,Stmts,Cond,Stmt,Cols):-
  get_stmts(DBC,No,Stmts,NewStmts,Stmt,Cols),
  sql_statements( No,Items,SQL,Cond),
  sql_prepare(Stmt,SQL),
  sql_bind_cols(Stmt,1,Items,Cols),
  odbc_env(_,DBCS0-Q),
  replace_stmts(DBCS0,DBC,NewStmts,NewDBC),
  odbc_replace(_,NewDBC-Q),
  (sql_execute(Stmt) ->true;if_debs(SQL),fail).

if_debs(X):-e_switch(1,on,on),!,write(X),nl,xx_puts(X),nl.
if_debs(X).

xx_puts([]):-!.
xx_puts([X|L]):- put(X),xx_puts(L).

%%%%%%%%%%%%%%%%%%%%%
fetch_one(_,_,[],[]):-!.
fetch_one(Stmt,Tag,Cols,List):-
  repeat,
  	sql_fetch(Stmt,X), 
  	(X \== sql_succeeded -> throw(Tag);true), 
  	sql_get_param_all(Cols,List).

sql_bind_cols(S,N,[],[]):-!.
sql_bind_cols(S,N,[A|L],[B|E]):-
	coltype(A,Type,Vol),
	sql_bind_col(S,N,Type,B,Vol),
	NN is N+1,
	sql_bind_cols(S,NN,L,E).

coltype(char/N,    sql_c_char,N):-!.
coltype(date,      sql_c_date,_):-!.
coltype(long,      sql_c_long,_):-!.
coltype(double,    sql_c_double,_):-!.
coltype(timestamp, sql_c_timestamp,_):-!.
coltype(X,_,_):-write(X),nl,error(199).

sql_get_param_all([],[]):-!.
sql_get_param_all([A|B],[C|D]):-
	sql_get_param(A,C),
	sql_get_param_all(B,D).

sql_statements(No,Items,X,P):- sql_statement(No,Items,Y),!,sql_flat(Y,X,P).

/* ************************** */
/* ***** General Utility **** */
/* ************************** */

% reset_counter(N,N):-!.
% reset_counter(N,M):-e_register(N,_,0),NN is N+1,reset_counter(NN,M).

sql_flat(A,X,P):- dflat(A,X-[],P-_).

dflat(X,Q,[A|S]-T):-var(X),!,conv_data(A,AL),dflat(AL,Q,S-T).
dflat([],X-X,P-P):-!.
dflat([A|L],Y-Z,P-Q):-!,dflat(A,Y-W,P-R),dflat(L,W-Z,R-Q).
dflat(X,[X0,X1|L]-L,P-P):-integer(X),X>=256,!,to_1byte([X],[X0,X1]).
dflat(X,L,P):-atom(X),!,name(X,XL),dflat(XL,L,P).
dflat(X,[X|L]-L,P-P).

conv_data(A,AL):- atom(A),A \== [],!,name(A,AL0),to_1byte(AL0,AL).
conv_data(A,AL):- number(A),!,name(A,AL).
conv_data([Y,M,D],L):- M>0,M<13,D>0,D<32,!,all_name([Y,M,D],L-[39],39).
conv_data(X,XL):- to_1byte(X,XL).

to_1byte([],[]):-!.
to_1byte([A|B],[A|C]):- A<256,!,to_1byte(B,C).
to_1byte([A|B],[A0,A1|C]):-
	is_smallendian,			/*  2011.6.9 */
	!,A0 is A//256,A1 is A mod 256,
	to_1byte(B,C).

to_1byte([A|B],[A0,A1|C]):-			% BigEndian
	A1 is A//256,A0 is A mod 256,
	to_1byte(B,C).

all_name([],L-L,D):-!.
all_name([A|L],Q-P,D):- name(A,AL),sql_append([D|AL],R,Q),all_name(L,R-P,47).


/*  2011.6.9 */
is_smallendian:-s_version(_,_,_,x86),!.
is_smallendian:-s_version(_,_,_,x64),!.

sql_append([],L,L):-!.
sql_append([A|R],L,[A|RL]):- sql_append(R,L,RL).

odbc_env(X,Y):-odbc_env0(X,Y),!.

odbc_assert(X,Y):- s_mode(_,on), !,assert(odbc_env0(X,Y)), s_mode(_,off).

odbc_replace(X,Y):- 
	s_mode(_,on),
		retract(odbc_env0(Env,X)),!,assert(odbc_env0(Env,Y)),
	s_mode(_,off).

odbc_retract(X,Y):- s_mode(_,on),retract(odbc_env0(X,Y)),!,s_mode(_,off).
odbc_retract(X,Y):- s_mode(_,off),fail.

odbc_member(X):- odbc_env(_,DBCS-[]),odbc_member(X,DBCS).

odbc_member(X,[X|L]):-!.
odbc_member(X,[A|L]):- odbc_member(X,L).

is_null('NULL!').

