diff --git a/C/stdpreds.c b/C/stdpreds.c index f3f38d2ec..892e962ce 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -11,8 +11,11 @@ * File: stdpreds.c * * comments: General-purpose C implemented system predicates * * * -* Last rev: $Date: 2005-10-28 17:38:49 $,$Author: vsc $ * +* Last rev: $Date: 2005-11-22 11:25:59 $,$Author: tiagosoares $ * * $Log: not supported by cvs2svn $ +* Revision 1.96 2005/10/28 17:38:49 vsc +* sveral updates +* * Revision 1.95 2005/10/21 16:09:02 vsc * SWI compatible module only operators * @@ -3257,6 +3260,18 @@ Yap_InitBackCPreds(void) Yap_InitBackIO(); Yap_InitBackDB(); Yap_InitUserBacks(); +#if defined MYDDAS_MYSQL && defined CUT_C + Yap_InitBackMYDDAS_MySQLPreds(); +#endif +#if defined MYDDAS_ODBC && defined CUT_C + Yap_InitBackMYDDAS_ODBCPreds(); +#endif +#if defined CUT_C && (defined MYDDAS_ODBC || defined MYDDAS_MYSQL) + Yap_InitBackMYDDAS_SharedPreds(); +#endif +#if defined CUT_C && (defined MYDDAS_ODBC || defined MYDDAS_MYSQL) + Yap_InitBackMYDDAS_testPreds(); +#endif } typedef void (*Proc)(void); @@ -3367,7 +3382,18 @@ Yap_InitCPreds(void) Yap_InitArrayPreds(); Yap_InitLoadForeign(); Yap_InitModulesC(); - +#if defined CUT_C && defined MYDDAS_MYSQL + Yap_InitMYDDAS_MySQLPreds(); +#endif +#if defined CUT_C && defined MYDDAS_ODBC + Yap_InitMYDDAS_ODBCPreds(); +#endif +#if defined CUT_C && (defined MYDDAS_ODBC || defined MYDDAS_MYSQL) + Yap_InitMYDDAS_SharedPreds(); +#endif +#if defined CUT_C && (defined MYDDAS_ODBC || defined MYDDAS_MYSQL) + Yap_InitMYDDAS_testPreds(); +#endif Yap_InitUserCPreds(); Yap_InitUtilCPreds(); Yap_InitSortPreds(); diff --git a/H/Yapproto.h b/H/Yapproto.h index 7df9bfec0..5edec681a 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -10,7 +10,7 @@ * File: Yap.proto * * mods: * * comments: Function declarations for YAP * -* version: $Id: Yapproto.h,v 1.63 2005-11-18 18:50:34 tiagosoares Exp $ * +* version: $Id: Yapproto.h,v 1.64 2005-11-22 11:25:10 tiagosoares Exp $ * *************************************************************************/ /* prototype file for Yap */ @@ -308,6 +308,23 @@ void STD_PROTO(Yap_InitUtilCPreds,(void)); /* yap.c */ +/* myddas_* */ +#if defined CUT_C && defined MYDDAS_MYSQL +void STD_PROTO(Yap_InitMYDDAS_MySQLPreds,(void)); +void STD_PROTO(Yap_InitBackMYDDAS_MySQLPreds,(void)); +#endif +#if defined CUT_C && defined MYDDAS_ODBC +void STD_PROTO(Yap_InitMYDDAS_ODBCPreds,(void)); +void STD_PROTO(Yap_InitBackMYDDAS_ODBCPreds,(void)); +#endif +#if defined CUT_C && (defined MYDDAS_ODBC || defined MYDDAS_MYSQL) +void STD_PROTO(Yap_InitMYDDAS_SharedPreds,(void)); +void STD_PROTO(Yap_InitBackMYDDAS_SharedPreds,(void)); +#endif +#if defined CUT_C && (defined MYDDAS_ODBC || defined MYDDAS_MYSQL) +void STD_PROTO(Yap_InitMYDDAS_testPreds,(void)); +void STD_PROTO(Yap_InitBackMYDDAS_testPreds,(void)); +#endif /* ypsocks.c */ void STD_PROTO(Yap_InitSockets,(void)); diff --git a/MYDDAS/myddas_mysql.c b/MYDDAS/myddas_mysql.c new file mode 100755 index 000000000..8b2c0c676 --- /dev/null +++ b/MYDDAS/myddas_mysql.c @@ -0,0 +1,638 @@ +/************************************************************************* +* * +* 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_mysql.c * +* Last rev: 22/03/05 * +* mods: * +* comments: Predicates for comunicating with a mysql database system * +* * +*************************************************************************/ + +#if defined MYDDAS_MYSQL && defined CUT_C + +#include +#include +#include +#include +#include "Yap.h" +#include "Yatom.h" +#include "cut_c.h" +#include "myddas_util.h" + +#define IS_SQL_INT(FIELD) FIELD == FIELD_TYPE_INT24 || \ + FIELD == FIELD_TYPE_LONG || \ + FIELD == FIELD_TYPE_LONGLONG || \ + FIELD == FIELD_TYPE_SHORT || \ + FIELD == FIELD_TYPE_TINY + +#define IS_SQL_FLOAT(FIELD) FIELD == FIELD_TYPE_DECIMAL || \ + FIELD == FIELD_TYPE_DOUBLE || \ + FIELD == FIELD_TYPE_FLOAT + + +static int null_id = 0; + +STATIC_PROTO(int c_db_my_connect,(void)); +STATIC_PROTO(int c_db_my_disconnect,(void)); +STATIC_PROTO(int c_db_my_number_of_fields,(void)); +STATIC_PROTO(int c_db_my_get_attributes_types,(void)); +STATIC_PROTO(int c_db_my_query,(void)); +STATIC_PROTO(int c_db_my_table_write,(void)); +STATIC_PROTO(int c_db_my_row,(void)); +STATIC_PROTO(int c_db_my_row_cut,(void)); +STATIC_PROTO(int c_db_my_get_fields_properties,(void)); +STATIC_PROTO(int c_db_my_number_of_fields_in_query,(void)); + + +static void n_print(int, char); + +static int +c_db_my_connect(void) { + Term arg_host = Deref(ARG1); + Term arg_user = Deref(ARG2); + Term arg_passwd = Deref(ARG3); + Term arg_database = Deref(ARG4); + Term arg_conn = Deref(ARG5); + + MYSQL *conn; + + MYDDAS_UTIL_CONNECTION new = NULL; + + char *host = AtomName(AtomOfTerm(arg_host)); + char *user = AtomName(AtomOfTerm(arg_user)); + char *passwd = AtomName(AtomOfTerm(arg_passwd)); + char *database = AtomName(AtomOfTerm(arg_database)); + + + conn = mysql_init(NULL); + if (conn == NULL) { + printf("erro no init\n"); + return FALSE; + } + + if (mysql_real_connect(conn, host, user, passwd, database,0, NULL, 0) == NULL) { + printf("erro no connect\n"); + return FALSE; + } + + if (!Yap_unify(arg_conn, MkIntegerTerm((int)conn))) + return FALSE; + else + { + /* Criar um novo no na lista de ligacoes*/ + //new = add_connection(&TOP,conn,NULL); + new = myddas_util_add_connection(conn,NULL); + if (new == NULL){ + printf("Erro ao alocar memoria para lista\n"); + return FALSE; + } + return TRUE; + } +} + +/* db_query: SQLQuery x ResultSet x Connection */ +static int +c_db_my_query(void) { + Term arg_sql_query = Deref(ARG1); + Term arg_result_set = Deref(ARG2); + Term arg_conn = Deref(ARG3); + Term arg_mode = Deref(ARG4); + + char *sql = AtomName(AtomOfTerm(arg_sql_query)); + char *mode = AtomName(AtomOfTerm(arg_mode)); + MYSQL *conn = (MYSQL *) (IntegerOfTerm(arg_conn)); + + MYSQL_RES *res_set; + + int length=strlen(sql); + +/* Measure time spent by the MySQL Server + processing the SQL Query */ +#ifdef MYDDAS_STATS + unsigned long start,end,total_time; + start = myddas_current_time(); +#endif + /* executar a query SQL */ + if (mysql_real_query(conn, sql, length) != 0) + { + printf("Erro na query!\n"); + return FALSE; + } +/* Measure time spent by the MySQL Server + processing the SQL Query */ +#ifdef MYDDAS_STATS + end = myddas_current_time(); + MYDDAS_UTIL_CONNECTION node = myddas_util_search_connection(conn); + total_time = (end-start) + myddas_util_get_conn_total_time_DBServer(node); + myddas_util_set_conn_total_time_DBServer(node,total_time); +#endif + + /* guardar os tuplos do lado do cliente */ + if (strcmp(mode,"store_result")!=0) //Verdadeiro + res_set = mysql_use_result(conn); + else{ + /* */ +#ifdef MYDDAS_STATS +#endif + res_set = mysql_store_result(conn); +#ifdef MYDDAS_STATS + /* With an INSERT statement, + mysql_(use or store)_result() returns + a NULL pointer*/ + if (res_set != NULL) + { + MYDDAS_UTIL_CONNECTION node = + myddas_util_search_connection(conn); + + /* This is only works if we use mysql_store_result */ + unsigned long numberRows = mysql_num_rows(res_set); + numberRows = numberRows + myddas_util_get_conn_total_rows(node); + myddas_util_set_conn_total_rows(node,numberRows); + } +#endif + + } + + if (res_set == NULL) + { + //INSERT statements don't return any res_set + if (mysql_field_count(conn) == 0) + return TRUE; + printf("Query vazia!\n"); + return FALSE; + } + + if (!Yap_unify(arg_result_set, MkIntegerTerm((int) res_set))) + { + mysql_free_result(res_set); + return FALSE; + } + else + { + return TRUE; + } +} + +static int +c_db_my_number_of_fields(void) { + Term arg_relation = Deref(ARG1); + Term arg_conn = Deref(ARG2); + Term arg_fields = Deref(ARG3); + + char *relation = AtomName(AtomOfTerm(arg_relation)); + MYSQL *conn = (MYSQL *) (IntegerOfTerm(arg_conn)); + + char sql[256]; + + MYSQL_RES *res_set; + + sprintf(sql,"DESCRIBE %s",relation); + + /* executar a query SQL */ + if (mysql_query(conn, sql) != 0) + { + + printf("Erro na query!\n"); + return FALSE; + } + + /* guardar os tuplos do lado do cliente */ + if ((res_set = mysql_store_result(conn)) == NULL) + { + printf("Query vazia!\n"); + return FALSE; + } + + if (!Yap_unify(arg_fields, MkIntegerTerm(mysql_num_rows(res_set)))){ + mysql_free_result(res_set); + return FALSE; + } + mysql_free_result(res_set); + return TRUE; +} + + +/* db_get_attributes_types: RelName x Connection -> TypesList */ +static int +c_db_my_get_attributes_types(void) { + Term arg_relation = Deref(ARG1); + Term arg_conn = Deref(ARG2); + Term arg_types_list = Deref(ARG3); + + char *relation = AtomName(AtomOfTerm(arg_relation)); + MYSQL *conn = (MYSQL *) IntegerOfTerm(arg_conn); + char sql[256]; + + MYSQL_RES *res_set; + MYSQL_ROW row; + Term head, list; + + sprintf(sql,"DESCRIBE %s",relation); + + /* executar a query SQL */ + if (mysql_query(conn, sql) != 0) + { + printf("Erro na query!\n"); + return FALSE; + } + /* guardar os tuplos do lado do cliente */ + if ((res_set = mysql_store_result(conn)) == NULL) + { + printf("Query vazia!\n"); + return FALSE; + } + + list = arg_types_list; + + while ((row = mysql_fetch_row(res_set)) != NULL) + { + head = HeadOfTerm(list); + Yap_unify(head, MkAtomTerm(Yap_LookupAtom(row[0]))); + list = TailOfTerm(list); + head = HeadOfTerm(list); + list = TailOfTerm(list); + + if (strncmp(row[1], "smallint",8) == 0 || strncmp(row[1],"int",3) == 0 || + strncmp(row[1], "mediumint",9) == 0 || strncmp(row[1], "tinyint",7) == 0 || + strncmp(row[1], "bigint",6) == 0 || strcmp(row[1], "year") == 0) + Yap_unify(head, MkAtomTerm(Yap_LookupAtom("integer"))); + else if (strcmp(row[1], "float") == 0 || strncmp(row[1], "double",6) == 0 + || strcmp(row[1], "real") == 0) + Yap_unify(head, MkAtomTerm(Yap_LookupAtom("real"))); + else Yap_unify(head, MkAtomTerm(Yap_LookupAtom("string"))); + } + + mysql_free_result(res_set); + return TRUE; + +} + +/* db_disconnect */ +static int +c_db_my_disconnect(void) { + Term arg_conn = Deref(ARG1); + + MYSQL *conn = (MYSQL *) IntegerOfTerm(arg_conn); + + if ((myddas_util_search_connection(conn)) != NULL) + { + myddas_util_delete_connection(conn); + mysql_close(conn); + return TRUE; + } + else + { + return FALSE; + } +} + +/* db_table_write: Result Set */ +static int +c_db_my_table_write(void) { + Term arg_res_set = Deref(ARG1); + + MYSQL_RES *res_set = (MYSQL_RES *) IntegerOfTerm(arg_res_set); + MYSQL_ROW row; + MYSQL_FIELD *fields; + int i,f; + + f = mysql_num_fields(res_set); + + fields = mysql_fetch_field(res_set); + for(i=0;ifields[i].max_length) fields[i].max_length=strlen(fields[i].name); + n_print(fields[i].max_length+2,'-'); + } + printf("+\n"); + + for(i=0;i0;n--) printf("%c",c); +} + + +static int +c_db_my_row_cut(void) { + MYSQL_RES *mysql_res=NULL; + + mysql_res = (MYSQL_RES *) IntegerOfTerm(EXTRA_CBACK_CUT_ARG(Term,1)); + mysql_free_result(mysql_res); + return TRUE; +} + +/* db_row: ResultSet x Arity_ListOfArgs x ListOfArgs -> */ +static int +c_db_my_row(void) { + Term arg_result_set = Deref(ARG1); + Term arg_arity = Deref(ARG2); + Term arg_list_args = Deref(ARG3); + + MYSQL_RES *res_set = (MYSQL_RES *) IntegerOfTerm(arg_result_set); + EXTRA_CBACK_ARG(3,1)=(CELL) MkIntegerTerm((int)res_set); + MYSQL_ROW row; + MYSQL_FIELD *field; + + Term head, list, null_atom[1]; + int i, arity; + + arity = IntegerOfTerm(arg_arity); + + while(TRUE) + { + if ((row = mysql_fetch_row(res_set)) != NULL) + { + mysql_field_seek(res_set,0); + list = arg_list_args; + + for (i = 0; i < arity; i++) + { + /* Aqui serão feitas as conversões de tipos de dados */ + field = mysql_fetch_field(res_set); + head = HeadOfTerm(list); + list = TailOfTerm(list); + + if (row[i] == NULL) + { + null_atom[0] = MkIntegerTerm(null_id++); + + if (!Yap_unify(head, Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("null"),1),1,null_atom))) + continue; + } + else + { + if (IS_SQL_INT(field->type)) + { + if (!Yap_unify(head, MkIntegerTerm(atoi(row[i])))) + continue; + } + else if (IS_SQL_FLOAT(field->type)) + { + if (!Yap_unify(head, MkFloatTerm(atof(row[i])))) + continue; + } + else + { + if (!Yap_unify(head, MkAtomTerm(Yap_LookupAtom(row[i])))) + continue; + } + } + } + return TRUE; + } + else + { + mysql_free_result(res_set); + cut_fail(); + return FALSE; + } + } +} + + +/* Mudar esta funcao de forma a nao fazer a consulta, pois + no predicate db_sql_selet vai fazer duas vezes a mesma consutla*/ +static int +c_db_my_number_of_fields_in_query(void) { + Term arg_query = Deref(ARG1); + Term arg_conn = Deref(ARG2); + Term arg_fields = Deref(ARG3); + + char *query = AtomName(AtomOfTerm(arg_query)); + MYSQL *conn = (MYSQL *) (IntegerOfTerm(arg_conn)); + + MYSQL_RES *res_set; + + /* executar a query SQL */ + if (mysql_query(conn, query) != 0) + { + printf("Erro na query!\n"); + return FALSE; + } + + /* guardar os tuplos do lado do cliente */ + if ((res_set = mysql_store_result(conn)) == NULL) + { + printf("Query vazia!\n"); + return FALSE; + } + + if (!Yap_unify(arg_fields, MkIntegerTerm(mysql_num_fields(res_set)))){ + return FALSE; + } + mysql_free_result(res_set); + return TRUE; +} + +static int +c_db_my_get_fields_properties(void) { + Term nome_relacao = Deref(ARG1); + Term arg_conn = Deref(ARG2); + Term fields_properties_list = Deref(ARG3); + Term head, list; + + char *relacao = AtomName(AtomOfTerm(nome_relacao)); + char sql[256]; + int num_fields,i; + MYSQL_FIELD *fields; + MYSQL_RES *res_set; + MYSQL *conn = (MYSQL *) (IntegerOfTerm(arg_conn)); + + + /* 1=2 -> We only need the meta information about the fields + to know their properties, we don't need the results of the + query*/ + sprintf (sql,"SELECT * FROM %s where 1=2",relacao); + + /* executar a query SQL */ + if (mysql_query(conn, sql) != 0) + { + printf("Erro na query!\n"); + return FALSE; + } + + Functor functor = Yap_MkFunctor(Yap_LookupAtom("property"),4); + + Term properties[4]; + + + /* guardar os tuplos do lado do cliente */ + /* nao precisamos do resultado, mas apenas no res_set */ + /* para obter a informação através do mysql_fetch_fields*/ + res_set = mysql_store_result(conn); + + num_fields = mysql_num_fields(res_set); + fields = mysql_fetch_fields(res_set); + + list = fields_properties_list; + + + + for (i=0;i Total Number of Rows by connection + //Total number of Rows returned by the server + //WARNING: only works with store_result + head = HeadOfTerm(list); + list = TailOfTerm(list); + int totalRows = myddas_util_get_conn_total_rows(node); + Yap_unify(head, MkIntegerTerm(totalRows)); + printf ("Total Number of Rows returned from the Server: %d\n",totalRows); + + //[Index 2] -> Total Number of Rows by connection + //Total number of Rows returned by the server + //WARNING: only works with store_result + head = HeadOfTerm(list); + list = TailOfTerm(list); + int totalTimeDBServer = myddas_util_get_conn_total_time_DBServer(node); + Yap_unify(head, MkIntegerTerm(totalTimeDBServer)); + printf ("Total Time Spent by the Server: %d\n",totalTimeDBServer); + + return TRUE; +} +#endif + +void Yap_InitMYDDAS_MySQLPreds(void) +{ + /* db_connect: Host x User x Passwd x Database x Connection x ERROR_CODE */ + Yap_InitCPred("c_db_my_connect", 5, c_db_my_connect, SafePredFlag|SyncPredFlag|HiddenPredFlag); + + /* db_number_of_fields: Relation x Connection x NumberOfFields */ + Yap_InitCPred("c_db_my_number_of_fields",3, c_db_my_number_of_fields, 0); + + /* db_number_of_fields_in_query: SQLQuery x Connection x NumberOfFields */ + Yap_InitCPred("c_db_my_number_of_fields_in_query",3, c_db_my_number_of_fields_in_query, 0); + + /* db_get_attributes_types: Relation x TypesList */ + Yap_InitCPred("c_db_my_get_attributes_types", 3, c_db_my_get_attributes_types, 0); + + /* db_query: SQLQuery x ResultSet x Connection */ + Yap_InitCPred("c_db_my_query", 4, c_db_my_query, 0); + + /* db_disconnect: Connection */ + Yap_InitCPred("c_db_my_disconnect", 1,c_db_my_disconnect, 0); + + /* db_table_write: Result Set */ + Yap_InitCPred("c_db_my_table_write", 1, c_db_my_table_write, 0); + + /* db_get_fields_properties: PredName x Connnection x PropertiesList*/ + Yap_InitCPred("c_db_my_get_fields_properties",3,c_db_my_get_fields_properties,0); + +#ifdef MYDDAS_STATS + /* db_stats: Connection */ + Yap_InitCPred("c_db_my_stats",2, c_db_my_stats, 0); +#endif + +} + +void Yap_InitBackMYDDAS_MySQLPreds(void) +{ + /* db_row: ResultSet x Arity x ListOfArgs */ + Yap_InitCPredBackCut("c_db_my_row", 3, sizeof(int), + c_db_my_row, + c_db_my_row, + c_db_my_row_cut, 0); + +} + +#endif /*MYDDAS_MYSQL && CUT_C*/ diff --git a/MYDDAS/myddas_odbc.c b/MYDDAS/myddas_odbc.c new file mode 100755 index 000000000..fa2115f39 --- /dev/null +++ b/MYDDAS/myddas_odbc.c @@ -0,0 +1,748 @@ +/************************************************************************* +* * +* 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_odbc.c * +* Last rev: 22/03/05 * +* mods: * +* comments: Predicates for comunicating with ODBC drivers * +* * +*************************************************************************/ + +/* Problema colocar no configure uma forma de detctar se o mysql * +* devel esta instalado*/ + +/* This flag should be deleted, and do this test, off including this file, which is depending on the flag "MYDDAS_MYSQL", on configure time */ +#if defined MYDDAS_ODBC && defined CUT_C + +#include +#include +#include +#include "Yap.h" +#include "Yatom.h" +#include "myddas_util.h" +#include "cut_c.h" +#include +#include + +static int null_id = 0; + +STATIC_PROTO(int c_db_odbc_connect,(void)); +STATIC_PROTO(int c_db_odbc_disconnect,(void)); +STATIC_PROTO(int c_db_odbc_number_of_fields,(void)); +STATIC_PROTO(int c_db_odbc_get_attributes_types,(void)); +STATIC_PROTO(int c_db_odbc_query,(void)); +STATIC_PROTO(int c_db_odbc_row,(void)); +STATIC_PROTO(int c_db_odbc_row_cut,(void)); +STATIC_PROTO(int c_db_odbc_get_fields_properties,(void)); +STATIC_PROTO(int c_db_odbc_number_of_fields_in_query,(void)); + + +#define SQLALLOCHANDLE(A,B,C,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLAllocHandle(A,B,C); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLAllocHandle(ENV) %s\n",print); \ + return FALSE; \ + } \ +} + +#define SQLSETENVATTR(A,B,C,D,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLSetEnvAttr(A,B,C,D); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLSetEnvAttr %s\n",print); \ + return FALSE; \ + } \ +} + +#define SQLCONNECT(A,B,C,D,E,F,G,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLConnect(A,B,C,D,E,F,G); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLConnect %s\n",print); \ + return FALSE; \ + } \ +} + +#define SQLEXECDIRECT(A,B,C,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLExecDirect(A,B,C); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLExecDirect %s \n",print); \ + return FALSE; \ + } \ +} + +#define SQLDESCRIBECOL(A,B,C,D,E,F,G,H,I,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLDescribeCol(A,B,C,D,E,F,G,H,I); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLDescribeCol %s\n",print); \ + return FALSE; \ + } \ +} + +#define SQLSETCONNECTATTR(A,B,C,D,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLSetConnectAttr(A,B,C,D); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLSetConnectAttr %s\n",print); \ + return FALSE; \ + } \ +} + +#define SQLBINDCOL(A,B,C,D,E,F,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLBindCol(A,B,C,D,E,F); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLbindCol %s\n",print); \ + return FALSE; \ + } \ +} + +#define SQLFREESTMT(A,B,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLFreeStmt(A,B); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLFreeStmt %s\n",print); \ + return FALSE; \ + } \ +} + +#define SQLNUMRESULTCOLS(A,B,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLNumResultCols(A,B); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLNumResultCols %s\n",print); \ + return FALSE; \ + } \ +} + + +#define SQLCLOSECURSOR(A,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLCloseCursor(A); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLCloseCursor %s\n",print); \ + return FALSE; \ + } \ +} + +/* no db_odbc_row não é utilizada esta macro*/ +#define SQLFETCH(A,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLFetch(A); \ + if (retcode == SQL_NO_DATA) \ + break; \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLFETCH %s\n",print); \ + return FALSE; \ + } \ +} + +#define SQLGETDATA(A,B,C,D,E,F,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLGetData(A,B,C,D,E,F); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLgetdata %s\n",print); \ + return FALSE; \ + } \ +} + +#define SQLDISCONNECT(A,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLDisconnect(A); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLDisconnect %s\n",print); \ + return FALSE; \ + } \ +} + +#define SQLFREEHANDLE(A,B,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLFreeHandle(A,B); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLFreeHandle %s\n",print); \ + return FALSE; \ + } \ +} + +#define SQLPRIMARYKEYS(A,B,C,D,E,F,G,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLPrimaryKeys(A,B,C,D,E,F,G); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLPrimaryKeys %s\n",print); \ + return FALSE; \ + } \ +} + +#define SQLGETTYPEINFO(A,B,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLGetTypeInfo(A,B); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLGetTypeInfo %s\n",print); \ + return FALSE; \ + } \ +} + +#define SQLCOLATTRIBUTE(A,B,C,D,E,F,G,print) \ +{ \ + SQLRETURN retcode; \ + retcode = SQLColAttribute(A,B,C,D,E,F,G); \ + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) \ + { \ + printf("erro no SQLColAttribute %s\n",print); \ + return FALSE; \ + } \ +} + + + +/* Verificar tipo de dados*/ +#define IS_SQL_INT(FIELD) FIELD == SQL_DECIMAL || \ + FIELD == SQL_NUMERIC || \ + FIELD == SQL_SMALLINT || \ + FIELD == SQL_INTEGER || \ + FIELD == SQL_TINYINT || \ + FIELD == SQL_BIGINT + +#define IS_SQL_FLOAT(FIELD) FIELD == SQL_FLOAT || \ + FIELD == SQL_DOUBLE || \ + FIELD == SQL_REAL + + + + +static int +c_db_odbc_connect(void) { + Term arg_driver = Deref(ARG1); + Term arg_user = Deref(ARG2); + Term arg_passwd = Deref(ARG3); + Term arg_conn = Deref(ARG4); + + MYDDAS_UTIL_CONNECTION new = NULL; + + char *driver = AtomName(AtomOfTerm(arg_driver)); + char *user = AtomName(AtomOfTerm(arg_user)); + char *passwd = AtomName(AtomOfTerm(arg_passwd)); + + SQLHENV henv; + SQLHDBC hdbc; + + /*Allocate environment handle */ + SQLALLOCHANDLE(SQL_HANDLE_ENV, SQL_NULL_HANDLE, &henv, "connect"); + /* Set the ODBC version environment attribute */ + SQLSETENVATTR(henv, SQL_ATTR_ODBC_VERSION, (SQLPOINTER)SQL_OV_ODBC3, 0, "connect"); + /* Allocate connection handle */ + SQLALLOCHANDLE(SQL_HANDLE_DBC, henv, &hdbc, "connect"); + /* Set login timeout to 6 seconds. */ + SQLSETCONNECTATTR(hdbc, SQL_LOGIN_TIMEOUT,(SQLPOINTER) 6, 0, "connect"); + /* Connect to data source */ + SQLCONNECT(hdbc, + (SQLCHAR*) driver, SQL_NTS, + (SQLCHAR*) user, SQL_NTS, + (SQLCHAR*) passwd, SQL_NTS, "connect"); + + if (!Yap_unify(arg_conn, MkIntegerTerm((int)(hdbc)))) + return FALSE; + else + { + /* Criar um novo no na lista de ligacoes*/ + //new = add_connection(&TOP,hdbc,henv); + new = myddas_util_add_connection(hdbc,henv); + if (new == NULL){ + printf("Erro ao alocar memoria para lista\n"); + return FALSE; + } + return TRUE; + } +} + +/* db_query: SQLQuery x ResultSet x Arity x BindList x Connection */ +static int +c_db_odbc_query(void) { + Term arg_sql_query = Deref(ARG1); + Term arg_result_set = Deref(ARG2); + Term arg_arity = Deref(ARG3); + Term arg_bind_list = Deref(ARG4); + Term arg_conn = Deref(ARG5); + + char *sql = AtomName(AtomOfTerm(arg_sql_query)); + + + SQLHDBC hdbc =(SQLHDBC) (IntegerOfTerm(arg_conn)); + SQLHSTMT hstmt; + SQLSMALLINT type; + + /*Allocate an handle for the query*/ + SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt, "db_query"); + /* Executes the query*/ + SQLEXECDIRECT(hstmt,sql,SQL_NTS, "db_query"); + + int arity; + int i; + + if (IsNonVarTerm(arg_arity)){ + arity = IntegerOfTerm(arg_arity); + + + char *bind_space=NULL; + + const int functor_arity=3; + Functor functor = Yap_MkFunctor(Yap_LookupAtom("bind"),functor_arity); + Term properties[functor_arity]; + + Term head,list=arg_bind_list; + + SQLUINTEGER ColumnSizePtr; + SQLINTEGER *data_info=NULL; + + for (i=1;i<=arity;i++) + { + head = HeadOfTerm(list); + list = TailOfTerm(list); + + SQLDESCRIBECOL(hstmt,i,NULL,0,NULL,&type,&ColumnSizePtr,NULL,NULL,"db_query"); + + /* +1 because of '\0' */ + bind_space = malloc(sizeof(char)*(ColumnSizePtr+1)); + data_info = malloc(sizeof(SQLINTEGER)); + SQLBINDCOL(hstmt,i,SQL_C_CHAR,bind_space,(ColumnSizePtr+1),data_info,"db_query"); + + properties[0] = MkIntegerTerm((int)bind_space); + properties[2] = MkIntegerTerm((int)data_info); + + if (IS_SQL_INT(type)) + properties[1]=MkAtomTerm(Yap_LookupAtom("integer")); + else if (IS_SQL_FLOAT(type)) + properties[1]=MkAtomTerm(Yap_LookupAtom("real")); + else + properties[1]=MkAtomTerm(Yap_LookupAtom("string")); + + Yap_unify(head,Yap_MkApplTerm(functor,functor_arity,properties)); + continue; + + } + } + + if (!Yap_unify(arg_result_set, MkIntegerTerm((int) hstmt))) + { + SQLCLOSECURSOR(hstmt,"db_query"); + SQLFREESTMT(hstmt,SQL_CLOSE,"db_query"); + return FALSE; + } + return TRUE; +} + +static int +c_db_odbc_number_of_fields(void) { + Term arg_relation = Deref(ARG1); + Term arg_conn = Deref(ARG2); + Term arg_fields = Deref(ARG3); + + + char *relation = AtomName(AtomOfTerm(arg_relation)); + + SQLHDBC hdbc =(SQLHDBC) (IntegerOfTerm(arg_conn)); + SQLHSTMT hstmt; + + char sql[256]; + SQLSMALLINT number_fields; + + sprintf(sql,"DESCRIBE %s",relation); + + SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt, "db_number_of_fields"); + SQLEXECDIRECT(hstmt,sql,SQL_NTS, "db_number_of_fields"); + + /* Calcula o numero de campos*/ + number_fields=0; + while(TRUE) { + SQLFETCH(hstmt,"db_number_of_fields"); + number_fields++; + } + + SQLCLOSECURSOR(hstmt,"db_number_of_fields"); + SQLFREESTMT(hstmt,SQL_CLOSE,"db_number_of_fields"); + + if (!Yap_unify(arg_fields, MkIntegerTerm(number_fields))) + return FALSE; + return TRUE; +} + + +/* db_get_attributes_types: RelName x Connection -> TypesList */ +static int +c_db_odbc_get_attributes_types(void) { + Term arg_relation = Deref(ARG1); + Term arg_conn = Deref(ARG2); + Term arg_types_list = Deref(ARG3); + + char *relation = AtomName(AtomOfTerm(arg_relation)); + SQLHDBC hdbc =(SQLHDBC) (IntegerOfTerm(arg_conn)); + SQLHSTMT hstmt; + + char sql[256]; + Term head, list; + list = arg_types_list; + + sprintf(sql,"DESCRIBE %s",relation); + + SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt, "db_get_attributes_types"); + SQLEXECDIRECT(hstmt,sql,SQL_NTS, "db_get_attributes_types"); + + while (TRUE) + { + SQLFETCH(hstmt, "db_get_attributes_types"); + + /* Tentar fazer de uma maneira que a gente consiga calcular o tamanho que o + nome do campo vai ocupar, assim podemos alocar memoria dinamicamente*/ + sql[0]='\0'; + SQLGETDATA(hstmt, 1, SQL_C_CHAR, sql, 256, NULL, "db_get_attributes_types"); + + head = HeadOfTerm(list); + Yap_unify(head, MkAtomTerm(Yap_LookupAtom(sql))); + list = TailOfTerm(list); + head = HeadOfTerm(list); + list = TailOfTerm(list); + + sql[0]='\0'; + SQLGETDATA(hstmt, 2, SQL_C_CHAR, sql, 256, NULL, "db_get_attributes_types"); + + if (strncmp(sql, "smallint",8) == 0 || strncmp(sql,"int",3) == 0 || + strncmp(sql, "mediumint",9) == 0 || strncmp(sql, "tinyint",7) == 0 || + strncmp(sql, "bigint",6) == 0 || strcmp(sql, "year") == 0) + Yap_unify(head, MkAtomTerm(Yap_LookupAtom("integer"))); + else + if (strcmp(sql, "float") == 0 || strncmp(sql, "double",6) == 0 + || strcmp(sql, "real") == 0) + Yap_unify(head, MkAtomTerm(Yap_LookupAtom("real"))); + else + Yap_unify(head, MkAtomTerm(Yap_LookupAtom("string"))); + } + + SQLCLOSECURSOR(hstmt,"db_get_attributes_types"); + SQLFREESTMT(hstmt,SQL_CLOSE, "db_get_attributes_types"); + return TRUE; +} + +/* db_disconnect */ +static int +c_db_odbc_disconnect(void) { + Term arg_conn = Deref(ARG1); + + SQLHDBC conn = (SQLHDBC) (IntegerOfTerm(arg_conn)); + SQLHENV henv = myddas_util_get_odbc_enviromment(conn); + + if ((myddas_util_search_connection(conn)) != NULL) + { + myddas_util_delete_connection(conn); + /* More information about this process on + msdn.microsoft.com*/ + SQLDISCONNECT(conn,"db_disconnect"); + SQLFREEHANDLE(SQL_HANDLE_DBC,conn,"db_disconnect"); + SQLFREEHANDLE(SQL_HANDLE_ENV,henv,"db_disconnect"); + + return TRUE; + } + else + return FALSE; +} + +static int +c_db_odbc_row_cut(void) { + + SQLHSTMT hstmt = (SQLHSTMT) IntegerOfTerm(EXTRA_CBACK_CUT_ARG(Term,1)); + + SQLCLOSECURSOR(hstmt,"db_row_cut"); + SQLFREESTMT(hstmt,SQL_CLOSE,"db_row_cut"); + + return TRUE; +} + +/* db_row: ResultSet x BindList x ListOfArgs -> */ +static int +c_db_odbc_row(void) { + Term arg_result_set = Deref(ARG1); + Term arg_bind_list = Deref(ARG2); + Term arg_list_args = Deref(ARG3); + + SQLHSTMT hstmt = (SQLHSTMT) IntegerOfTerm(arg_result_set); + + /* EXTRA_CBACK_ARG(ARIDADE,LOCAL_ONDE_COLOCAR_VALOR)*/ + EXTRA_CBACK_ARG(3,1)=(CELL) MkIntegerTerm((int)hstmt); + + Term head, list, null_atom[1]; + Term head_bind, list_bind; + + SQLRETURN retcode = SQLFetch(hstmt); + if (retcode == SQL_NO_DATA) + { + SQLCLOSECURSOR(hstmt,"db_row"); + SQLFREESTMT(hstmt,SQL_CLOSE,"db_row"); + + cut_fail(); + return FALSE; + } + if (retcode != SQL_SUCCESS && retcode != SQL_SUCCESS_WITH_INFO) + { + printf("erro no SQLFETCH number of fields\n"); + return FALSE; + } + + char *bind_value=NULL; + Term type; + + list = arg_list_args; + list_bind = arg_bind_list; + SQLINTEGER *data_info=NULL; + + while (IsPairTerm(list_bind)) + { + head = HeadOfTerm(list); + list = TailOfTerm(list); + + head_bind = HeadOfTerm(list_bind); + list_bind = TailOfTerm(list_bind); + + bind_value = (char *)IntegerOfTerm(ArgOfTerm(1,head_bind)); + type = ArgOfTerm(2,head_bind); + data_info = (SQLINTEGER *)IntegerOfTerm(ArgOfTerm(3,head_bind)); + + if ((*data_info) == SQL_NULL_DATA){ + null_atom[0] = MkIntegerTerm(null_id++); + if (!Yap_unify(head, Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("null"),1),1,null_atom))) + continue; + } + else + { + + if (!strcmp(AtomName(AtomOfTerm(type)),"integer")) + { + if (!Yap_unify(head, MkIntegerTerm(atoi(bind_value)))) + continue; + } + else if (!strcmp(AtomName(AtomOfTerm(type)),"real")) + { + if (!Yap_unify(head, MkFloatTerm(atof(bind_value)))) + continue; + } + else if (!strcmp(AtomName(AtomOfTerm(type)),"string")) + { + if (!Yap_unify(head, MkAtomTerm(Yap_LookupAtom(bind_value)))) + continue; + } + } + } + return TRUE; +} + + +/* Mudar esta funcao de forma a nao fazer a consulta, pois + no predicate db_sql_selet vai fazer duas vezes a mesma consutla*/ +static int +c_db_odbc_number_of_fields_in_query(void) { + Term arg_query = Deref(ARG1); + Term arg_conn = Deref(ARG2); + Term arg_fields = Deref(ARG3); + + char *sql = AtomName(AtomOfTerm(arg_query)); + + SQLHDBC hdbc =(SQLHDBC) (IntegerOfTerm(arg_conn)); + SQLHSTMT hstmt; + SQLSMALLINT number_cols=0; + + SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt, + "db_number_of_fields_in_query"); + SQLEXECDIRECT(hstmt,sql,SQL_NTS, + "db_number_of_fields_in_query"); + + SQLNUMRESULTCOLS(hstmt,&number_cols, + "db_number_of_fields_in_query"); + + if (!Yap_unify(arg_fields, MkIntegerTerm(number_cols))){ + return FALSE; + } + + SQLCLOSECURSOR(hstmt,"db_number_of_fields_in_query"); + SQLFREESTMT(hstmt,SQL_CLOSE, "db_number_of_fields_in_query"); + + return TRUE; +} + +static int +c_db_odbc_get_fields_properties(void) { + Term nome_relacao = Deref(ARG1); + Term arg_conn = Deref(ARG2); + Term fields_properties_list = Deref(ARG3); + Term head, list; + + char *relacao = AtomName(AtomOfTerm(nome_relacao)); + char sql[256]; + char name[200]; + int i; + + + SQLSMALLINT num_fields=0; + SQLSMALLINT NullablePtr=0; + SQLSMALLINT AutoIncrementPointer=0; + SQLHSTMT hstmt,hstmt2; + SQLHDBC hdbc =(SQLHDBC) (IntegerOfTerm(arg_conn)); + + + /* 1=2 -> We don't need the results of the query, + only the information about the fields of the relation*/ + sprintf (sql,"SELECT * FROM %s where 1=2",relacao); + + /*Allocate an handle for the query*/ + SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt, "db_get_fields_properties"); + /* Executes the query*/ + SQLEXECDIRECT(hstmt,sql,SQL_NTS, "db_get_fields_properties"); + + Functor functor = Yap_MkFunctor(Yap_LookupAtom("property"),4); + Term properties[4]; + + SQLNUMRESULTCOLS(hstmt,&num_fields, + "db_get_fields_properties"); + + list = fields_properties_list; + + SQLSMALLINT bind_prim_key; + //por causa de as rows em odbc começam em 1 :) + short *null=malloc(sizeof(short)*(1+num_fields)); + + SQLALLOCHANDLE(SQL_HANDLE_STMT, hdbc, &hstmt2, "db_get_fields_properties"); + /* Executes the query*/ + SQLPRIMARYKEYS(hstmt2,NULL,0,NULL,0,relacao,SQL_NTS, "db_get_fields_properties"); + /* Associates bind value for the 5 column*/ + SQLBINDCOL(hstmt2,5,SQL_C_SSHORT,&bind_prim_key,sizeof(SQLSMALLINT),NULL, + "db_get_fields_properties"); + + while(1) + { + SQLFETCH(hstmt2,"db_get_fields_properties"); + null[bind_prim_key]=1; + } + + SQLCLOSECURSOR(hstmt2,"db_get_fields_properties"); + SQLFREESTMT(hstmt2,SQL_CLOSE,"db_get_fields_properties"); + + for (i=1;i<=num_fields;i++) + { + head = HeadOfTerm(list); + name[0]='\0'; + SQLDESCRIBECOL(hstmt,i,name,200,NULL,NULL,NULL,NULL,&NullablePtr, + "db_get_fields_properties"); + + SQLCOLATTRIBUTE(hstmt,i,SQL_DESC_AUTO_UNIQUE_VALUE,NULL,0,NULL,&AutoIncrementPointer, + "db_get_fields_properties"); + + properties[0] = MkAtomTerm(Yap_LookupAtom(name)); + + + if (NullablePtr & SQL_NULLABLE) + properties[1] = MkIntegerTerm(1); //Can't be NULL + else + properties[1] = MkIntegerTerm(0); + + if (null[i] == 1) + properties[2] = MkIntegerTerm(1); //It''s a primary key + else + properties[2] = MkIntegerTerm(0); + + if (AutoIncrementPointer & SQL_TRUE) + properties[3] = MkIntegerTerm(1); //It's auto_incremented field + else + properties[3] = MkIntegerTerm(0); + + + list = TailOfTerm(list); + if (!Yap_unify(head, Yap_MkApplTerm(functor,4,properties))){ + return FALSE; + } + } + + SQLCLOSECURSOR(hstmt,"db_get_fields_properties"); + SQLFREESTMT(hstmt,SQL_CLOSE,"db_get_fields_properties"); + + return TRUE; +} + + + +void Yap_InitMYDDAS_ODBCPreds(void) +{ + /* db_connect: Host x User x Passwd x Database x Connection */ + Yap_InitCPred("c_db_odbc_connect", 4, c_db_odbc_connect, 0); + + /* db_number_of_fields: Relation x Connection x NumberOfFields */ + Yap_InitCPred("c_db_odbc_number_of_fields",3, c_db_odbc_number_of_fields, 0); + + /* db_number_of_fields_in_query: SQLQuery x Connection x NumberOfFields */ + Yap_InitCPred("c_db_odbc_number_of_fields_in_query",3, c_db_odbc_number_of_fields_in_query, 0); + + /* db_get_attributes_types: Relation x TypesList */ + Yap_InitCPred("c_db_odbc_get_attributes_types", 3, c_db_odbc_get_attributes_types, 0); + + /* db_query: SQLQuery x ResultSet x Connection */ + Yap_InitCPred("c_db_odbc_query", 5, c_db_odbc_query, 0); + + /* db_disconnect: Connection */ + Yap_InitCPred("c_db_odbc_disconnect", 1,c_db_odbc_disconnect, 0); + + /* db_get_fields_properties: PredName x Connnection x PropertiesList */ + Yap_InitCPred("c_db_odbc_get_fields_properties",3,c_db_odbc_get_fields_properties,0); + +} + + +void Yap_InitBackMYDDAS_ODBCPreds(void) +{ + + /* db_row: ResultSet x ListOfArgs */ + Yap_InitCPredBackCut("c_db_odbc_row", 3, sizeof(int), + c_db_odbc_row, + c_db_odbc_row, + c_db_odbc_row_cut, 0); + +} + +#endif /*MYDDAS_ODBC*/ diff --git a/MYDDAS/myddas_shared.c b/MYDDAS/myddas_shared.c new file mode 100644 index 000000000..70638f53a --- /dev/null +++ b/MYDDAS/myddas_shared.c @@ -0,0 +1,161 @@ +/************************************************************************* +* * +* 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_shared.c * +* Last rev: 22/03/05 * +* mods: * +* comments: Predicates for maintaining MYDDAS * +* * +*************************************************************************/ + +#if defined CUT_C && (defined MYDDAS_MYSQL || defined MYDDAS_ODBC) + +#include "Yap.h" +#include "Yatom.h" +#include "cut_c.h" +#include "myddas_util.h" + + +STATIC_PROTO(int c_db_preds_conn_start ,(void)); +STATIC_PROTO(int c_db_preds_conn_continue ,(void)); +STATIC_PROTO(int c_db_add_preds,(void)); +STATIC_PROTO(int c_db_check_if_exists_pred,(void)); + +#ifdef DEBUG +STATIC_PROTO(int c_db_check,(void)); +#endif + + +/* db_add_preds: PredName * Arity * Module * Connection*/ +static int +c_db_add_preds (void){ + Term arg_nome = Deref(ARG1); + Term arg_aridade = Deref(ARG2); + Term arg_module = Deref(ARG3); + Term arg_conn = Deref(ARG4); + + char *nome = AtomName(AtomOfTerm(arg_nome)); + char *module = AtomName(AtomOfTerm(arg_module)); + int aridade = IntegerOfTerm(arg_aridade); + int *conn = (int *) IntegerOfTerm(arg_conn); + + if (myddas_util_add_predicate(nome,aridade,module,conn) == NULL) + { + printf ("ERRO : Nao consegui adicionar predicado\n"); + return FALSE; + } + + return TRUE; +} + +/* db_add_preds: PredName * Arity */ +static int +c_db_check_if_exists_pred (void){ + Term arg_nome = Deref(ARG1); + Term arg_aridade = Deref(ARG2); + Term arg_module = Deref(ARG3); + + char *nome = AtomName(AtomOfTerm(arg_nome)); + char *module = AtomName(AtomOfTerm(arg_module)); + int aridade = IntegerOfTerm(arg_aridade); + + if (myddas_util_search_predicate(nome,aridade,module) == NULL) + return FALSE; + else + return TRUE; +} + + +/* db_preds_conn : Connection(+) * Pred_name(-) * Pred_arity */ +static int +c_db_preds_conn_start (void){ + Term arg_conn = Deref(ARG1); + Term nome = Deref(ARG2); + Term aridade = Deref(ARG3); + + int *conn = (int *) IntegerOfTerm(arg_conn); + MYDDAS_UTIL_CONNECTION node = + myddas_util_search_connection(conn); + + /* Caso a ligacao já tenha sido apagada*/ + if (node == NULL) + { + cut_fail(); + return FALSE; + } + + void *pointer = myddas_util_get_list_pred(node); + EXTRA_CBACK_ARG(3,1)=(CELL) MkIntegerTerm((int)pointer); + + if (IsVarTerm(nome) && IsVarTerm(aridade)) + return (c_db_preds_conn_continue()); + + cut_fail(); + return FALSE; +} + +/* db_preds_conn : Connection(+) * Pred_name(-) * Pred_arity*/ +static int +c_db_preds_conn_continue (void){ + Term nome = Deref(ARG2); + Term aridade = Deref(ARG3); + + void *pointer; + pointer = (void *) IntegerOfTerm(EXTRA_CBACK_ARG(3,1)); + + if (pointer != NULL) + { + Yap_unify(nome, MkAtomTerm(Yap_LookupAtom(myddas_util_get_pred_name(pointer)))); + Yap_unify(aridade, MkIntegerTerm((int)myddas_util_get_pred_arity(pointer))); + + EXTRA_CBACK_ARG(3,1)=(CELL) MkIntegerTerm((int)myddas_util_get_pred_next(pointer)); + return TRUE; + } + else + { + cut_fail(); + return FALSE; + } +} + +#ifdef DEBUG +static int +c_db_check(void){ + check_int(); + return TRUE; +} +#endif /*DEBUG*/ + + +void Yap_InitMYDDAS_SharedPreds(void) +{ + /* db_add_preds : PredName * Arity * Connection */ + Yap_InitCPred("c_db_add_preds",4,c_db_add_preds, 0); + + /* db_check_if_exists_pred : PredName * Arity * Connection */ + Yap_InitCPred("c_db_check_if_exists_pred",3,c_db_check_if_exists_pred, 0); + +#ifdef DEBUG + Yap_InitCPred("c_db_check",0, c_db_check, 0); +#endif +} + +void Yap_InitBackMYDDAS_SharedPreds(void) +{ + Yap_InitCPredBack("c_db_preds_conn", 3, sizeof(int), + c_db_preds_conn_start, + c_db_preds_conn_continue, 0); + +} + + + + +#endif /*CUT_C && (MYDDAS_MYSQL || MYDDAS_ODBC)*/ diff --git a/MYDDAS/myddas_test_predicates.c b/MYDDAS/myddas_test_predicates.c new file mode 100644 index 000000000..71b1b9f15 --- /dev/null +++ b/MYDDAS/myddas_test_predicates.c @@ -0,0 +1,391 @@ + +#if (defined MYDDAS_MYSQL || defined MYDDAS_ODBC) && defined CUT_C + + +#include +#include +#include + +#include +#include "Yap.h" +#include "Yatom.h" +#include "cut_c.h" +#include "myddas_util.h" + + + +#define IS_SQL_INT(FIELD) FIELD == FIELD_TYPE_INT24 || \ + FIELD == FIELD_TYPE_LONG || \ + FIELD == FIELD_TYPE_LONGLONG || \ + FIELD == FIELD_TYPE_SHORT || \ + FIELD == FIELD_TYPE_TINY + +#define IS_SQL_FLOAT(FIELD) FIELD == FIELD_TYPE_DECIMAL || \ + FIELD == FIELD_TYPE_DOUBLE || \ + FIELD == FIELD_TYPE_FLOAT + + +static int null_id = 0; + + +STATIC_PROTO(int c_db_my_query_no_result,(void)); +STATIC_PROTO(int c_db_my_query_result,(void)); + +STATIC_PROTO(int c_db_my_row,(void)); +STATIC_PROTO(int c_db_my_row_cut,(void)); +STATIC_PROTO(int c_db_my_row_unify,(void)); + +static int +c_db_my_query_no_result(void) { + Term arg_sql_query = Deref(ARG1); + Term arg_conn = Deref(ARG2); + + char *sql = AtomName(AtomOfTerm(arg_sql_query)); + MYSQL *conn = (MYSQL *) (IntegerOfTerm(arg_conn)); + + int length=strlen(sql); + if (mysql_real_query(conn, sql, length) != 0){ + printf("Erro na query!\n"); + return FALSE; + } + /* With an INSERT statement, + mysql_(use or store)_result() returns + a NULL pointer, so it isn't necessary to + use mysql_(use or store)_result*/ + + return TRUE; +} + +/* Only use this function, with querys that return result sets*/ +/* db_query: SQLQuery x ResultSet x Connection */ +static int +c_db_my_query_result(void) { + Term arg_sql_query = Deref(ARG1); + Term arg_result_set = Deref(ARG2); + Term arg_conn = Deref(ARG3); + Term arg_mode = Deref(ARG4); + + char *sql = AtomName(AtomOfTerm(arg_sql_query)); + char *mode = AtomName(AtomOfTerm(arg_mode)); + MYSQL *conn = (MYSQL *) (IntegerOfTerm(arg_conn)); + + MYSQL_RES *res_set; + + int length=strlen(sql); + + /* executar a query SQL */ + if (mysql_real_query(conn, sql, length) != 0) + { + printf("Erro na query!\n"); + return FALSE; + } + + /* guardar os tuplos do lado do cliente */ + if (strcmp(mode,"store_result")!=0) //Verdadeiro + { + res_set = mysql_use_result(conn); + } + else + { + res_set = mysql_store_result(conn); + + int count = mysql_num_rows(res_set); + if (count == 0){ + mysql_free_result(res_set); + return FALSE; + } + +#ifdef MYDDAS_STATS + MYDDAS_UTIL_CONNECTION node = + myddas_util_search_connection(conn); + + /* This only works if we use mysql_store_result */ + int numberRows = mysql_num_rows(res_set); + numberRows = numberRows + myddas_util_get_conn_total_rows(node); + myddas_util_set_conn_total_rows(node,numberRows); +#endif + + } + + Bind(VarOfTerm(arg_result_set), MkIntegerTerm((int) res_set)); + return TRUE; +} + + +static int +c_db_my_row_cut(void) { + MYSQL_RES *mysql_res=NULL; + + mysql_res = (MYSQL_RES *) IntegerOfTerm(EXTRA_CBACK_CUT_ARG(Term,1)); + mysql_free_result(mysql_res); + return TRUE; +} + +/* db_row: ResultSet x Arity_ListOfArgs x ListOfArgs -> */ +static int +c_db_my_row(void) { + Term arg_result_set = Deref(ARG1); + Term arg_arity = Deref(ARG2); + Term arg_list_args = Deref(ARG3); + + MYSQL_RES *res_set = (MYSQL_RES *) IntegerOfTerm(arg_result_set); + EXTRA_CBACK_ARG(3,1)=(CELL) MkIntegerTerm((int)res_set); + MYSQL_ROW row; + MYSQL_FIELD *field; + + Term head, list, null_atom[1]; + int i, arity; + + arity = IntegerOfTerm(arg_arity); + + while(TRUE) + { + if ((row = mysql_fetch_row(res_set)) != NULL) + { + mysql_field_seek(res_set,0); + list = arg_list_args; + + for (i = 0; i < arity; i++) + { + /* Aqui sero feitas as converses de tipos de dados */ + field = mysql_fetch_field(res_set); + head = HeadOfTerm(list); + list = TailOfTerm(list); + + if (row[i] == NULL) + { + null_atom[0] = MkIntegerTerm(null_id++); + + //if (!Yap_unify(head, Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("null"),1),1,null_atom))) + Bind(VarOfTerm(head), Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("null"),1),1,null_atom)); + continue; + } + else + { + if (IS_SQL_INT(field->type)) + { + //if (!Yap_unify(head, MkIntegerTerm(atoi(row[i])))){ + Bind(VarOfTerm(head), MkIntegerTerm(atoi(row[i]))); + continue; + } + else if (IS_SQL_FLOAT(field->type)) + { + //if (!Yap_unify(head, MkFloatTerm(atof(row[i])))) + Bind(VarOfTerm(head), MkFloatTerm(atof(row[i]))); + continue; + } + else + { + //if (!Yap_unify(head, MkAtomTerm(Yap_LookupAtom(row[i])))) + Bind(VarOfTerm(head), MkAtomTerm(Yap_LookupAtom(row[i]))); + continue; + } + } + } + return TRUE; + } + else + { + mysql_free_result(res_set); + cut_fail(); + return FALSE; + } + } +} +/* db_row: ResultSet x Arity_ListOfArgs x ListOfArgs -> */ +static int +c_db_my_row_unify(void) { + Term arg_result_set = Deref(ARG1); + Term arg_arity = Deref(ARG2); + Term arg_list_args = Deref(ARG3); + + MYSQL_RES *res_set = (MYSQL_RES *) IntegerOfTerm(arg_result_set); + EXTRA_CBACK_ARG(3,1)=(CELL) MkIntegerTerm((int)res_set); + MYSQL_ROW row; + MYSQL_FIELD *field; + + Term head, list, null_atom[1]; + int i, arity; + + arity = IntegerOfTerm(arg_arity); + + while(TRUE) + { + if ((row = mysql_fetch_row(res_set)) != NULL) + { + mysql_field_seek(res_set,0); + list = arg_list_args; + + for (i = 0; i < arity; i++) + { + /* Aqui sero feitas as converses de tipos de dados */ + field = mysql_fetch_field(res_set); + head = HeadOfTerm(list); + list = TailOfTerm(list); + + if (row[i] == NULL) + { + null_atom[0] = MkIntegerTerm(null_id++); + + if (!Yap_unify(head, Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("null"),1),1,null_atom))) + //Bind(VarOfTerm(head), Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("null"),1),1,null_atom)); + continue; + } + else + { + if (IS_SQL_INT(field->type)) + { + if (!Yap_unify(head, MkIntegerTerm(atoi(row[i])))) + //Bind(VarOfTerm(head), MkIntegerTerm(atoi(row[i]))); + continue; + } + else if (IS_SQL_FLOAT(field->type)) + { + if (!Yap_unify(head, MkFloatTerm(atof(row[i])))) + //Bind(VarOfTerm(head), MkFloatTerm(atof(row[i]))); + continue; + } + else + { + if (!Yap_unify(head, MkAtomTerm(Yap_LookupAtom(row[i])))) + //Bind(VarOfTerm(head), MkAtomTerm(Yap_LookupAtom(row[i]))); + continue; + } + } + } + return TRUE; + } + else + { + mysql_free_result(res_set); + cut_fail(); + return FALSE; + } + } +} + +/* static int */ +/* c_db_my_row_term_cut(void) { */ +/* MYSQL_RES *mysql_res=NULL; */ + +/* mysql_res = (MYSQL_RES *) IntegerOfTerm(EXTRA_CBACK_CUT_ARG(Term,1)); */ +/* mysql_free_result(mysql_res); */ +/* return TRUE; */ +/* } */ + +/* /\* db_row: ResultSet x ListOfArgs -> *\/ */ +/* static int */ +/* c_db_my_row_term(void) { */ +/* Term arg_result_set = Deref(ARG1); */ +/* Term arg_functor_name = Deref(ARG2); */ +/* Term arg_term = Deref(ARG3); */ + +/* MYSQL_RES *res_set = (MYSQL_RES *) IntegerOfTerm(arg_result_set); */ +/* EXTRA_CBACK_ARG(3,1)=(CELL) MkIntegerTerm((int)res_set); */ +/* MYSQL_ROW row; */ +/* MYSQL_FIELD *field; */ +/* char *functor_name = AtomName(AtomOfTerm(arg_functor_name)); */ +/* Term null_atom[1]; */ + +/* int i, arity; */ +/* arity = mysql_num_fields(res_set); */ + +/* Functor functor = Yap_MkFunctor(Yap_LookupAtom(functor_name),arity); */ +/* Term properties[arity]; */ + +/* while(TRUE) */ +/* { */ +/* if ((row = mysql_fetch_row(res_set)) != NULL) */ +/* { */ +/* mysql_field_seek(res_set,0); */ +/* for (i = 0; i < arity; i++) */ +/* { */ +/* /\* Aqui serão feitas as conversões de tipos de dados *\/ */ +/* field = mysql_fetch_field(res_set); */ + +/* if (row[i] == NULL) */ +/* { */ +/* null_atom[0] = MkIntegerTerm(null_id++); */ +/* properties[i]= Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("null"),1),1,null_atom); */ +/* } */ +/* else */ +/* { */ +/* if (IS_SQL_INT(field->type)) */ +/* { */ +/* properties[i]= MkIntegerTerm(atoi(row[i])); */ +/* } */ +/* else if (IS_SQL_FLOAT(field->type)) */ +/* { */ +/* properties[i]= MkFloatTerm(atof(row[i])); */ +/* } */ +/* /\* This if is for case if we have a data type */ +/* like int(11)*\/ */ +/* else if (strchr(row[i],'(') && strchr(row[i],')')) */ +/* { */ +/* char *type = strtok(row[i],"("); */ +/* char *num = strtok(NULL,")"); */ +/* Term size[1]; */ +/* size[0] = MkIntegerTerm(atoi(num)); */ +/* properties[i]= Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom(type),1),1,size); */ + +/* //printf ("-->%s %s %s\n",row[i],type,num); */ + +/* } */ +/* else */ +/* { */ +/* properties[i]= MkAtomTerm(Yap_LookupAtom(row[i])); */ +/* } */ +/* } */ +/* } */ +/* if (!Yap_unify(arg_term, Yap_MkApplTerm(functor,arity,properties))){ */ +/* mysql_free_result(res_set); */ +/* cut_fail(); */ +/* return FALSE; */ +/* } */ +/* return TRUE; */ +/* } */ +/* else */ +/* { */ +/* mysql_free_result(res_set); */ +/* cut_fail(); */ +/* return FALSE; */ +/* } */ +/* } */ +/* } */ + + + + +void Yap_InitMYDDAS_testPreds(void) +{ + + /* db_query: SQLQuery x ResultSet x Connection */ + Yap_InitCPred("c_db_my_query_result", 4, c_db_my_query_result, 0); + /* db_query: SQLQuery x ResultSet x Connection */ + Yap_InitCPred("c_db_my_query_no_result", 2, c_db_my_query_no_result, 0); + + +} + + + +void Yap_InitBackMYDDAS_testPreds(void) +{ + /* db_row: ResultSet x Arity x ListOfArgs */ + Yap_InitCPredBackCut("c_db_my_row_bind", 3, sizeof(int), + c_db_my_row, + c_db_my_row, + c_db_my_row_cut, 0); + /* db_row: ResultSet x Arity x ListOfArgs */ + Yap_InitCPredBackCut("c_db_my_row_unify", 3, sizeof(int), + c_db_my_row_unify, + c_db_my_row_unify, + c_db_my_row_cut, 0); + /* /\* db_row_term: ResultSet x NameFunctor x Term *\/ */ + /* Yap_InitCPredBackCut("c_db_my_row_term", 3, sizeof(int), */ + /* c_db_my_row_term, */ + /* c_db_my_row_term, */ + /* c_db_my_row_term_cut, 0); */ +} + +#endif /*MYDDAS_MYSQL && CUT_C*/ diff --git a/MYDDAS/myddas_util.c b/MYDDAS/myddas_util.c new file mode 100755 index 000000000..3304d55a7 --- /dev/null +++ b/MYDDAS/myddas_util.c @@ -0,0 +1,395 @@ +#ifdef CUT_C +#if defined MYDDAS_ODBC || defined MYDDAS_MYSQL + +#include +#include +#include "cut_c.h" +#include "myddas_util.h" +#ifdef MYDDAS_ODBC +#include +#endif /*MYDDAS_ODBC*/ + + +static MYDDAS_UTIL_CONNECTION MYDDAS_TOP = NULL; + +struct list_preds { + char *pred_module; + char *pred_name; + short pred_arity; + struct list_preds *next; +}; + +struct list_connection { + void *connection; + /*If variable env is NULL, then it's a + MySQL connection, if not then it as the pointer + to the ODBC enviromment variable*/ + void *odbc_enviromment; +#ifdef MYDDAS_STATS + /* Time spent by the DataBase Server */ + unsigned long totalTimeofDBServer; + unsigned long totalNumberOfRows; +#endif + MYDDAS_UTIL_PREDICATE predicates; + struct list_connection *next; +}; + + +/* Prints a error message */ +static void +myddas_util_error_message(char *,int,char *); + +/* Search for the connection node, before of the actual*/ +static MYDDAS_UTIL_CONNECTION +myddas_util_search_previous_connection(void *); +/* Initializes a new connection node for the MYDDAS list*/ +static MYDDAS_UTIL_CONNECTION +myddas_util_initialize_connection(void *,void *, MYDDAS_UTIL_CONNECTION); + +/* Initializes a new predicate node for the MYDDAS list */ +static MYDDAS_UTIL_PREDICATE +myddas_util_initialize_predicate(char *, int,char *); +/* Search for the predicate in the given predicate list*/ +static MYDDAS_UTIL_PREDICATE +myddas_util_find_predicate(char *, int , char *, MYDDAS_UTIL_PREDICATE); +/* Add's a predicate node to the given predicate list*/ +static void +myddas_util_add_predicate_node(MYDDAS_UTIL_PREDICATE, MYDDAS_UTIL_PREDICATE *); +/* Deletes a predicate list */ +static void +myddas_util_delete_predicate_list(MYDDAS_UTIL_PREDICATE); + +#ifdef DEBUG +void check_int(){ + int i; + MYDDAS_UTIL_PREDICATE pred = NULL; + MYDDAS_UTIL_CONNECTION top = MYDDAS_TOP; + for (i=1 ; top!=NULL ; top=top->next) + { + printf ("***************\n"); + printf ("===== top =====\n"); + printf ("======= %p =====\n",top); + printf ("CONN: = %p =====\n",top->connection); + printf ("ENV : = %p =====\n",top->odbc_enviromment); + printf ("PRED: = %p =====\n",top->predicates); + printf ("======= %p =====\n",top->next); + if (top->predicates != NULL) + { + printf ("\t******\n"); + printf ("\t===== PREDICADOS =====\n"); + for (pred = top->predicates ; pred != NULL ; pred = pred->next) + { + printf ("\t--------------\n"); + printf ("\t===== %p =====\n",pred); + printf ("\t===== %s =====\n",pred->pred_name); + printf ("\t===== %d =====\n",pred->pred_arity); + printf ("\t===== %s =====\n",pred->pred_module); + printf ("\t===== %p =====\n",pred->next); + } + } + + } + + return; +} +#endif + +#ifdef MYDDAS_STATS +int +myddas_util_get_conn_total_rows(MYDDAS_UTIL_CONNECTION node){ + return node->totalNumberOfRows; +} +void +myddas_util_set_conn_total_rows(MYDDAS_UTIL_CONNECTION node , + int totalRows){ + node->totalNumberOfRows = totalRows; +} + +unsigned long +myddas_util_get_conn_total_time_DBServer(MYDDAS_UTIL_CONNECTION node){ + return node->totalTimeofDBServer; +} +void +myddas_util_set_conn_total_time_DBServer(MYDDAS_UTIL_CONNECTION node , + unsigned long totaltime){ + node->totalTimeofDBServer = totaltime; +} + +unsigned long +myddas_current_time(void) { + /* to get time as Yap */ + /* + double now, interval; + cputime_interval(&now, &interval); + return ((realtime)now); + */ + /*Fine grained time + tv_usec -> microseconds [0-999999] + */ + /*Fine grained time + sec -> [0-999] + tv_usec -> microseconds [0-99999] -> last digit is negleted + -> max execution time: 16minutes + milliseconds -> s/1000 + microseconds -> s/1000000 + */ + struct timeval tempo; + if (!gettimeofday(&tempo, NULL)) + //returns time in microseconds + return (tempo.tv_sec %1000)*1000000+tempo.tv_usec; + return 0; +} + + +#endif + +void * +myddas_util_get_pred_next(void *pointer){ + MYDDAS_UTIL_PREDICATE temp = (MYDDAS_UTIL_PREDICATE) pointer; + return (void *) (temp->next); +} + +int +myddas_util_get_pred_arity(void *pointer){ + MYDDAS_UTIL_PREDICATE temp = (MYDDAS_UTIL_PREDICATE) pointer; + return temp->pred_arity; +} + +char * +myddas_util_get_pred_name(void *pointer){ + MYDDAS_UTIL_PREDICATE temp = (MYDDAS_UTIL_PREDICATE) pointer; + return temp->pred_name; +} + +void * +myddas_util_get_list_pred(MYDDAS_UTIL_CONNECTION node){ + return (void *)(node->predicates); +} + +MYDDAS_UTIL_PREDICATE +myddas_util_search_predicate(char *pred_name, int pred_arity, + char *pred_module){ + MYDDAS_UTIL_PREDICATE pred=NULL; + MYDDAS_UTIL_CONNECTION top = MYDDAS_TOP; + + for (;top!=NULL;top=top->next) + { + if ((pred=myddas_util_find_predicate(pred_name,pred_arity,pred_module,top->predicates))) + return pred; + } + return NULL; +} + +/* When using this function, we must guarante that this predicate + it's unique */ +MYDDAS_UTIL_CONNECTION +myddas_util_add_predicate(char *pred_name, int pred_arity, + char *pred_module, void *conn){ + + MYDDAS_UTIL_CONNECTION node_conn = + myddas_util_search_connection(conn); + + MYDDAS_UTIL_PREDICATE new = + myddas_util_initialize_predicate(pred_name,pred_arity,pred_module); + + if (new == NULL) + { + myddas_util_error_message("Could not initialize predicate node",__LINE__,__FILE__); + return NULL; + } + + myddas_util_add_predicate_node(new,&(node_conn->predicates)); + + return node_conn; +} + +void +myddas_util_delete_connection(void *conn){ + + MYDDAS_UTIL_CONNECTION before_to_delete = NULL; + MYDDAS_UTIL_CONNECTION to_delete = + myddas_util_search_connection(conn); + + if (to_delete == NULL) + return; + else + { + /*Removes the predicates list*/ + myddas_util_delete_predicate_list(to_delete->predicates); + + if (to_delete == MYDDAS_TOP) + { + MYDDAS_TOP= to_delete->next; + free(to_delete); + return; + } + else + { + before_to_delete = + myddas_util_search_previous_connection(conn); + before_to_delete->next=to_delete->next; + free(to_delete); + return; + } + } +} + +MYDDAS_UTIL_CONNECTION +myddas_util_search_connection(void *conn){ + MYDDAS_UTIL_CONNECTION list = MYDDAS_TOP; + + for (;list!=NULL;list=list->next) + if (list->connection == conn) + return list; + return NULL; +} + +MYDDAS_UTIL_CONNECTION +myddas_util_add_connection(void *conn, void *enviromment){ + + MYDDAS_UTIL_CONNECTION node=NULL; + MYDDAS_UTIL_CONNECTION temp=NULL; + + if ((node = myddas_util_search_connection(conn)) != NULL) + { + return node; + } + + if (MYDDAS_TOP!=NULL) + { + //put the new connection node on the top of the list + temp = myddas_util_initialize_connection(conn,enviromment,MYDDAS_TOP); + if (temp == NULL) + { + myddas_util_error_message("Could not initialize connection node",__LINE__,__FILE__); + return NULL; + } + MYDDAS_TOP = temp; + return MYDDAS_TOP; + } + else //The MYDDAS list is empty + { + temp = myddas_util_initialize_connection(conn,enviromment,NULL); + if (temp == NULL) + { + myddas_util_error_message("Could not initialize connection node",__LINE__,__FILE__); + return NULL; + } + MYDDAS_TOP = temp; + return MYDDAS_TOP; + } +} + +#ifdef MYDDAS_ODBC +/* This function searches the MYDDAS list for odbc connections + If there isn't any, it returns NULL. This is a nice way to know + if there is any odbc connections left on the list*/ +SQLHENV +myddas_util_get_odbc_enviromment(SQLHDBC connection){ + MYDDAS_UTIL_CONNECTION top = MYDDAS_TOP; + + for (;top != NULL;top=top->next) + if (top->connection == ((void *)connection)) + return top->odbc_enviromment; + + return NULL; +} +#endif + +static +void myddas_util_error_message(char *message,int line,char *file){ +#ifdef DEBUG + printf ("ERROR: %s at line %d in file %s\n",message,line,file); +#else + printf ("ERROR: %s\n",message); +#endif +} + +static MYDDAS_UTIL_CONNECTION +myddas_util_search_previous_connection(void *conn){ + MYDDAS_UTIL_CONNECTION top = MYDDAS_TOP; + for(;top->next!=NULL;top=top->next) + if (top->next->connection == conn) + return top; + return NULL; +} + +static MYDDAS_UTIL_CONNECTION +myddas_util_initialize_connection(void *conn,void *enviromment, + MYDDAS_UTIL_CONNECTION next){ + + MYDDAS_UTIL_CONNECTION new = malloc (sizeof(struct list_connection)); + if (new == NULL) + { + return NULL; + } + new->predicates=NULL; + new->connection=conn; + new->odbc_enviromment=enviromment; + new->next=next; +#ifdef MYDDAS_STATS + new->totalNumberOfRows=0; + new->totalTimeofDBServer=0; +#endif + return new; +} + +static MYDDAS_UTIL_PREDICATE +myddas_util_initialize_predicate(char *pred_name, int pred_arity, + char *pred_module){ + MYDDAS_UTIL_PREDICATE new = malloc (sizeof(struct list_preds)); + if (new == NULL) + { + return NULL; + } + new->pred_name=pred_name; + new->pred_arity=pred_arity; + new->pred_module=pred_module; + new->next=NULL; + return new; +} + +static MYDDAS_UTIL_PREDICATE +myddas_util_find_predicate(char *pred_name, int pred_arity, + char *pred_module, MYDDAS_UTIL_PREDICATE list){ + + for(;list != NULL ; list = list->next) + if (pred_arity == list->pred_arity && + !strcmp(pred_name,list->pred_name) && + !strcmp(pred_module,list->pred_module)) + return list; + + return NULL; +} + +static void +myddas_util_add_predicate_node(MYDDAS_UTIL_PREDICATE new, + MYDDAS_UTIL_PREDICATE *list){ + + MYDDAS_UTIL_PREDICATE temp = *list; + *list = new; + new->next = temp; + +} + +/* DUVIDA: nesta estrutura (list_preds) existe um char* que é atribuido +por uma funcao do YAP (YAP_AtomOfTerm) na funcao c_db_add_preds. +Temos que fazer free deste apontador?*/ +static void +myddas_util_delete_predicate_list(MYDDAS_UTIL_PREDICATE preds_list){ + MYDDAS_UTIL_PREDICATE to_delete = NULL; + + for (;preds_list != NULL;) + { + to_delete = preds_list; + preds_list = preds_list->next; + + free(to_delete); + } + return; +} + + +#endif /*defined MYDDAS_ODBC || defined MYDDAS_MYSQL*/ +#endif /*CUT_C*/ + diff --git a/MYDDAS/myddas_util.h b/MYDDAS/myddas_util.h new file mode 100755 index 000000000..8a105bf31 --- /dev/null +++ b/MYDDAS/myddas_util.h @@ -0,0 +1,71 @@ +#ifndef __MYDDAS_UTIL_H__ +#define __MYDDAS_UTIL_H__ + +#include +#ifdef MYDDAS_ODBC +#include +#endif + + +typedef struct list_connection *MYDDAS_UTIL_CONNECTION; +typedef struct list_preds *MYDDAS_UTIL_PREDICATE; + +#ifdef MYDDAS_STATS +#include +#include +#endif + + +/* Adds a connection identifier to the MYDDAS connections list*/ +MYDDAS_UTIL_CONNECTION +myddas_util_add_connection(void *,void *); +/* Search for the node of the specified connection*/ +MYDDAS_UTIL_CONNECTION +myddas_util_search_connection(void *); +/* Deletes a connection node from the MYDDAS connections list*/ +void +myddas_util_delete_connection(void *); + +/* Adds a new predicate to it's connection node list*/ +MYDDAS_UTIL_CONNECTION +myddas_util_add_predicate(char *,int , char *,void *); +/* Search for a predicate node in it's connection list*/ +MYDDAS_UTIL_PREDICATE +myddas_util_search_predicate(char *,int , char *); + +#ifdef MYDDAS_ODBC +/* Return enviromment identifier*/ +SQLHENV +myddas_util_get_odbc_enviromment(SQLHDBC); +#endif + +void * +myddas_util_get_list_pred(MYDDAS_UTIL_CONNECTION); +void * +myddas_util_get_pred_next(void *); +char * +myddas_util_get_pred_name(void *); +int +myddas_util_get_pred_arity(void *); + + +#ifdef MYDDAS_STATS +int +myddas_util_get_conn_total_rows(MYDDAS_UTIL_CONNECTION); +void +myddas_util_set_conn_total_rows(MYDDAS_UTIL_CONNECTION,int); +unsigned long +myddas_util_get_conn_total_time_DBServer(MYDDAS_UTIL_CONNECTION); +void +myddas_util_set_conn_total_time_DBServer(MYDDAS_UTIL_CONNECTION,unsigned long); + +unsigned long +myddas_current_time(void); +#endif + + +#ifdef DEBUG +void check_int(void); +#endif + +#endif /*__MYDDAS_UTIL_H__*/ diff --git a/Makefile.in b/Makefile.in index 2fbddac8a..a4f22b050 100644 --- a/Makefile.in +++ b/Makefile.in @@ -123,7 +123,8 @@ HEADERS = \ $(srcdir)/OPTYap/mips_locks_funcs.h $(srcdir)/OPTYap/alpha_locks.h \ $(srcdir)/OPTYap/alpha_locks_funcs.h \ $(srcdir)/OPTYap/pthread_locks.h \ - $(srcdir)/H/cut_c.h + $(srcdir)/H/cut_c.h \ + $(srcdir)/MYDDAS/myddas_util.h C_SOURCES= \ $(srcdir)/C/absmi.c $(srcdir)/C/adtdefs.c \ @@ -163,7 +164,12 @@ C_SOURCES= \ $(srcdir)/OPTYap/or.scheduler.c $(srcdir)/OPTYap/or.cut.c \ $(srcdir)/OPTYap/tab.tries.c $(srcdir)/OPTYap/tab.suspend.c \ $(srcdir)/library/mpi/mpi.c $(srcdir)/library/mpi/mpe.c \ - $(srcdir)/C/cut_c.c + $(srcdir)/C/cut_c.c \ + $(srcdir)/MYDDAS/myddas_mysql.c \ + $(srcdir)/MYDDAS/myddas_odbc.c \ + $(srcdir)/MYDDAS/myddas_util.c \ + $(srcdir)/MYDDAS/myddas_shared.c \ + $(srcdir)/MYDDAS/myddas_test_predicates.c PL_SOURCES= \ $(srcdir)/pl/arith.yap $(srcdir)/pl/arrays.yap $(srcdir)/pl/boot.yap \ @@ -195,7 +201,9 @@ ENGINE_OBJECTS = \ cdmgr.o cmppreds.o compiler.o computils.o \ corout.o cut_c.o dbase.o dlmalloc.o errors.o eval.o bignum.o \ exec.o grow.o heapgc.o index.o init.o inlines.o \ - iopreds.o depth_bound.o mavar.o modules.o other.o \ + iopreds.o depth_bound.o mavar.o \ + myddas_mysql.o myddas_odbc.o myddas_shared.o myddas_test_predicates.o \ + myddas_util.o modules.o other.o \ parser.o save.o scanner.o sort.o stdpreds.o sysbits.o threads.o \ tracer.o \ unify.o userpreds.o utilpreds.o write.o ypsocks.o ypstdio.o @MPI_OBJS@ @@ -404,6 +412,21 @@ ypsocks.o: $(srcdir)/C/ypsocks.c ypstdio.o: $(srcdir)/C/ypstdio.c $(CC) -c $(CFLAGS) $(srcdir)/C/ypstdio.c -o $@ +myddas_mysql.o: $(srcdir)/MYDDAS/myddas_mysql.c + $(CC) -c $(CFLAGS) $(srcdir)/MYDDAS/myddas_mysql.c -o $@ + +myddas_odbc.o: $(srcdir)/MYDDAS/myddas_odbc.c + $(CC) -c $(CFLAGS) $(srcdir)/MYDDAS/myddas_odbc.c -o $@ + +myddas_shared.o: $(srcdir)/MYDDAS/myddas_shared.c + $(CC) -c $(CFLAGS) $(srcdir)/MYDDAS/myddas_shared.c -o $@ + +myddas_test_predicates.o: $(srcdir)/MYDDAS/myddas_test_predicates.c + $(CC) -c $(CFLAGS) $(srcdir)/MYDDAS/myddas_test_predicates.c -o $@ + +myddas_util.o: $(srcdir)/MYDDAS/myddas_util.c + $(CC) -c $(CFLAGS) $(srcdir)/MYDDAS/myddas_util.c -o $@ + opt.memory.o: $(srcdir)/OPTYap/opt.memory.c $(CC) -c $(CFLAGS) $(srcdir)/OPTYap/opt.memory.c -o $@ diff --git a/configure b/configure index 13d31910e..a42bd0c6f 100755 --- a/configure +++ b/configure @@ -845,7 +845,9 @@ if test -n "$ac_init_help"; then Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] ---enable-cut-c support for executing c code when a cut occurs + --enable-cut-c support for executing c code when a cut occurs + --enable-myddas enable the MYDDAS library + --enable-myddas-stats enable the MYDDAS library statistics support --enable-tabling support tabling --enable-or-parallelism support or-parallelism as: env-copy,sba,a-cow --enable-depth-limit support depth-bound computation @@ -2270,6 +2272,167 @@ if test "${enable_cut_c+set}" = set; then else cut_c=no fi; +# Check whether --enable-myddas was given +# and if so, trys to guess which development libraries +# (MySQL or ODBC) to use +if test "${enable_myddas+set}" = set; then + + #Tests for MySQL Devel Libraries + echo "$as_me:$LINENO: checking for MySQL for MYDDAS" >&5 + echo $ECHO_N "checking for MySQL for MYDDAS... $ECHO_C" >&6 + if test "${ac_cv_lib_mysql_myddas+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-L/usr/lib/mysql -lmysqlclient -lz -lcrypt -lnsl -lm -lc -lnss_files -lnss_dns -lresolv $LIBS" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +#include + +int main(){ + MYSQL *conn; + conn = mysql_init(NULL); + return 0; +} +_ACEOF + + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_mysql_myddas=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_mysql_myddas=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_mysql_myddas" >&5 + echo "${ECHO_T}$ac_cv_lib_mysql_myddas" >&6 + if test $ac_cv_lib_mysql_myddas = yes; then + LIBS="-L/usr/lib/mysql -lmysqlclient -lz -lcrypt -lnsl -lm -lc -lnss_files -lnss_dns -lresolv $LIBS" + fi + + + # Tests for ODBC Devel Libraries + echo "$as_me:$LINENO: checking for ODBC for MYDDAS" >&5 + echo $ECHO_N "checking for ODBC for MYDDAS... $ECHO_C" >&6 + if test "${ac_cv_lib_ODBC_myddas+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lodbc $LIBS" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF + cat confdefs.h >>conftest.$ac_ext + cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +#include +#include + +int main(){ + SQLHENV henv; + SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, &henv); + return 0; +} +_ACEOF + + rm -f conftest.$ac_objext conftest$ac_exeext + if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_odbc_myddas=yes + else + echo "$as_me: failed program was:" >&5 + sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_odbc_myddas=no + fi + rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS=$ac_check_lib_save_LIBS + fi + echo "$as_me:$LINENO: result: $ac_cv_lib_odbc_myddas" >&5 + echo "${ECHO_T}$ac_cv_lib_odbc_myddas" >&6 + if test $ac_cv_lib_odbc_myddas = yes; then + LIBS="-lodbc $LIBS" + fi + + + if test "$ac_cv_lib_mysql_myddas" = "no" + then + if test "$ac_cv_lib_odbc_myddas" = "no" + then + echo "-------------------------------" + echo "--" + echo "--" + echo "--" + echo "-- Theres no Devel Libraries for MySQL or ODBC" + echo "--" + echo "--" + echo "--" + echo "-------------------------------" + exit + fi + fi + + # Check whether --enable-myddas-stats was given. + if test "${enable_myddas_stats+set}" = set; then + enableval="$enable_myddas_stats" + myddas_stats="$enableval" + else + myddas_stats=no +fi; + +fi + # Check whether --enable-tabling or --disable-tabling was given. if test "${enable_tabling+set}" = set; then enableval="$enable_tabling" @@ -6265,6 +6428,55 @@ if test "$cut_c" = "yes" YAP_EXTRAS="$YAP_EXTRAS -DCUT_C=1" fi +if test "$ac_cv_lib_mysql_myddas" = "yes" + then + if test "$cut_c" = "no" + then + echo + echo + echo "********************************************************" + echo + echo + echo "!!!!!! WARNING !!!!!!" + echo "The MyDDAS interface makes no sense without cut-c" + echo "Please contact tiagosoares@ncc.up.pt for help" + echo + echo + echo "********************************************************" + echo + echo + exit + fi + YAP_EXTRAS="$YAP_EXTRAS -DMYDDAS_MYSQL" +fi + +if test "$ac_cv_lib_odbc_myddas" = "yes" + then + if test "$cut_c" = "no" + then + echo + echo + echo "********************************************************" + echo + echo + echo "!!!!!! WARNING !!!!!!" + echo "The MyDDAS interface makes no sense without cut-c" + echo "Please contact tiagosoares@ncc.up.pt for help" + echo + echo + echo "********************************************************" + echo + echo + exit + fi + YAP_EXTRAS="$YAP_EXTRAS -DMYDDAS_ODBC" +fi + +if test "$myddas_stats" = "yes" + then + YAP_EXTRAS="$YAP_EXTRAS -DMYDDAS_STATS" +fi + if test "$tabling" = "yes" then YAP_EXTRAS="$YAP_EXTRAS -DTABLING=1" diff --git a/library/MYDDAS/myddas.yap b/library/MYDDAS/myddas.yap new file mode 100644 index 000000000..9a5525891 --- /dev/null +++ b/library/MYDDAS/myddas.yap @@ -0,0 +1,80 @@ +/************************************************************************* +* * +* 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.yap * +* Last rev: * +* mods: * +* comments: Global predicates for the MyDDAS Interface * +* * +*************************************************************************/ + +:- module(myddas,[ + db_verbose/1, + db_is_database_predicate/3, + db_module/1, + db_stats/2 + ]). + +:- use_module(myddas_util_predicates). +:- use_module(myddas_errors). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_verbose/1 +% +% +db_verbose(X):- + var(X),!, + get_value(db_verbose,X). +db_verbose(1):-!, + set_value(db_verbose,1). +db_verbose(_):- + set_value(db_verbose,0). +%default value +:- db_verbose(0). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_is_database_predicate/3 +% +% +db_is_database_predicate(PredName,Arity,Module):- + '$error_checks'(db_is_database_predicate(PredName,Arity,Module)), + c_db_check_if_exists_pred(PredName,Arity,Module). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_module/1 +% +% +db_module(X):- + var(X),!, + get_value(db_module,X). +db_module(ModuleName):- + set_value(db_module,ModuleName). +%default value +:- db_module(user). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_stats/2 +% +% +db_stats(Connection,List):- + '$get_value'(Connection,Conn), + NumberOfStats = 2, + '$make_a_list'(NumberOfStats,List), + c_db_my_stats(Conn,List). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \ No newline at end of file diff --git a/library/MYDDAS/myddas_errors.yap b/library/MYDDAS/myddas_errors.yap new file mode 100644 index 000000000..a73fb633f --- /dev/null +++ b/library/MYDDAS/myddas_errors.yap @@ -0,0 +1,124 @@ +/************************************************************************* +* * +* 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_errors.yap * +* Last rev: * +* mods: * +* comments: MYDDAS errors checks and errors Messages * +* * +*************************************************************************/ + +:- module(myddas_errors,[ + '$error_checks'/1, + '$db_my_error'/2 + ]). + +:- use_module(myddas_util_predicates). + +% must have only one relation +'$error_checks'(db_my_insert3(_,_,_)):-!. +'$error_checks'(db_my_insert2(_,Conn,[query(Att,[rel(Relation,_)],_)])) :- !, + % Number of fields of the Relation, must be + % equal to the number of attributes + c_db_my_number_of_fields(Relation,Conn,Arity), + length(Att,Arity), + % All fields must be Instanciated ( FALTA POR O NULL ) + '$make_a_list'(Arity,FieldsProperties), + c_db_my_get_fields_properties(Relation,Conn,FieldsProperties), + '$check_fields'(Att,FieldsProperties). +%'$error_checks'(Preddb_Call):- + %'$do_error'(db_my_error(incompatible_db_predicate,PredCall)). + +'$error_checks'(db_my_open(Host,User,Password,Db,Conn)) :- !, + nonvar(Host), % == \+var(Host) + nonvar(User), + nonvar(Password), + nonvar(Db), + atom(Conn), + get_value(Conn,[]). % Nao pode ter nenhum valor atribuido +'$error_checks'(db_my_close(_)) :- !. +'$error_checks'(db_my_import(RelationName,PredName,_)) :- !, + nonvar(RelationName), + nonvar(PredName). +'$error_checks'(db_my_view(PredName,DbGoal,_)) :- !, + nonvar(DbGoal), + nonvar(PredName). +'$error_checks'(db_my_number_of_fields(RelationName,_,_)) :- !, + nonvar(RelationName). +'$error_checks'(db_my_get_attributes_types(RelationName,_,_)) :- !, + nonvar(RelationName). +'$error_checks'(db_my_describe(Relation,_)) :- !, + nonvar(Relation). +'$error_checks'(db_my_show_tables(_)):- !. +'$error_checks'(db_my_sql_select(_,SQL,LA)):- !, + nonvar(SQL), + var(LA). +'$error_checks'(db_is_database_predicate(PredName,Arity,Module)):-!, + nonvar(PredName), + nonvar(Arity), + nonvar(Module). +% Prevent the error of given an atom that has no value +'$error_checks'(get_value(Conn,Connection)) :- !, + % This also prevents the case of giving the number of the connection + % as an argument + atom(Conn), + var(Connection), + get_value(Conn,Value), + Value \== []. + +% must have only one relation +%'$error_checks'(db_insert(_,_,_)):-!. +'$error_checks'(db_odbc_insert3(_,_,_)):-!. +'$error_checks'(db_odbc_insert2(PredName,Conn,[query(Att,[rel(Relation,_)],_)])) :- !, + % Number of fields of the Relation, must be + % equal to the number of attributes + c_db_odbc_number_of_fields(Relation,Conn,Arity), + length(Att,Arity), + % All fields must be Instanciated ( FALTA POR O NULL ) + '$make_a_list'(Arity,FieldsProperties), + c_db_odbc_get_fields_properties(Relation,Conn,FieldsProperties), + '$check_fields'(Att,FieldsProperties). +%'$error_checks'(PredCall):- + %'$do_error'(db_error(incompatible_db_predicate,PredCall)). + +'$error_checks'(db_odbc_open(Host,User,Password,Conn)) :- !, + nonvar(Host), % == \+var(Host) + nonvar(User), + nonvar(Password), + atom(Conn), + get_value(Conn,[]). % Nao pode ter nenhum valor atribuido +'$error_checks'(db_odbc_close(_)) :- !. +'$error_checks'(db_odbc_import(RelationName,PredName,_)) :- !, + nonvar(RelationName), + nonvar(PredName). +'$error_checks'(db_odbc_view(PredName,DbGoal,Connection)) :- !, + nonvar(DbGoal), + nonvar(PredName). +'$error_checks'(db_odbc_number_of_fields(RelationName,Connection,Arity)) :- !, + nonvar(RelationName). +'$error_checks'(db_odbc_get_attributes_types(RelationName,Connection,TypesList)) :- !, + nonvar(RelationName). +'$error_checks'(db_odbc_sql_select(Connection,SQL,LA)):- !, + nonvar(SQL), + var(LA). +% Prevent the error of given an atom that has no value +'$error_checks'(get_value(Conn,Connection)) :- !, + % This also prevents the case of giving the number of the connection + % as an argument + atom(Conn), + var(Connection), + get_value(Conn,Value), + Value \== []. + + + +'$db_my_error'(ERROR,_):-var(ERROR),!. +'$db_my_error'(2005,c_db_my_connect(Host,User,Password,Db,Connection)):-!, + write(Host),nl. \ No newline at end of file diff --git a/library/MYDDAS/myddas_mysql.yap b/library/MYDDAS/myddas_mysql.yap new file mode 100755 index 000000000..d78e3c4dd --- /dev/null +++ b/library/MYDDAS/myddas_mysql.yap @@ -0,0 +1,350 @@ +/************************************************************************* +* * +* 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_mysql.yap * +* Last rev: * +* mods: * +* comments: MySQL Server communication library * +* * +*************************************************************************/ + +:- module(myddas_mysql,[ + db_my_open/5, + db_my_close/1, + db_my_import/3, + db_my_view/3, + db_my_insert/2, + db_my_insert/3, + db_my_result_set/1, + db_my_describe/2, + db_my_describe/3, + db_my_show_tables/1, + db_my_show_tables/2, + db_my_sql_select/3, + db_my_number_of_fields/3, + db_my_get_attributes_types/3 + ]). + + + +:- use_module(myddas). +:- use_module(myddas_errors). +:- use_module(myddas_prolog2sql,[translate/3,queries_atom/2]). +:- use_module(myddas_util_predicates). + +:- use_module(lists,[append/3]). + +%-------------------------------------------------------- +% Public Predicates +%-------------------------------------------------------- + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_open/5 +% +% +db_my_open(Host,User,Password,Db,Conn) :- + '$error_checks'(db_my_open(Host,User,Password,Db,Conn)), + c_db_my_connect(Host,User,Password,Db,Connection), + %'$db_my_error'(ERROR,c_db_my_connect(Host,User,Password,Db,Connection)), + set_value(Conn,Connection). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_close/1 +% +% +db_my_close(Conn):- + '$error_checks'(db_my_close(Conn)), + '$abolish_all'(Conn). +db_my_close(Conn) :- + '$error_checks'(db_my_close(Conn)), + '$get_value'(Conn,Connection), + c_db_my_disconnect(Connection), + set_value(Conn,[]). % "deletes" atom +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_import/3 +% +% +db_my_import(RelationName,PredName,Connection) :- + '$error_checks'(db_my_import(RelationName,PredName,Connection)), + '$get_value'(Connection,Conn), + '$assert_import_clause'(RelationName,PredName,Conn). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_view/3 +% +% +db_my_view(PredName,DbGoal,Connection) :- + '$error_checks'(db_my_view(PredName,DbGoal,Connection)), + '$get_value'(Connection,Conn), + '$assert_view_clause'(PredName,DbGoal,Conn). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_insert/2 +% +% +db_my_insert(PredName,Connection):- + '$get_value'(Connection,Conn), + translate(PredName,PredName,Code), + '$error_checks'(db_my_insert2(PredName,Conn,Code)), + '$get_values_for_insert'(Code,ValuesList,RelName), + '$make_atom'(['INSERT INTO ',RelName,' VALUES'|ValuesList],SQL), + db_my_result_set(Mode), + c_db_my_query(SQL,_,Conn,Mode). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_insert/3 +% +% +db_my_insert(RelationName,PredName,Connection) :- + '$get_value'(Connection,Conn), + '$error_checks'(db_my_insert3(RelationName,PredName,Connection)), + '$assert_relation_insert'(RelationName,PredName,Conn). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_result_set/1 +% +% +db_my_result_set(X):- + var(X),!, + get_value(db_my_result_set,X). +db_my_result_set(use_result):- + set_value(db_my_result_set,use_result). +db_my_result_set(store_result):- + set_value(db_my_result_set,store_result). +%default value +:- db_my_result_set(store_result). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_describe/2 +% +% +db_my_describe(Relation,Connection) :- + '$error_checks'(db_my_describe(Relation,Connection)), + '$get_value'(Connection,Conn), + '$make_atom'(['DESCRIBE ',Relation],SQL), + db_my_result_set(Mode), + c_db_my_query(SQL,ResultSet,Conn,Mode), + c_db_my_table_write(ResultSet). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_describe/3 +% gives the results of the DESCRIBE statement +% by backtracking +db_my_describe(Relation,Connection,tableinfo(A1,A2,A3,A4,A5,A6)) :- + '$error_checks'(db_my_describe(Relation,Connection)), + '$get_value'(Connection,Conn), + '$make_atom'(['DESCRIBE ',Relation],SQL), + db_my_result_set(Mode), + '$write_or_not'(SQL), + c_db_my_query(SQL,ResultSet,Conn,Mode), + !,c_db_my_row(ResultSet,6,[A1,A2,A3,A4,A5,A6]). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_show_tables/1 +% +% +db_my_show_tables(Connection) :- + '$error_checks'(db_my_show_tables(Connection)), + '$get_value'(Connection,Conn), + db_my_result_set(Mode), + '$write_or_not'('SHOW TABLES'), + c_db_my_query('SHOW TABLES',ResultSet,Conn,Mode), + c_db_my_table_write(ResultSet). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_show_tables/2 +% gives the results of the SHOW TABLES statement +% by backtracking +db_my_show_tables(Connection,table(Table)) :- + '$error_checks'(db_my_show_tables(Connection)), + '$get_value'(Connection,Conn), + db_my_result_set(Mode), + '$write_or_not'('SHOW TABLES'), + c_db_my_query('SHOW TABLES',ResultSet,Conn,Mode), + !,c_db_my_row(ResultSet,1,[Table]). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_sql_select/3 +% +% +db_my_sql_select(Connection,SQL,LA):- + '$error_checks'(db_my_sql_select(Connection,SQL,LA)), + '$get_value'(Connection,Conn), + c_db_my_number_of_fields_in_query(SQL,Conn,Arity), + '$make_a_list'(Arity,LA), + db_my_result_set(Mode), + '$write_or_not'(SQL),!, + c_db_my_query(SQL,ResultSet,Conn,Mode), + c_db_my_row(ResultSet,Arity,LA). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_number_of_fields/3 +% +% +db_my_number_of_fields(RelationName,Connection,Arity) :- + '$error_checks'(db_my_number_of_fields(RelationName,Connection,Arity)), + '$get_value'(Connection,Conn), + c_db_my_number_of_fields(RelationName,Conn,Arity). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_get_attributes_types/3 +% +% +db_my_get_attributes_types(RelationName,Connection,TypesList) :- + '$error_checks'(db_my_get_attributes_types(RelationName,Connection,TypesList)), + '$get_value'(Connection,Conn), + c_db_my_number_of_fields(RelationName,Conn,Arity), + Size is 2*Arity, + '$make_a_list'(Size,TypesList), + c_db_my_get_attributes_types(RelationName,Conn,TypesList). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + + + +%-------------------------------------------------------- +% Private Predicates +%-------------------------------------------------------- +'$assert_view_clause'(ViewName,DbGoal,Connection) :- + % here we can add some error control, like checking DBgoals include + % only DB relations + % get arity of projection term + functor(ViewName,PredName,Arity), + functor(NewName,PredName,Arity), + db_module(Module), + not c_db_my_check_if_exists_pred(PredName,Arity,Module), + + % This copy_term is done to prevent the unification + % with top-level variables A='var('A')' error + copy_term((ViewName,DbGoal),(CopyView,CopyGoal)), + translate(CopyView,CopyGoal,Code), + queries_atom(Code,SQL), + % checks if the WHERE commend of SQL exists in the string + '$where_exists'(SQL,Flag), + + '$make_list_of_args'(1,Arity,NewName,LA), + % build view clause + Assert =..[':-',NewName, + ','(myddas_mysql:'$build_query'(Flag,SQL,Code,LA,FinalSQL), + ','(myddas_mysql:db_my_result_set(Mode), + ','(myddas_mysql:'$write_or_not'(FinalSQL), + ','(myddas_mysql:c_db_my_query(FinalSQL,ResultSet,Connection,Mode), + ','(!,myddas_mysql:c_db_my_row(ResultSet,Arity,LA))))))], + assert(Module:Assert), + c_db_add_preds(PredName,Arity,Module,Connection). + + +'$assert_relation_insert'(RelationName,PredName,Connection) :- + % get relation arity + c_db_my_number_of_fields(RelationName,Connection,Arity), + db_module(Module), + not c_db_my_check_if_exists_pred(PredName,Arity,Module), + + R=..[relation,PredName,Arity,RelationName], + % assert relation fact + assert(myddas_prolog2sql:R), + + Size is 2*Arity, + '$make_a_list'(Size,TypesList), + % get attributes types in TypesList [field0,type0,field1,type1...] + c_db_my_get_attributes_types(RelationName,Connection,TypesList), + + % build PredName functor + functor(P,PredName,Arity), + '$make_list_of_args'(1,Arity,P,LA), + + % build PredName clause + Assert =..[':-',P,','(myddas_mysql:'$get_values_for_insert'(TypesList,LA,ValuesList), + ','(myddas_mysql:'$make_atom'(['INSERT INTO ',RelationName,' VALUES ('|ValuesList],SQL), + ','(myddas_mysql:db_my_result_set(Mode), + ','(myddas_mysql:'$write_or_not'(SQL), + myddas_mysql:c_db_my_query(SQL,_,Connection,Mode)))))], + assert(Module:Assert), + c_db_add_preds(PredName,Arity,Module,Connection). + + +'$assert_import_clause'(RelationName,PredName,Connection) :- + % get relation arity + c_db_my_number_of_fields(RelationName,Connection,Arity), + db_module(Module), + not c_db_my_check_if_exists_pred(PredName,Arity,Module), + + R=..[relation,PredName,Arity,RelationName], + % assert relation fact + assert(myddas_prolog2sql:R), + + Size is 2*Arity, + '$make_a_list'(Size,TypesList), + % get attributes types in TypesList [field0,type0,field1,type1...] + c_db_my_get_attributes_types(RelationName,Connection,TypesList), + % assert attributes facts + '$assert_attribute_information'(0,Arity,RelationName,TypesList), + + % build PredName functor + functor(P,PredName,Arity), + '$make_list_of_args'(1,Arity,P,LA), + + %Optimization + '$copy_term_nv'(P,[],G,_), + + %generate the SQL query + translate(G,G,Code), + queries_atom(Code,SQL), + + % build PredName clause + Assert =..[':-',P,','(myddas_mysql:'$build_query'(0,SQL,Code,LA,FinalSQL), + ','(myddas_mysql:db_my_result_set(Mode), + ','(myddas_mysql:'$write_or_not'(FinalSQL), + ','(myddas_mysql:c_db_my_query(FinalSQL,ResultSet,Connection,Mode), + ','(!,myddas_mysql:c_db_my_row(ResultSet,Arity,LA))))))], + assert(Module:Assert), + c_db_add_preds(PredName,Arity,Module,Connection). diff --git a/library/MYDDAS/myddas_odbc.yap b/library/MYDDAS/myddas_odbc.yap new file mode 100755 index 000000000..6615aa76d --- /dev/null +++ b/library/MYDDAS/myddas_odbc.yap @@ -0,0 +1,260 @@ +/************************************************************************* +* * +* 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_odbc.yap * +* Last rev: * +* mods: * +* comments: ODBC Driver communication library * +* * +*************************************************************************/ + +:- module(myddas_odbc,[ + db_odbc_open/4, + db_odbc_close/1, + db_odbc_import/3, + db_odbc_view/3, + db_odbc_insert/2, + db_odbc_insert/3, + db_odbc_sql_select/3, + db_odbc_number_of_fields/3, + db_odbc_get_attributes_types/3 + ]). + +:- use_module(myddas). +:- use_module(myddas_errors). +:- use_module(myddas_prolog2sql,[translate/3,queries_atom/2]). +:- use_module(myddas_util_predicates). + +:- use_module(lists,[append/3]). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_odbc_open/4 +% +% +db_odbc_open(ODBCEntry,User,Password,Conn) :- + '$error_checks'(db_odbc_open(ODBCEntry,User,Password,Conn)), + c_db_odbc_connect(ODBCEntry,User,Password,Connection), + set_value(Conn,Connection). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_odbc_close/1 +% +% +db_odbc_close(Conn):- + '$error_checks'(db_odbc_close(Conn)), + '$abolish_all'(Conn). +db_odbc_close(Conn) :- + '$error_checks'(db_odbc_close(Conn)), + '$get_value'(Conn,Connection), + c_db_odbc_disconnect(Connection), + set_value(Conn,[]). % "deletes" atom +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_odbc_import/3 +% +% +db_odbc_import(RelationName,PredName,Connection) :- + '$error_checks'(db_odbc_import(RelationName,PredName,Connection)), + '$get_value'(Connection,Conn), + '$assert_import_clause'(RelationName,PredName,Conn). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_odbc_view/3 +% +% +db_odbc_view(PredName,DbGoal,Connection) :- + '$error_checks'(db_odbc_view(PredName,DbGoal,Connection)), + '$get_value'(Connection,Conn), + '$assert_view_clause'(PredName,DbGoal,Conn). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_odbc_insert/2 +% +% +db_odbc_insert(PredName,Connection):- + '$get_value'(Connection,Conn), + translate(PredName,PredName,Code), + '$error_checks'(db_odbc_insert2(PredName,Conn,Code)), + '$get_values_for_insert'(Code,ValuesList,RelName), + '$make_atom'(['INSERT INTO ',RelName,' VALUES'|ValuesList],SQL), + c_db_odbc_query(SQL,_,_,_,Conn). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_odbc_insert/3 +% +% +db_odbc_insert(RelationName,PredName,Connection) :- + '$error_checks'(db_odbc_insert3(RelationName,PredName,Connection)), + '$get_value'(Connection,Conn), + '$assert_relation_insert'(RelationName,PredName,Conn). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_odbc_sql_select/3 +% +% +db_odbc_sql_select(Connection,SQL,LA):- + '$error_checks'(db_odbc_sql_select(Connection,SQL,LA)), + '$get_value'(Connection,Conn), + c_db_odbc_number_of_fields_in_query(SQL,Conn,Arity), + '$make_a_list'(Arity,LA), + '$make_a_list'(Arity,BindList), + '$write_or_not'(SQL), + c_db_odbc_query(SQL,ResultSet,Arity,BindList,Conn),!, + c_db_odbc_row(ResultSet,BindList,LA). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_odbc_number_of_fields/3 +% +% +db_odbc_number_of_fields(RelationName,Connection,Arity) :- + '$error_checks'(db_odbc_number_of_fields(RelationName,Connection,Arity)), + '$get_value'(Connection,Conn), + c_db_odbc_number_of_fields(RelationName,Conn,Arity). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_odbc_get_attributes_types/3 +% +% +db_odbc_get_attributes_types(RelationName,Connection,TypesList) :- + '$error_checks'(db_odbc_get_attributes_types(RelationName,Connection,TypesList)), + '$get_value'(Connection,Conn), + c_db_odbc_number_of_fields(RelationName,Conn,Arity), + Size is 2*Arity, + '$make_a_list'(Size,TypesList), + c_db_odbc_get_attributes_types(RelationName,Conn,TypesList). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%-------------------------------------------------------- +% Private Predicates +%-------------------------------------------------------- +'$assert_view_clause'(ViewName,DbGoal,Connection) :- + % here we can add some error control, like checking DBgoals include + % only DB relations + % get arity of projection term + functor(ViewName,PredName,Arity), + functor(NewName,PredName,Arity), + db_module(Module), + not c_db_check_if_exists_pred(PredName,Arity,Module), + + % This copy_term is done to prevent the unification + % with top-level variables A='var('A')' error + copy_term((ViewName,DbGoal),(CopyView,CopyGoal)), + translate(ViewName,DbGoal,Code), + queries_atom(Code,SQL), + % checks if the WHERE commend of SQL exists in the string + '$where_exists'(SQL,Flag), + + '$make_list_of_args'(1,Arity,NewName,LA), + % build view clause + Assert =..[':-',NewName, + ','(myddas_odbc:'$build_query'(Flag,SQL,Code,LA,FinalSQL), + ','(myddas_odbc:'$make_a_list'(Arity,BindList), + ','(myddas_odbc:c_db_odbc_query(FinalSQL,ResultSet,Arity,BindList,Connection), + ','(myddas_odbc:'$write_or_not'(FinalSQL), + ','(!,myddas_odbc:c_db_odbc_row(ResultSet,BindList,LA))))))], + assert(Module:Assert), + c_db_add_preds(PredName,Arity,Module,Connection). + + + +'$assert_relation_insert'(RelationName,PredName,Connection) :- + % get relation arity + c_db_odbc_number_of_fields(RelationName,Connection,Arity), + db_module(Module), + not c_db_check_if_exists_pred(PredName,Arity,Module), + + R=..[relation,PredName,Arity,RelationName], + % assert relation fact + assert(myddas_prolog2sql:R), + + Size is 2*Arity, + '$make_a_list'(Size,TypesList), + % get attributes types in TypesList [field0,type0,field1,type1...] + c_db_odbc_get_attributes_types(RelationName,Connection,TypesList), + + % build PredName functor + functor(P,PredName,Arity), + '$make_list_of_args'(1,Arity,P,LA), + + % build PredName clause + Assert =..[':-',P,','(myddas_odbc:'$get_values_for_insert'(TypesList,LA,ValuesList), + ','(myddas_odbc:'$make_atom'(['INSERT INTO ',RelationName,' VALUES ('|ValuesList],SQL), + myddas_odbc:c_db_odbc_query(SQL,_,_,_,Connection)))], + assert(Module:Assert), + c_db_add_preds(PredName,Arity,Module,Connection). + + + + +'$assert_import_clause'(RelationName,PredName,Connection) :- + % get relation arity + c_db_odbc_number_of_fields(RelationName,Connection,Arity), + db_module(Module), + not c_db_check_if_exists_pred(PredName,Arity,Module), + + R=..[relation,PredName,Arity,RelationName], + % assert relation fact + assert(myddas_prolog2sql:R), + + Size is 2*Arity, + '$make_a_list'(Size,TypesList), + % get attributes types in TypesList [field0,type0,field1,type1...] + c_db_odbc_get_attributes_types(RelationName,Connection,TypesList), + % assert attributes facts + '$assert_attribute_information'(0,Arity,RelationName,TypesList), + + % build PredName functor + functor(P,PredName,Arity), + % build arg list for db_row/2 + '$make_list_of_args'(1,Arity,P,LA), + + %Optimization + '$copy_term_nv'(P,[],G,_), + + %generate the SQL query + translate(G,G,Code), + queries_atom(Code,SQL), + + % build PredName clause + Assert =..[':-',P,','(myddas_odbc:'$build_query'(0,SQL,Code,LA,FinalSQL), + ','(myddas_odbc:'$make_a_list'(Arity,BindList), + ','(myddas_odbc:c_db_odbc_query(FinalSQL,ResultSet,Arity,BindList,Connection), + ','(myddas_odbc:'$write_or_not'(FinalSQL), + ','(!,myddas_odbc:c_db_odbc_row(ResultSet,BindList,LA))))))], + assert(Module:Assert), + c_db_add_preds(PredName,Arity,Module,Connection). + + diff --git a/library/MYDDAS/myddas_prolog2sql.yap b/library/MYDDAS/myddas_prolog2sql.yap new file mode 100644 index 000000000..a71a6fd78 --- /dev/null +++ b/library/MYDDAS/myddas_prolog2sql.yap @@ -0,0 +1,1414 @@ +% -*- Mode: Prolog -*- +% -------------------------------------------------------------------------------------- +% +% This Prolog to SQL compiler may be distributed free of charge provided that it is +% not used in commercial applications without written consent of the author, and +% that the copyright notice remains unchanged. +% +% (C) Copyright by Christoph Draxler, Munich +% Version 1.1 of Dec. 21st 1992 +% +% I would like to keep in my hands the further development and distribution of the +% compiler. This does not mean that I don't want other people to suggest or even +% implement improvements - quite on the contrary: I greatly appreciate contributions +% and if they make sense to me I will incorporate them into the compiler (with due +% credits given!). +% +% For further development of the compiler, address your requests, comments and +% criticism to the author: +% +% Christoph Draxler +% CIS Centre for Information and Speech Processing +% Ludwig-Maximilians-University Munich +% Wagmuellerstr. 23 +% D 80538 Munich +% Tel : ++49 / +89 / 211 06 64 (-60) +% Fax : ++49 / +89 / 211 06 74 +% Mail: draxler@cis.uni-muenchen.de +% +% +% A report describing the implementation is available upon request from the +% author. +% +% +% RELEASE INFORMATION +% =================== +% Current version is v. 1.1 of Dec. 21st 1992. +% Version 1.0 Sept. 3 1992 +% -------------------------------------------------------------------------------------- + + +:- module(myddas_prolog2sql,[ + translate/3, + queries_atom/2 + ]). + + + + + + +% -------------------------------------------------------------------------------------- +% +% Top level predicate translate/3 organizes the compilation and constructs a +% Prolog term representation of the SQL query. +% +% -------------------------------------------------------------------------------------- + + +translate(ProjectionTerm,DatabaseGoal,SQLQueryTerm):- + % --- initialize variable identifiers and range variables for relations ----- + init_gensym(var), + init_gensym(rel), + + % --- tokenize projection term and database goal ---------------------------- + tokenize_term(DatabaseGoal,TokenDatabaseGoal), + tokenize_term(ProjectionTerm,TokenProjectionTerm), + + % --- lexical analysis: reordering of goals for disjunctive normalized form - + disjunction(TokenDatabaseGoal,Disjunction), + + % --- code generation --------------------------------------------------------------- + query_generation(Disjunction,TokenProjectionTerm,SQLQueryTerm). + + + + + +% --- disjunction(Goal,Disjunction) ---------------------------------------------------- +% +% turns original goal into disjunctive normalized form by computing all conjunctions +% and collecting them in a list +% +% -------------------------------------------------------------------------------------- + +disjunction(Goal,Disjunction):- + findall(Conjunction,linearize(Goal,Conjunction),Disjunction). + + + + +% --- linearize(Goal,ConjunctionList) -------------------------------------------------- +% +% Returns a conjunction of base goals for a complex disjunctive or conjunctive goal +% Yields several solutions upon backtracking for disjunctive goals +% +% -------------------------------------------------------------------------------------- + +linearize(((A,B),C),(LinA,(LinB,LinC))):- + % --- transform left-linear to right-linear conjunction (',' is associative) ---- + linearize(A,LinA), + linearize(B,LinB), + linearize(C,LinC). + +linearize((A,B),(LinA,LinB)):- + A \= (_,_), + % --- make sure A is not a conjunction ------------------------------------------ + linearize(A,LinA), + linearize(B,LinB). + +% ILP +%linearize((A;B),LinA):- +linearize((A;_),LinA):- + linearize(A,LinA). + +% ILP +%linearize((A;B),LinB):- +linearize((_;B),LinB):- + linearize(B,LinB). + +linearize(not A, not LinA):- + linearize(A,LinA). + +linearize(Var^A, Var^LinA):- + linearize(A,LinA). + +linearize(A,A):- + A \= (_,_), + A \= (_;_), + A \= _^_, + A \= not(_). + + + + +% --- tokenize_term(Term,TokenizedTerm) ------------------------------------------------- +% +% If Term is a +% +% - variable, then this variable is instantiated with a unique identifier +% of the form '$var$'(VarId), and TokenizedTerm is bound to the same +% term '$var$'(VarId). +% +% - constant, then TokenizedTerm is bound to '$const$'(Term). +% +% - complex term, then the term is decomposed, its arguments are tokenized, +% and TokenizedTerm is bound to the result of the composition of the original +% functor and the tokenized arguments. +% +% -------------------------------------------------------------------------------------- + +tokenize_term('$var$'(VarId),'$var$'(VarId)):- + var(VarId), + % --- uninstantiated variable: instantiate it with unique identifier. + gensym(var,VarId). + +tokenize_term('$var$'(VarId),'$var$'(VarId)):- + nonvar(VarId). + +tokenize_term(Constant,'$const$'(Constant)):- + nonvar(Constant), + functor(Constant,_,0). + +tokenize_term(Term,TokenizedTerm):- + nonvar(Term), + Term \= '$var$'(_), + Term \= '$const$'(_), + Term =.. [Functor|Arguments], + Arguments \= [], + tokenize_arguments(Arguments,TokenArguments), + TokenizedTerm =.. [Functor|TokenArguments]. + + + +% --- tokenize_arguments(Arguments,TokenizedArguments) --------------------------------- +% +% organizes tokenization of arguments by traversing list and calling tokenize_term +% for each element of the list. +% +% -------------------------------------------------------------------------------------- + +tokenize_arguments([],[]). + +tokenize_arguments([FirstArg|RestArgs],[TokFirstArg|TokRestArgs]):- + tokenize_term(FirstArg,TokFirstArg), + tokenize_arguments(RestArgs,TokRestArgs). + + + + + + + +% --- query_generation(ListOfConjunctions, ProjectionTerm, ListOfQueries) -------------- +% +% For each Conjunction translate the pair (ProjectionTerm,Conjunction) to an SQL query +% and connect each such query through a UNION-operator to result in the ListOfQueries. +% +% A Conjunction consists of positive or negative subgoals. Each subgoal is translated +% as follows: +% - the functor of a goal that is not a comparison operation is translated to +% a relation name with a range variable +% - negated goals are translated to NOT EXISTS-subqueries with * projection +% - comparison operations are translated to comparison operations in the WHERE-clause +% - aggregate function terms are translated to aggregate function (sub)queries +% +% The arguments of a goal are translated as follows: +% - variables of a goal are translated to qualified attributes +% - variables occurring in several goals are translated to equality comparisons +% (equi join) in the WHERE-clause +% - constant arguments are translated to equality comparisons in the WHERE-clause +% +% Special treatment of arithmetic functions: +% - arithmetic functions are identified through the Prolog is/2 operator +% - an arithmetic function may contain an unbound variable only on its left side +% - the right side of the is/2 operator may consist of +% * bound variables (bound through occurrence within a positive database goal, or +% bound through preceeding arithmetic function), or of +% * constants (numbers, i.e. integers, reals) +% +% The following RESTRICTION holds: +% +% - the binding of variables follows Prolog: variables are bound by positive base goals +% and on the left side of the is/2 predicate - comparison operations, negated goals +% and right sides of the is/2 predicate do not return variable bindings and may even +% require all arguments to be bound for a safe evaluation. +% +% -------------------------------------------------------------------------------------- + +query_generation([],_,[]). + +query_generation([Conjunction|Conjunctions],ProjectionTerm,[Query|Queries]):- + projection_term_variables(ProjectionTerm,InitDict), + translate_conjunction(Conjunction,SQLFrom,SQLWhere,InitDict,Dict), + translate_projection(ProjectionTerm,Dict,SQLSelect), + Query = query(SQLSelect,SQLFrom,SQLWhere), + query_generation(Conjunctions,ProjectionTerm,Queries). + + + +% --- translate_goal(Goal,SQLFrom,SQLWhere,Dict,NewDict) ------------------------------- +% +% translates a +% +% - positive database goal to the associated FROM- and WHERE clause of an SQL query +% - a negated goal to a negated existential subquery +% - an arithmetic goal to an arithmetic expression or an aggregate function query +% - a comparison goal to a comparison expression +% - a negated comparison goal to a comparison expression with the opposite comparison +% operator +% +% -------------------------------------------------------------------------------------- + +translate_goal(SimpleGoal,[SQLFrom],SQLWhere,Dict,NewDict):- + % --- positive goal binds variables - these bindings are held in the dictionary ----- + functor(SimpleGoal,Functor,Arity), + translate_functor(Functor,Arity,SQLFrom), + SimpleGoal =.. [Functor|Arguments], + translate_arguments(Arguments,SQLFrom,1,SQLWhere,Dict,NewDict). + +translate_goal(Result is Expression,[],SQLWhere,Dict,NewDict):- + translate_arithmetic_function(Result,Expression,SQLWhere,Dict,NewDict). + +translate_goal(not NegatedGoals,[],SQLNegatedSubquery,Dict,Dict):- + % --- negated goals do not bind variables - hence Dict is returned unchanged -------- + functor(NegatedGoals,Functor,_), + not comparison(Functor,_), + translate_conjunction(NegatedGoals,SQLFrom,SQLWhere,Dict,_), + SQLNegatedSubquery = [negated_existential_subquery([*],SQLFrom,SQLWhere)]. + +translate_goal(not ComparisonGoal,[],SQLCompOp,Dict,Dict):- + % --- comparison operations do not bind variables - Dict is returned unchanged ------ + ComparisonGoal =.. [ComparisonOperator,LeftArg,RightArg], + comparison(ComparisonOperator,SQLOperator), + negated_comparison(SQLOperator,SQLNegOperator), + translate_comparison(LeftArg,RightArg,SQLNegOperator,Dict,SQLCompOp). + +translate_goal(ComparisonGoal,[],SQLCompOp,Dict,Dict):- + % --- comparison operations do not bind variables - Dict is returned unchanged ------ + ComparisonGoal =.. [ComparisonOperator,LeftArg,RightArg], + comparison(ComparisonOperator,SQLOperator), + translate_comparison(LeftArg,RightArg,SQLOperator,Dict,SQLCompOp). + +%DISTINCT +translate_goal(distinct(Goal),List,SQL,Dict,DistinctDict):-!, + translate_goal(Goal,List,SQL,Dict,NewDict), + add_distinct_statement(NewDict,DistinctDict). + +%DEBUG +add_distinct_statement(Dict,Dict):- + append([A],[1,2],_). + + + +% --- translate_conjunction(Conjunction,SQLFrom,SQLWhere,Dict,NewDict) ----------------- +% +% translates a conjunction of goals (represented as a list of goals preceeded by +% existentially quantified variables) to FROM- and WHERE-clause of an SQL query. +% A dictionary containing the associated SQL table and attribute names is built up +% as an accumulator pair (arguments Dict and NewDict) +% +% -------------------------------------------------------------------------------------- + +translate_conjunction('$var$'(VarId)^Goal,SQLFrom,SQLWhere,Dict,NewDict):- + % --- add info on existentially quantified variables to dictionary here ------------- + add_to_dictionary(VarId,_,_,_,existential,Dict,TmpDict), + translate_conjunction(Goal,SQLFrom,SQLWhere,TmpDict,NewDict). + +translate_conjunction(Goal,SQLFrom,SQLWhere,Dict,NewDict):- + Goal \= (_,_), + translate_goal(Goal,SQLFrom,SQLWhere,Dict,NewDict). + +translate_conjunction((Goal,Conjunction),SQLFrom,SQLWhere,Dict,NewDict):- + translate_goal(Goal,FromBegin,WhereBegin,Dict,TmpDict), + translate_conjunction(Conjunction,FromRest,WhereRest,TmpDict,NewDict), + append(FromBegin,FromRest,SQLFrom), + append(WhereBegin,WhereRest,SQLWhere). + + + + + +% --- translate_arithmetic_function(Result,Expression,SQLWhere,Dict,NewDict) ----------- +% +% Arithmetic functions (left side of is/2 operator is bound to value of expression on +% right side) may be called with either +% +% - Result unbound: then Result is bound to the value of the evaluation of Expression +% - Result bound: then an equality condition is returned between the value of Result +% and the value of the evaluation of Expression. +% +% Only the equality test shows up in the WHERE clause of an SQLquery. +% +% -------------------------------------------------------------------------------------- + +translate_arithmetic_function('$var$'(VarId),Expression,[],Dict,NewDict):- + % assigment of value of arithmetic expression to variable - does not + % show up in WHERE-part, but expression corresponding to + % variable must be stored in Dict for projection translation + + evaluable_expression(Expression,Dict,ArithExpression,Type), + add_to_dictionary(VarId,is,ArithExpression,Type,all,Dict,NewDict). + + +translate_arithmetic_function('$var$'(VarId),Expression,ArithComparison,Dict,Dict):- + % --- test whether left side evaluates to right side: return equality comparison ---- + % Left side consists of qualified attribute, i.e. range variable must not be + % arithmetic operator is/2 + + lookup(VarId,Dict,PrevRangeVar,PrevAtt,PrevType), + not (PrevRangeVar = is), + + % test whether type of attribute is numeric - if not, there's no sense in + % continuing the translation + + type_compatible(PrevType,number), + evaluable_expression(Expression,Dict,ArithExpression,ExprType), + type_compatible(ExprType,number), + ArithComparison = [comp(att(PrevRangeVar,PrevAtt),'=',ArithExpression)]. + + +translate_arithmetic_function('$var$'(VarId),Expression,ArithComparison,Dict,Dict):- + % --- test whether left side evaluates to right side: return equality comparison ---- + % Left side consists of arithmetic expression, i.e. VarId is stored in Dict as + % belonging to arithmetic expression which is expressed as RangeVar-argument + % of lookup returning is/2. Type information is implicit through the is/2 functor + + lookup(VarId,Dict,is,LeftExpr,Type), + type_compatible(Type,number), + evaluable_expression(Expression,Dict,RightExpr,ExprType), + type_compatible(ExprType,number), + ArithComparison = [comp(LeftExpr,'=',RightExpr)]. + + +translate_arithmetic_function('$const$'(Constant),Expression,ArithComparison,Dict,Dict):- + % --- is/2 used to test whether left side evaluates to right side ------------------- + get_type('$const$'(Constant),ConstantType), + type_compatible(ConstantType,number), + evaluable_expression(Expression,Dict,ArithExpression,ExprType), + type_compatible(ExprType,number), + ArithComparison = [comp('$const$'(Constant),'=',ArithExpression)]. + + + +% --- translate_comparison(LeftArg,RightArg,CompOp,Dict,SQLComparison) --------- +% +% translates the left and right arguments of a comparison term into the +% appropriate comparison operation in SQL. The result type of each +% argument expression is checked for type compatibility +% +% ------------------------------------------------------------------------------ + +translate_comparison(LeftArg,RightArg,CompOp,Dict,Comparison):- + evaluable_expression(LeftArg,Dict,LeftTerm,LeftArgType), + evaluable_expression(RightArg,Dict,RightTerm,RightArgType), + type_compatible(LeftArgType,RightArgType), + Comparison = [comp(LeftTerm,CompOp,RightTerm)]. + + + + + + + +% --- translate_functor(Functor,QualifiedTableName) ------------------------------------ +% +% translate_functor searches for the matching relation table name for +% a given functor and creates a unique range variable to result in +% a unique qualified relation table name. +% +% -------------------------------------------------------------------------------------- + +translate_functor(Functor,Arity,rel(TableName,RangeVariable)):- + relation(Functor,Arity,TableName), + gensym(rel,RangeVariable). + + + + +% --- translate_arguments(Arguments,RelTable,ArgPos,Conditions,Dict) ------------------- +% +% translate_arguments organizes the translation of term arguments. One +% term argument after the other is taken from the list of term arguments +% until the list is exhausted. +% +% -------------------------------------------------------------------------------------- + +translate_arguments([],_,_,[],Dict,Dict). + +translate_arguments([Arg|Args],SQLTable,Position,SQLWhere,Dict,NewDict):- + translate_argument(Arg,SQLTable,Position,Where,Dict,TmpDict), + NewPosition is Position + 1, + translate_arguments(Args,SQLTable,NewPosition,RestWhere,TmpDict,NewDict), + append(Where,RestWhere,SQLWhere). + + + + +% --- translate_argument(Argument,RelTable,Position,Condition,Dict) -------------------- +% +% The first occurrence of a variable leads to its associated SQL attribute information +% to be recorded in the Dict. Any further occurrence creates an equi-join condition +% between the current attribute and the previously recorded attribute. +% Constant arguments always translate to equality comparisons between an attribute and +% the constant value. +% +% -------------------------------------------------------------------------------------- + +translate_argument('$var$'(VarId),rel(SQLTable,RangeVar),Position,[],Dict,NewDict):- + attribute(Position,SQLTable,Attribute,Type), + add_to_dictionary(VarId,RangeVar,Attribute,Type,all,Dict,NewDict). + +translate_argument('$var$'(VarId),rel(SQLTable,RangeVar),Position,AttComparison,Dict,Dict):- + % --- Variable occurred previously - retrieve first occurrence data from dictionary - + lookup(VarId,Dict,PrevRangeVar,PrevAtt,PrevType), + attribute(Position,SQLTable,Attribute,Type), + type_compatible(PrevType,Type), + AttComparison = [comp(att(RangeVar,Attribute),=,att(PrevRangeVar,PrevAtt))]. + +translate_argument('$const$'(Constant),rel(SQLTable,RangeVar),Position,ConstComparison,Dict,Dict):- + % --- Equality comparison of constant value and attribute in table ------------------ + attribute(Position,SQLTable,Attribute,Type), + get_type('$const$'(Constant),ConstType), + type_compatible(ConstType,Type), + ConstComparison = [comp(att(RangeVar,Attribute),=,'$const$'(Constant))]. + + + + + +% --- projection_term_variables(ProjectionTerm,Dict) ----------------------------------- +% +% extracts all variables from the ProjectionTerm and places them into the +% Dict as a dict/4 term with their Identifier, a non instantiated RangeVar and +% Attribute argument, and the keyword existential for the type of quantification +% +% -------------------------------------------------------------------------------------- + +%% ERRO?? +%projection_term_variables('$const(_)$',[]). +projection_term_variables('$const$'(_),[]). + +projection_term_variables('$var$'(VarId),[dict(VarId,_,_,_,existential)]). + +projection_term_variables(ProjectionTerm,ProjectionTermVariables):- + ProjectionTerm =.. [Functor|ProjectionTermList], + not (Functor = '$var$'), + not (ProjectionTermList = []), + projection_list_vars(ProjectionTermList,ProjectionTermVariables). + + +projection_list_vars([],[]). +projection_list_vars(['$var$'(VarId)|RestArgs],[dict(VarId,_,_,_,existential)|RestVars]):- + projection_list_vars(RestArgs,RestVars). +projection_list_vars(['$const$'(_)|RestArgs],Vars):- + projection_list_vars(RestArgs,Vars). + + + + + + +% -------------------------------------------------------------------------------------- +% RESTRICTION! ProjectionTerm underlies the following restrictions: +% +% - ProjectionTerm must have a functor other than the built-in +% operators, i.e. ',',';', etc. are not allowed +% +% - only variables and constants are allowed as arguments, +% i.e. no structured terms +% +% -------------------------------------------------------------------------------------- + +translate_projection('$var$'(VarId),Dict,SelectList):- + projection_arguments(['$var$'(VarId)],SelectList,Dict). + +translate_projection('$const$'(Const),_,['$const$'(Const)]). + +translate_projection(ProjectionTerm,Dict,SelectList):- + ProjectionTerm =.. [Functor|Arguments], + not (Functor = '$var$'), + not (Functor = '$const$'), + not (Arguments = []), + projection_arguments(Arguments,SelectList,Dict). + + + +projection_arguments([],[],_). + +projection_arguments([Arg|RestArgs],[Att|RestAtts],Dict):- + retrieve_argument(Arg,Att,Dict), + projection_arguments(RestArgs,RestAtts,Dict). + + + + +% - retrieve_argument(Argument,SQLAttribute,Dictionary) -------------------------------- +% +% retrieves the mapping of an argument to the appropriate SQL construct, i.e. +% +% - qualified attribute names for variables in base goals +% - arithmetic expressions for variables in arithmetic goals +% - constant values for constants +% +% -------------------------------------------------------------------------------------- + +retrieve_argument('$var$'(VarId),Attribute,Dict):- + lookup(VarId,Dict,TableName,AttName,_), + ( + TableName = is -> + Attribute = AttName + ; + Attribute = att(TableName,AttName) + ). + +retrieve_argument('$const$'(Constant),'$const$'(Constant),_). + + + + + +% --- lookup(Key,Dict,Value) ----------------------------------------------------------- + +lookup(VarId,Dict,RangeVar,Attribute,Type):- + member(dict(VarId,RangeVar,Attribute,Type,Quant),Dict), + ( + Quant = all -> + true + ; + nonvar(RangeVar), + nonvar(Attribute) + ). + + + +% --- add_to_dictionary(Key,RangeVar,Attribute,Quantifier,Dict,NewDict) ---------------- + +add_to_dictionary(Key,RangeVar,Attribute,Type,_,Dict,Dict):- + member(dict(Key,RangeVar,Attribute,Type,existential),Dict). + +add_to_dictionary(Key,RangeVar,Attribute,Type,Quantifier,Dict,NewDict):- + not member(dict(Key,_,_,_,_),Dict), + NewDict = [dict(Key,RangeVar,Attribute,Type,Quantifier)|Dict]. + + + + +% --- aggregate_function(AggregateFunctionTerm,Dict,AggregateFunctionQuery) ------------ +% +% aggregate_function discerns five Prolog aggregate function terms: count, avg, min, +% max, and sum. Each such term is has two arguments: a variable indicating the attribute +% over which the function is to be computed, and a goal argument which must contain in +% at least one argument position the variable: +% +% e.g. avg(Seats,plane(Type,Seats)) +% +% These aggregate function terms correspond to the SQL built-in aggregate functions. +% +% RESTRICTION: AggregateGoal may only be conjunction of (positive or negative) base +% goals +% +% -------------------------------------------------------------------------------------- + +aggregate_function(AggregateFunctionTerm,Dict,AggregateFunctionExpression):- + AggregateFunctionTerm =..[AggFunctor,AggVar,AggGoal], + aggregate_functor(AggFunctor,SQLFunction), + conjunction(AggGoal,AggConjunction), + aggregate_query_generation(SQLFunction,AggVar,AggConjunction,Dict,AggregateFunctionExpression). + + +conjunction(Goal,Conjunction):- + disjunction(Goal,[Conjunction]). + + + + +% --- aggregate_query_generation(Function,FunctionVariable,AggGoal,Dict,AggregateQuery) +% +% compiles the function variable (representing the attribute over which the aggregate +% function is to be computed) and the aggregate goal (representing the selection and +% join conditions for the computation of the aggregate function) to an SQL aggregate +% function subquery. +% +% -------------------------------------------------------------------------------------- + +% ILP +% aggregate_query_generation(count,'$const$'('*'),AggGoal,Dict,AggregateQuery):- +% translate_conjunction(AggGoal,SQLFrom,SQLWhere,Dict,TmpDict), +% AggregateQuery = agg_query(Function,(count,['$const$'(*)]),SQLFrom,SQLWhere,[]). + +aggregate_query_generation(count,'$const$'('*'),AggGoal,Dict,AggregateQuery):- + translate_conjunction(AggGoal,SQLFrom,SQLWhere,Dict,_), + + % ATTENTION! It is assumed that in count(*) aggregate query terms there cannot be + % free variables because '*' stands for "all arguments" + + AggregateQuery = agg_query(_,(count,['$const$'(*)]),SQLFrom,SQLWhere,[]). + +%DISTINCT +aggregate_query_generation(countdistinct,'$const$'('*'),AggGoal,Dict,AggregateQuery):- + translate_conjunction(AggGoal,SQLFrom,SQLWhere,Dict,_), + + % ATTENTION! It is assumed that in count(*) aggregate query terms there cannot be + % free variables because '*' stands for "all arguments" + + AggregateQuery = agg_query(_,(countdistinct,['$const$'(*)]),SQLFrom,SQLWhere,[]). + + +aggregate_query_generation(Function,FunctionVariable,AggGoal,Dict,AggregateQuery):- + translate_conjunction(AggGoal,SQLFrom,SQLWhere,Dict,TmpDict), + + % --- only variables occurring in the aggregate goal are relevant to the translation + % of the function variable and the free variables in the goal. + % Thus subtract from TmpDict all entries of Dict + set_difference(TmpDict,Dict,AggDict), + + translate_projection(FunctionVariable,AggDict,SQLSelect), + translate_grouping(FunctionVariable,AggDict,SQLGroup), + AggregateQuery = agg_query(Function,SQLSelect,SQLFrom,SQLWhere,SQLGroup). + + + + +% --- translate_grouping(FunctionVariable,Dict,SQLGroup) ------------------------------- +% +% finds the free variables in the aggregate function term and collects their +% corresponding SQL qualified attributes in the SQLGroup list. +% +% -------------------------------------------------------------------------------------- + +translate_grouping(FunctionVariable,Dict,SQLGroup):- + free_vars(FunctionVariable,Dict,FreeVariables), + translate_free_vars(FreeVariables,SQLGroup). + + + + +% --- free_vars(FunctionVariable,Dict,FreeVarList) ------------------------------------- +% +% A Variable is free if it neither occurs as the FunctionVariable, nor is stored as +% existentially quantified (through ^/2 in the original goal) in the dictionary +% +% FreeVars contains for each variable the relevant attribute and relation information +% contained in the dictionary +% +% -------------------------------------------------------------------------------------- + +% ILP +% free_vars(FunctionVariable,Dict,FreeVarList):- +% projection_term_variables(FunctionVariable,FunctionVariableList), +% findall((Var,Table,Attribute), +% (member(dict(Var,Table,Attribute,Type,all),Dict), +% not member(dict(Var,_,_,_,_),FunctionVariableList) +% ), +% FreeVarList). +free_vars(FunctionVariable,Dict,FreeVarList):- + projection_term_variables(FunctionVariable,FunctionVariableList), + findall((Var,Table,Attribute), + (member(dict(Var,Table,Attribute,_,all),Dict), + not member(dict(Var,_,_,_,_),FunctionVariableList) + ), + FreeVarList). + + +% --- function_variable_list(FunctionVariable,FunctionVariableList) -------------------- +% +% extracts the list of variables which occur in the function variable term +% +% RESTRICTION: FunctionVariable may only contain one single variable. +% +% -------------------------------------------------------------------------------------- + +function_variable_list('$var$'(VarId),[VarId]). + + + + +% --- translate_free_vars(FreeVars,SQLGroup) ------------------------------------------- +% +% translates dictionary information on free variables to SQLGroup of aggregate +% function query +% +% -------------------------------------------------------------------------------------- + +translate_free_vars([],[]). +% ILP +%translate_free_vars([(VarId,Table,Attribute)|FreeVars],[att(Table,Attribute)|SQLGroups]):- +translate_free_vars([(_,Table,Attribute)|FreeVars],[att(Table,Attribute)|SQLGroups]):- + translate_free_vars(FreeVars,SQLGroups). + + + + +% --- evaluable_expression(ExpressionTerm,Dictionary,Expression,Type) -------------------- +% +% evaluable_expression constructs SQL arithmetic expressions with qualified attribute names +% from the Prolog arithmetic expression term and the information stored in the dictionary. +% +% The type of an evaluable function is returned in the argument Type. +% +% The dictionary is not changed because it is used for lookup only. +% + +evaluable_expression(AggregateFunctionTerm,Dictionary,AggregateFunctionExpression,number):- + aggregate_function(AggregateFunctionTerm,Dictionary,AggregateFunctionExpression). + +evaluable_expression(LeftExp + RightExp,Dictionary,LeftAr + RightAr,number):- + evaluable_expression(LeftExp,Dictionary,LeftAr,number), + evaluable_expression(RightExp,Dictionary,RightAr,number). + +evaluable_expression(LeftExp - RightExp,Dictionary,LeftAr - RightAr,number):- + evaluable_expression(LeftExp,Dictionary,LeftAr,number), + evaluable_expression(RightExp,Dictionary,RightAr,number). + +evaluable_expression(LeftExp * RightExp,Dictionary,LeftAr * RightAr,number):- + evaluable_expression(LeftExp,Dictionary,LeftAr,number), + evaluable_expression(RightExp,Dictionary,RightAr,number). + +evaluable_expression(LeftExp / RightExp,Dictionary, LeftAr / RightAr,number):- + evaluable_expression(LeftExp,Dictionary,LeftAr,number), + evaluable_expression(RightExp,Dictionary,RightAr,number). + +evaluable_expression('$var$'(VarId),Dictionary,att(RangeVar,Attribute),Type):- + lookup(VarId,Dictionary,RangeVar,Attribute,Type), + RangeVar \= is. + +evaluable_expression('$var$'(VarId),Dictionary,ArithmeticExpression,Type):- + lookup(VarId,Dictionary,is,ArithmeticExpression,Type). + +evaluable_expression('$const$'(Const),_,'$const$'(Const),ConstType):- + get_type('$const$'(Const),ConstType). + + + + + +% -------------------------------------------------------------------------------------- +% +% Output to screen predicates - rather crude at the moment +% +% -------------------------------------------------------------------------------------- + + +% --- printqueries(Code) --------------------------------------------------------------- + +printqueries([Query]):- + nl, + print_query(Query), + write(';'), + nl, + nl. + +printqueries([Query|Queries]):- + not (Queries = []), + nl, + print_query(Query), + nl, + write('UNION'), + nl, + printqueries(Queries). + + + +% --- print_query(QueryCode) ----------------------------------------------------------- + +print_query(query([agg_query(Function,Select,From,Where,Group)],_,_)):- + % --- ugly rule here: aggregate function only in SELECT Part of query ---- + !, + print_query(agg_query(Function,Select,From,Where,Group)). + +print_query(query(Select,From,Where)):- + print_clause('SELECT',Select,','), + nl, + print_clause('FROM',From,','), + nl, + print_clause('WHERE',Where,'AND'), + nl. + +print_query(agg_query(Function,Select,From,Where,Group)):- + print_clause('SELECT',Function,Select,','), + nl, + print_clause('FROM',From,','), + nl, + print_clause('WHERE',Where,'AND'), + nl, + print_clause('GROUP BY',Group,','). + +print_query(negated_existential_subquery(Select,From,Where)):- + write('NOT EXISTS'), + nl, + write('('), + print_clause('SELECT',Select,','), + nl, + print_clause('FROM',From,','), + nl, + print_clause('WHERE',Where,'AND'), + nl, + write(')'). + + + + +% --- print_clause(Keyword,ClauseCode,Separator) --------------------------------------- +% +% with +% Keyword one of SELECT, FROM, WHERE, or GROUP BY, +% ClauseCode the code corresponding to the appropriate clause of an SQL query, and +% Separator indicating the character(s) through which the items of a clause +% are separated from each other (',' or 'AND'). +% +% -------------------------------------------------------------------------------------- + +% ILP +% print_clause(Keyword,[],_). +print_clause(_,[],_). + +print_clause(Keyword,[Column|RestColumns],Separator):- + write(Keyword), + write(' '), + print_clause([Column|RestColumns],Separator). + +print_clause(Keyword,Function,[Column],Separator):- + write(Keyword), + write(' '), + write(Function), + write('('), + print_clause([Column],Separator), + write(')'). + + + + + +% --- print_clause(ClauseCode,Separator) ----------------------------------------------- + +print_clause([Item],_):- + print_column(Item). + +print_clause([Item,NextItem|RestItems],Separator):- + print_column(Item), + write(' '), + write(Separator), + write(' '), + print_clause([NextItem|RestItems],Separator). + + + + +% --- print_column(ColumnCode) -------------------------------- + +print_column('*'):- + write('*'). + +print_column(att(RangeVar,Attribute)):- + write(RangeVar), + write('.'), + write(Attribute). + +print_column(rel(Relation,RangeVar)):- + write(Relation), + write(' '), + write(RangeVar). + +print_column('$const$'(String)):- + get_type('$const$'(String),string), + write('"'), + write(String), + write('"'). + +print_column('$const$'(Number)):- + get_type('$const$'(Number),NumType), + type_compatible(NumType,number), + write(Number). + +print_column(comp(LeftArg,Operator,RightArg)):- + print_column(LeftArg), + write(' '), + write(Operator), + write(' '), + print_column(RightArg). + +print_column(LeftExpr * RightExpr):- + print_column(LeftExpr), + write('*'), + print_column(RightExpr). + +print_column(LeftExpr / RightExpr):- + print_column(LeftExpr), + write('/'), + print_column(RightExpr). + +print_column(LeftExpr + RightExpr):- + print_column(LeftExpr), + write('+'), + print_column(RightExpr). + +print_column(LeftExpr - RightExpr):- + print_column(LeftExpr), + write('-'), + print_column(RightExpr). + +print_column(agg_query(Function,Select,From,Where,Group)):- + nl, + write('('), + print_query(agg_query(Function,Select,From,Where,Group)), + write(')'). + +print_column(negated_existential_subquery(Select,From,Where)):- + print_query(negated_existential_subquery(Select,From,Where)). + + + + + +% --- queries_atom(Queries,QueryAtom) ---------------------------- +% +% queries_atom(Queries,QueryAtom) returns in its second argument +% the SQL query as a Prolog atom. For efficiency reasons, a list +% of ASCII codes is ceated as a difference list, and it is then +% transformed to an atom by name/2 +% ---------------------------------------------------------------- + + +queries_atom(Queries,QueryAtom):- + queries_atom(Queries,QueryList,[]), + name(QueryAtom,QueryList). + + + +queries_atom([Query],QueryList,Diff):- + query_atom(Query,QueryList,Diff). + +queries_atom([Query|Queries],QueryList,Diff):- + Queries \= [], + query_atom(Query,QueryList,X1), + column_atom('UNION',X1,X2), + queries_atom(Queries,X2,Diff). + + + +% --- query_atom(QueryCode) -------------------------------- + +query_atom(query([agg_query(Function,Select,From,Where,Group)],_,_),QueryList,Diff):- + % --- ugly rule here: aggregate function only in SELECT Part of query ---- + !, + query_atom(agg_query(Function,Select,From,Where,Group),QueryList,Diff). + +query_atom(query(Select,From,Where),QueryList,Diff):- + clause_atom('SELECT',Select,',',QueryList,X1), + clause_atom('FROM',From,',',X1,X2), + clause_atom('WHERE',Where,'AND',X2,Diff). + +query_atom(agg_query(Function,Select,From,Where,Group),QueryList,Diff):- + clause_atom('SELECT',Function,Select,',',QueryList,X1), + clause_atom('FROM',From,',',X1,X2), + clause_atom('WHERE',Where,'AND',X2,X3), + clause_atom('GROUP BY',Group,',',X3,Diff). + +query_atom(negated_existential_subquery(Select,From,Where),QueryList,Diff):- + column_atom('NOT EXISTS(',QueryList,X1), + clause_atom('SELECT',Select,',',X1,X2), + clause_atom('FROM',From,',',X2,X3), + clause_atom('WHERE',Where,'AND',X3,X4), + column_atom(')',X4,Diff). + + + + +% --- clause_atom(Keyword,ClauseCode,Junctor,CurrAtom,QueryAtom) ------------- +% +% with +% Keyword one of SELECT, FROM, WHERE, or GROUP BY, +% ClauseCode the code corresponding to the appropriate clause of an SQL query, and +% Junctor indicating the character(s) through which the items of a clause +% are separated from each other (',' or 'AND'). + +% ILP +% clause_atom(Keyword,[],_,QueryList,QueryList). +clause_atom(_,[],_,QueryList,QueryList). + +clause_atom(Keyword,[Column|RestColumns],Junctor,QueryList,Diff):- + column_atom(Keyword,QueryList,X1), + column_atom(' ',X1,X2), + clause_atom([Column|RestColumns],Junctor,X2,X3), + column_atom(' ',X3,Diff). + +%DISTINCT +clause_atom(Keyword,'COUNTDISTINCT',[Column],Junctor,QueryList,Diff):-!, + column_atom(Keyword,QueryList,X1), + column_atom(' ',X1,X2), + column_atom('COUNT',X2,X3), + column_atom('(DISTINCT ',X3,X4), + clause_atom([Column],Junctor,X4,X5), + column_atom(') ',X5,Diff). + +clause_atom(Keyword,Function,[Column],Junctor,QueryList,Diff):- + column_atom(Keyword,QueryList,X1), + column_atom(' ',X1,X2), + column_atom(Function,X2,X3), + column_atom('(',X3,X4), + clause_atom([Column],Junctor,X4,X5), + column_atom(') ',X5,Diff). + + + + + + +% --- clause_atom(ClauseCode,Junctor) -------------------------------- + +clause_atom([Item],_,QueryList,Diff):- + column_atom(Item,QueryList,Diff). + +clause_atom([Item,NextItem|RestItems],Junctor,QueryList,Diff):- + column_atom(Item,QueryList,X1), + column_atom(' ',X1,X2), + column_atom(Junctor,X2,X3), + column_atom(' ',X3,X4), + clause_atom([NextItem|RestItems],Junctor,X4,Diff). + + + + + +column_atom(att(RangeVar,Attribute),QueryList,Diff):- + column_atom(RangeVar,QueryList,X1), + column_atom('.',X1,X2), + column_atom(Attribute,X2,Diff). + +column_atom(rel(Relation,RangeVar),QueryList,Diff):- + column_atom(Relation,QueryList,X1), + column_atom(' ',X1,X2), + column_atom(RangeVar,X2,Diff). + +column_atom('$const$'(String),QueryList,Diff):- + get_type('$const$'(String),string), + column_atom('"',QueryList,X1), + column_atom(String,X1,X2), + column_atom('"',X2,Diff). + +column_atom('$const$'(Number),QueryList,Diff):- + get_type('$const$'(Number),NumType), + type_compatible(NumType,number), + column_atom(Number,QueryList,Diff). + +column_atom(comp(LeftArg,Operator,RightArg),QueryList,Diff):- + column_atom(LeftArg,QueryList,X1), + column_atom(' ',X1,X2), + column_atom(Operator,X2,X3), + column_atom(' ',X3,X4), + column_atom(RightArg,X4,Diff). + +column_atom(LeftExpr * RightExpr,QueryList,Diff):- + column_atom(LeftExpr,QueryList,X1), + column_atom('*',X1,X2), + column_atom(RightExpr,X2,Diff). + +column_atom(LeftExpr + RightExpr,QueryList,Diff):- + column_atom(LeftExpr,QueryList,X1), + column_atom('+',X1,X2), + column_atom(RightExpr,X2,Diff). + +column_atom(LeftExpr - RightExpr,QueryList,Diff):- + column_atom(LeftExpr,QueryList,X1), + column_atom('-',X1,X2), + column_atom(RightExpr,X2,Diff). + +column_atom(LeftExpr / RightExpr,QueryList,Diff):- + column_atom(LeftExpr,QueryList,X1), + column_atom('/',X1,X2), + column_atom(RightExpr,X2,Diff). + +column_atom(agg_query(Function,Select,From,Where,Group),QueryList,Diff):- + column_atom('(',QueryList,X1), + query_atom(agg_query(Function,Select,From,Where,Group),X1,X2), + column_atom(')',X2,Diff). + +column_atom(negated_existential_subquery(Select,From,Where),QueryList,Diff):- + query_atom(negated_existential_subquery(Select,From,Where),QueryList,Diff). + + +column_atom(Atom,List,Diff):- + atom(Atom), + name(Atom,X1), + append(X1,Diff,List). + +column_atom(Number,List,Diff) :- + number(Number), + name(Number,X1), + append(X1,Diff,List). + + + +% --- gensym(Root,Symbol) ---------------------------------------------------- +% +% SEPIA 3.2. version - other Prolog implementations provide gensym/2 +% and init_gensym/1 as built-ins. */ +% +% (C) Christoph Draxler, Aug. 1992 +% +% + +init_gensym(Atom) :- + set_value(Atom,'@'). + +gensym(Atom,Var) :- + var(Var), + get_value(Atom,Value), + char_code(Value,Code), + NewCode is Code + 1, + char_code(Var,NewCode), + set_value(Atom,Var). + + + +% --- auxiliary predicates (some of them may be built-in... -------------------- + +append([],L,L). +append([H1|L1],L2,[H1|L3]):- + append(L1,L2,L3). + + + +member(X,[X|_]). +member(X,[_|T]):- + member(X,T). + + + +repeat_n(N):- + integer(N), + N > 0, + repeat_1(N). + +repeat_1(1):-!. +repeat_1(_). +repeat_1(N):- + N1 is N-1, + repeat_1(N1). + + + +% --- set_difference(SetA,SetB,Difference) -------------------------------------------- +% +% SetA - SetB = Difference + +set_difference([],_,[]). + +set_difference([Element|RestSet],Set,[Element|RestDifference]):- + not member(Element,Set), + set_difference(RestSet,Set,RestDifference). + +set_difference([Element|RestSet],Set,RestDifference):- + member(Element,Set), + set_difference(RestSet,Set,RestDifference). + + + +% % --- benchmarking programs -------------------------------------------- +% % +% % taken from R. O'Keefe: The Craft of Prolog, MIT Press 1990 +% % +% % Sepia Prolog version + +% cpu_time(Time):- +% cputime(Time). + + +% cpu_time(Goal,Duration):- +% !, +% cputime(T1), +% (call(Goal) -> true; true), +% cputime(T2), +% Duration is T2 - T1. + +% cpu_time(N,Goal,Duration):- +% !, +% cpu_time((repeat_n(N),(Goal -> fail);true),D1), +% cpu_time((repeat_n(N),(true -> fail);true),D2), +% Duration is D1 - D2. + + + + +% % --- benchmarks of sample queries --------- + +% benchmark(N,1,D):- +% cpu_time(N, +% (translate(flight(No,Dep,Dest,Type),flight(No,Dep,Dest,Type),Code), +% printqueries(Code)), +% D). + +% benchmark(N,2,D):- +% cpu_time(N, +% (translate(capacity(No,Dep,Dest,Type,Seats), +% (flight(No,Dep,Dest,Type), +% plane(Type,Seats), +% Type='b-737'),Code), +% printqueries(Code)), +% D). + +% benchmark(N,3,D):- +% cpu_time(N, +% (translate(no_planes(No,Dep,Dest,Type), +% (flight(No,Dep,Dest,Type), +% not plane(Type,Seats)),Code), +% printqueries(Code)), +% D). + +% benchmark(N,4,D):- +% cpu_time(N,(translate(X,X is count(S,plane(P,S)),Code),printqueries(Code)),D). + +% benchmark(N,5,D):- +% cpu_time(N, +% (translate(big_planes(munich,Dest,Type,Seats), +% FNo^(flight(FNo,munich,Dest,Type), +% plane(Type,Seats), +% Seats > avg(S, T^plane(T,S))),Code), +% printqueries(Code)), +% D). + +% benchmark(N,6,D):- +% cpu_time(N,( +% translate(big_planes(munich,Dest,Type,Seats), +% FNo^(flight(FNo,munich,Dest,Type), +% plane(Type,Seats), +% Seats > avg(S, T^plane(T,S))),Code), +% printqueries(Code)), +% D). + +% benchmark(N,7,D):- +% cpu_time(N,( +% translate(big_planes(munich,Dest,Type,Seats), +% FNo^(flight(FNo,munich,Dest,Type), +% plane(Type,Seats), +% Seats > avg(S, T^plane(T,S))),Code), +% queries_atom(Code,SQLQueryAtom), +% writeq(query_atom(SQLQueryAtom)), +% nl), +% D). + + + + + +% % --- Meta Database for schema definition of SQL DB in Prolog -------------------------- +% % +% % maps Prolog predicates to SQL table names, Prolog predicate argument positions to SQL +% % attributes, and Prolog operators to SQL operators. +% % +% % ATTENTION! It is assumed that the arithmetic operators in Prolog and SQL are the same, +% % i.e. + is addition in Prolog and in SQL, etc. If this is not the case, then a mapping +% % function for arithmetic operators is necessary too. +% % -------------------------------------------------------------------------------------- + + +% % --- relation(PrologFunctor,Arity,SQLTableName) --------------------------------------- + +% relation(flight,4,'FLIGHT'). +% relation(plane,2,'PLANE'). + + +% % --- attribute(PrologArgumentPosition,SQLTableName,SQLAttributeName) ------------------ + +% attribute(1,'FLIGHT','FLIGHT_NO',string). +% attribute(2,'FLIGHT','DEPARTURE',string). +% attribute(3,'FLIGHT','DESTINATION',string). +% attribute(4,'FLIGHT','PLANE_TYPE',string). + + +% attribute(1,'PLANE','TYPE',string). +% attribute(2,'PLANE','SEATS',integer). + + +% --- Mapping of Prolog operators to SQL operators ------------------------------------- + +comparison(=,=). +comparison(<,<). +comparison(>,>). +comparison(@<,<). +comparison(@>,>). + + +negated_comparison(=,'<>'). +negated_comparison(\=,=). +negated_comparison(>,=<). +negated_comparison(=<,>). +negated_comparison(<,>=). +negated_comparison(>=,<). + + +% --- aggregate_function(PrologFunctor,SQLFunction) ----------------- + +aggregate_functor(avg,'AVG'). +aggregate_functor(min,'MIN'). +aggregate_functor(max,'MAX'). +aggregate_functor(sum,'SUM'). +aggregate_functor(count,'COUNT'). +aggregate_functor(countdistinct,'COUNTDISTINCT'). + + + +% --- type system -------------------------------------------------------------- +% +% A rudimentary type system is provided for consistency checking during the +% translation and for output formatting +% +% The basic types are string and number. number has the subtypes integer and +% real. +% +% ------------------------------------------------------------------------------ + + +type_compatible(Type,Type):- + is_type(Type). +type_compatible(SubType,Type):- + subtype(SubType,Type). +type_compatible(Type,SubType):- + subtype(SubType,Type). + + +% --- subtype(SubType,SuperType) ----------------------------------------------- +% +% Simple type hierarchy checking +% +% ------------------------------------------------------------------------------ + +subtype(SubType,SuperType):- + is_subtype(SubType,SuperType). + +subtype(SubType,SuperType):- + is_subtype(SubType,InterType), + subtype(InterType,SuperType). + + + +% --- is_type(Type) ------------------------------------------------------------ +% +% Type names +% +% ------------------------------------------------------------------------------ + +is_type(number). +is_type(integer). +is_type(real). +is_type(string). +is_type(natural). + + +% --- is_subtype(SubType,SuperType) -------------------------------------------- +% +% Simple type hierarchy for numeric types +% +% ------------------------------------------------------------------------------ + +is_subtype(integer,number). +is_subtype(real,number). +is_subtype(natural,integer). + + +% --- get_type(Constant,Type) -------------------------------------------------- +% +% Prolog implementation specific definition of type retrieval +% sepia Prolog version given here +% +% ------------------------------------------------------------------------------ + +get_type('$const$'(Constant),integer):- + integer(Constant),!. + +get_type('$const$'(Constant),real):- + number(Constant),!. + +get_type('$const$'(Constant),string):- + atom(Constant). diff --git a/library/MYDDAS/myddas_test_predicates.yap b/library/MYDDAS/myddas_test_predicates.yap new file mode 100644 index 000000000..e161943f0 --- /dev/null +++ b/library/MYDDAS/myddas_test_predicates.yap @@ -0,0 +1,317 @@ +:- module(myddas_test_predicates,[ + % Tests or Debug Predicates + %db_my_delete/2, + db_my_insert_test/2, + db_my_update/3, + db_my_import_query_normal/3, + db_view/3, % DEBUG ONLY + db_my_ilpview/4 + ]). + + +:- use_module(myddas). +:- use_module(myddas_mysql). +:- use_module(myddas_util_predicates). +:- use_module(myddas_prolog2sql,[translate/3,queries_atom/2]). +:- use_module(myddas_errors). +:- use_module(lists). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_insert/2 +% +% +db_my_insert_test(PredName,Connection):- + '$get_value'(Connection,Conn), + translate(PredName,PredName,Code), + '$error_checks'(db_my_insert2(PredName,Conn,Code)), + '$get_values_for_insert'(Code,ValuesList,RelName), + '$make_atom'(['INSERT INTO ',RelName,' VALUES'|ValuesList],SQL), + c_db_my_query_no_result(SQL,Conn). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_update/3 +% UpdaList = [X,1,Y,2,T,0] +% +db_my_update(UpdateList,Relation,Connection):- + '$get_value'(Connection,Conn), + %TODO: error_checks + functor(Relation,PredName,Arity), + functor(NewRelation,PredName,Arity), + '$extract_args'(Relation,1,Arity,ArgsList1), + copy_term(ArgsList1,ArgsList2), + '$make_list_of_args'(1,Arity,NewRelation,ArgsList2), + translate(NewRelation,NewRelation,Code), + '$get_table_name'(Code,TableName), + '$get_values_for_update'(Code,SetCondition,ArgsList1,UpdateList,WhereCondition), + append(SetCondition,WhereCondition,Conditions), + '$make_atom'(['UPDATE ',TableName,' '|Conditions],SQL), + '$write_or_not'(SQL), + c_db_my_query_no_result(SQL,Conn). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_delete/2 +% +% +% db_my_delete(PredName,Connection):- +% '$get_value'(Connection,Conn), +% translate(PredName,PredName,Code), +% %'$error_checks'(db_my_delete(PredName,Conn,Code)), +% queries_atom(Code,SQL), +% c_db_my_query('SELECT 46 , "ola" , "Adeus" FROM estrada A WHERE A.id_estrada = 46 , "ola" , "Adeus" FROM estrada A WHERE A.id_estrada = 46 AND A.nome = "ola" AND A.nome_alternativo = "Adeus"',_,Conn). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_import_michel/3 +% +% +db_my_import_query_normal(RelationName,PredName,Connection) :- + '$error_checks'(db_my_import(RelationName,PredName,Connection)), + % get connection id based on given atom + '$get_value'(Connection,Conn), + % assert information needed for translate/3 and PredName clause + '$assert_relation_info_and_pred_clause_michel_query'(RelationName,PredName,Conn). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +% --- '$assert_relation_info_and_pred_clause'(RelationName,PredName,Connection) +% Asserts information needed for translate/3 and the clause of the +% PredName predicate +% --- +'$assert_relation_info_and_pred_clause_michel_query'(RelationName,PredName,Connection) :- + % get relation arity + % C Predicate + c_db_my_number_of_fields(RelationName,Connection,Arity), + db_module(Module), + not c_db_my_check_if_exists_pred(PredName,Arity,Module), + R=..[relation,PredName,Arity,RelationName], + % assert relation fact + '$assert_facts'(myddas_prolog2sql,R), + %assert(myddas_prolog2sql:R), + Size is 2*Arity, + '$make_a_list'(Size,TypesList), + % get attributes types in TypesList [field0,type0,field1,type1...] + c_db_my_get_attributes_types(RelationName,Connection,TypesList), + % assert attributes facts + '$assert_attribute_information'(0,Arity,RelationName,TypesList), + % build PredName functor + functor(P,PredName,Arity), + % build PredName clause + Assert =..[':-',P,','(myddas_test_predicates:'$generate_optimized_SQL'(P,SQL,LA,ArityProj), + ','(myddas_test_predicates:db_my_result_set(Mode), + ','(myddas_test_predicates:'$write_or_not'(SQL), + ','(myddas_test_predicates:c_db_my_query(SQL,ResultSet,Connection,Mode), + ','(!,myddas_test_predicates:c_db_my_row_unify(ResultSet,ArityProj,LA))))))], + % we are assuming that all the predicates will be inserted in + % the user module + assert(Module:Assert), + % ALTERACAO + % Adds PredName and Arity to this Connection List + % C Predicate + c_db_add_preds(PredName,Arity,Module,Connection). + + +% Beginning of new predicates for optimized translate + +'$generate_optimized_SQL'(Pred,SQL,DbRowList,Arity) :- + Pred =..[F|Args], + functor(Pred,_,A), + myddas_prolog2sql:relation(F,A,Relation), + '$divide_args_in_proj_and_where'(1,Relation,Args,[],Proj,Where), + '$generate_SQL'(Relation,Proj,Where,SQL), + '$generate_dbrow_list'(Proj,DbRowList,Arity). + + +'$divide_args_in_proj_and_where'(_, _, [], _, [], []) :- !. + +'$divide_args_in_proj_and_where'(I, Relation, [H|T], Dict, Proj, [v(Att,Att1)|Where]) :- + var(H), + '$member_var'(H,Dict,Att),!, + myddas_prolog2sql:attribute(I,Relation,Att1,_), + I1 is I+1, + '$divide_args_in_proj_and_where'(I1, Relation, T, Dict, Proj, Where). + +'$divide_args_in_proj_and_where'(I, Relation, [H|T], Dict, [(Att,H)|Proj], Where) :- + var(H),!, + myddas_prolog2sql:attribute(I,Relation,Att,_), + I1 is I+1, + '$divide_args_in_proj_and_where'( I1, Relation, T, [(H,Att)|Dict], Proj, Where). + +'$divide_args_in_proj_and_where'(I, Relation, [H|T], Dict, Proj, [g(Att,H)|Where]) :- + myddas_prolog2sql:attribute(I,Relation,Att,_), + I1 is I+1, + '$divide_args_in_proj_and_where'(I1,Relation,T,Dict,Proj,Where). + + +'$generate_SQL'(Relation,_,[],SQL) :- + !, + atom_concat('SELECT * FROM ',Relation, SQL). + + +'$generate_SQL'(Relation,Proj,Where,SQL) :- + '$make_proj_atom'(Proj,Proj_Atom), + atom_concat('SELECT ',Proj_Atom,R), + atom_concat(R, ' FROM ',R1), + atom_concat(R1, Relation, R2), + atom_concat(R2, ' WHERE ', R3), + '$make_where_atom'(Where,Where_Atom), + atom_concat(R3,Where_Atom,SQL). + + +'$generate_dbrow_list'([],[_],0) :- !. % important for empty projection terms. + +'$generate_dbrow_list'([(_,V)],[V],1) :- !. + +'$generate_dbrow_list'([(_,V)|T],[V|R],I1) :- + '$generate_dbrow_list'(T,R,I), I1 is I+1. + + +'$make_proj_atom'([],'1') :- !. % important for empty projection terms. + +'$make_proj_atom'([(A,_)],A) :- !. + +'$make_proj_atom'([(A,_)|T],Atom) :- + '$make_proj_atom'(T,Atom1), + atom_concat(A,',',Atom2), + atom_concat(Atom2,Atom1,Atom). + + +'$make_where_atom'([v(Att,H)],Atom) :- + !, + atom_concat(Att,' = ',R), + atom_concat(R,H,Atom). + +'$make_where_atom'([v(Att,H)|T],Atom) :- + '$make_where_atom'(T,Atom1), + atom_concat(Att,' = ',R), + atom_concat(R,H,Atom2), + atom_concat(Atom2, ' AND ', Atom3), + atom_concat(Atom3,Atom1,Atom). + + +'$make_where_atom'([g(Att,H)],Atom) :- + number(H), + !, + number_atom(H,H1), + atom_concat(Att,' = \'',R), + atom_concat(R,H1,R1), + atom_concat(R1,'\'',Atom). + +'$make_where_atom'([g(Att,H)],Atom) :- + !, + atom_concat(Att,' = \'',R), + atom_concat(R,H,R1), + atom_concat(R1,'\'',Atom). + +'$make_where_atom'([g(Att,H)|T],Atom) :- + number(H), + !, + number_atom(H,H1), + '$make_where_atom'(T,Atom1), + atom_concat(Att,' = \'',R), + atom_concat(R,H1,R1), + atom_concat(R1,'\'',Atom2), + atom_concat(Atom2, ' AND ', Atom3), + atom_concat(Atom3,Atom1,Atom). + +'$make_where_atom'([g(Att,H)|T],Atom) :- + '$make_where_atom'(T,Atom1), + atom_concat(Att,' = \'',R), + atom_concat(R,H,R1), + atom_concat(R1,'\'',Atom2), + atom_concat(Atom2, ' AND ', Atom3), + atom_concat(Atom3,Atom1,Atom). + + +'$member_var'(H,[(V,Att)|_],Att) :- + H == V,!. + +'$member_var'(H,[_|T],Att) :- + '$member_var'(H,T,Att). + +% End of predicates for optimized translate + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_my_ilpview/4 +% +% +db_my_ilpview(LA,ViewName,DbGoal,Connection):- + '$get_value'(Connection,Conn), + functor(ViewName,PredName,Arity), + functor(NewName,PredName,Arity), + translate(ViewName,DbGoal,Code), + queries_atom(Code,SQL), + % build arg list for db_my_row/2 + '$make_list_of_args'(1,Arity,NewName,LA), + % checks if the WHERE commend of SQL exists in the string + '$where_exists'(SQL,Flag), + '$build_query'(Flag,SQL,Code,LA,FinalSQL), + db_my_result_set(Mode), + '$write_or_not'(FinalSQL), + c_db_my_query(FinalSQL,ResultSet,Conn,Mode), + !,c_db_my_row(ResultSet,Arity,LA). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% db_view/3 +% +% +db_view(PredName,DbGoal,Connection) :- + '$error_checks'(db_my_view(PredName,DbGoal,Connection)), + '$get_value'(Connection,Conn), + '$assert_view_clause2'(PredName,DbGoal,Conn). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +'$assert_view_clause2'(ViewName,DbGoal,Connection) :- + % here we can add some error control, like checking DBgoals include + % only DB relations + % get arity of projection term + % PredName necessary for c_db_add_preds + functor(ViewName,PredName,Arity), + functor(NewName,PredName,Arity), + db_module(Module), + not c_db_my_check_if_exists_pred(PredName,Arity,Module), + %'$copy_term_nv'(NewName,[],G,_), + %translate(ViewName,DbGoal,Code), + %queries_atom(Code,SQL), + % build arg list for db_my_row/2 + '$make_list_of_args'(1,Arity,NewName,LA), + % checks if the WHERE commend of SQL exists in the string + %'$where_exists'(SQL,Flag), + % build view clause + Assert =..[':-',NewName, + ','(myddas_test_predicates:translate(ViewName,DbGoal,Code), + ','(myddas_test_predicates:queries_atom(Code,FinalSQL), + ','(myddas_test_predicates:db_my_result_set(Mode), + ','(myddas_test_predicates:c_db_my_query(FinalSQL,ResultSet,Connection,Mode), + ','(myddas_test_predicates:'$write_or_not'(FinalSQL), + ','(!,myddas_test_predicates:c_db_my_row(ResultSet,Arity,LA)))))))], + assert(Module:Assert), + % ALTERACAO + % Adds PredName and Arity to this Connection List + % C Predicate + c_db_add_preds(PredName,Arity,Module,Connection). + + + + + diff --git a/library/MYDDAS/myddas_util_predicates.yap b/library/MYDDAS/myddas_util_predicates.yap new file mode 100644 index 000000000..ad6fb8aa4 --- /dev/null +++ b/library/MYDDAS/myddas_util_predicates.yap @@ -0,0 +1,308 @@ +/************************************************************************* +* * +* 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,[ + '$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'/5, + '$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 + ]). + +:- use_module(myddas). +:- use_module(myddas_errors). +:- use_module(lists,[append/3]). + +% +% 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,_,Comp)],[' SET '|SQLSet],ArgList,UpdateList,[' WHERE '|Where]):-!, + '$get_values_for_set'(Fields,ArgList,UpdateList,Set), + '$build_set_condition'(Set,SQLSet), + '$get_values_for_where'(Comp,Where). + +'$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). + +'$get_values_for_set'([],[],_,[]). +'$get_values_for_set'([att(_,Field)|FieldList],[Var|ArgList],UpdateList,[Field,Value|ValueList]):-!, + '$lookup_variable_value'(Var,UpdateList,Value), + '$get_values_for_set'(FieldList,ArgList,UpdateList,ValueList). +'$get_values_for_set'([_|FieldList],[_|ArgList],UpdateList,ValueList):- + '$get_values_for_set'(FieldList,ArgList,UpdateList,ValueList). + +'$lookup_variable_value'(Var,[TestVar,Value|_],Value):- + Var==TestVar,!. +'$lookup_variable_value'(Var,[_,_|List],Value):- + '$lookup_variable_value'(Var,List,Value). + +'$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). + + +% Este predicado vai sempre falhar +'$abolish_all'(Conn):- + '$get_value'(Conn,Connection),!, + % C Predicate + p_db_preds_conn(Connection,Pred_Name,Pred_Arity), + abolish(user:Pred_Name,Pred_Arity), + fail. + +'$write_or_not'(X) :- + get_value(db_verbose,1),!, + write(X),nl. +'$write_or_not'(_). + + +'$make_atom'(L,A) :- + '$make_atom_list'(L,L1), + atom_codes(A,L1). + +'$make_atom_list'([],[]). +'$make_atom_list'([H|T],L2) :- + atom(H),!, + atom_codes(H,L), + '$make_atom_list'(T,L1), + append(L,L1,L2). +'$make_atom_list'([H|T],L2) :- + number_chars(H,L), + '$make_atom_list'(T,L1), + append(L,L1,L2). + + + +% 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'(Conn,Connection) :- + '$error_checks'(get_value(Conn,Connection)), + get_value(Conn,Connection). + + +'$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). \ No newline at end of file diff --git a/library/Makefile.in b/library/Makefile.in index d30bfec42..7f8c41ae6 100644 --- a/library/Makefile.in +++ b/library/Makefile.in @@ -48,7 +48,14 @@ PROGRAMS= $(srcdir)/apply_macros.yap \ $(srcdir)/timeout.yap \ $(srcdir)/trees.yap \ $(srcdir)/ugraphs.yap \ - $(srcdir)/ypp.yap + $(srcdir)/ypp.yap \ + $(srcdir)/MYDDAS/myddas.yap \ + $(srcdir)/MYDDAS/myddas_mysql.yap \ + $(srcdir)/MYDDAS/myddas_odbc.yap \ + $(srcdir)/MYDDAS/myddas_errors.yap \ + $(srcdir)/MYDDAS/myddas_prolog2sql.yap \ + $(srcdir)/MYDDAS/myddas_util_predicates.yap \ + $(srcdir)/MYDDAS/myddas_test_predicates.yap LOGTALK_PROGRAMS= \ $(srcdir)/logtalk/logtalk.pl \