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