1/*  Part of SWI-Prolog
2
3    Author:        Jan Wielemaker
4    E-mail:        J.Wielemaker@vu.nl
5    WWW:           http://www.swi-prolog.org
6    Copyright (c)  2002-2013, University of Amsterdam
7    All rights reserved.
8
9    Redistribution and use in source and binary forms, with or without
10    modification, are permitted provided that the following conditions
11    are met:
12
13    1. Redistributions of source code must retain the above copyright
14       notice, this list of conditions and the following disclaimer.
15
16    2. Redistributions in binary form must reproduce the above copyright
17       notice, this list of conditions and the following disclaimer in
18       the documentation and/or other materials provided with the
19       distribution.
20
21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32    POSSIBILITY OF SUCH DAMAGE.
33*/
34
35:- module(odbc,
36          [ odbc_connect/3,             % +DSN, -Conn, +Options
37            odbc_driver_connect/3,      % +DriverString, -Conn, +Options
38            odbc_disconnect/1,          % +Conn
39            odbc_current_connection/2,  % ?Conn, -DSN
40            odbc_set_connection/2,      % +Conn, +Option
41            odbc_get_connection/2,      % +Conn, ?Option
42            odbc_end_transaction/2,     % +Conn, +CommitRollback
43
44            odbc_query/4,               % +Conn, +SQL, -Row, +Options
45            odbc_query/3,               % +Conn, +SQL, -Row
46            odbc_query/2,               % +Conn, +SQL
47
48            odbc_prepare/4,             % +Conn, +SQL, +Parms, -Qid
49            odbc_prepare/5,             % +Conn, +SQL, +Parms, -Qid, +Options
50            odbc_execute/2,             % +Qid, +Parms
51            odbc_execute/3,             % +Qid, +Parms, -Row
52	    odbc_fetch/3,               % +Qid, -Row, +Options
53	    odbc_next_result_set/1,     % +Qid
54            odbc_close_statement/1,     % +Statement
55            odbc_clone_statement/2,     % +Statement, -Clone
56            odbc_free_statement/1,      % +Statement
57            odbc_cancel_thread/1,       % +ThreadId
58                                        % DB dictionary info
59            odbc_current_table/2,       % +Conn, -Table
60            odbc_current_table/3,       % +Conn, -Table, ?Facet
61            odbc_table_column/3,        % +Conn, ?Table, ?Column
62            odbc_table_column/4,        % +Conn, ?Table, ?Column, ?Facet
63            odbc_type/3,                % +Conn, ?Type, -Facet
64            odbc_data_source/2,         % ?DSN, ?Description
65
66            odbc_table_primary_key/3,   % +Conn, ?Table, ?Column
67            odbc_table_foreign_key/5,   % +Conn, ?PkTable, ?PkColumn, ?FkTable, ?FkColumn
68
69	    odbc_set_option/1,          % -Option
70            odbc_statistics/1,          % -Value
71            odbc_debug/1                % +Level
72          ]).
73:- autoload(library(lists),[member/2]).
74
75:- use_foreign_library(foreign(odbc4pl)).
76
77%!  odbc_current_connection(?Conn, ?DSN) is nondet.
78%
79%   True if Conn is an open ODBC connection to DSN.
80
81odbc_current_connection(Conn, DSN) :-
82    odbc_current_connections(Conn, DSN, Pairs),
83    member(Conn-DSN, Pairs).
84
85%!  odbc_driver_connect(+DriverString, -Connection, +Options) is det.
86%
87%   Connects to a database using SQLDriverConnect(). This API allows
88%   for driver-specific additional options.   DriverString is passed
89%   without  checking.  Options  should  *not*  include  =user=  and
90%   =password=.
91%
92%   Whenever possible, applications should   use  odbc_connect/3. If
93%   you need this predicate,  please   check  the  documentation for
94%   SQLDriverConnect() and the documentation of your driver.
95%
96%   @tbd    Add facilities to deal with prompted completion of the
97%           driver options.
98
99odbc_driver_connect(DriverString, Connection, Options) :-
100    odbc_connect(-, Connection, [driver_string(DriverString)|Options]).
101
102%!  odbc_query(+Connection, +SQL, -Row)
103%
104%   Run query without options.
105
106odbc_query(Connection, SQL, Row) :-
107    odbc_query(Connection, SQL, Row, []).
108
109%!  odbc_query(+Connection, +SQL)
110%
111%   Execute SQL-statement that does not produce a result
112
113odbc_query(Connection, SQL) :-
114    odbc_query(Connection, SQL, Row),
115    !,
116    (   Row = affected(_)
117    ->  true
118    ;   print_message(warning, odbc(unexpected_result(Row)))
119    ).
120
121odbc_execute(Statement, Parameters) :-
122    odbc_execute(Statement, Parameters, Row),
123    !,
124    (   Row = affected(_)
125    ->  true
126    ;   print_message(warning, odbc(unexpected_result(Row)))
127    ).
128
129odbc_prepare(Connection, SQL, Parameters, Statement) :-
130    odbc_prepare(Connection, SQL, Parameters, Statement, []).
131
132                 /*******************************
133                 *          SCHEMA STUFF        *
134                 *******************************/
135
136%!  odbc_current_table(-Table, -Facet)
137%
138%   Enumerate the existing tables.
139
140odbc_current_table(Connection, Table) :-
141    odbc_tables(Connection, row(_Qualifier, _Owner, Table, 'TABLE', _Comment)).
142
143odbc_current_table(Connection, Table, Facet) :-
144    odbc_tables(Connection, Tuple),
145    arg(3, Tuple, Table),
146    table_facet(Facet, Connection, Tuple).
147
148table_facet(qualifier(Qualifier), _, Tuple) :- arg(1, Tuple, Qualifier).
149table_facet(owner(Owner), _, Tuple) :-         arg(2, Tuple, Owner).
150table_facet(type(Type), _, Tuple) :-           arg(4, Tuple, Type).
151table_facet(comment(Comment), _, Tuple) :-     arg(5, Tuple, Comment).
152table_facet(arity(Arity), Connection, Tuple) :-
153    arg(3, Tuple, Table),
154    findall(C, odbc_table_column(Connection, Table, C), Cs),
155    length(Cs, Arity).
156
157%!  odbc_table_column(+Connection, +Table, +Column) is semidet.
158%!  odbc_table_column(+Connection, +Table, -Column) is nondet.
159%
160%   True if Column appears in Table on Connection.
161
162odbc_table_column(Connection, Table, Column) :-
163    table_column(Connection, Table, Column, _Tuple).
164
165table_column(Connection, Table, Column, Tuple) :-
166    (   var(Table)
167    ->  odbc_current_table(Connection, Table)
168    ;   true
169    ),
170    (   ground(Column)              % force determinism
171    ->  odbc_column(Connection, Table, Tuple),
172        arg(4, Tuple, Column), !
173    ;   odbc_column(Connection, Table, Tuple),
174        arg(4, Tuple, Column)
175    ).
176
177%!  odbc_table_column(+Connection, +Table, ?Column, -Facet)
178
179odbc_table_column(Connection, Table, Column, Facet) :-
180    table_column(Connection, Table, Column, Tuple),
181    column_facet(Facet, Tuple).
182
183column_facet(table_qualifier(Q), T) :- arg(1, T, Q).
184column_facet(table_owner(Q), T)     :- arg(2, T, Q).
185column_facet(table_name(Q), T)      :- arg(3, T, Q).
186%column_facet(column_name(Q), T)    :- arg(4, T, Q).
187column_facet(data_type(Q), T)       :- arg(5, T, Q).
188column_facet(type_name(Q), T)       :- arg(6, T, Q).
189column_facet(precision(Q), T)       :- non_null_arg(7, T, Q).
190column_facet(length(Q), T)          :- non_null_arg(8, T, Q).
191column_facet(scale(Q), T)           :- non_null_arg(9, T, Q).
192column_facet(radix(Q), T)           :- non_null_arg(10, T, Q).
193column_facet(nullable(Q), T)        :- non_null_arg(11, T, Q).
194column_facet(remarks(Q), T)         :- non_null_arg(12, T, Q).
195column_facet(type(Type), T) :-
196    arg(6, T, TypeName),
197    sql_type(TypeName, T, Type).
198
199%!  sql_type(+TypeName, +Row, -Type)
200%
201%   Create a canonical Prolog representation for the type.  This
202%   is very incomplete code.
203
204sql_type(dec, T, Type) :-
205    !,
206    sql_type(decimal, T, Type).
207sql_type(numeric, T, Type) :-
208    !,
209    sql_type(decimal, T, Type).
210sql_type(decimal, T, Type) :-
211    !,
212    column_facet(precision(Len), T),
213    (   column_facet(scale(D), T),
214        D \== 0
215    ->  Type = decimal(Len, D)
216    ;   Type = decimal(Len)
217    ).
218sql_type(char, T, char(Len)) :-
219    !,
220    column_facet(length(Len), T).
221sql_type(varchar, T, varchar(Len)) :-
222    !,
223    column_facet(length(Len), T).
224sql_type(TypeName, _T, Type) :-
225    downcase_atom(TypeName, Type).
226
227%!  odbc_type(+Connection, +TypeSpec, ?Facet).
228
229odbc_type(Connection, TypeSpec, Facet) :-
230    odbc_types(Connection, TypeSpec, Row),
231    type_facet(Facet, Row).
232
233type_facet(name(V), Row)           :- arg(1, Row, V).
234type_facet(data_type(V), Row)      :- arg(2, Row, V).
235type_facet(precision(V), Row)      :- arg(3, Row, V).
236type_facet(literal_prefix(V), Row) :- non_null_arg(4, Row, V).
237type_facet(literal_suffix(V), Row) :- non_null_arg(5, Row, V).
238type_facet(create_params(V), Row)  :- non_null_arg(6, Row, V).
239type_facet(nullable(V), Row)       :- arg(7, Row, I), nullable_arg(I, V).
240type_facet(case_sensitive(V), Row) :- bool_arg(8, Row, V).
241type_facet(searchable(V), Row)     :- arg(9, Row, I), searchable_arg(I, V).
242type_facet(unsigned(V), Row)       :- bool_arg(10, Row, V).
243type_facet(money(V), Row)          :- bool_arg(11, Row, V).
244type_facet(auto_increment(V), Row) :- bool_arg(12, Row, V).
245type_facet(local_name(V), Row)     :- non_null_arg(13, Row, V).
246type_facet(minimum_scale(V), Row)  :- non_null_arg(14, Row, V).
247type_facet(maximum_scale(V), Row)  :- non_null_arg(15, Row, V).
248
249non_null_arg(Index, Row, V) :-
250    arg(Index, Row, V),
251    V \== '$null$'.
252bool_arg(Index, Row, V) :-
253    arg(Index, Row, I),
254    int_to_bool(I, V).
255
256int_to_bool(0, false).
257int_to_bool(1, true).
258
259nullable_arg(0, false).
260nullable_arg(1, true).
261nullable_arg(2, unknown).
262
263searchable_arg(0, false).
264searchable_arg(1, like_only).
265searchable_arg(2, all_except_like).
266searchable_arg(4, true).
267
268
269%!  odbc_data_source(?DSN, ?Description)
270%
271%   Enumerate the available data-sources
272
273odbc_data_source(DSN, Description) :-
274    odbc_data_sources(List),
275    member(data_source(DSN, Description), List).
276
277                 /*******************************
278                 *    Primary & foreign keys    *
279                 *******************************/
280
281%!  odbc_table_primary_key(+Connection, +Table, ?Column)
282%
283%   Enumerate columns in primary key for table
284
285odbc_table_primary_key(Connection, Table, Column) :-
286    (   var(Table)
287    ->  odbc_current_table(Connection, Table)
288    ;   true
289    ),
290    (   ground(Column)              % force determinism
291    ->  odbc_primary_key(Connection, Table, Tuple),
292        arg(4, Tuple, Column), !
293    ;   odbc_primary_key(Connection, Table, Tuple),
294        arg(4, Tuple, Column)
295    ).
296
297%!  odbc_table_foreign_key(+Connection, ?PkTable, ?PkCol, ?FkTable, ?FkCol)
298%
299%   Enumerate foreign keys columns
300
301odbc_table_foreign_key(Connection, PkTable, PkColumn, FkTable, FkColumn) :-
302    odbc_foreign_key(Connection, PkTable, FkTable, Tuple),
303    ( var(PkTable) -> arg(3, Tuple, PkTable) ; true ),
304    arg(4, Tuple, PkColumn),
305    ( var(FkTable) -> arg(7, Tuple, FkTable) ; true ),
306    arg(8, Tuple, FkColumn).
307
308
309                 /*******************************
310                 *           STATISTICS         *
311                 *******************************/
312
313odbc_statistics(Key) :-
314    statistics_key(Key),
315    '$odbc_statistics'(Key).
316
317statistics_key(statements(_Created, _Freed)).
318
319
320                 /*******************************
321                 *            MESSAGES          *
322                 *******************************/
323
324:- multifile
325    prolog:message/3.
326
327prolog:message(error(odbc(ODBCCode, _NativeCode, Comment), _)) -->
328    [ 'ODBC: State ~w: ~w'-[ODBCCode, Comment] ].
329prolog:message(error(context_error(Obj, Error, What), _)) -->
330    [ 'Context error: ~w ~w: '-[What, Obj] ],
331    context(Error).
332
333prolog:message(odbc(ODBCCode, _NativeCode, Comment)) -->
334    [ 'ODBC: State ~w: ~w'-[ODBCCode, Comment] ].
335prolog:message(odbc(unexpected_result(Row))) -->
336    [ 'ODBC: Unexpected result-row: ~p'-[Row] ].
337
338context(in_use) -->
339    [ 'object is in use' ].
340