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