db-aodbc/aodbc-sql.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          aodbc-sql.cl
   6 ;;;; Purpose:       Low-level interface for CLSQL AODBC backend
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Feb 2002
   9 ;;;;
  10 ;;;; $Id$
  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 (in-package #:clsql-aodbc)
  20
  21 ;; interface foreign library loading routines
  22 (defmethod clsql-base-sys:database-type-library-loaded ((database-type (eql :aodbc)))
  23   "T if foreign library was able to be loaded successfully. "
  24   (when (find-package :dbi) ;; finds Allegro's DBI (AODBC) package
  25     t))
  26
  27 (defmethod clsql-base-sys:database-type-load-foreign ((databae-type (eql :aodbc)))
  28   t)
  29
  30 (when (find-package :dbi)
  31   (clsql-base-sys:database-type-load-foreign :aodbc))
  32
  33 (defmethod database-initialize-database-type ((database-type (eql :aodbc)))
  34   t)
  35
  36
  37 ;; AODBC interface
  38
  39 (defclass aodbc-database (database)
  40   ((aodbc-conn :accessor database-aodbc-conn :initarg :aodbc-conn)))
  41
  42 (defmethod database-name-from-spec (connection-spec
  43                                     (database-type (eql :aodbc)))
  44   (check-connection-spec connection-spec database-type (dsn user password))
  45   (destructuring-bind (dsn user password) connection-spec
  46     (declare (ignore password))
  47     (concatenate 'string dsn "/" user)))
  48
  49 (defmethod database-connect (connection-spec (database-type (eql :aodbc)))
  50   (check-connection-spec connection-spec database-type (dsn user password))
  51   #+aodbc-v2
  52   (destructuring-bind (dsn user password) connection-spec
  53     (handler-case
  54         (make-instance 'aodbc-database
  55           :name (database-name-from-spec connection-spec :aodbc)
  56           :database-type :aodbc
  57           :aodbc-conn
  58           (dbi:connect :user user
  59                        :password password
  60                        :data-source-name dsn))
  61       (clsql-error (e)
  62         (error e))
  63       (error ()         ;; Init or Connect failed
  64         (error 'clsql-connect-error
  65                :database-type database-type
  66                :connection-spec connection-spec
  67                :errno nil
  68                :error "Connection failed")))))
  69
  70 (defmethod database-disconnect ((database aodbc-database))
  71   #+aodbc-v2
  72   (dbi:disconnect (database-aodbc-conn database))
  73   (setf (database-aodbc-conn database) nil)
  74   t)
  75
  76 (defmethod database-query (query-expression (database aodbc-database) result-types)
  77   #+aodbc-v2
  78   (handler-case
  79       (dbi:sql query-expression :db (database-aodbc-conn database)
  80                :types result-types)
  81       (clsql-error (e)
  82         (error e))
  83     (error ()
  84       (error 'clsql-sql-error
  85              :database database
  86              :expression query-expression
  87              :errno nil
  88              :error "Query failed"))))
  89
  90 (defmethod database-execute-command (sql-expression
  91                                      (database aodbc-database))
  92   #+aodbc-v2
  93   (handler-case
  94       (dbi:sql sql-expression :db (database-aodbc-conn database))
  95       (clsql-error (e)
  96         (error e))
  97     (error ()
  98       (error 'clsql-sql-error
  99              :database database
 100              :expression sql-expression
 101              :errno nil
 102              :error "Execute command failed"))))
 103
 104 (defstruct aodbc-result-set
 105   (query nil)
 106   (types nil :type cons)
 107   (full-set nil :type boolean))
 108
 109 (defmethod database-query-result-set ((query-expression string)
 110                                       (database aodbc-database)
 111                                       &key full-set result-types)
 112   #+aodbc-v2
 113   (handler-case
 114       (multiple-value-bind (query column-names)
 115           (dbi:sql query-expression
 116                    :db (database-aodbc-conn database)
 117                    :row-count nil
 118                    :column-names t
 119                    :query t
 120                    :types result-types
 121                    )
 122         (values
 123          (make-aodbc-result-set :query query :full-set full-set
 124                                 :types result-types)
 125          (length column-names)
 126          nil ;; not able to return number of rows with aodbc
 127          ))
 128       (clsql-error (e)
 129         (error e))
 130     (error ()
 131       (error 'clsql-sql-error
 132              :database database
 133              :expression query-expression
 134              :errno nil
 135              :error "Query result set failed"))))
 136
 137 (defmethod database-dump-result-set (result-set (database aodbc-database))
 138   #+aodbc-v2
 139   (dbi:close-query (aodbc-result-set-query result-set))
 140   t)
 141
 142 (defmethod database-store-next-row (result-set
 143                                     (database aodbc-database)
 144                                     list)
 145   #+aodbc-v2
 146   (let ((row (dbi:fetch-row (aodbc-result-set-query result-set) nil 'eof)))
 147     (if (eq row 'eof)
 148         nil
 149       (progn
 150         (loop for elem in row
 151             for rest on list
 152             do
 153               (setf (car rest) elem))
 154         list))))
 155
 156 ;;; Sequence functions
 157
 158 (defun %sequence-name-to-table (sequence-name)
 159   (concatenate 'string "_clsql_seq_" (sql-escape sequence-name)))
 160
 161 (defun %table-name-to-sequence-name (table-name)
 162   (and (>= (length table-name) 11)
 163        (string= (subseq table-name 0 11) "_clsql_seq_")
 164        (subseq table-name 11)))
 165
 166 (defmethod database-create-sequence (sequence-name
 167                                      (database aodbc-database))
 168   (let ((table-name (%sequence-name-to-table sequence-name)))
 169     (database-execute-command
 170      (concatenate 'string "CREATE TABLE " table-name
 171                   " (last_value int NOT NULL PRIMARY KEY, increment_by int, min_value int, is_called char(1))")
 172      database)
 173     (database-execute-command
 174      (concatenate 'string "INSERT INTO " table-name
 175                   " VALUES (1,1,1,'f')")
 176      database)))
 177
 178 (defmethod database-drop-sequence (sequence-name
 179                                    (database aodbc-database))
 180   (database-execute-command
 181    (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name))
 182    database))
 183
 184 (defmethod database-list-sequences ((database aodbc-database)
 185                                     &key (owner nil))
 186   (declare (ignore owner))
 187   (mapcar #'(lambda (s) (%table-name-to-sequence-name (car s)))
 188           (database-query "SHOW TABLES LIKE '%clsql_seq%'"
 189                           database nil)))
 190
 191 (defmethod database-list-tables ((database aodbc-database)
 192                                  &key (owner nil))
 193   (declare (ignore owner))
 194   #+aodbc-v2
 195   (multiple-value-bind (rows col-names)
 196       (dbi:list-all-database-tables :db (database-aodbc-conn database))
 197     (declare (ignore col-names))
 198       ;; TABLE_SCHEM is hard-coded in second column by ODBC Driver Manager
 199       ;; TABLE_NAME in third column, TABLE_TYPE in fourth column
 200       (loop for row in rows
 201           when (and (not (string-equal "information_schema" (nth 1 row)))
 202                     (string-equal "TABLE" (nth 3 row)))
 203           collect (nth 2 row))))
 204
 205 (defmethod database-list-attributes ((table string) (database aodbc-database)
 206                                      &key (owner nil))
 207   (declare (ignore owner))
 208   #+aodbc-v2
 209   (multiple-value-bind (rows col-names)
 210       (dbi:list-all-table-columns table :db (database-aodbc-conn database))
 211     (let ((pos (position "COLUMN_NAME" col-names :test #'string-equal)))
 212       (when pos
 213         (loop for row in rows
 214             collect (nth pos row))))))
 215
 216 (defmethod database-attribute-type ((attribute string) (table string) (database aodbc-database)
 217                                      &key (owner nil))
 218   (declare (ignore owner))
 219   #+aodbc-v2
 220   (multiple-value-bind (rows col-names)
 221       (dbi:list-all-table-columns table :db (database-aodbc-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 aodbc-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 aodbc-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 aodbc-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 :aodbc)))
 268   (warn "Not implemented."))
 269
 270 (defmethod database-destroy (connection-spec (type (eql :aodbc)))
 271   (warn "Not implemented."))
 272
 273 (defmethod database-probe (connection-spec (type (eql :aodbc)))
 274   (warn "Not implemented."))
 275
 276 #+ignore
 277 (when (clsql-base-sys:database-type-library-loaded :aodbc)
 278   (clsql-base-sys:initialize-database-type :database-type :aodbc))