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) result-types)
  81   (handler-case
  82       (odbc-dbi:sql query-expression :db (database-odbc-conn database)
  83                :types result-types)
  84     (error ()
  85       (error 'clsql-sql-error
  86              :database database
  87              :expression query-expression
  88              :errno nil
  89              :error "Query failed"))))
  90
  91 (defmethod database-execute-command (sql-expression
  92                                      (database odbc-database))
  93   (handler-case
  94       (odbc-dbi:sql sql-expression (database-odbc-conn database))
  95     (error ()
  96       (error 'clsql-sql-error
  97              :database database
  98              :expression sql-expression
  99              :errno nil
 100              :error "Execute command failed"))))
 101
 102 (defstruct odbc-result-set
 103   (query nil)
 104   (types nil :type cons)
 105   (full-set nil :type boolean))
 106
 107 (defmethod database-query-result-set ((query-expression string)
 108                                       (database odbc-database)
 109                                       &key full-set result-types)
 110   (handler-case
 111       (multiple-value-bind (query column-names)
 112           (odbc-dbi:sql query-expression
 113                    :db (database-odbc-conn database)
 114                    :row-count nil
 115                    :column-names t
 116                    :query t
 117                    :result-types result-types
 118                    )
 119         (values
 120          (make-odbc-result-set :query query :full-set full-set
 121                                 :types result-types)
 122          (length column-names)
 123          nil ;; not able to return number of rows with odbc
 124          ))
 125     (error ()
 126       (error 'clsql-sql-error
 127              :database database
 128              :expression query-expression
 129              :errno nil
 130              :error "Query result set failed"))))
 131
 132 (defmethod database-dump-result-set (result-set (database odbc-database))
 133   (odbc-dbi:close-query (odbc-result-set-query result-set))
 134   t)
 135
 136 (defmethod database-store-next-row (result-set
 137                                     (database odbc-database)
 138                                     list)
 139   (let ((row (odbc-dbi:fetch-row (odbc-result-set-query result-set) nil 'eof)))
 140     (if (eq row 'eof)
 141         nil
 142       (progn
 143         (loop for elem in row
 144             for rest on list
 145             do
 146               (setf (car rest) elem))
 147         list))))
 148
 149 ;;; Sequence functions
 150
 151 (defun %sequence-name-to-table (sequence-name)
 152   (concatenate 'string "_clsql_seq_" (sql-escape sequence-name)))
 153
 154 (defun %table-name-to-sequence-name (table-name)
 155   (and (>= (length table-name) 11)
 156        (string= (subseq table-name 0 11) "_clsql_seq_")
 157        (subseq table-name 11)))
 158
 159 (defmethod database-create-sequence (sequence-name
 160                                      (database odbc-database))
 161   (let ((table-name (%sequence-name-to-table sequence-name)))
 162     (database-execute-command
 163      (concatenate 'string "CREATE TABLE " table-name
 164                   " (id int NOT NULL PRIMARY KEY AUTO_INCREMENT)")
 165      database)
 166     (database-execute-command
 167      (concatenate 'string "INSERT INTO " table-name
 168                   " VALUES (0)")
 169      database)))
 170
 171 (defmethod database-drop-sequence (sequence-name
 172                                    (database odbc-database))
 173   (database-execute-command
 174    (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name))
 175    database))
 176
 177 (defmethod database-list-sequences ((database odbc-database)
 178                                     &key (owner nil))
 179   (declare (ignore owner))
 180   (mapcar #'(lambda (s) (%table-name-to-sequence-name (car s)))
 181           (database-query "SHOW TABLES LIKE '%clsql_seq%'"
 182                           database nil)))
 183
 184 (defmethod database-set-sequence-position (sequence-name
 185                                            (position integer)
 186                                            (database odbc-database))
 187   (database-execute-command
 188    (format nil "UPDATE ~A SET id=~A" (%sequence-name-to-table sequence-name)
 189            position)
 190    database)
 191   position)
 192
 193 (defmethod database-sequence-next (sequence-name (database odbc-database))
 194   (warn "Not implemented."))
 195
 196 (defmethod database-sequence-last (sequence-name (database odbc-database))
 197   (declare (ignore sequence-name)))
 198
 199 (defmethod database-create (connection-spec (type (eql :odbc)))
 200   (warn "Not implemented."))
 201
 202 (defmethod database-destroy (connection-spec (type (eql :odbc)))
 203   (warn "Not implemented."))
 204
 205 (defmethod database-probe (connection-spec (type (eql :odbc)))
 206   (warn "Not implemented."))
 207
 208 #+ignore
 209 (when (clsql-base-sys:database-type-library-loaded :odbc)
 210   (clsql-base-sys:initialize-database-type :database-type :odbc))