/************************************************************************* * * * 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,[ '$prolog2sql'/3, '$create_multi_query'/3, '$get_multi_results'/4, '$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 ]). '$prolog2sql'(ProjTerm,DbGoal,SQL):- copy_term((ProjTerm,DbGoal),(CopyTerm,CopyGoal)), translate(CopyTerm,CopyGoal,Code), queries_atom(Code,SQL). '$create_multi_query'([ProjTerm],[DbGoal],SQL):- !, '$lenght'(ProjTerm,Arity), functor(ViewName,viewname,Arity), '$make_list_of_args'(1,Arity,ViewName,ProjTerm), '$prolog2sql'(ViewName,DbGoal,SQL). '$create_multi_query'([ProjTerm|TermList],[DbGoal|GoalList],SQL):- '$lenght'(ProjTerm,Arity), functor(ViewName,viewname,Arity), '$make_list_of_args'(1,Arity,ViewName,ProjTerm), '$prolog2sql'(ViewName,DbGoal,SQLQuery), '$create_multi_query'(TermList,GoalList,SQLMulti), '$make_atom'([SQLQuery,' ; ',SQLMulti],SQL). '$get_multi_results'(_,_,_,[]). '$get_multi_results'(Con,ConType,ResSet,[List|Results]):- '$lenght'(List,Arity), ( ConType == mysql -> c_db_my_row(ResSet,Arity,List),!, c_db_my_get_next_result_set(Con,NextResSet) ; true ), '$get_multi_results'(Con,ConType,NextResSet,Results). '$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,'" AND '|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'(X) :- get_value(db_verbose,2),!, get_value(db_verbose_filename,FileName), open(FileName,append,Stream), write(Stream,X),write(Stream,';'),nl(Stream), close(Stream). '$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, é sempre parte da chave, e como é 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.