1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Low-level interface for CLSQL ODBC backend
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Feb 2002
12 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
14 ;;;; CLSQL users are granted the rights to distribute and use this software
15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
17 ;;;; *************************************************************************
19 (defpackage #:clsql-odbc
20 (:use #:common-lisp #:clsql-sys)
21 (:export #:odbc-database)
22 (:documentation "This is the CLSQL interface to ODBC."))
24 (in-package #:clsql-odbc)
28 (defclass odbc-database (generic-odbc-database)
29 ((odbc-db-type :accessor database-odbc-db-type)))
31 (defmethod database-name-from-spec (connection-spec
32 (database-type (eql :odbc)))
33 (check-connection-spec connection-spec database-type (dsn user password))
34 (destructuring-bind (dsn user password) connection-spec
35 (declare (ignore password))
36 (concatenate 'string dsn "/" user)))
38 (defmethod database-connect (connection-spec (database-type (eql :odbc)))
39 (check-connection-spec connection-spec database-type (dsn user password))
40 (destructuring-bind (dsn user password) connection-spec
42 (let ((db (make-instance 'odbc-database
43 :name (database-name-from-spec connection-spec :odbc)
45 :dbi-package (find-package '#:odbc-dbi)
47 (odbc-dbi:connect :user user
49 :data-source-name dsn))))
50 (store-type-of-connected-database db)
51 ;; Ensure this database type is initialized so can check capabilities of
52 ;; underlying database
53 (initialize-database-type :database-type database-type)
56 (error () ;; Init or Connect failed
57 (error 'sql-connection-error
58 :database-type database-type
59 :connection-spec connection-spec
60 :message "Connection failed")))))
62 (defmethod database-underlying-type ((database odbc-database))
63 (database-odbc-db-type database))
65 (defun store-type-of-connected-database (db)
66 (let* ((odbc-conn (clsql-sys::odbc-conn db))
67 (server-name (odbc-dbi::get-odbc-info odbc-conn odbc::$SQL_SERVER_NAME))
68 (dbms-name (odbc-dbi::get-odbc-info odbc-conn odbc::$SQL_DBMS_NAME))
70 ;; need SERVER-NAME and DBMS-NAME because many drivers mix this up
72 ((or (search "postgresql" server-name :test #'char-equal)
73 (search "postgresql" dbms-name :test #'char-equal))
74 (unless (find-package 'clsql-postgresql)
75 (ignore-errors (asdf:operate 'asdf:load-op 'clsql-postgresql-socket)))
77 ((or (search "mysql" server-name :test #'char-equal)
78 (search "mysql" dbms-name :test #'char-equal))
79 (unless (find-package 'clsql-mysql)
80 ;; ignore errors on platforms where the shared libraries are not available
81 (ignore-errors (asdf:operate 'asdf:load-op 'clsql-mysql)))
83 ((or (search "oracle" server-name :test #'char-equal)
84 (search "oracle" dbms-name :test #'char-equal))
86 (setf (database-odbc-db-type db) type)))
90 (defmethod database-create (connection-spec (type (eql :odbc)))
91 (declare (ignore connection-spec))
92 (warn "Not implemented."))
94 (defmethod database-destroy (connection-spec (type (eql :odbc)))
95 (declare (ignore connection-spec))
96 (warn "Not implemented."))
98 (defmethod database-probe (connection-spec (type (eql :odbc)))
99 (when (find (car connection-spec) (database-list connection-spec type)
100 :test #'string-equal)
103 (defmethod database-list (connection-spec (type (eql :odbc)))
104 (declare (ignore connection-spec))
105 (odbc-dbi:list-all-data-sources))
107 (defmethod database-list-indexes ((database odbc-database)
110 (dolist (table (database-list-tables database :owner owner) result)
112 (append (database-list-table-indexes table database :owner owner)
115 (defmethod database-list-table-indexes (table (database odbc-database)
117 (declare (ignore owner))
118 (multiple-value-bind (rows col-names)
119 (odbc-dbi:list-table-indexes
121 :db (clsql-sys::odbc-conn database))
122 (declare (ignore col-names))
123 ;; INDEX_NAME is hard-coded in sixth position by ODBC driver
124 ;; FIXME: ??? is hard-coded in the fourth position
126 (loop-rows rows (cdr loop-rows)))
127 ((null loop-rows) (nreverse results))
128 (let* ((row (car loop-rows))
130 (unless (find col results :test #'string-equal)
131 (push col results))))))
133 ;;; Database capabilities
135 (defmethod db-backend-has-create/destroy-db? ((db-type (eql :odbc)))
139 (defmethod database-initialize-database-type ((database-type (eql :odbc)))
143 (when (clsql-sys:database-type-library-loaded :odbc)
144 (clsql-sys:initialize-database-type :database-type :odbc))