1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Low-level interface for CLSQL ODBC backend
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Feb 2002
10 ;;;; $Id: odbc-sql.lisp 8983 2004-04-12 21:16:48Z kevin $
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 (defpackage #:clsql-odbc
20 (:use #:common-lisp #:clsql-base-sys)
21 (:export #:odbc-database)
22 (:documentation "This is the CLSQL interface to ODBC."))
24 (in-package #:clsql-odbc)
28 (defclass odbc-database (database)
29 ((odbc-conn :accessor database-odbc-conn :initarg :odbc-conn)))
31 (defmethod database-name-from-spec (connection-spec
32 (database-type (eql :odbc)))
33 (check-connection-spec connection-spec database-type (dsn user password))
34 (destructuring-bind (dsn user password) connection-spec
35 (declare (ignore password))
36 (concatenate 'string dsn "/" user)))
38 (defmethod database-connect (connection-spec (database-type (eql :odbc)))
39 (check-connection-spec connection-spec database-type (dsn user password))
40 (destructuring-bind (dsn user password) connection-spec
42 (make-instance 'odbc-database
43 :name (database-name-from-spec connection-spec :odbc)
45 (odbc-dbi:connect :user user
47 :data-source-name dsn))
48 (error () ;; Init or Connect failed
49 (error 'clsql-connect-error
50 :database-type database-type
51 :connection-spec connection-spec
53 :error "Connection failed")))))
55 (defmethod database-disconnect ((database odbc-database))
56 (odbc-dbi:disconnect (database-odbc-conn database))
57 (setf (database-odbc-conn database) nil)
60 (defmethod database-query (query-expression (database odbc-database) result-types)
62 (odbc-dbi:sql query-expression :db (database-odbc-conn database)
65 (error 'clsql-sql-error
67 :expression query-expression
69 :error "Query failed"))))
71 (defmethod database-execute-command (sql-expression
72 (database odbc-database))
74 (odbc-dbi:sql sql-expression (database-odbc-conn database))
76 (error 'clsql-sql-error
78 :expression sql-expression
80 :error "Execute command failed"))))
82 (defstruct odbc-result-set
84 (types nil :type cons)
85 (full-set nil :type boolean))
87 (defmethod database-query-result-set ((query-expression string)
88 (database odbc-database)
89 &key full-set result-types)
91 (multiple-value-bind (query column-names)
92 (odbc-dbi:sql query-expression
93 :db (database-odbc-conn database)
97 :result-types result-types
100 (make-odbc-result-set :query query :full-set full-set
102 (length column-names)
103 nil ;; not able to return number of rows with odbc
106 (error 'clsql-sql-error
108 :expression query-expression
110 :error "Query result set failed"))))
112 (defmethod database-dump-result-set (result-set (database odbc-database))
113 (odbc-dbi:close-query (odbc-result-set-query result-set))
116 (defmethod database-store-next-row (result-set
117 (database odbc-database)
119 (let ((row (odbc-dbi:fetch-row (odbc-result-set-query result-set) nil 'eof)))
123 (loop for elem in row
126 (setf (car rest) elem))
129 ;;; Sequence functions
131 (defun %sequence-name-to-table (sequence-name)
132 (concatenate 'string "_clsql_seq_" (sql-escape sequence-name)))
134 (defun %table-name-to-sequence-name (table-name)
135 (and (>= (length table-name) 11)
136 (string= (subseq table-name 0 11) "_clsql_seq_")
137 (subseq table-name 11)))
139 (defmethod database-create-sequence (sequence-name
140 (database odbc-database))
141 (let ((table-name (%sequence-name-to-table sequence-name)))
142 (database-execute-command
143 (concatenate 'string "CREATE TABLE " table-name
144 " (id int NOT NULL PRIMARY KEY AUTO_INCREMENT)")
146 (database-execute-command
147 (concatenate 'string "INSERT INTO " table-name
151 (defmethod database-drop-sequence (sequence-name
152 (database odbc-database))
153 (database-execute-command
154 (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name))
157 (defmethod database-list-sequences ((database odbc-database)
159 (declare (ignore owner))
160 (mapcar #'(lambda (s) (%table-name-to-sequence-name (car s)))
161 (database-query "SHOW TABLES LIKE '%clsql_seq%'"
164 (defmethod database-set-sequence-position (sequence-name
166 (database odbc-database))
167 (database-execute-command
168 (format nil "UPDATE ~A SET id=~A" (%sequence-name-to-table sequence-name)
173 (defmethod database-sequence-next (sequence-name (database odbc-database))
174 (warn "Not implemented."))
176 (defmethod database-sequence-last (sequence-name (database odbc-database))
177 (declare (ignore sequence-name)))
179 (defmethod database-create (connection-spec (type (eql :odbc)))
180 (warn "Not implemented."))
182 (defmethod database-destroy (connection-spec (type (eql :odbc)))
183 (warn "Not implemented."))
185 (defmethod database-probe (connection-spec (type (eql :odbc)))
186 (warn "Not implemented."))
189 (when (clsql-base-sys:database-type-library-loaded :odbc)
190 (clsql-base-sys:initialize-database-type :database-type :odbc))