1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; ======================================================================
4 ;;;; Updated: <04/04/2004 12:05:03 marcusp>
5 ;;;; ======================================================================
7 ;;;; Description ==========================================================
8 ;;;; ======================================================================
10 ;;;; The CLSQL-USQL Functional Data Definition Language (FDDL)
11 ;;;; including functions for schema manipulation. Currently supported
12 ;;;; SQL objects include tables, views, indexes, attributes and
15 ;;;; ======================================================================
17 (in-package :clsql-usql-sys)
22 (defun database-identifier (name)
23 (sql-escape (etypecase name
34 (defvar *table-schemas* (make-hash-table :test #'equal)
35 "Hash of schema name to table lists.")
37 (defun create-table (name description &key (database *default-database*)
39 "Create a table called NAME, in DATABASE which defaults to
40 *DEFAULT-DATABASE*, containing the attributes in DESCRIPTION which is
41 a list containing lists of attribute-name and type information pairs."
42 (let* ((table-name (etypecase name
43 (symbol (sql-expression :attribute name))
44 (string (sql-expression :attribute (make-symbol name)))
46 (stmt (make-instance 'sql-create-table
49 :modifiers constraints)))
50 (pushnew table-name (gethash *default-schema* *table-schemas*)
52 (execute-command stmt :database database)))
54 (defun drop-table (name &key (if-does-not-exist :error)
55 (database *default-database*))
56 "Drops table NAME from DATABASE which defaults to
57 *DEFAULT-DATABASE*. If the table does not exist and IF-DOES-NOT-EXIST
58 is :ignore then DROP-TABLE returns nil whereas an error is signalled
59 if IF-DOES-NOT-EXIST is :error."
60 (let ((table-name (database-identifier name)))
61 (ecase if-does-not-exist
63 (unless (table-exists-p table-name :database database)
64 (return-from drop-table nil)))
67 (let ((expr (concatenate 'string "DROP TABLE " table-name)))
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)
87 (list-tables :owner owner :database database)
94 (defvar *view-schemas* (make-hash-table :test #'equal)
95 "Hash of schema name to view lists.")
97 (defun create-view (name &key as column-list (with-check-option nil)
98 (database *default-database*))
99 "Creates a view called NAME using the AS query and the optional
100 COLUMN-LIST and WITH-CHECK-OPTION. The COLUMN-LIST argument is a list
101 of columns to add to the view. The WITH-CHECK-OPTION adds 'WITH CHECK
102 OPTION' to the resulting SQL. The default value of WITH-CHECK-OPTION
103 is NIL. The default value of DATABASE is *DEFAULT-DATABASE*."
104 (let* ((view-name (etypecase name
105 (symbol (sql-expression :attribute name))
106 (string (sql-expression :attribute (make-symbol name)))
108 (stmt (make-instance 'sql-create-view
110 :column-list column-list
112 :with-check-option with-check-option)))
113 (pushnew view-name (gethash *default-schema* *view-schemas*) :test #'equal)
114 (execute-command stmt :database database)))
116 (defun drop-view (name &key (if-does-not-exist :error)
117 (database *default-database*))
118 "Deletes view NAME from DATABASE which defaults to
119 *DEFAULT-DATABASE*. If the view does not exist and IF-DOES-NOT-EXIST
120 is :ignore then DROP-VIEW returns nil whereas an error is signalled if
121 IF-DOES-NOT-EXIST is :error."
122 (let ((view-name (database-identifier name)))
123 (ecase if-does-not-exist
125 (unless (view-exists-p view-name :database database)
126 (return-from drop-view)))
129 (let ((expr (concatenate 'string "DROP VIEW " view-name)))
130 (execute-command expr :database database))))
132 (defun list-views (&key (owner nil) (database *default-database*))
133 "List all views in DATABASE which defaults to *DEFAULT-DATABASE*. If
134 OWNER is nil, only user-owned views are considered. This is the
135 default. If OWNER is :all , all views are considered. If OWNER is a
136 string, this denotes a username and only views owned by OWNER are
137 considered. View names are returned as a list of strings."
138 (database-list-views database :owner owner))
140 (defun view-exists-p (name &key (owner nil) (database *default-database*))
141 "Test for existence of an SQL view called NAME in DATABASE which
142 defaults to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned views
143 are considered. This is the default. If OWNER is :all , all views are
144 considered. If OWNER is a string, this denotes a username and only
145 views owned by OWNER are considered. View names are returned as a list
147 (when (member (database-identifier name)
148 (list-views :owner owner :database database)
149 :test #'string-equal)
155 (defvar *index-schemas* (make-hash-table :test #'equal)
156 "Hash of schema name to index lists.")
158 (defun create-index (name &key on (unique nil) attributes
159 (database *default-database*))
160 "Creates an index called NAME on the table specified by ON. The
161 attributes of the table to index are given by ATTRIBUTES. Setting
162 UNIQUE to T includes UNIQUE in the SQL index command, specifying that
163 the columns indexed must contain unique values. The default value of
164 UNIQUE is nil. The default value of DATABASE is *DEFAULT-DATABASE*."
165 (let* ((index-name (database-identifier name))
166 (table-name (database-identifier on))
167 (attributes (mapcar #'database-identifier (listify attributes)))
168 (stmt (format nil "CREATE ~A INDEX ~A ON ~A (~{~A~^, ~})"
169 (if unique "UNIQUE" "")
170 index-name table-name attributes)))
171 (pushnew index-name (gethash *default-schema* *index-schemas*))
172 (execute-command stmt :database database)))
174 (defun drop-index (name &key (if-does-not-exist :error)
176 (database *default-database*))
177 "Deletes index NAME from table FROM in DATABASE which defaults to
178 *DEFAULT-DATABASE*. If the index does not exist and IF-DOES-NOT-EXIST
179 is :ignore then DROP-INDEX returns nil whereas an error is signalled
180 if IF-DOES-NOT-EXIST is :error. The argument ON allows the optional
181 specification of a table to drop the index from."
182 (let ((index-name (database-identifier name)))
183 (ecase if-does-not-exist
185 (unless (index-exists-p index-name :database database)
186 (return-from drop-index)))
188 (execute-command (format nil "DROP INDEX ~A~A" index-name
190 (concatenate 'string " ON "
191 (database-identifier on))))
192 :database database)))
194 (defun list-indexes (&key (owner nil) (database *default-database*))
195 "List all indexes in DATABASE, which defaults to
196 *default-database*. If OWNER is :all , all indexs are considered. If
197 OWNER is a string, this denotes a username and only indexs owned by
198 OWNER are considered. Index names are returned as a list of strings."
199 (database-list-indexes database :owner owner))
201 (defun index-exists-p (name &key (owner nil) (database *default-database*))
202 "Test for existence of an index called NAME in DATABASE which
203 defaults to *DEFAULT-DATABASE*. If OWNER is :all , all indexs are
204 considered. If OWNER is a string, this denotes a username and only
205 indexs owned by OWNER are considered. Index names are returned as a
207 (when (member (database-identifier name)
208 (list-indexes :owner owner :database database)
209 :test #'string-equal)
214 (defun list-attributes (name &key (owner nil) (database *default-database*))
215 "List the attributes of a attribute called NAME in DATABASE which
216 defaults to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned
217 attributes are considered. This is the default. If OWNER is :all , all
218 attributes are considered. If OWNER is a string, this denotes a
219 username and only attributes owned by OWNER are considered. Attribute
220 names are returned as a list of strings. Attributes are returned as a
222 (database-list-attributes (database-identifier name) database :owner owner))
224 (defun attribute-type (attribute table &key (owner nil)
225 (database *default-database*))
226 "Return the field type of the ATTRIBUTE in TABLE. The optional
227 keyword argument DATABASE specifies the database to query, defaulting
228 to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned attributes are
229 considered. This is the default. If OWNER is :all , all attributes are
230 considered. If OWNER is a string, this denotes a username and only
231 attributes owned by OWNER are considered. Attribute names are returned
232 as a list of strings. Attributes are returned as a list of strings."
233 (database-attribute-type (database-identifier attribute)
234 (database-identifier table)
238 (defun list-attribute-types (table &key (owner nil)
239 (database *default-database*))
240 "Returns type information for the attributes in TABLE from DATABASE
241 which has a default value of *default-database*. If OWNER is nil, only
242 user-owned attributes are considered. This is the default. If OWNER is
243 :all, all attributes are considered. If OWNER is a string, this
244 denotes a username and only attributes owned by OWNER are
245 considered. Returns a list in which each element is a list (attribute
246 datatype). Attribute is a string denoting the atribute name. Datatype
247 is the vendor-specific type returned by ATTRIBUTE-TYPE."
248 (mapcar #'(lambda (type)
249 (list type (attribute-type type table :database database
251 (list-attributes table :database database :owner owner)))
253 ;(defun add-attribute (table attribute &key (database *default-database*))
254 ; (database-add-attribute table attribute database))
256 ;(defun rename-attribute (table oldatt newname
257 ; &key (database *default-database*))
258 ; (error "(rename-attribute ~a ~a ~a ~a) is not implemented"
259 ; table oldatt newname database))
264 (defvar *sequence-schemas* (make-hash-table :test #'equal)
265 "Hash of schema name to sequence lists.")
267 (defun create-sequence (name &key (database *default-database*))
268 "Create a sequence called NAME in DATABASE which defaults to
270 (let ((sequence-name (database-identifier name)))
271 (database-create-sequence sequence-name database)
272 (pushnew sequence-name (gethash *default-schema* *sequence-schemas*)
276 (defun drop-sequence (name &key (if-does-not-exist :error)
277 (database *default-database*))
278 "Drops sequence NAME from DATABASE which defaults to
279 *DEFAULT-DATABASE*. If the sequence does not exist and
280 IF-DOES-NOT-EXIST is :ignore then DROP-SEQUENCE returns nil whereas an
281 error is signalled if IF-DOES-NOT-EXIST is :error."
282 (let ((sequence-name (database-identifier name)))
283 (ecase if-does-not-exist
285 (unless (sequence-exists-p sequence-name :database database)
286 (return-from drop-sequence)))
288 (database-drop-sequence sequence-name database))
291 (defun list-sequences (&key (owner nil) (database *default-database*))
292 "List all sequences in DATABASE, which defaults to
293 *default-database*. If OWNER is nil, only user-owned sequences are
294 considered. This is the default. If OWNER is :all , all sequences are
295 considered. If OWNER is a string, this denotes a username and only
296 sequences owned by OWNER are considered. Sequence names are returned
297 as a list of strings."
298 (database-list-sequences database :owner owner))
300 (defun sequence-exists-p (name &key (owner nil)
301 (database *default-database*))
302 "Test for existence of a sequence called NAME in DATABASE which
303 defaults to *DEFAULT-DATABASE*."
304 (when (member (database-identifier name)
305 (list-sequences :owner owner :database database)
306 :test #'string-equal)
309 (defun sequence-next (name &key (database *default-database*))
310 "Return the next value in the sequence NAME in DATABASE."
311 (database-sequence-next (database-identifier name) database))
313 (defun set-sequence-position (name position &key (database *default-database*))
314 "Explicitly set the the position of the sequence NAME in DATABASE to
316 (database-set-sequence-position (database-identifier name) position database))
318 (defun sequence-last (name &key (database *default-database*))
319 "Return the last value of the sequence NAME in DATABASE."
320 (database-sequence-last (database-identifier name) database))