db-odbc/odbc-sql.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          odbc-sql.cl
   6 ;;;; Purpose:       Medium-level interface for CLSQL ODBC backend
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Feb 2002
   9 ;;;;
  10 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
  11 ;;;;
  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 ;;;; *************************************************************************
  16
  17 (defpackage #:clsql-odbc
  18     (:use #:common-lisp #:clsql-sys)
  19     (:export #:odbc-database)
  20     (:documentation "This is the CLSQL interface to ODBC."))
  21
  22 (in-package #:clsql-odbc)
  23
  24 ;; ODBC interface
  25
  26 (defclass odbc-database (generic-odbc-database)
  27   ())
  28
  29 (defclass odbc-postgresql-database (generic-odbc-database
  30                                     generic-postgresql-database)
  31   ())
  32
  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)))
  40
  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
  45     (handler-case
  46         (let ((db (make-instance 'odbc-database
  47                    :name (database-name-from-spec connection-spec :odbc)
  48                    :database-type :odbc
  49                    :connection-spec connection-spec
  50                    :dbi-package (find-package '#:odbc-dbi)
  51                    :odbc-conn
  52                    (odbc-dbi:connect :user user
  53                                      :password password
  54                                      :data-source-name dsn
  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)
  65                              :database-type :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))
  70               db))
  71       #+ignore
  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")))))
  77
  78 (defmethod database-underlying-type ((database generic-odbc-database))
  79   (clsql-sys::database-odbc-db-type database))
  80
  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))
  85          (type
  86           ;; need SERVER-NAME and DBMS-NAME because many drivers mix this up
  87           (cond
  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)))
  92             :postgresql)
  93            ((or (search "Microsoft SQL Server" server-name :test #'char-equal)
  94                 (search "Microsoft SQL Server" dbms-name :test #'char-equal))
  95             :mssql)
  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)))
 101             :mysql)
 102            ((or (search "oracle" server-name :test #'char-equal)
 103                 (search "oracle" dbms-name :test #'char-equal))
 104             :oracle))))
 105     (setf (clsql-sys::database-odbc-db-type db) type)))
 106
 107
 108
 109 (defmethod database-create (connection-spec (type (eql :odbc)))
 110   (declare (ignore connection-spec))
 111   (warn "Not implemented."))
 112
 113 (defmethod database-destroy (connection-spec (type (eql :odbc)))
 114   (declare (ignore connection-spec))
 115   (warn "Not implemented."))
 116
 117 (defmethod database-probe (connection-spec (type (eql :odbc)))
 118   (when (find (car connection-spec) (database-list connection-spec type)
 119               :test #'string-equal)
 120     t))
 121
 122 (defmethod database-list (connection-spec (type (eql :odbc)))
 123   (declare (ignore connection-spec))
 124   (odbc-dbi:list-all-data-sources))
 125
 126 (defmethod database-list-indexes ((database odbc-database)
 127                                   &key (owner nil))
 128   (let ((result '()))
 129     (dolist (table (database-list-tables database :owner owner) result)
 130       (setq result
 131         (append (database-list-table-indexes table database :owner owner)
 132                 result)))))
 133
 134 (defmethod database-list-table-indexes (table (database odbc-database)
 135                                         &key (owner nil))
 136   (declare (ignore owner))
 137   (multiple-value-bind (rows col-names)
 138       (odbc-dbi:list-table-indexes
 139        table
 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
 144     (do ((results nil)
 145          (loop-rows rows (cdr loop-rows)))
 146         ((null loop-rows) (nreverse results))
 147       (let* ((row (car loop-rows))
 148              (col (nth 5 row)))
 149         (unless (or (null col) (find col results :test #'string-equal))
 150           (push col results))))))
 151
 152 ;;; Database capabilities
 153
 154 (defmethod db-backend-has-create/destroy-db? ((db-type (eql :odbc)))
 155   nil)
 156
 157
 158 (defmethod database-initialize-database-type ((database-type (eql :odbc)))
 159   ;; nothing to do
 160   t)
 161
 162 (when (clsql-sys:database-type-library-loaded :odbc)
 163   (clsql-sys:initialize-database-type :database-type :odbc))