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
  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         (make-instance 'odbc-database
  43           :name (database-name-from-spec connection-spec :odbc)
  44           :odbc-conn
  45           (odbc-dbi:connect :user user
  46                         :password password
  47                         :data-source-name dsn))
  48       (error ()         ;; Init or Connect failed
  49         (error 'clsql-connect-error
  50                :database-type database-type
  51                :connection-spec connection-spec
  52                :errno nil
  53                :error "Connection failed")))))
  54
  55 #+nil
  56 (defun store-type-of-connected-database (db)
  57   (let* ((odbc-db (odbc-db db))
  58          (server-name (get-odbc-info odbc-db odbc::$SQL_SERVER_NAME))
  59          (dbms-name (get-odbc-info odbc-db odbc::$SQL_DBMS_NAME))
  60          (type
  61           ;; need SERVER-NAME and DBMS-NAME because many drivers mix this up
  62           (cond
  63            ((or (search "postgresql" server-name :test #'char-equal)
  64                 (search "postgresql" dbms-name :test #'char-equal))
  65             :postgresql)
  66            ((or (search "mysql" server-name :test #'char-equal)
  67                 (search "mysql" dbms-name :test #'char-equal))
  68             :mysql)
  69            ((or (search "oracle" server-name :test #'char-equal)
  70                 (search "oracle" dbms-name :test #'char-equal))
  71             :oracle))))
  72     (setf (database-type db) type)))
  73
  74
  75 (defmethod database-disconnect ((database odbc-database))
  76   (odbc-dbi:disconnect (database-odbc-conn database))
  77   (setf (database-odbc-conn database) nil)
  78   t)
  79
  80 (defmethod database-query (query-expression (database odbc-database)
  81                            result-types)
  82   (handler-case
  83       (odbc-dbi:sql query-expression :db (database-odbc-conn database)
  84                     :query t :result-types result-types)
  85     (error ()
  86       (error 'clsql-sql-error
  87              :database database
  88              :expression query-expression
  89              :errno nil
  90              :error "Query failed"))))
  91
  92 (defmethod database-execute-command (sql-expression
  93                                      (database odbc-database))
  94   (handler-case
  95       (odbc-dbi:sql sql-expression (database-odbc-conn database))
  96     (error ()
  97       (error 'clsql-sql-error
  98              :database database
  99              :expression sql-expression
 100              :errno nil
 101              :error "Execute command failed"))))
 102
 103 (defstruct odbc-result-set
 104   (query nil)
 105   (types nil :type cons)
 106   (full-set nil :type boolean))
 107
 108 (defmethod database-query-result-set ((query-expression string)
 109                                       (database odbc-database)
 110                                       &key full-set result-types)
 111   (handler-case
 112       (multiple-value-bind (query column-names)
 113           (odbc-dbi:sql query-expression
 114                    :db (database-odbc-conn database)
 115                    :row-count nil
 116                    :column-names t
 117                    :query t
 118                    :result-types result-types
 119                    )
 120         (values
 121          (make-odbc-result-set :query query :full-set full-set
 122                                 :types result-types)
 123          (length column-names)
 124          nil ;; not able to return number of rows with odbc
 125          ))
 126     (error ()
 127       (error 'clsql-sql-error
 128              :database database
 129              :expression query-expression
 130              :errno nil
 131              :error "Query result set failed"))))
 132
 133 (defmethod database-dump-result-set (result-set (database odbc-database))
 134   (odbc-dbi:close-query (odbc-result-set-query result-set))
 135   t)
 136
 137 (defmethod database-store-next-row (result-set
 138                                     (database odbc-database)
 139                                     list)
 140   (let ((row (odbc-dbi:fetch-row (odbc-result-set-query result-set) nil 'eof)))
 141     (if (eq row 'eof)
 142         nil
 143       (progn
 144         (loop for elem in row
 145             for rest on list
 146             do
 147               (setf (car rest) elem))
 148         list))))
 149
 150 ;;; Sequence functions
 151
 152 (defun %sequence-name-to-table (sequence-name)
 153   (concatenate 'string "_clsql_seq_" (sql-escape sequence-name)))
 154
 155 (defun %table-name-to-sequence-name (table-name)
 156   (and (>= (length table-name) 11)
 157        (string= (subseq table-name 0 11) "_clsql_seq_")
 158        (subseq table-name 11)))
 159
 160 (defmethod database-create-sequence (sequence-name
 161                                      (database odbc-database))
 162   (let ((table-name (%sequence-name-to-table sequence-name)))
 163     (database-execute-command
 164      (concatenate 'string "CREATE TABLE " table-name
 165                   " (id int NOT NULL PRIMARY KEY AUTO_INCREMENT)")
 166      database)
 167     (database-execute-command
 168      (concatenate 'string "INSERT INTO " table-name
 169                   " VALUES (0)")
 170      database)))
 171
 172 (defmethod database-drop-sequence (sequence-name
 173                                    (database odbc-database))
 174   (database-execute-command
 175    (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name))
 176    database))
 177
 178 (defmethod database-list-sequences ((database odbc-database)
 179                                     &key (owner nil))
 180   (declare (ignore owner))
 181   (mapcar #'(lambda (s) (%table-name-to-sequence-name (car s)))
 182           (database-query "SHOW TABLES LIKE '%clsql_seq%'"
 183                           database nil)))
 184
 185 (defmethod database-set-sequence-position (sequence-name
 186                                            (position integer)
 187                                            (database odbc-database))
 188   (database-execute-command
 189    (format nil "UPDATE ~A SET id=~A" (%sequence-name-to-table sequence-name)
 190            position)
 191    database)
 192   position)
 193
 194 (defmethod database-sequence-next (sequence-name (database odbc-database))
 195   (warn "Not implemented."))
 196
 197 (defmethod database-sequence-last (sequence-name (database odbc-database))
 198   (declare (ignore sequence-name)))
 199
 200 (defmethod database-create (connection-spec (type (eql :odbc)))
 201   (warn "Not implemented."))
 202
 203 (defmethod database-destroy (connection-spec (type (eql :odbc)))
 204   (warn "Not implemented."))
 205
 206 (defmethod database-probe (connection-spec (type (eql :odbc)))
 207   (warn "Not implemented."))
 208
 209 #+ignore
 210 (when (clsql-base-sys:database-type-library-loaded :odbc)
 211   (clsql-base-sys:initialize-database-type :database-type :odbc))