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: odbc-sql.lisp 8983 2004-04-12 21:16:48Z kevin $
  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-base-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 (database)
  29   ((odbc-conn :accessor database-odbc-conn :initarg :odbc-conn)
  30    (odbc-db-type :accessor database-odbc-db-type)))
  31
  32 (defmethod database-name-from-spec (connection-spec
  33                                     (database-type (eql :odbc)))
  34   (check-connection-spec connection-spec database-type (dsn user password))
  35   (destructuring-bind (dsn user password) connection-spec
  36     (declare (ignore password))
  37     (concatenate 'string dsn "/" user)))
  38
  39 (defmethod database-connect (connection-spec (database-type (eql :odbc)))
  40   (check-connection-spec connection-spec database-type (dsn user password))
  41   (destructuring-bind (dsn user password) connection-spec
  42     (handler-case
  43         (let ((db
  44                (make-instance 'odbc-database
  45                  :name (database-name-from-spec connection-spec :odbc)
  46                  :database-type :odbc
  47                  :odbc-conn
  48                  (odbc-dbi:connect :user user
  49                                    :password password
  50                                    :data-source-name dsn))))
  51           (store-type-of-connected-database db)
  52           db)
  53     (clsql-error (e)
  54       (error e))
  55     #+ignore
  56     (error ()   ;; Init or Connect failed
  57       (error 'clsql-connect-error
  58              :database-type database-type
  59              :connection-spec connection-spec
  60              :errno nil
  61              :error "Connection failed")))))
  62
  63 (defmethod database-underlying-type ((database odbc-database))
  64   (odbc-db-type database))
  65
  66 (defun store-type-of-connected-database (db)
  67   (let* ((odbc-conn (database-odbc-conn db))
  68          (server-name (odbc-dbi::get-odbc-info odbc-conn odbc::$SQL_SERVER_NAME))
  69          (dbms-name (odbc-dbi::get-odbc-info odbc-conn odbc::$SQL_DBMS_NAME))
  70          (type
  71           ;; need SERVER-NAME and DBMS-NAME because many drivers mix this up
  72           (cond
  73            ((or (search "postgresql" server-name :test #'char-equal)
  74                 (search "postgresql" dbms-name :test #'char-equal))
  75             :postgresql)
  76            ((or (search "mysql" server-name :test #'char-equal)
  77                 (search "mysql" dbms-name :test #'char-equal))
  78             :mysql)
  79            ((or (search "oracle" server-name :test #'char-equal)
  80                 (search "oracle" dbms-name :test #'char-equal))
  81             :oracle))))
  82     (setf (database-odbc-db-type db) type)))
  83
  84 (defmethod database-disconnect ((database odbc-database))
  85   (odbc-dbi:disconnect (database-odbc-conn database))
  86   (setf (database-odbc-conn database) nil)
  87   t)
  88
  89 (defmethod database-query (query-expression (database odbc-database)
  90                            result-types)
  91   (handler-case
  92       (odbc-dbi:sql query-expression :db (database-odbc-conn database)
  93                     :result-types result-types)
  94     (clsql-error (e)
  95       (error e))
  96     #+ignore
  97     (error ()
  98       (error 'clsql-sql-error
  99              :database database
 100              :expression query-expression
 101              :errno nil
 102              :error "Query failed"))))
 103
 104 (defmethod database-execute-command (sql-expression
 105                                      (database odbc-database))
 106   (handler-case
 107       (odbc-dbi:sql sql-expression :db (database-odbc-conn database))
 108     (clsql-error (e)
 109       (error e))
 110     #+ignore
 111     (error ()
 112       (error 'clsql-sql-error
 113              :database database
 114              :expression sql-expression
 115              :errno nil
 116              :error "Execute command failed"))))
 117
 118 (defstruct odbc-result-set
 119   (query nil)
 120   (types nil)
 121   (full-set nil :type boolean))
 122
 123 (defmethod database-query-result-set ((query-expression string)
 124                                       (database odbc-database)
 125                                       &key full-set result-types)
 126   (handler-case
 127       (multiple-value-bind (query column-names)
 128           (odbc-dbi:sql query-expression
 129                    :db (database-odbc-conn database)
 130                    :row-count nil
 131                    :column-names t
 132                    :query t
 133                    :result-types result-types)
 134         (values
 135          (make-odbc-result-set :query query :full-set full-set
 136                                 :types result-types)
 137          (length column-names)
 138          nil ;; not able to return number of rows with odbc
 139          ))
 140     #+ignore
 141     (error ()
 142       (error 'clsql-sql-error
 143              :database database
 144              :expression query-expression
 145              :errno nil
 146              :error "Query result set failed"))))
 147
 148 (defmethod database-dump-result-set (result-set (database odbc-database))
 149   (odbc-dbi:close-query (odbc-result-set-query result-set))
 150   t)
 151
 152 (defmethod database-store-next-row (result-set
 153                                     (database odbc-database)
 154                                     list)
 155   (let ((row (odbc-dbi:fetch-row (odbc-result-set-query result-set) nil 'eof)))
 156     (if (eq row 'eof)
 157         nil
 158       (progn
 159         (loop for elem in row
 160             for rest on list
 161             do
 162               (setf (car rest) elem))
 163         list))))
 164
 165 ;;; Sequence functions
 166
 167 (defun %sequence-name-to-table (sequence-name)
 168   (concatenate 'string "_clsql_seq_" (sql-escape sequence-name)))
 169
 170 (defun %table-name-to-sequence-name (table-name)
 171   (and (>= (length table-name) 11)
 172        (string= (subseq table-name 0 11) "_clsql_seq_")
 173        (subseq table-name 11)))
 174
 175 (defmethod database-create-sequence (sequence-name
 176                                      (database odbc-database))
 177   (let ((table-name (%sequence-name-to-table sequence-name)))
 178     (database-execute-command
 179      (concatenate 'string "CREATE TABLE " table-name
 180                   " (last_value int NOT NULL PRIMARY KEY, increment_by int, min_value int, is_called char(1))")
 181      database)
 182     (database-execute-command
 183      (concatenate 'string "INSERT INTO " table-name
 184                   " VALUES (1,1,1,'f')")
 185      database)))
 186
 187 (defmethod database-drop-sequence (sequence-name
 188                                    (database odbc-database))
 189   (database-execute-command
 190    (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name))
 191    database))
 192
 193 (defmethod database-list-sequences ((database odbc-database)
 194                                     &key (owner nil))
 195   (declare (ignore owner))
 196   (mapcar #'(lambda (s) (%table-name-to-sequence-name (car s)))
 197           (database-query "SHOW TABLES LIKE '%clsql_seq%'"
 198                           database nil)))
 199
 200 (defmethod database-list-tables ((database odbc-database)
 201                                  &key (owner nil))
 202   (declare (ignore owner))
 203     (multiple-value-bind (rows col-names)
 204         (odbc-dbi:list-all-database-tables :db (database-odbc-conn database))
 205       (declare (ignore col-names))
 206       ;; TABLE_SCHEM is hard-coded in second column by ODBC Driver Manager
 207       ;; TABLE_NAME in third column, TABLE_TYPE in fourth column
 208       (loop for row in rows
 209           when (and (not (string-equal "information_schema" (nth 1 row)))
 210                     (string-equal "TABLE" (nth 3 row)))
 211           collect (nth 2 row))))
 212
 213 (defmethod database-list-attributes ((table string) (database odbc-database)
 214                                      &key (owner nil))
 215   (declare (ignore owner))
 216   (multiple-value-bind (rows col-names)
 217       (odbc-dbi:list-all-table-columns table :db (database-odbc-conn database))
 218     (let ((pos (position "COLUMN_NAME" col-names :test #'string-equal)))
 219       (when pos
 220         (loop for row in rows
 221             collect (nth pos row))))))
 222
 223 (defmethod database-attribute-type ((attribute string) (table string) (database odbc-database)
 224                                      &key (owner nil))
 225   (declare (ignore owner))
 226   (multiple-value-bind (rows col-names)
 227       (odbc-dbi:list-all-table-columns table :db (database-odbc-conn database))
 228     (let ((pos (position "TYPE_NAME" col-names :test #'string-equal)))
 229       (when pos
 230         (loop for row in rows
 231             collect (nth pos row))))))
 232
 233 (defmethod database-set-sequence-position (sequence-name
 234                                            (position integer)
 235                                            (database odbc-database))
 236   (database-execute-command
 237    (format nil "UPDATE ~A SET last_value=~A,is_called='t'"
 238            (%sequence-name-to-table sequence-name)
 239            position)
 240    database)
 241   position)
 242
 243 (defmethod database-sequence-next (sequence-name (database odbc-database))
 244   (without-interrupts
 245    (let* ((table-name (%sequence-name-to-table sequence-name))
 246           (tuple
 247            (car (database-query
 248                  (concatenate 'string "SELECT last_value,is_called FROM "
 249                               table-name)
 250                  database
 251                  :auto))))
 252      (cond
 253        ((char-equal (schar (second tuple) 0) #\f)
 254         (database-execute-command
 255          (format nil "UPDATE ~A SET is_called='t'" table-name)
 256          database)
 257         (car tuple))
 258        (t
 259         (let ((new-pos (1+ (car tuple))))
 260          (database-execute-command
 261           (format nil "UPDATE ~A SET last_value=~D" table-name new-pos)
 262           database)
 263          new-pos))))))
 264
 265 (defmethod database-sequence-last (sequence-name (database odbc-database))
 266   (without-interrupts
 267    (caar (database-query
 268           (concatenate 'string "SELECT last_value FROM "
 269                        (%sequence-name-to-table sequence-name))
 270           database
 271           :auto))))
 272
 273 (defmethod database-create (connection-spec (type (eql :odbc)))
 274   (warn "Not implemented."))
 275
 276 (defmethod database-destroy (connection-spec (type (eql :odbc)))
 277   (warn "Not implemented."))
 278
 279 (defmethod database-probe (connection-spec (type (eql :odbc)))
 280   (when (find (car connection-spec) (database-list connection-spec type)
 281               :test #'string-equal)
 282     t))
 283
 284 (defmethod database-list (connection-spec (type (eql :odbc)))
 285   (declare (ignore connection-spec))
 286   (odbc-dbi:list-all-data-sources))
 287
 288 (defmethod database-list-indexes ((database odbc-database)
 289                                   &key (owner nil))
 290   (let ((result '()))
 291     (dolist (table (database-list-tables database :owner owner) result)
 292       (setq result
 293         (append (database-list-table-indexes table database :owner owner)
 294                 result)))))
 295
 296 (defmethod database-list-table-indexes (table (database odbc-database)
 297                                         &key (owner nil))
 298   (declare (ignore owner))
 299   (multiple-value-bind (rows col-names)
 300       (odbc-dbi:list-table-indexes
 301        (string-downcase table)
 302        :db (database-odbc-conn database))
 303     (declare (ignore col-names))
 304     ;; INDEX_NAME is hard-coded in sixth position by ODBC driver
 305     ;; FIXME: ??? is hard-coded in the fourth position
 306     (do ((results nil)
 307          (loop-rows rows (cdr loop-rows)))
 308         ((null loop-rows) (nreverse results))
 309       (let* ((row (car loop-rows))
 310              (col (nth 5 row))
 311              (type (nth 3 row)))
 312         (unless (or (find col results :test #'string-equal)
 313                     #+ignore (equal "0" type))
 314           (push col results))))))
 315
 316 (defmethod database-initialize-database-type ((database-type (eql :odbc)))
 317   ;; nothing to do
 318   t)
 319
 320 (when (clsql-base-sys:database-type-library-loaded :odbc)
 321   (clsql-base-sys:initialize-database-type :database-type :odbc))