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
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
&key connection-string completion window-handle
))
34 (destructuring-bind (dsn user password
&key connection-string completion window-handle
) connection-spec
35 (declare (ignore password connection-string completion window-handle
))
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
&key connection-string completion window-handle
))
40 (destructuring-bind (dsn user password
&key connection-string
(completion :no-prompt
) window-handle
) 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
50 :connection-string connection-string
51 :completion completion
52 :window-handle window-handle
))))
53 (store-type-of-connected-database db
)
54 ;; Ensure this database type is initialized so can check capabilities of
55 ;; underlying database
56 (initialize-database-type :database-type database-type
)
59 (error () ;; Init or Connect failed
60 (error 'sql-connection-error
61 :database-type database-type
62 :connection-spec connection-spec
63 :message
"Connection failed")))))
65 (defmethod database-underlying-type ((database odbc-database
))
66 (database-odbc-db-type database
))
68 (defun store-type-of-connected-database (db)
69 (let* ((odbc-conn (clsql-sys::odbc-conn db
))
70 (server-name (odbc-dbi::get-odbc-info odbc-conn odbc
::$SQL_SERVER_NAME
))
71 (dbms-name (odbc-dbi::get-odbc-info odbc-conn odbc
::$SQL_DBMS_NAME
))
73 ;; need SERVER-NAME and DBMS-NAME because many drivers mix this up
75 ((or (search "postgresql" server-name
:test
#'char-equal
)
76 (search "postgresql" dbms-name
:test
#'char-equal
))
77 (unless (find-package 'clsql-postgresql
)
78 (ignore-errors (asdf:operate
'asdf
:load-op
'clsql-postgresql-socket
)))
80 ((or (search "Microsoft SQL Server" server-name
:test
#'char-equal
)
81 (search "Microsoft SQL Server" dbms-name
:test
#'char-equal
))
83 ((or (search "mysql" server-name
:test
#'char-equal
)
84 (search "mysql" dbms-name
:test
#'char-equal
))
85 (unless (find-package 'clsql-mysql
)
86 ;; ignore errors on platforms where the shared libraries are not available
87 (ignore-errors (asdf:operate
'asdf
:load-op
'clsql-mysql
)))
89 ((or (search "oracle" server-name
:test
#'char-equal
)
90 (search "oracle" dbms-name
:test
#'char-equal
))
92 (setf (database-odbc-db-type db
) type
)))
96 (defmethod database-create (connection-spec (type (eql :odbc
)))
97 (declare (ignore connection-spec
))
98 (warn "Not implemented."))
100 (defmethod database-destroy (connection-spec (type (eql :odbc
)))
101 (declare (ignore connection-spec
))
102 (warn "Not implemented."))
104 (defmethod database-probe (connection-spec (type (eql :odbc
)))
105 (when (find (car connection-spec
) (database-list connection-spec type
)
106 :test
#'string-equal
)
109 (defmethod database-list (connection-spec (type (eql :odbc
)))
110 (declare (ignore connection-spec
))
111 (odbc-dbi:list-all-data-sources
))
113 (defmethod database-list-indexes ((database odbc-database
)
116 (dolist (table (database-list-tables database
:owner owner
) result
)
118 (append (database-list-table-indexes table database
:owner owner
)
121 (defmethod database-list-table-indexes (table (database odbc-database
)
123 (declare (ignore owner
))
124 (multiple-value-bind (rows col-names
)
125 (odbc-dbi:list-table-indexes
127 :db
(clsql-sys::odbc-conn database
))
128 (declare (ignore col-names
))
129 ;; INDEX_NAME is hard-coded in sixth position by ODBC driver
130 ;; FIXME: ??? is hard-coded in the fourth position
132 (loop-rows rows
(cdr loop-rows
)))
133 ((null loop-rows
) (nreverse results
))
134 (let* ((row (car loop-rows
))
136 (unless (or (null col
) (find col results
:test
#'string-equal
))
137 (push col results
))))))
139 ;;; Database capabilities
141 (defmethod db-backend-has-create/destroy-db?
((db-type (eql :odbc
)))
145 (defmethod database-initialize-database-type ((database-type (eql :odbc
)))
149 (when (clsql-sys:database-type-library-loaded
:odbc
)
150 (clsql-sys:initialize-database-type
:database-type
:odbc
))