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     (error ()   ;; Init or Connect failed
  56       (error 'clsql-connect-error
  57              :database-type database-type
  58              :connection-spec connection-spec
  59              :errno nil
  60              :error "Connection failed")))))
  61
  62 (defun store-type-of-connected-database (db)
  63   (let* ((odbc-conn (database-odbc-conn db))
  64          (server-name (odbc-dbi::get-odbc-info odbc-conn odbc::$SQL_SERVER_NAME))
  65          (dbms-name (odbc-dbi::get-odbc-info odbc-conn odbc::$SQL_DBMS_NAME))
  66          (type
  67           ;; need SERVER-NAME and DBMS-NAME because many drivers mix this up
  68           (cond
  69            ((or (search "postgresql" server-name :test #'char-equal)
  70                 (search "postgresql" dbms-name :test #'char-equal))
  71             :postgresql)
  72            ((or (search "mysql" server-name :test #'char-equal)
  73                 (search "mysql" dbms-name :test #'char-equal))
  74             :mysql)
  75            ((or (search "oracle" server-name :test #'char-equal)
  76                 (search "oracle" dbms-name :test #'char-equal))
  77             :oracle))))
  78     (setf (database-odbc-db-type db) type)))
  79
  80 (defmethod database-disconnect ((database odbc-database))
  81   (odbc-dbi:disconnect (database-odbc-conn database))
  82   (setf (database-odbc-conn database) nil)
  83   t)
  84
  85 (defmethod database-query (query-expression (database odbc-database)
  86                            result-types)
  87   (handler-case
  88       (odbc-dbi:sql query-expression :db (database-odbc-conn database)
  89                     :result-types result-types)
  90     (clsql-error (e)
  91       (error e))
  92     #+ignore
  93     (error ()
  94       (error 'clsql-sql-error
  95              :database database
  96              :expression query-expression
  97              :errno nil
  98              :error "Query failed"))))
  99
 100 (defmethod database-execute-command (sql-expression
 101                                      (database odbc-database))
 102   (handler-case
 103       (odbc-dbi:sql sql-expression :db (database-odbc-conn database))
 104     (clsql-error (e)
 105       (error e))
 106     (error ()
 107       (error 'clsql-sql-error
 108              :database database
 109              :expression sql-expression
 110              :errno nil
 111              :error "Execute command failed"))))
 112
 113 (defstruct odbc-result-set
 114   (query nil)
 115   (types nil)
 116   (full-set nil :type boolean))
 117
 118 (defmethod database-query-result-set ((query-expression string)
 119                                       (database odbc-database)
 120                                       &key full-set result-types)
 121   (handler-case
 122       (multiple-value-bind (query column-names)
 123           (odbc-dbi:sql query-expression
 124                    :db (database-odbc-conn database)
 125                    :row-count nil
 126                    :column-names t
 127                    :query t
 128                    :result-types result-types)
 129         (values
 130          (make-odbc-result-set :query query :full-set full-set
 131                                 :types result-types)
 132          (length column-names)
 133          nil ;; not able to return number of rows with odbc
 134          ))
 135     (error ()
 136       (error 'clsql-sql-error
 137              :database database
 138              :expression query-expression
 139              :errno nil
 140              :error "Query result set failed"))))
 141
 142 (defmethod database-dump-result-set (result-set (database odbc-database))
 143   (odbc-dbi:close-query (odbc-result-set-query result-set))
 144   t)
 145
 146 (defmethod database-store-next-row (result-set
 147                                     (database odbc-database)
 148                                     list)
 149   (let ((row (odbc-dbi:fetch-row (odbc-result-set-query result-set) nil 'eof)))
 150     (if (eq row 'eof)
 151         nil
 152       (progn
 153         (loop for elem in row
 154             for rest on list
 155             do
 156               (setf (car rest) elem))
 157         list))))
 158
 159 ;;; Sequence functions
 160
 161 (defun %sequence-name-to-table (sequence-name)
 162   (concatenate 'string "_clsql_seq_" (sql-escape sequence-name)))
 163
 164 (defun %table-name-to-sequence-name (table-name)
 165   (and (>= (length table-name) 11)
 166        (string= (subseq table-name 0 11) "_clsql_seq_")
 167        (subseq table-name 11)))
 168
 169 (defmethod database-create-sequence (sequence-name
 170                                      (database odbc-database))
 171   (let ((table-name (%sequence-name-to-table sequence-name)))
 172     (database-execute-command
 173      (concatenate 'string "CREATE TABLE " table-name
 174                   " (last_value int NOT NULL PRIMARY KEY, increment_by int, min_value int, is_called char(1))")
 175      database)
 176     (database-execute-command
 177      (concatenate 'string "INSERT INTO " table-name
 178                   " VALUES (1,1,1,'f')")
 179      database)))
 180
 181 (defmethod database-drop-sequence (sequence-name
 182                                    (database odbc-database))
 183   (database-execute-command
 184    (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name))
 185    database))
 186
 187 (defmethod database-list-sequences ((database odbc-database)
 188                                     &key (owner nil))
 189   (declare (ignore owner))
 190   (mapcar #'(lambda (s) (%table-name-to-sequence-name (car s)))
 191           (database-query "SHOW TABLES LIKE '%clsql_seq%'"
 192                           database nil)))
 193
 194 (defmethod database-list-tables ((database odbc-database)
 195                                  &key (owner nil))
 196   (declare (ignore owner))
 197     (multiple-value-bind (rows col-names)
 198       (odbc-dbi:list-all-database-tables :db (database-odbc-conn database))
 199     (let ((pos (position "TABLE_NAME" col-names :test #'string-equal)))
 200       (when pos
 201         (loop for row in rows
 202             collect (nth pos row))))))
 203
 204 (defmethod database-list-attributes ((table string) (database odbc-database)
 205                                      &key (owner nil))
 206   (declare (ignore owner))
 207   (multiple-value-bind (rows col-names)
 208       (odbc-dbi:list-all-table-columns table :db (database-odbc-conn database))
 209     (let ((pos (position "COLUMN_NAME" col-names :test #'string-equal)))
 210       (when pos
 211         (loop for row in rows
 212             collect (nth pos row))))))
 213
 214 (defmethod database-attribute-type ((attribute string) (table string) (database odbc-database)
 215                                      &key (owner nil))
 216   (declare (ignore owner))
 217   (multiple-value-bind (rows col-names)
 218       (odbc-dbi:list-all-table-columns table :db (database-odbc-conn database))
 219     (let ((pos (position "TYPE_NAME" col-names :test #'string-equal)))
 220       (when pos
 221         (loop for row in rows
 222             collect (nth pos row))))))
 223
 224 (defmethod database-set-sequence-position (sequence-name
 225                                            (position integer)
 226                                            (database odbc-database))
 227   (database-execute-command
 228    (format nil "UPDATE ~A SET last_value=~A,is_called='t'"
 229            (%sequence-name-to-table sequence-name)
 230            position)
 231    database)
 232   position)
 233
 234 (defmethod database-sequence-next (sequence-name (database odbc-database))
 235   (without-interrupts
 236    (let* ((table-name (%sequence-name-to-table sequence-name))
 237           (tuple
 238            (car (database-query
 239                  (concatenate 'string "SELECT last_value,is_called FROM "
 240                               table-name)
 241                  database
 242                  :auto))))
 243      (cond
 244        ((char-equal (schar (second tuple) 0) #\f)
 245         (database-execute-command
 246          (format nil "UPDATE ~A SET is_called='t'" table-name)
 247          database)
 248         (car tuple))
 249        (t
 250         (let ((new-pos (1+ (car tuple))))
 251          (database-execute-command
 252           (format nil "UPDATE ~A SET last_value=~D" table-name new-pos)
 253           database)
 254          new-pos))))))
 255
 256 (defmethod database-sequence-last (sequence-name (database odbc-database))
 257   (without-interrupts
 258    (caar (database-query
 259           (concatenate 'string "SELECT last_value FROM "
 260                        (%sequence-name-to-table sequence-name))
 261           database
 262           :auto))))
 263
 264 (defmethod database-create (connection-spec (type (eql :odbc)))
 265   (warn "Not implemented."))
 266
 267 (defmethod database-destroy (connection-spec (type (eql :odbc)))
 268   (warn "Not implemented."))
 269
 270 (defmethod database-probe (connection-spec (type (eql :odbc)))
 271   (warn "Not implemented."))
 272
 273 #+ignore
 274 (when (clsql-base-sys:database-type-library-loaded :odbc)
 275   (clsql-base-sys:initialize-database-type :database-type :odbc))