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 "Create a table called NAME, in DATABASE which defaults to
38 *DEFAULT-DATABASE*, containing the attributes in DESCRIPTION which is
39 a list containing lists of attribute-name and type information pairs."
40 (let* ((table-name (etypecase name
41 (symbol (sql-expression :attribute name))
42 (string (sql-expression :attribute (make-symbol name)))
44 (stmt (make-instance 'sql-create-table
47 :modifiers constraints
48 :transactions transactions)))
49 (execute-command stmt :database database)))
51 (defun drop-table (name &key (if-does-not-exist :error)
52 (database *default-database*))
53 "Drops table NAME from DATABASE which defaults to
54 *DEFAULT-DATABASE*. If the table does not exist and IF-DOES-NOT-EXIST
55 is :ignore then DROP-TABLE returns nil whereas an error is signalled
56 if IF-DOES-NOT-EXIST is :error."
57 (let ((table-name (database-identifier name database)))
58 (ecase if-does-not-exist
60 (unless (table-exists-p table-name :database database)
61 (return-from drop-table nil)))
64 (let ((expr (concatenate 'string "DROP TABLE " table-name
65 (if (eq :oracle (database-type database))
68 (execute-command expr :database database))))
70 (defun list-tables (&key (owner nil) (database *default-database*))
71 "List all tables in DATABASE which defaults to
72 *DEFAULT-DATABASE*. If OWNER is nil, only user-owned tables are
73 considered. This is the default. If OWNER is :all , all tables are
74 considered. If OWNER is a string, this denotes a username and only
75 tables owned by OWNER are considered. Table names are returned as a
77 (database-list-tables database :owner owner))
79 (defun table-exists-p (name &key (owner nil) (database *default-database*))
80 "Test for existence of an SQL table called NAME in DATABASE which
81 defaults to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned
82 tables are considered. This is the default. If OWNER is :all , all
83 tables are considered. If OWNER is a string, this denotes a username
84 and only tables owned by OWNER are considered. Table names are
85 returned as a list of strings."
86 (when (member (database-identifier name database)
87 (list-tables :owner owner :database database)
94 (defun create-view (name &key as column-list (with-check-option nil)
95 (database *default-database*))
96 "Creates a view called NAME using the AS query and the optional
97 COLUMN-LIST and WITH-CHECK-OPTION. The COLUMN-LIST argument is a list
98 of columns to add to the view. The WITH-CHECK-OPTION adds 'WITH CHECK
99 OPTION' to the resulting SQL. The default value of WITH-CHECK-OPTION
100 is NIL. The default value of DATABASE is *DEFAULT-DATABASE*."
101 (let* ((view-name (etypecase name
102 (symbol (sql-expression :attribute name))
103 (string (sql-expression :attribute (make-symbol name)))
105 (stmt (make-instance 'sql-create-view
107 :column-list column-list
109 :with-check-option with-check-option)))
110 (execute-command stmt :database database)))
112 (defun drop-view (name &key (if-does-not-exist :error)
113 (database *default-database*))
114 "Deletes view NAME from DATABASE which defaults to
115 *DEFAULT-DATABASE*. If the view does not exist and IF-DOES-NOT-EXIST
116 is :ignore then DROP-VIEW returns nil whereas an error is signalled if
117 IF-DOES-NOT-EXIST is :error."
118 (let ((view-name (database-identifier name database)))
119 (ecase if-does-not-exist
121 (unless (view-exists-p view-name :database database)
122 (return-from drop-view)))
125 (let ((expr (concatenate 'string "DROP VIEW " view-name)))
126 (execute-command expr :database database))))
128 (defun list-views (&key (owner nil) (database *default-database*))
129 "List all views in DATABASE which defaults to *DEFAULT-DATABASE*. If
130 OWNER is nil, only user-owned views are considered. This is the
131 default. If OWNER is :all , all views are considered. If OWNER is a
132 string, this denotes a username and only views owned by OWNER are
133 considered. View names are returned as a list of strings."
134 (database-list-views database :owner owner))
136 (defun view-exists-p (name &key (owner nil) (database *default-database*))
137 "Test for existence of an SQL view called NAME in DATABASE which
138 defaults to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned views
139 are considered. This is the default. If OWNER is :all , all views are
140 considered. If OWNER is a string, this denotes a username and only
141 views owned by OWNER are considered. View names are returned as a list
143 (when (member (database-identifier name database)
144 (list-views :owner owner :database database)
145 :test #'string-equal)
151 (defun create-index (name &key on (unique nil) attributes
152 (database *default-database*))
153 "Creates an index called NAME on the table specified by ON. The
154 attributes of the table to index are given by ATTRIBUTES. Setting
155 UNIQUE to T includes UNIQUE in the SQL index command, specifying that
156 the columns indexed must contain unique values. The default value of
157 UNIQUE is nil. The default value of DATABASE is *DEFAULT-DATABASE*."
158 (let* ((index-name (database-identifier name database))
159 (table-name (database-identifier on database))
160 (attributes (mapcar #'(lambda (a) (database-identifier a database)) (listify attributes)))
161 (stmt (format nil "CREATE ~A INDEX ~A ON ~A (~{~A~^, ~})"
162 (if unique "UNIQUE" "")
163 index-name table-name attributes)))
164 (execute-command stmt :database database)))
166 (defun drop-index (name &key (if-does-not-exist :error)
168 (database *default-database*))
169 "Deletes index NAME from table FROM in DATABASE which defaults to
170 *DEFAULT-DATABASE*. If the index does not exist and IF-DOES-NOT-EXIST
171 is :ignore then DROP-INDEX returns nil whereas an error is signalled
172 if IF-DOES-NOT-EXIST is :error. The argument ON allows the optional
173 specification of a table to drop the index from."
174 (let ((index-name (database-identifier name database)))
175 (ecase if-does-not-exist
177 (unless (index-exists-p index-name :database database)
178 (return-from drop-index)))
180 (unless (db-type-use-column-on-drop-index?
181 (database-underlying-type database))
183 (execute-command (format nil "DROP INDEX ~A~A" index-name
185 (concatenate 'string " ON "
186 (database-identifier on database))))
187 :database database)))
189 (defun list-indexes (&key (owner nil) (database *default-database*))
190 "List all indexes in DATABASE, which defaults to
191 *default-database*. If OWNER is :all , all indexs are considered. If
192 OWNER is a string, this denotes a username and only indexs owned by
193 OWNER are considered. Index names are returned as a list of strings."
194 (database-list-indexes database :owner owner))
196 (defun list-table-indexes (table &key (owner nil)
197 (database *default-database*))
198 "List all indexes in DATABASE for a TABLE, which defaults to
199 *default-database*. If OWNER is :all , all indexs are considered. If
200 OWNER is a string, this denotes a username and only indexs owned by
201 OWNER are considered. Index names are returned as a list of strings."
202 (database-list-table-indexes (database-identifier table database)
203 database :owner owner))
205 (defun index-exists-p (name &key (owner nil) (database *default-database*))
206 "Test for existence of an index called NAME in DATABASE which
207 defaults to *DEFAULT-DATABASE*. If OWNER is :all , all indexs are
208 considered. If OWNER is a string, this denotes a username and only
209 indexs owned by OWNER are considered. Index names are returned as a
211 (when (member (database-identifier name database)
212 (list-indexes :owner owner :database database)
213 :test #'string-equal)
218 (defvar *cache-table-queries-default* "Default atribute type caching behavior.")
220 (defun cache-table-queries (table &key (action nil) (database *default-database*))
221 "Provides per-table control on the caching in a particular database
222 connection of attribute type information using during update
223 operations. If TABLE is a string, it is the name of the table for
224 which caching is to be altered. If TABLE is t, then the action applies
225 to all tables. If TABLE is :default, then the default caching action
226 is set for those tables which do not have an explicit setting. ACTION
227 specifies the caching action. The value t means cache the attribute
228 type information. The value nil means do not cache the attribute type
229 information. If TABLE is :default, the setting applies to all tables
230 which do not have an explicit setup. The value :flush means remove any
231 existing cache for table in database, but continue to cache. This
232 function should be called with action :flush when the attribute
233 specifications in table have changed."
234 (with-slots (attribute-cache) database
237 (multiple-value-bind (val found) (gethash table attribute-cache)
239 ((and found (eq action :flush))
240 (setf (gethash table attribute-cache) (list t nil)))
241 ((and found (eq action t))
242 (setf (gethash table attribute-cache) (list t (second val))))
243 ((and found (null action))
244 (setf (gethash table attribute-cache) (list nil nil)))
246 (setf (gethash table attribute-cache) (list action nil))))))
248 (maphash (lambda (k v)
251 (setf (gethash k attribute-cache) (list t nil)))
253 (setf (gethash k attribute-cache) (list nil nil)))
255 (setf (gethash k attribute-cache) (list t (second v))))))
258 (maphash (lambda (k v)
259 (when (eq (first v) :unspecified)
262 (setf (gethash k attribute-cache) (list t nil)))
264 (setf (gethash k attribute-cache) (list nil nil)))
266 (setf (gethash k attribute-cache) (list t (second v)))))))
271 (defun list-attributes (name &key (owner nil) (database *default-database*))
272 "List the attributes of a attribute called NAME in DATABASE which
273 defaults to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned
274 attributes are considered. This is the default. If OWNER is :all , all
275 attributes are considered. If OWNER is a string, this denotes a
276 username and only attributes owned by OWNER are considered. Attribute
277 names are returned as a list of strings. Attributes are returned as a
279 (database-list-attributes (database-identifier name database) database :owner owner))
281 (defun attribute-type (attribute table &key (owner nil)
282 (database *default-database*))
283 "Return the field type of the ATTRIBUTE in TABLE. The optional
284 keyword argument DATABASE specifies the database to query, defaulting
285 to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned attributes are
286 considered. This is the default. If OWNER is :all , all attributes are
287 considered. If OWNER is a string, this denotes a username and only
288 attributes owned by OWNER are considered. Attribute names are returned
289 as a list of strings. Attributes are returned as a list of strings."
290 (database-attribute-type (database-identifier attribute database)
291 (database-identifier table database)
295 (defun list-attribute-types (table &key (owner nil)
296 (database *default-database*))
297 "Returns type information for the attributes in TABLE from DATABASE
298 which has a default value of *default-database*. If OWNER is nil, only
299 user-owned attributes are considered. This is the default. If OWNER is
300 :all, all attributes are considered. If OWNER is a string, this
301 denotes a username and only attributes owned by OWNER are
302 considered. Returns a list in which each element is a list (attribute
303 datatype). Attribute is a string denoting the atribute name. Datatype
304 is the vendor-specific type returned by ATTRIBUTE-TYPE."
305 (with-slots (attribute-cache) database
306 (let ((table-ident (database-identifier table database)))
307 (multiple-value-bind (val found) (gethash table-ident attribute-cache)
308 (if (and found (second val))
310 (let ((types (mapcar #'(lambda (attribute)
313 (database-attribute-type
314 (database-identifier attribute database)
318 (list-attributes table :database database :owner owner))))
320 ((and (not found) (eq t *cache-table-queries-default*))
321 (setf (gethash table-ident attribute-cache) (list :unspecified types)))
322 ((and found (eq t (first val))
323 (setf (gethash table-ident attribute-cache) (list t types)))))
329 (defun create-sequence (name &key (database *default-database*))
330 "Create a sequence called NAME in DATABASE which defaults to
332 (let ((sequence-name (database-identifier name database)))
333 (database-create-sequence sequence-name database))
336 (defun drop-sequence (name &key (if-does-not-exist :error)
337 (database *default-database*))
338 "Drops sequence NAME from DATABASE which defaults to
339 *DEFAULT-DATABASE*. If the sequence does not exist and
340 IF-DOES-NOT-EXIST is :ignore then DROP-SEQUENCE returns nil whereas an
341 error is signalled if IF-DOES-NOT-EXIST is :error."
342 (let ((sequence-name (database-identifier name database)))
343 (ecase if-does-not-exist
345 (unless (sequence-exists-p sequence-name :database database)
346 (return-from drop-sequence)))
348 (database-drop-sequence sequence-name database))
351 (defun list-sequences (&key (owner nil) (database *default-database*))
352 "List all sequences in DATABASE, which defaults to
353 *default-database*. If OWNER is nil, only user-owned sequences are
354 considered. This is the default. If OWNER is :all , all sequences are
355 considered. If OWNER is a string, this denotes a username and only
356 sequences owned by OWNER are considered. Sequence names are returned
357 as a list of strings."
358 (database-list-sequences database :owner owner))
360 (defun sequence-exists-p (name &key (owner nil)
361 (database *default-database*))
362 "Test for existence of a sequence called NAME in DATABASE which
363 defaults to *DEFAULT-DATABASE*."
364 (when (member (database-identifier name database)
365 (list-sequences :owner owner :database database)
366 :test #'string-equal)
369 (defun sequence-next (name &key (database *default-database*))
370 "Return the next value in the sequence NAME in DATABASE."
371 (database-sequence-next (database-identifier name database) database))
373 (defun set-sequence-position (name position &key (database *default-database*))
374 "Explicitly set the the position of the sequence NAME in DATABASE to
376 (database-set-sequence-position (database-identifier name database) position database))
378 (defun sequence-last (name &key (database *default-database*))
379 "Return the last value of the sequence NAME in DATABASE."
380 (database-sequence-last (database-identifier name database) database))
384 (defvar *default-update-objects-max-len* nil
385 "The default maximum number of objects supplying data for a query when updating remote joins.")