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:       Low-level interface for CLSQL ODBC backend
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Feb 2002
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
  13 ;;;;
  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 ;;;; *************************************************************************
  18
  19 (defpackage #:clsql-odbc
  20     (:use #:common-lisp #:clsql-sys)
  21     (:export #:odbc-database)
  22     (:documentation "This is the CLSQL interface to ODBC."))
  23
  24 (in-package #:clsql-odbc)
  25
  26 ;; ODBC interface
  27
  28 (defclass odbc-database (generic-odbc-database)
  29   ((odbc-db-type :accessor database-odbc-db-type)))
  30
  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)))
  37
  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
  41     (handler-case
  42         (let ((db (make-instance 'odbc-database
  43                                  :name (database-name-from-spec connection-spec :odbc)
  44                                  :database-type :odbc
  45                                  :dbi-package (find-package '#:odbc-dbi)
  46                                  :odbc-conn
  47                                  (odbc-dbi:connect :user user
  48                                                    :password password
  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)
  54           db)
  55       #+ignore
  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")))))
  61
  62 (defmethod database-underlying-type ((database odbc-database))
  63   (database-odbc-db-type database))
  64
  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))
  69          (type
  70           ;; need SERVER-NAME and DBMS-NAME because many drivers mix this up
  71           (cond
  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)))
  76             :postgresql)
  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)))
  82             :mysql)
  83            ((or (search "oracle" server-name :test #'char-equal)
  84                 (search "oracle" dbms-name :test #'char-equal))
  85             :oracle))))
  86     (setf (database-odbc-db-type db) type)))
  87
  88
  89
  90 (defmethod database-create (connection-spec (type (eql :odbc)))
  91   (declare (ignore connection-spec))
  92   (warn "Not implemented."))
  93
  94 (defmethod database-destroy (connection-spec (type (eql :odbc)))
  95   (declare (ignore connection-spec))
  96   (warn "Not implemented."))
  97
  98 (defmethod database-probe (connection-spec (type (eql :odbc)))
  99   (when (find (car connection-spec) (database-list connection-spec type)
 100               :test #'string-equal)
 101     t))
 102
 103 (defmethod database-list (connection-spec (type (eql :odbc)))
 104   (declare (ignore connection-spec))
 105   (odbc-dbi:list-all-data-sources))
 106
 107 (defmethod database-list-indexes ((database odbc-database)
 108                                   &key (owner nil))
 109   (let ((result '()))
 110     (dolist (table (database-list-tables database :owner owner) result)
 111       (setq result
 112         (append (database-list-table-indexes table database :owner owner)
 113                 result)))))
 114
 115 (defmethod database-list-table-indexes (table (database odbc-database)
 116                                         &key (owner nil))
 117   (declare (ignore owner))
 118   (multiple-value-bind (rows col-names)
 119       (odbc-dbi:list-table-indexes
 120        table
 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
 125     (do ((results nil)
 126          (loop-rows rows (cdr loop-rows)))
 127         ((null loop-rows) (nreverse results))
 128       (let* ((row (car loop-rows))
 129              (col (nth 5 row)))
 130         (unless (find col results :test #'string-equal)
 131           (push col results))))))
 132
 133 ;;; Database capabilities
 134
 135 (defmethod db-backend-has-create/destroy-db? ((db-type (eql :odbc)))
 136   nil)
 137
 138
 139 (defmethod database-initialize-database-type ((database-type (eql :odbc)))
 140   ;; nothing to do
 141   t)
 142
 143 (when (clsql-sys:database-type-library-loaded :odbc)
 144   (clsql-sys:initialize-database-type :database-type :odbc))