1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
6 ;;;; The CLSQL Functional Data Definition Language (FDDL)
7 ;;;; including functions for schema manipulation. Currently supported
8 ;;;; SQL objects include tables, views, indexes, attributes and
11 ;;;; This file is part of CLSQL.
13 ;;;; CLSQL users are granted the rights to distribute and use this software
14 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
15 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
16 ;;;; *************************************************************************
18 (in-package #:clsql-sys)
23 (defun database-identifier (name database)
24 (sql-escape (etypecase name
26 (convert-to-db-default-case name database))
28 (sql-output name database))
30 (sql-output name database)))))
35 (defun create-table (name description &key (database *default-database*)
36 (constraints nil) (transactions t))
37 "Creates a table called NAME, which may be a string, symbol or
38 SQL table identifier, in DATABASE which defaults to
39 *DEFAULT-DATABASE*. DESCRIPTION is a list whose elements are
40 lists containing the attribute names, types, and other
41 constraints such as not-null or primary-key for each column in
42 the table. CONSTRAINTS is a string representing an SQL table
43 constraint expression or a list of such strings. With MySQL
44 databases, if TRANSACTIONS is t an InnoDB table is created which
45 supports transactions."
46 (let* ((table-name (etypecase name
47 (symbol (sql-expression :attribute name))
48 (string (sql-expression :attribute (make-symbol name)))
50 (stmt (make-instance 'sql-create-table
53 :modifiers constraints
54 :transactions transactions)))
55 (execute-command stmt :database database)))
57 (defun drop-table (name &key (if-does-not-exist :error)
58 (database *default-database*))
59 "Drops the table called NAME from DATABASE which defaults to
60 *DEFAULT-DATABASE*. If the table does not exist and
61 IF-DOES-NOT-EXIST is :ignore then DROP-TABLE returns nil whereas
62 an error is signalled if IF-DOES-NOT-EXIST is :error."
63 (let ((table-name (database-identifier name database)))
64 (ecase if-does-not-exist
66 (unless (table-exists-p table-name :database database)
67 (return-from drop-table nil)))
71 ;; Fixme: move to clsql-oracle
72 (let ((expr (concatenate 'string "DROP TABLE " table-name)))
73 (when (and (find-package 'clsql-oracle)
74 (eq :oracle (database-type database))
75 (eql 9 (slot-value database
76 (intern (symbol-name '#:major-version-number)
77 (symbol-name '#:clsql-oracle)))))
78 (setq expr (concatenate 'string expr " PURGE")))
80 (execute-command expr :database database))))
82 (defun list-tables (&key (owner nil) (database *default-database*))
83 "Returns a list of strings representing table names in DATABASE
84 which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
85 which means that only tables owned by users are listed. If OWNER
86 is a string denoting a user name, only tables owned by OWNER are
87 listed. If OWNER is :all then all tables are listed."
88 (database-list-tables database :owner owner))
90 (defun table-exists-p (name &key (owner nil) (database *default-database*))
91 "Tests for the existence of an SQL table called NAME in DATABASE
92 which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
93 which means that only tables owned by users are examined. If
94 OWNER is a string denoting a user name, only tables owned by
95 OWNER are examined. If OWNER is :all then all tables are
97 (when (member (database-identifier name database)
98 (list-tables :owner owner :database database)
105 (defun create-view (name &key as column-list (with-check-option nil)
106 (database *default-database*))
107 "Creates a view called NAME in DATABASE which defaults to
108 *DEFAULT-DATABASE*. The view is created using the query AS and
109 the columns of the view may be specified using the COLUMN-LIST
110 parameter. The WITH-CHECK-OPTION is nil by default but if it has
111 a non-nil value, then all insert/update commands on the view are
112 checked to ensure that the new data satisfy the query AS."
113 (let* ((view-name (etypecase name
114 (symbol (sql-expression :attribute name))
115 (string (sql-expression :attribute (make-symbol name)))
117 (stmt (make-instance 'sql-create-view
119 :column-list column-list
121 :with-check-option with-check-option)))
122 (execute-command stmt :database database)))
124 (defun drop-view (name &key (if-does-not-exist :error)
125 (database *default-database*))
126 "Drops the view called NAME from DATABASE which defaults to
127 *DEFAULT-DATABASE*. If the view does not exist and
128 IF-DOES-NOT-EXIST is :ignore then DROP-VIEW returns nil whereas
129 an error is signalled if IF-DOES-NOT-EXIST is :error."
130 (let ((view-name (database-identifier name database)))
131 (ecase if-does-not-exist
133 (unless (view-exists-p view-name :database database)
134 (return-from drop-view)))
137 (let ((expr (concatenate 'string "DROP VIEW " view-name)))
138 (execute-command expr :database database))))
140 (defun list-views (&key (owner nil) (database *default-database*))
141 "Returns a list of strings representing view names in DATABASE
142 which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
143 which means that only views owned by users are listed. If OWNER
144 is a string denoting a user name, only views owned by OWNER are
145 listed. If OWNER is :all then all views are listed."
146 (database-list-views database :owner owner))
148 (defun view-exists-p (name &key (owner nil) (database *default-database*))
149 "Tests for the existence of an SQL view called NAME in DATABASE
150 which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
151 which means that only views owned by users are examined. If OWNER
152 is a string denoting a user name, only views owned by OWNER are
153 examined. If OWNER is :all then all views are examined."
154 (when (member (database-identifier name database)
155 (list-views :owner owner :database database)
156 :test #'string-equal)
162 (defun create-index (name &key on (unique nil) attributes
163 (database *default-database*))
164 "Creates an index called NAME on the table specified by ON in
165 DATABASE which default to *DEFAULT-DATABASE*. The table
166 attributes to use in constructing the index NAME are specified by
167 ATTRIBUTES. The UNIQUE argument is nil by default but if it has a
168 non-nil value then the indexed attributes must have unique
170 (let* ((index-name (database-identifier name database))
171 (table-name (database-identifier on database))
172 (attributes (mapcar #'(lambda (a) (database-identifier a database)) (listify attributes)))
173 (stmt (format nil "CREATE ~A INDEX ~A ON ~A (~{~A~^, ~})"
174 (if unique "UNIQUE" "")
175 index-name table-name attributes)))
176 (execute-command stmt :database database)))
178 (defun drop-index (name &key (if-does-not-exist :error)
180 (database *default-database*))
181 "Drops the index called NAME in DATABASE which defaults to
182 *DEFAULT-DATABASE*. If the index does not exist and
183 IF-DOES-NOT-EXIST is :ignore then DROP-INDEX returns nil whereas
184 an error is signalled if IF-DOES-NOT-EXIST is :error. The
185 argument ON allows the optional specification of a table to drop
187 (let ((index-name (database-identifier name database)))
188 (ecase if-does-not-exist
190 (unless (index-exists-p index-name :database database)
191 (return-from drop-index)))
193 (unless (db-type-use-column-on-drop-index?
194 (database-underlying-type database))
196 (execute-command (format nil "DROP INDEX ~A~A" index-name
198 (concatenate 'string " ON "
199 (database-identifier on database))))
200 :database database)))
202 (defun list-indexes (&key (owner nil) (database *default-database*))
203 "Returns a list of strings representing index names in DATABASE
204 which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
205 which means that only indexes owned by users are listed. If OWNER
206 is a string denoting a user name, only indexes owned by OWNER are
207 listed. If OWNER is :all then all indexes are listed."
208 (database-list-indexes database :owner owner))
210 (defun list-table-indexes (table &key (owner nil)
211 (database *default-database*))
212 "Returns a list of strings representing index names on the
213 table specified by TABLE in DATABASE which defaults to
214 *DEFAULT-DATABASE*. OWNER is nil by default which means that only
215 indexes owned by users are listed. If OWNER is a string denoting
216 a user name, only indexes owned by OWNER are listed. If OWNER
217 is :all then all indexes are listed."
218 (database-list-table-indexes (database-identifier table database)
219 database :owner owner))
221 (defun index-exists-p (name &key (owner nil) (database *default-database*))
222 "Tests for the existence of an SQL index called NAME in DATABASE
223 which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
224 which means that only indexes owned by users are examined. If
225 OWNER is a string denoting a user name, only indexes owned by
226 OWNER are examined. If OWNER is :all then all indexes are
228 (when (member (database-identifier name database)
229 (list-indexes :owner owner :database database)
230 :test #'string-equal)
235 (defvar *cache-table-queries-default* nil
236 "Specifies the default behaivour for caching of attribute
237 types. Meaningful values are t, nil and :flush as described for
238 the action argument to CACHE-TABLE-QUERIES.")
240 (defun cache-table-queries (table &key (action nil) (database *default-database*))
241 "Controls the caching of attribute type information on the
242 table specified by TABLE in DATABASE which defaults to
243 *DEFAULT-DATABASE*. ACTION specifies the caching behaviour to
244 adopt. If its value is t then attribute type information is
245 cached whereas if its value is nil then attribute type
246 information is not cached. If ACTION is :flush then all existing
247 type information in the cache for TABLE is removed, but caching
248 is still enabled. TABLE may be a string representing a table for
249 which the caching action is to be taken while the caching action
250 is applied to all tables if TABLE is t. Alternativly, when TABLE
251 is :default, the default caching action specified by
252 *CACHE-TABLE-QUERIES-DEFAULT* is applied to all table for which a
253 caching action has not been explicitly set."
254 (with-slots (attribute-cache) database
257 (multiple-value-bind (val found) (gethash table attribute-cache)
259 ((and found (eq action :flush))
260 (setf (gethash table attribute-cache) (list t nil)))
261 ((and found (eq action t))
262 (setf (gethash table attribute-cache) (list t (second val))))
263 ((and found (null action))
264 (setf (gethash table attribute-cache) (list nil nil)))
266 (setf (gethash table attribute-cache) (list action nil))))))
268 (maphash (lambda (k v)
271 (setf (gethash k attribute-cache) (list t nil)))
273 (setf (gethash k attribute-cache) (list nil nil)))
275 (setf (gethash k attribute-cache) (list t (second v))))))
278 (maphash (lambda (k v)
279 (when (eq (first v) :unspecified)
282 (setf (gethash k attribute-cache) (list t nil)))
284 (setf (gethash k attribute-cache) (list nil nil)))
286 (setf (gethash k attribute-cache) (list t (second v)))))))
291 (defun list-attributes (name &key (owner nil) (database *default-database*))
292 "Returns a list of strings representing the attributes of table
293 NAME in DATABASE which defaults to *DEFAULT-DATABASE*. OWNER is
294 nil by default which means that only attributes owned by users
295 are listed. If OWNER is a string denoting a user name, only
296 attributes owned by OWNER are listed. If OWNER is :all then all
297 attributes are listed."
298 (database-list-attributes (database-identifier name database) database
301 (defun attribute-type (attribute table &key (owner nil)
302 (database *default-database*))
303 "Returns a string representing the field type of the supplied
304 attribute ATTRIBUTE in the table specified by TABLE in DATABASE
305 which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
306 which means that the attribute specified by ATTRIBUTE, if it
307 exists, must be user owned else nil is returned. If OWNER is a
308 string denoting a user name, the attribute, if it exists, must be
309 owned by OWNER else nil is returned, whereas if OWNER is :all
310 then the attribute, if it exists, will be returned regardless of
312 (database-attribute-type (database-identifier attribute database)
313 (database-identifier table database)
317 (defun list-attribute-types (table &key (owner nil)
318 (database *default-database*))
319 "Returns a list containing information about the SQL types of
320 each of the attributes in the table specified by TABLE in
321 DATABASE which has a default value of *DEFAULT-DATABASE*. OWNER
322 is nil by default which means that only attributes owned by users
323 are listed. If OWNER is a string denoting a user name, only
324 attributes owned by OWNER are listed. If OWNER is :all then all
325 attributes are listed. The elements of the returned list are
326 lists where the first element is the name of the attribute, the
327 second element is its SQL type, the third is the type precision,
328 the fourth is the scale of the attribute and the fifth is 1 if
329 the attribute accepts null values and otherwise 0."
330 (with-slots (attribute-cache) database
331 (let ((table-ident (database-identifier table database)))
332 (multiple-value-bind (val found) (gethash table-ident attribute-cache)
333 (if (and found (second val))
335 (let ((types (mapcar #'(lambda (attribute)
338 (database-attribute-type
339 (database-identifier attribute
344 (list-attributes table :database database
347 ((and (not found) (eq t *cache-table-queries-default*))
348 (setf (gethash table-ident attribute-cache)
349 (list :unspecified types)))
350 ((and found (eq t (first val))
351 (setf (gethash table-ident attribute-cache)
358 (defun create-sequence (name &key (database *default-database*))
359 "Creates a sequence called NAME in DATABASE which defaults to
361 (let ((sequence-name (database-identifier name database)))
362 (database-create-sequence sequence-name database))
365 (defun drop-sequence (name &key (if-does-not-exist :error)
366 (database *default-database*))
367 "Drops the sequence called NAME from DATABASE which defaults to
368 *DEFAULT-DATABASE*. If the sequence does not exist and
369 IF-DOES-NOT-EXIST is :ignore then DROP-SEQUENCE returns nil
370 whereas an error is signalled if IF-DOES-NOT-EXIST is :error."
371 (let ((sequence-name (database-identifier name database)))
372 (ecase if-does-not-exist
374 (unless (sequence-exists-p sequence-name :database database)
375 (return-from drop-sequence)))
377 (database-drop-sequence sequence-name database))
380 (defun list-sequences (&key (owner nil) (database *default-database*))
381 "Returns a list of strings representing sequence names in
382 DATABASE which defaults to *DEFAULT-DATABASE*. OWNER is nil by
383 default which means that only sequences owned by users are
384 listed. If OWNER is a string denoting a user name, only sequences
385 owned by OWNER are listed. If OWNER is :all then all sequences
387 (database-list-sequences database :owner owner))
389 (defun sequence-exists-p (name &key (owner nil)
390 (database *default-database*))
391 "Tests for the existence of an SQL sequence called NAME in
392 DATABASE which defaults to *DEFAULT-DATABASE*. OWNER is nil by
393 default which means that only sequences owned by users are
394 examined. If OWNER is a string denoting a user name, only
395 sequences owned by OWNER are examined. If OWNER is :all then all
396 sequences are examined."
397 (when (member (database-identifier name database)
398 (list-sequences :owner owner :database database)
399 :test #'string-equal)
402 (defun sequence-next (name &key (database *default-database*))
403 "Return the next value in the sequence called NAME in DATABASE
404 which defaults to *DEFAULT-DATABASE*."
405 (database-sequence-next (database-identifier name database) database))
407 (defun set-sequence-position (name position &key (database *default-database*))
408 "Explicitly set the the position of the sequence called NAME in
409 DATABASE, which defaults to *DEFAULT-DATABSE*, to POSITION."
410 (database-set-sequence-position (database-identifier name database)
413 (defun sequence-last (name &key (database *default-database*))
414 "Return the last value of the sequence called NAME in DATABASE
415 which defaults to *DEFAULT-DATABASE*."
416 (database-sequence-last (database-identifier name database) database))