441 lines
14 KiB
Plaintext
441 lines
14 KiB
Plaintext
/*************************************************************************
|
||
* *
|
||
* 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,
|
||
'$make_atom_args'/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,
|
||
#ifdef MYDDAS_STATS
|
||
'$make_stats_list'/2,
|
||
#endif
|
||
'$check_list_on_list'/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),
|
||
Name=viewname,
|
||
functor(ViewName,Name,Arity),
|
||
ViewName=..[Name|ProjTerm],
|
||
'$prolog2sql'(ViewName,DbGoal,SQL).
|
||
'$create_multi_query'([ProjTerm|TermList],[DbGoal|GoalList],SQL):-
|
||
'$lenght'(ProjTerm,Arity),
|
||
Name=viewname,
|
||
functor(ViewName,Name,Arity),
|
||
ViewName=..[Name|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_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).
|
||
|
||
'$make_atom_args'([Atom],Atom):-
|
||
atom(Atom),!.
|
||
'$make_atom_args'([Number],Atom):-
|
||
number_atom(Number,Atom),!.
|
||
'$make_atom_args'([Atom|T],Final) :-
|
||
atom(Atom),!,
|
||
'$make_atom_args'(T,Result),
|
||
atom_concat(',',Result,X1),
|
||
atom_concat(Atom,X1,Final).
|
||
'$make_atom_args'([Number|T],Final) :-
|
||
'$make_atom_args'(T,Result),
|
||
number_atom(Number,Atom),
|
||
atom_concat(',',Result,X1),
|
||
atom_concat(Atom,X1,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.
|
||
|
||
'$check_list_on_list'([],_).
|
||
'$check_list_on_list'([H|T],DbGoalArgs) :-
|
||
'$member_strick'(H,DbGoalArgs),
|
||
'$check_list_on_list'(T,DbGoalArgs).
|
||
|
||
'$member_strick'(Element1, [Element2|_]) :-
|
||
Element1 == Element2,!.
|
||
'$member_strick'(Element, [_|Rest]) :-
|
||
'$member_strick'(Element, Rest).
|
||
|
||
|
||
'$make_stats_list'([],[]).
|
||
'$make_stats_list'([Ref|Tail],[Time|Final]):-
|
||
c_db_stats_time(Ref,Time),
|
||
'$make_stats_list'(Tail,Final).
|