1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: aodbc-sql.cl
6 ;;;; Purpose: Low-level interface for CLSQL AODBC backend
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Feb 2002
12 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
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 ;;;; *************************************************************************
19 (in-package #:clsql-aodbc)
21 ;; interface foreign library loading routines
22 (defmethod clsql-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
27 (defmethod clsql-sys:database-type-load-foreign ((databae-type (eql :aodbc)))
30 (when (find-package :dbi)
31 (clsql-sys:database-type-load-foreign :aodbc))
36 (defclass aodbc-database (database)
37 ((aodbc-conn :accessor database-aodbc-conn :initarg :aodbc-conn)
38 (aodbc-db-type :accessor database-aodbc-db-type :initform :unknown)))
40 (defmethod database-name-from-spec (connection-spec
41 (database-type (eql :aodbc)))
42 (check-connection-spec connection-spec database-type (dsn user password))
43 (destructuring-bind (dsn user password) connection-spec
44 (declare (ignore password))
45 (concatenate 'string dsn "/" user)))
47 (defmethod database-connect (connection-spec (database-type (eql :aodbc)))
48 (check-connection-spec connection-spec database-type (dsn user password))
50 (destructuring-bind (dsn user password) connection-spec
52 (make-instance 'aodbc-database
53 :name (database-name-from-spec connection-spec :aodbc)
56 (dbi:connect :user user
58 :data-source-name dsn))
61 (error () ;; Init or Connect failed
62 (error 'sql-connection-error
63 :database-type database-type
64 :connection-spec connection-spec
65 :message "Connection failed")))))
67 (defmethod database-disconnect ((database aodbc-database))
69 (dbi:disconnect (database-aodbc-conn database))
70 (setf (database-aodbc-conn database) nil)
73 (defmethod database-query (query-expression (database aodbc-database) result-types field-names)
76 (dbi:sql query-expression :db (database-aodbc-conn database)
78 :column-names field-names)
82 (error 'sql-database-data-error
84 :expression query-expression
85 :message "Query failed."))))
87 (defmethod database-execute-command (sql-expression
88 (database aodbc-database))
91 (dbi:sql sql-expression :db (database-aodbc-conn database))
95 (error 'sql-database-data-error
97 :expression sql-expression
98 :error "Execute command failed."))))
100 (defstruct aodbc-result-set
102 (types nil :type cons)
103 (full-set nil :type boolean))
105 (defmethod database-query-result-set ((query-expression string)
106 (database aodbc-database)
107 &key full-set result-types)
110 (multiple-value-bind (query column-names)
111 (dbi:sql query-expression
112 :db (database-aodbc-conn database)
119 (make-aodbc-result-set :query query :full-set full-set
121 (length column-names)
122 nil ;; not able to return number of rows with aodbc
127 (error 'sql-database-data-error
129 :expression query-expression
130 :error "Query result set failed."))))
132 (defmethod database-dump-result-set (result-set (database aodbc-database))
134 (dbi:close-query (aodbc-result-set-query result-set))
137 (defmethod database-store-next-row (result-set
138 (database aodbc-database)
141 (let ((row (dbi:fetch-row (aodbc-result-set-query result-set) nil 'eof)))
145 (loop for elem in row
148 (setf (car rest) elem))
151 ;;; Sequence functions
153 (defun %sequence-name-to-table (sequence-name)
154 (concatenate 'string "_CLSQL_SEQ_" (sql-escape sequence-name)))
156 (defun %table-name-to-sequence-name (table-name)
157 (and (>= (length table-name) 11)
158 (string-equal (subseq table-name 0 11) "_CLSQL_SEQ_")
159 (subseq table-name 11)))
161 (defmethod database-create-sequence (sequence-name
162 (database aodbc-database))
163 (let ((table-name (%sequence-name-to-table sequence-name)))
164 (database-execute-command
165 (concatenate 'string "CREATE TABLE " table-name
166 " (last_value int NOT NULL PRIMARY KEY, increment_by int, min_value int, is_called char(1))")
168 (database-execute-command
169 (concatenate 'string "INSERT INTO " table-name
170 " VALUES (1,1,1,'f')")
173 (defmethod database-drop-sequence (sequence-name
174 (database aodbc-database))
175 (database-execute-command
176 (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name))
179 (defmethod database-list-sequences ((database aodbc-database)
181 (declare (ignore owner))
182 (warn "database-list-sequences not implemented for AODBC.")
185 (defmethod database-list-tables ((database aodbc-database)
187 (declare (ignore owner))
189 (multiple-value-bind (rows col-names)
190 (dbi:list-all-database-tables :db (database-aodbc-conn database))
191 (declare (ignore col-names))
192 ;; TABLE_SCHEM is hard-coded in second column by ODBC Driver Manager
193 ;; TABLE_NAME in third column, TABLE_TYPE in fourth column
194 (loop for row in rows
195 when (and (not (string-equal "information_schema" (nth 1 row)))
196 (string-equal "TABLE" (nth 3 row)))
197 collect (nth 2 row))))
199 (defmethod database-list-views ((database aodbc-database)
201 (declare (ignore owner))
203 (multiple-value-bind (rows col-names)
204 (dbi:list-all-database-tables :db (database-aodbc-conn database))
205 (declare (ignore col-names))
206 ;; TABLE_SCHEM is hard-coded in second column by ODBC Driver Manager
207 ;; TABLE_NAME in third column, TABLE_TYPE in fourth column
208 (loop for row in rows
209 when (and (not (string-equal "information_schema" (nth 1 row)))
210 (string-equal "VIEW" (nth 3 row)))
211 collect (nth 2 row))))
213 (defmethod database-list-attributes ((table string) (database aodbc-database)
215 (declare (ignore owner))
217 (multiple-value-bind (rows col-names)
218 (dbi:list-all-table-columns table :db (database-aodbc-conn database))
219 (let ((pos (position "COLUMN_NAME" col-names :test #'string-equal)))
221 (loop for row in rows
222 collect (nth pos row))))))
224 (defmethod database-attribute-type ((attribute string) (table string) (database aodbc-database)
226 (declare (ignore owner))
228 (multiple-value-bind (rows col-names)
229 (dbi:list-all-table-columns table :db (database-aodbc-conn database))
230 (let ((pos (position "TYPE_NAME" col-names :test #'string-equal)))
232 (loop for row in rows
233 collect (nth pos row))))))
235 (defmethod database-list-indexes ((database aodbc-database)
237 (warn "database-list-indexes not implemented for AODBC.")
240 (defmethod database-set-sequence-position (sequence-name
242 (database aodbc-database))
243 (database-execute-command
244 (format nil "UPDATE ~A SET last_value=~A,is_called='t'"
245 (%sequence-name-to-table sequence-name)
250 (defmethod database-sequence-next (sequence-name (database aodbc-database))
252 (let* ((table-name (%sequence-name-to-table sequence-name))
255 (concatenate 'string "SELECT last_value,is_called FROM "
257 database :auto nil))))
259 ((char-equal (schar (second tuple) 0) #\f)
260 (database-execute-command
261 (format nil "UPDATE ~A SET is_called='t'" table-name)
265 (let ((new-pos (1+ (car tuple))))
266 (database-execute-command
267 (format nil "UPDATE ~A SET last_value=~D" table-name new-pos)
271 (defmethod database-sequence-last (sequence-name (database aodbc-database))
273 (caar (database-query
274 (concatenate 'string "SELECT last_value FROM "
275 (%sequence-name-to-table sequence-name))
276 database :auto nil))))
278 (defmethod database-create (connection-spec (type (eql :aodbc)))
279 (warn "Not implemented."))
281 (defmethod database-destroy (connection-spec (type (eql :aodbc)))
282 (warn "Not implemented."))
284 (defmethod database-probe (connection-spec (type (eql :aodbc)))
285 (warn "Not implemented."))
287 ;;; Backend capabilities
289 (defmethod database-underlying-type ((database aodbc-database))
290 (database-aodbc-db-type database))
292 (defmethod db-backend-has-create/destroy-db? ((db-type (eql :aodbc)))
295 (defmethod database-initialize-database-type ((database-type (eql :aodbc)))
298 (when (clsql-sys:database-type-library-loaded :aodbc)
299 (clsql-sys:initialize-database-type :database-type :aodbc))