yap-6.3/library/MYDDAS/myddas_util_predicates.yap

/*************************************************************************
*									 *
*	 YAP Prolog 							 *
*									 *
*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
*									 *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
*									 *
**************************************************************************
*									 *
* File:		myddas_util_predicates.yap	                         *
  * Last rev:							         *
* mods:									 *
* comments:	Auxiliary for the MyDDAS MySQL and ODBC library		 *
*									 *
*************************************************************************/

:- module(myddas_util_predicates,[
				  '$process_sql_goal'/4,
				  '$process_fields'/3,
				  '$check_fields'/2,
				  '$get_value'/2,
				  '$get_values_for_insert'/3,
				  '$make_atom'/2,
				  '$write_or_not'/1,
				  '$abolish_all'/1,
				  '$get_values_for_update'/4,
				  '$get_table_name'/2,
				  '$extract_args'/4,
				  '$copy_term_nv'/4,
				  '$assert_attribute_information'/4,
				  '$make_a_list'/2,
				  '$make_list_of_args'/4,
				  '$where_exists'/2,
				  '$build_query'/5,
				  '$assert_facts'/2,
				  '$lenght'/2
				  ]).

:- use_module(myddas,[
		      db_verbose/1
		     ]).

:- use_module(myddas_errors,[
			     '$error_checks'/1
			     ]).

:- use_module(myddas_prolog2sql,[
				 translate/3,
				 queries_atom/2
				 ]).

'$process_sql_goal'(TableViewName,SQLorDbGoal,TableName,SQL):-
        (atom(SQLorDbGoal) ->
	    SQL = SQLorDbGoal,
	    TableName = TableViewName
	;
	    % This copy_term is done to prevent the unification
	    % with top-level variables   A='var('A')' error
	    copy_term((TableViewName,SQLorDbGoal),(CopyView,CopyGoal)),
	    translate(CopyView,CopyGoal,Code),
	    queries_atom(Code,SQL),
	    functor(TableViewName,TableName,_)
	).

'$process_fields'(FieldsInf,FieldString,KeysSQL):-
        '$create_field_list'(FieldsInf,FieldString,PrimaryKeys),
	'$process_primary_keys'(PrimaryKeys,KeysSQL).


'$process_primary_keys'([],'').
'$process_primary_keys'([FieldName|Fields],KeysSQL):-
        '$process_primary_keys_put_comma'(Fields,CommaSQL),
        '$make_atom'([' , PRIMARY KEY ( ',FieldName,CommaSQL,' )'],KeysSQL).

'$process_primary_keys_put_comma'([],''):-!.
'$process_primary_keys_put_comma'([FieldName|Fields],CommaSQL):-!,
        '$process_primary_keys_put_comma'(Fields,TempSQL),
        '$make_atom'([' , `',FieldName,'` ',TempSQL],CommaSQL).


'$create_field_list'([field(Name,Type,Null,Key,DefaultValue)],FinalSQL,PrimaryKeys):-!,
        '$field_extra_options'(Name,Null,Key,[],DefaultValue,TempSQL,PrimaryKeys),
        '$make_atom'([' `',Name,'` ',Type,TempSQL],FinalSQL).
'$create_field_list'([field(Name,Type,Null,Key,DefaultValue)|T],FinalSQL,PrimaryKeys):-
        %'$check_field_type'
        '$create_field_list'(T,Result,KeyInfo),
        '$field_extra_options'(Name,Null,Key,KeyInfo,DefaultValue,TempSQL1,PrimaryKeys),
	'$make_atom'([' `',Name,'` ',Type,TempSQL1,' , ',Result],FinalSQL).


'$field_extra_options'(Name,Null,Key,KeyInfo,DefaultValue,Result,PrimaryKeys):-
        ( Null == 'y' ->
	    '$make_atom'([' NOT NULL '],TempSQL1)
	;
	    TempSQL1 = ''
	),
	(var(DefaultValue) ->
	    Result = TempSQL1
	;
	    '$make_atom'([TempSQL1,' DEFAULT \'',DefaultValue,'\' '],Result)
	),
	( Key == 'y' ->
	    PrimaryKeys = [Name|KeyInfo]
	;
	    PrimaryKeys = KeyInfo
	).


%
% Predicate's used to determine if the command 'WHERE' exists in the
% query
%
'$where_exists'(SQL,1):-
        atom_codes(SQL,ListSQL),
	% Code for ' WHERE ', the spaces garantee that is the WHERE
	% command, and not a value of a field
	'$where_exists_aux'(ListSQL,[32,87,72,69,82,69,32]),!. 
'$where_exists'(_,0).

	
'$where_exists_aux'([W|TCodes],[W|TWhere]):-
	'$where_found'(TCodes,TWhere),!.
'$where_exists_aux'([_|TCodes],Where):-
	'$where_exists_aux'(TCodes,Where).

	
'$where_found'(_,[]).
'$where_found'([Letter|TCodes],[Letter|TWhere]):-
	'$where_found'(TCodes,TWhere).

%
% Predicates used to build the new string SQL
%

'$build_query'(0,SQL,[query(CodeArgs,_,_)],LA,FinalSQL):-
	'$build_query_aux'(0,SQL,CodeArgs,LA,FinalSQL).
'$build_query'(1,SQL,[query(CodeArgs,_,_)],LA,FinalSQL):-
	'$build_query_aux'(1,SQL,CodeArgs,LA,FinalSQL).

	
%Flag it necessary for knowing if it is the first argument
%added to where, and if so we do not add 'and'
'$build_query_aux'(_,SQL,[],[],SQL).
'$build_query_aux'(Flag,SQL,[CodeArg|CodeT],[LArg|LT],FinalSQL):-
	nonvar(LArg),!,
	'$concatSQL'(Flag,SQL,CodeArg,LArg,ConcatSQL),
	'$build_query_aux'(1,ConcatSQL,CodeT,LT,FinalSQL).
'$build_query_aux'(Flag,SQL,[_|CodeT],[_|LT],FinalSQL):-
	'$build_query_aux'(Flag,SQL,CodeT,LT,FinalSQL).

%This Predicate will concat the SQL query generated to the
% moment with the field and it's value
'$concatSQL'(Flag,SQL,att(Rel,Field),Value,ConcatSQL) :-
	number(Value),!,
	number_atom(Value,Number),
	'$and_or_where'(Flag,SQL,Temp0),
	atom_concat(Temp0,Rel,Temp1),
	atom_concat(Temp1,'.',Temp2),
	atom_concat(Temp2,Field,Temp3),
	atom_concat(Temp3,'=',Temp4),
	atom_concat(Temp4,Number,Temp5),
	atom_concat(Temp5,' ',ConcatSQL).

'$concatSQL'(Flag,SQL,att(Rel,Field),Value,ConcatSQL) :-
	'$and_or_where'(Flag,SQL,Temp0),
	atom_concat(Temp0,Rel,Temp1),
	atom_concat(Temp1,'.',Temp2),
	atom_concat(Temp2,Field,Temp3),
	atom_concat(Temp3,'=',Temp4),
	atom_concat(Temp4,'"',Temp5),  %"
	atom_concat(Temp5,Value,Temp6),
	atom_concat(Temp6,'" ',ConcatSQL). %"

% This predicate will determin if we should use AND or WHERE
'$and_or_where'(1,SQL,ConcatSQL):-
	atom_concat(SQL,'AND ',ConcatSQL).
'$and_or_where'(0,SQL,ConcatSQL):-
        atom_concat(SQL,' WHERE ',ConcatSQL).

%
% End of Predicates for making the SQL query
%

'$make_list_of_args'(N,N,F,[H]) :- !,
	arg(N,F,H).
'$make_list_of_args'(N,M,F,[H|T]) :-
	arg(N,F,H),
	N1 is N+1,
	'$make_list_of_args'(N1,M,F,T).

'$make_a_list'(0,[]) :- !.
'$make_a_list'(N,[_|T]) :-
	N1 is N-1,
	'$make_a_list'(N1,T).

'$assert_attribute_information'(N,N,_,_) :- !.
'$assert_attribute_information'(N,M,Relation,[FieldName,HeadType|TailTypes]) :-
	functor(Attrib,attribute,4),
	N1 is N+1,
	arg(1,Attrib,N1),
	arg(2,Attrib,Relation),
	arg(3,Attrib,FieldName),
	arg(4,Attrib,HeadType),
	'$assert_facts'(myddas_prolog2sql,Attrib),
	%assert(myddas_prolog2sql:Attrib),
	'$assert_attribute_information'(N1,M,Relation,TailTypes).


'$copy_term_nv'(T,Dic,NT,[(T,NT)|Dic]) :-
	var(T),!, 
	'$v_member'(T,Dic,(T,NT)).
'$copy_term_nv'(T,Dic,T,Dic) :-
	functor(T,_,0),!.
'$copy_term_nv'(T,Dic,NT,NDic) :-
	functor(T,F,N),
	functor(NT,F,N),
	'$iterate_on_args'(N,T,NT,Dic,NDic).

'$iterate_on_args'(0,_,_,Dic,Dic) :- !.
'$iterate_on_args'(N,T,NT,Dic,NDic2) :-
	arg(N,T,A),
	'$copy_term_nv'(A,Dic,NA,NDic),
	arg(N,NT,NA),
	N1 is N-1,
	'$iterate_on_args'(N1,T,NT,NDic,NDic2).

'$v_member'(T,[],(T,_)).
'$v_member'(T,[(V,V1)|_],(T,V1)) :-
	T == V, !.
'$v_member'(T,[_|R],V) :-
	'$v_member'(T,R,V).



% '$extract_args(+Predicate,+FirstArg,+Arity,-ArgList).
% extracts args from predicate, to a list
'$extract_args'(Predicate,Arity,Arity,[Arg]):-
        arg(Arity,Predicate,Arg).
'$extract_args'(Predicate,ArgNumber,Arity,[Arg|ArgList]):-
        arg(ArgNumber,Predicate,Arg),
	NextArg is ArgNumber+1,
	'$extract_args'(Predicate,NextArg,Arity,ArgList).

% '$get_table_name'(+SQLQueryTerm,?TableName).
% Gets the Table name from the SQLQueryTerm of translate/3
'$get_table_name'([query(_,[rel(TableName,_)],_)],TableName).


% '$get_values_for_update'(+SQLQueryTerm,-SetFields,+ArgList,+Updatelist,-WhereCondition)
% It will unify with the first clause
% only on the first call of the predicate
'$get_values_for_update'([query(Fields,_,[])],SetArgs,[' SET '|SQLSet],[]):-!,
	'$get_values_for_set'(Fields,SetArgs,Set),
	'$build_set_condition'(Set,SQLSet).
'$get_values_for_update'([query(Fields,_,Comp)],SetArgs,[' SET '|SQLSet],[' WHERE '|Where]):-!,
	'$get_values_for_set'(Fields,SetArgs,Set),
	'$build_set_condition'(Set,SQLSet),
	'$get_values_for_where'(Comp,Where).
	
'$get_values_for_set'([],[],[]).
'$get_values_for_set'([att(_,Field)|FieldList],[Value|ValueList],[Field,Value|FieldValueList]):-
	ground(Value),!,
	'$get_values_for_set'(FieldList,ValueList,FieldValueList).
'$get_values_for_set'([_|FieldList],[_|ValueList],FieldValueList):-!,
	'$get_values_for_set'(FieldList,ValueList,FieldValueList).

'$get_values_for_where'([comp(att(_,Field),'=','$const$'(Atom))],[' ',Field,' = "',Atom,'" ']).
'$get_values_for_where'([comp(att(_,Field),'=','$const$'(Atom))|Comp],[' ',Field,' = "',Atom,'" '|Rest]):-
	'$get_values_for_where'(Comp,Rest).

'$build_set_condition'([Field,Value|FieldValues],[SQLFirst|SQLRest]):-
        '$make_atom'([' ',Field,' = "',Value,'" '],SQLFirst),
        '$build_set_condition_with_comma'(FieldValues,SQLRest).

'$build_set_condition_with_comma'([],[]).
'$build_set_condition_with_comma'([Field,Value|FieldValues],[SQL|SQLRest]):-
        '$make_atom'([' , ',Field,' = "',Value,'" '],SQL),
        '$build_set_condition_with_comma'(FieldValues,SQLRest).


% This predicate will always fail
'$abolish_all'(Con):-
        c_db_preds_conn(Con,Pred_Module,Pred_Name,Pred_Arity),
	abolish(Pred_Module:Pred_Name,Pred_Arity),
        fail.

'$write_or_not'(X) :-
	get_value(db_verbose,1),!,
	write(X),nl.
'$write_or_not'(_).


'$make_atom'([],'').
'$make_atom'([Atom|T],Final) :-
        atom(Atom),!,
	'$make_atom'(T,Result),
	atom_concat(Atom,Result,Final).
'$make_atom'([Number|T],Final) :-
        '$make_atom'(T,Result),
        number_atom(Number,Atom),
	atom_concat(Atom,Result,Final).



% for db_my_insert/3
% integer,real, string, came from the myddas_mysql.c get_attributes_types function
'$get_values_for_insert'([_,_],[Value],['NULL',')']):-var(Value),!.
'$get_values_for_insert'([_,integer],[Value],[Value,')']):-!.
'$get_values_for_insert'([_,real],[Value],[Value,')']):-!.
'$get_values_for_insert'([_,string],[Value],['"',Value,'")']):-!.

'$get_values_for_insert'([_,_|TTypesList],[Value|TValues],['NULL',','|RestValues]):-
        var(Value),!,
	'$get_values_for_insert'(TTypesList,TValues,RestValues).
'$get_values_for_insert'([_,integer|TTypesList],[Value|TValues],[Value,','|RestValues]):-!,
        '$get_values_for_insert'(TTypesList,TValues,RestValues).
'$get_values_for_insert'([_,real|TTypesList],[Value|TValues],[Value,','|RestValues]):-!,
        '$get_values_for_insert'(TTypesList,TValues,RestValues).
'$get_values_for_insert'([_,string|TTypesList],[Value|TValues],['"',Value,'",'|RestValues]):-!,
        '$get_values_for_insert'(TTypesList,TValues,RestValues).


% for db_my_insert/2
'$get_values_for_insert'([query(Att,[rel(Relation,_)],_)],['('|ValuesList],Relation):-
        '$get_values_for_insert_make_list'(Att,ValuesList).

'$get_values_for_insert_make_list'([att(_,_)],['NULL',')']):-!.
'$get_values_for_insert_make_list'(['$const$'(Value)],[Value,')']):-
        number(Value),!.
'$get_values_for_insert_make_list'(['$const$'(Value)],['"',Value,'")']):-!.

'$get_values_for_insert_make_list'([att(_,_)|TAtt],['NULL',','|TList]):-!,
       '$get_values_for_insert_make_list'(TAtt,TList).
'$get_values_for_insert_make_list'(['$const$'(Value)|TAtt],[Value,','|TList]):-
        number(Value),!,
        '$get_values_for_insert_make_list'(TAtt,TList).
'$get_values_for_insert_make_list'(['$const$'(Value)|TAtt],['"',Value,'"',','|TList]):-
        '$get_values_for_insert_make_list'(TAtt,TList).


% Only for making the error tests in all of the calls to
% get_value/2
'$get_value'(Connection,Con) :-
	'$error_checks'(get_value(Connection,Con)),
	get_value(Connection,Con).


'$check_fields'([],[]).
'$check_fields'(['$const$'(_)|TAtt],[_|TFields]):-
        '$check_fields'(TAtt,TFields).
% um campo auto_incrementavel, <20> sempre parte da chave, e como <20> auto
% pode-se dar valores NULOS 
'$check_fields'([att(_,Name)|TAtt],[property(Name,_,1,1)|TFields]):-!,
        '$check_fields'(TAtt,TFields).
'$check_fields'([att(_,Name)|TAtt],[property(Name,0,_,_)|TFields]):-!,
        '$check_fields'(TAtt,TFields).



%
% This predicate asserts facts in a Module, but if that
% fact already exists, it dosen't assert it
%
'$assert_facts'(Module,Fact):-
        Module:Fact,!.
'$assert_facts'(Module,Fact):-
        assert(Module:Fact).

'$lenght'([],0).
'$lenght'([_|T],Sum):-
        '$lenght'(T,Num),
        Sum is Num + 1.