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