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     (let ((pos (position "TABLE_NAME" col-names :test #'string-equal)))
 198       (when pos
 199         (loop for row in rows
 200             collect (nth pos row))))))
 201
 202
 203 (defmethod database-list-attributes ((table string) (database aodbc-database)
 204                                      &key (owner nil))
 205   (declare (ignore owner))
 206   #+aodbc-v2
 207   (multiple-value-bind (rows col-names)
 208       (dbi:list-all-table-columns table :db (database-aodbc-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 aodbc-database)
 215                                      &key (owner nil))
 216   (declare (ignore owner))
 217   #+aodbc-v2
 218   (multiple-value-bind (rows col-names)
 219       (dbi:list-all-table-columns table :db (database-aodbc-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 aodbc-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 aodbc-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 aodbc-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 :aodbc)))
 266   (warn "Not implemented."))
 267
 268 (defmethod database-destroy (connection-spec (type (eql :aodbc)))
 269   (warn "Not implemented."))
 270
 271 (defmethod database-probe (connection-spec (type (eql :aodbc)))
 272   (warn "Not implemented."))
 273
 274 #+ignore
 275 (when (clsql-base-sys:database-type-library-loaded :aodbc)
 276   (clsql-base-sys:initialize-database-type :database-type :aodbc))