blob: b36833e28ec8ddf745fdc6b1a5651bf80b13efd3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: odbc-sql.cl
;;;; Purpose: Medium-level interface for CLSQL ODBC backend
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; CLSQL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
(defpackage #:clsql-odbc
(:use #:common-lisp #:clsql-sys)
(:export #:odbc-database)
(:documentation "This is the CLSQL interface to ODBC."))
(in-package #:clsql-odbc)
;; ODBC interface
(defclass odbc-database (generic-odbc-database)
())
(defclass odbc-postgresql-database (generic-odbc-database
generic-postgresql-database)
())
(defmethod database-name-from-spec (connection-spec
(database-type (eql :odbc)))
(check-connection-spec connection-spec database-type
(dsn user password &key connection-string completion window-handle))
(destructuring-bind (dsn user password &key connection-string completion window-handle) connection-spec
(declare (ignore password connection-string completion window-handle))
(concatenate 'string dsn "/" user)))
(defmethod database-connect (connection-spec (database-type (eql :odbc)))
(check-connection-spec connection-spec database-type
(dsn user password &key connection-string completion window-handle))
(destructuring-bind (dsn user password &key connection-string (completion :no-prompt) window-handle) connection-spec
(handler-case
(let ((db (make-instance 'odbc-database
:name (database-name-from-spec connection-spec :odbc)
:database-type :odbc
:connection-spec connection-spec
:dbi-package (find-package '#:odbc-dbi)
:odbc-conn
(odbc-dbi:connect :user user
:password password
:data-source-name dsn
:connection-string connection-string
:completion completion
:window-handle window-handle))))
(store-type-of-connected-database db)
;; Ensure this database type is initialized so can check capabilities of
;; underlying database
(initialize-database-type :database-type database-type)
(if (eql :postgresql (database-underlying-type db))
(make-instance 'odbc-postgresql-database
:name (database-name-from-spec connection-spec :odbc)
:database-type :odbc
:connection-spec connection-spec
:dbi-package (find-package '#:odbc-dbi)
:odbc-db-type :postgresql
:odbc-conn (clsql-sys::odbc-conn db))
db))
#+ignore
(error () ;; Init or Connect failed
(error 'sql-connection-error
:database-type database-type
:connection-spec connection-spec
:message "Connection failed")))))
(defmethod database-underlying-type ((database generic-odbc-database))
(clsql-sys::database-odbc-db-type database))
(defun store-type-of-connected-database (db)
(let* ((odbc-conn (clsql-sys::odbc-conn db))
(server-name (odbc-dbi::get-odbc-info odbc-conn odbc::$SQL_SERVER_NAME))
(dbms-name (odbc-dbi::get-odbc-info odbc-conn odbc::$SQL_DBMS_NAME))
(type
;; need SERVER-NAME and DBMS-NAME because many drivers mix this up
(cond
((or (search "postgresql" server-name :test #'char-equal)
(search "postgresql" dbms-name :test #'char-equal))
(unless (find-package 'clsql-postgresql)
(ignore-errors (asdf:operate 'asdf:load-op 'clsql-postgresql-socket)))
:postgresql)
((or (search "Microsoft SQL Server" server-name :test #'char-equal)
(search "Microsoft SQL Server" dbms-name :test #'char-equal))
:mssql)
((or (search "mysql" server-name :test #'char-equal)
(search "mysql" dbms-name :test #'char-equal))
(unless (find-package 'clsql-mysql)
;; ignore errors on platforms where the shared libraries are not available
(ignore-errors (asdf:operate 'asdf:load-op 'clsql-mysql)))
:mysql)
((or (search "oracle" server-name :test #'char-equal)
(search "oracle" dbms-name :test #'char-equal))
:oracle))))
(setf (clsql-sys::database-odbc-db-type db) type)))
(defmethod database-create (connection-spec (type (eql :odbc)))
(declare (ignore connection-spec))
(warn "Not implemented."))
(defmethod database-destroy (connection-spec (type (eql :odbc)))
(declare (ignore connection-spec))
(warn "Not implemented."))
(defmethod database-probe (connection-spec (type (eql :odbc)))
(when (find (car connection-spec) (database-list connection-spec type)
:test #'string-equal)
t))
(defmethod database-list (connection-spec (type (eql :odbc)))
(declare (ignore connection-spec))
(odbc-dbi:list-all-data-sources))
(defmethod database-list-indexes ((database odbc-database)
&key (owner nil))
(let ((result '()))
(dolist (table (database-list-tables database :owner owner) result)
(setq result
(append (database-list-table-indexes table database :owner owner)
result)))))
(defmethod database-list-table-indexes (table (database odbc-database)
&key (owner nil))
(declare (ignore owner))
(multiple-value-bind (rows col-names)
(odbc-dbi:list-table-indexes
table
:db (clsql-sys::odbc-conn database))
(declare (ignore col-names))
;; INDEX_NAME is hard-coded in sixth position by ODBC driver
;; FIXME: ??? is hard-coded in the fourth position
(do ((results nil)
(loop-rows rows (cdr loop-rows)))
((null loop-rows) (nreverse results))
(let* ((row (car loop-rows))
(col (nth 5 row)))
(unless (or (null col) (find col results :test #'string-equal))
(push col results))))))
;;; Database capabilities
(defmethod db-backend-has-create/destroy-db? ((db-type (eql :odbc)))
nil)
(defmethod database-initialize-database-type ((database-type (eql :odbc)))
;; nothing to do
t)
(when (clsql-sys:database-type-library-loaded :odbc)
(clsql-sys:initialize-database-type :database-type :odbc))
|
