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