r10839: 15 Nov 2005 Kevin Rosenberg <kevin@rosenberg.net>
[clsql.git] / sql / fddl.lisp
index 8f6c1780ad2eff2faf6916a94294bd8c6746f77f..51f8f05d5d5954b9a174d0bcc7bbd362c39fee67 100644 (file)
@@ -1,7 +1,7 @@
 ;;;; -*- 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*)
@@ -54,7 +79,8 @@ supports transactions."
     (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
@@ -62,7 +88,8 @@ an error is signalled if IF-DOES-NOT-EXIST is :error."
   (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))
@@ -198,24 +225,25 @@ the index from."
                                               (database-identifier on database))))
                      :database database)))
 
-(defun list-indexes (&key (owner nil) (database *default-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
@@ -299,15 +327,15 @@ attributes are listed."
 
 (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
@@ -399,18 +427,19 @@ sequences are examined."
     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))