r9741: 8 Jul 2004 Kevin Rosenberg <kevin@rosenberg.net>
[clsql.git] / sql / fdml.lisp
index 7c8ae7b2c20237ae22ad9b53be17394a2f961d86..470ad37d195b7f2df46feea74ca724b2ee54f3a4 100644 (file)
                            (list :flatp t))
                          (list :database database))))
 
-(defun truncate-database (&key (database *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))))
 
 (defun print-query (query-exp &key titles (formats t) (sizes t) (stream t)
                              (database *default-database*))
@@ -195,12 +177,11 @@ the SQL expression WHERE in the table specified by TABLE in
 DATABASE which defaults to *DEFAULT-DATABASE*. There are three
 ways of specifying the values to update for each row. In the
 first, VALUES contains a list of values to use in the update and
-ATTRIBUTES, AV-PAIRS and QUERY are nil. This can be used when
-values are supplied for all attributes in TABLE. In the second,
-ATTRIBUTES is a list of column names, VALUES is a corresponding
-list of values and AV-PAIRS and QUERY are nil. In the third,
-ATTRIBUTES, VALUES and QUERY are nil and AV-PAIRS is an alist
-of (attribute value) pairs."
+ATTRIBUTES and AV-PAIRS are nil. This can be used when values are
+supplied for all attributes in TABLE. In the second, ATTRIBUTES
+is a list of column names, VALUES is a corresponding list of
+values and AV-PAIRS is nil. In the third, ATTRIBUTES and VALUES
+are nil and AV-PAIRS is an alist of (attribute value) pairs."
   (when av-pairs
     (setf attributes (mapcar #'car av-pairs)
           values (mapcar #'cadr av-pairs)))
@@ -211,8 +192,6 @@ of (attribute value) pairs."
     (execute-command stmt :database database)))
 
 
-;; iteration 
-
 ;; output-sql
 
 (defmethod database-output-sql ((str string) database)
@@ -221,7 +200,7 @@ of (attribute value) pairs."
            (type (simple-array * (*)) str))
   (let ((len (length str)))
     (declare (type fixnum len))
-    (cond ((= len 0)
+    (cond ((zerop len)
            +empty-string+)
           ((and (null (position #\' str))
                 (null (position #\\ str)))
@@ -231,13 +210,14 @@ of (attribute value) pairs."
              (do* ((i 0 (incf i))
                    (j 1 (incf j)))
                   ((= i len) (subseq buf 0 (1+ j)))
-               (declare (type integer i j))
+               (declare (type fixnum i j))
                (let ((char (aref str i)))
-                 (cond ((eql char #\')
-                        (setf (aref buf j) #\\)
+                (declare (character char))
+                 (cond ((char= char #\')
+                        (setf (aref buf j) #\')
                         (incf j)
                         (setf (aref buf j) #\'))
-                       ((eql char #\\)
+                       ((char= char #\\)
                         (setf (aref buf j) #\\)
                         (incf j)
                         (setf (aref buf j) #\\))
@@ -314,13 +294,6 @@ of (attribute value) pairs."
         (write-char #\) *sql-stream*)))
   t)
 
-(defmethod describe-table ((table sql-create-table)
-                          &key (database *default-database*))
-  (database-describe-table
-   database
-   (convert-to-db-default-case 
-    (symbol-name (slot-value table 'name)) database)))
-
 #+nil
 (defmethod add-storage-class ((self database) (class symbol) &key (sequence t))
   (let ((tablename (view-table (find-class class))))
@@ -329,8 +302,8 @@ of (attribute value) pairs."
       (when sequence
         (create-sequence-from-class class)))))
  
-;;; Iteration
 
+;;; Iteration
 
 (defmacro do-query (((&rest args) query-expression
                     &key (database '*default-database*) (result-types :auto))
@@ -490,7 +463,8 @@ computed for each field."
 
 ;;; Row processing macro from CLSQL
 
-(defmacro for-each-row (((&rest fields) &key from order-by where distinct limit) &body body)
+(defmacro for-each-row (((&rest fields) &key from order-by where distinct limit)
+                        &body body)
   (let ((d (gensym "DISTINCT-"))
        (bind-fields (loop for f in fields collect (car f)))
        (w (gensym "WHERE-"))