;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;;
-;;;; $Id:
+;;;; $Id$
;;;;
;;;; The CLSQL Functional Data Definition Language (FDDL)
;;;; including functions for schema manipulation. Currently supported
(symbol (sql-output name database)))))
+;; Truncate database
+
+(defun truncate-database (&key (database *default-database*))
+ "Drops all tables, views, indexes and sequences in DATABASE which
+defaults to *DEFAULT-DATABASE*."
+ (unless (typep database 'database)
+ (signal-no-database-error database))
+ (unless (is-database-open database)
+ (database-reconnect database))
+ (when (eq :oracle (database-type database))
+ (ignore-errors (execute-command "PURGE RECYCLEBIN" :database database)))
+ (when (db-type-has-views? (database-underlying-type database))
+ (dolist (view (list-views :database database))
+ (drop-view view :database database)))
+ (dolist (table (list-tables :database database))
+ (drop-table table :database database))
+ (dolist (index (list-indexes :database database))
+ (drop-index index :database database))
+ (dolist (seq (list-sequences :database database))
+ (drop-sequence seq :database database))
+ (when (eq :oracle (database-type database))
+ (ignore-errors (execute-command "PURGE RECYCLEBIN" :database database)))
+ (values))
+
+
;; Tables
(defun create-table (name description &key (database *default-database*)
(execute-command stmt :database database)))
(defun drop-table (name &key (if-does-not-exist :error)
- (database *default-database*))
+ (database *default-database*)
+ (owner nil))
"Drops the table called NAME from DATABASE which defaults to
*DEFAULT-DATABASE*. If the table does not exist and
IF-DOES-NOT-EXIST is :ignore then DROP-TABLE returns nil whereas
(let ((table-name (database-identifier name database)))
(ecase if-does-not-exist
(:ignore
- (unless (table-exists-p table-name :database database)
+ (unless (table-exists-p table-name :database database
+ :owner owner)
(return-from drop-table nil)))
(:error
t))
(unless (index-exists-p index-name :database database)
(return-from drop-index)))
(:error t))
- (unless (db-type-use-column-on-drop-index?
- (database-underlying-type database))
- (setq on nil))
- (execute-command (format nil "DROP INDEX ~A~A" index-name
- (if (null on) ""
- (concatenate 'string " ON "
- (database-identifier on database))))
- :database database)))
-
-(defun list-indexes (&key (owner nil) (database *default-database*))
+ (let* ((db-type (database-underlying-type database))
+ (index-identifier (cond ((db-type-use-fully-qualified-column-on-drop-index? db-type)
+ (format nil "~A.~A" (database-identifier on database) index-name))
+ ((db-type-use-column-on-drop-index? db-type)
+ (format nil "~A ON ~A" index-name (database-identifier on database)))
+ (t index-name))))
+ (execute-command (format nil "DROP INDEX ~A" index-identifier)
+ :database database))))
+
+(defun list-indexes (&key (owner nil) (database *default-database*) (on nil))
"Returns a list of strings representing index names in DATABASE
which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
which means that only indexes owned by users are listed. If OWNER
is a string denoting a user name, only indexes owned by OWNER are
-listed. If OWNER is :all then all indexes are listed."
- (database-list-indexes database :owner owner))
-
-(defun list-table-indexes (table &key (owner nil)
- (database *default-database*))
- "Returns a list of strings representing index names on the
-table specified by TABLE in DATABASE which defaults to
-*DEFAULT-DATABASE*. OWNER is nil by default which means that only
-indexes owned by users are listed. If OWNER is a string denoting
-a user name, only indexes owned by OWNER are listed. If OWNER
-is :all then all indexes are listed."
- (database-list-table-indexes (database-identifier table database)
- database :owner owner))
+listed. If OWNER is :all then all indexes are listed. The keyword
+argument ON limits the results to indexes on the specified
+tables. Meaningful values for ON are nil (the default) which
+means that all tables are considered, a string, symbol or SQL
+expression representing a table name in DATABASE or a list of
+such table identifiers."
+ (if (null on)
+ (database-list-indexes database :owner owner)
+ (let ((tables (typecase on (cons on) (t (list on)))))
+ (reduce #'append
+ (mapcar #'(lambda (table) (database-list-table-indexes
+ (database-identifier table database)
+ database :owner owner))
+ tables)))))
(defun index-exists-p (name &key (owner nil) (database *default-database*))
"Tests for the existence of an SQL index called NAME in DATABASE
(defun attribute-type (attribute table &key (owner nil)
(database *default-database*))
- "Returns a string representing the field type of the supplied
-attribute ATTRIBUTE in the table specified by TABLE in DATABASE
-which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
-which means that the attribute specified by ATTRIBUTE, if it
-exists, must be user owned else nil is returned. If OWNER is a
-string denoting a user name, the attribute, if it exists, must be
-owned by OWNER else nil is returned, whereas if OWNER is :all
-then the attribute, if it exists, will be returned regardless of
-its owner."
+ "Returns a keyword representing the vendor-specific field type
+of the supplied attribute ATTRIBUTE in the table specified by
+TABLE in DATABASE which defaults to *DEFAULT-DATABASE*. OWNER is
+nil by default which means that the attribute specified by
+ATTRIBUTE, if it exists, must be user owned else nil is
+returned. If OWNER is a string denoting a user name, the
+attribute, if it exists, must be owned by OWNER else nil is
+returned, whereas if OWNER is :all then the attribute, if it
+exists, will be returned regardless of its owner."
(database-attribute-type (database-identifier attribute database)
(database-identifier table database)
database
t))
(defun sequence-next (name &key (database *default-database*))
- "Return the next value in the sequence called NAME in DATABASE
- which defaults to *DEFAULT-DATABASE*."
+ "Increment and return the next value in the sequence called
+ NAME in DATABASE which defaults to *DEFAULT-DATABASE*."
(database-sequence-next (database-identifier name database) database))
(defun set-sequence-position (name position &key (database *default-database*))
"Explicitly set the the position of the sequence called NAME in
-DATABASE, which defaults to *DEFAULT-DATABSE*, to POSITION."
+DATABASE, which defaults to *DEFAULT-DATABSE*, to POSITION which
+is returned."
(database-set-sequence-position (database-identifier name database)
position database))
(defun sequence-last (name &key (database *default-database*))
- "Return the last value of the sequence called NAME in DATABASE
+ "Return the last value allocated in the sequence called NAME in DATABASE
which defaults to *DEFAULT-DATABASE*."
(database-sequence-last (database-identifier name database) database))