Major rewrite of table/column name output escaping system wide.

[clsql.git] / sql / fddl.lisp

diff --git a/sql/fddl.lisp b/sql/fddl.lisp
index 2c28ab2bc212884195c2059cc141cbf6d89f3023..267ee290f1dfe583650f68a39e2c73e4f4d55119 100644 (file)
--- a/sql/fddl.lisp
+++ b/sql/fddl.lisp
@@ -16,16 +16,6 @@
 (in-package #:clsql-sys)
 
 
 (in-package #:clsql-sys)
 
 

-;; Utilities
-
-(defun database-identifier (name database)
-  (sql-escape (etypecase name
-                ;; honor case of strings
-                (string name)
-                (sql-ident (sql-output name database))
-                (symbol (sql-output name database)))))
-
-

 ;; Truncate database
 
 (defun truncate-database (&key (database *default-database*))
 ;; Truncate database
 
 (defun truncate-database (&key (database *default-database*))


@@ -79,20 +69,14 @@ supports transactions."
 *DEFAULT-DATABASE*. If the table does not exist and
 IF-DOES-NOT-EXIST is :ignore then DROP-TABLE returns nil whereas
 an error is signalled if IF-DOES-NOT-EXIST is :error."
 *DEFAULT-DATABASE*. If the table does not exist and
 IF-DOES-NOT-EXIST is :ignore then DROP-TABLE returns nil whereas
 an error is signalled if IF-DOES-NOT-EXIST is :error."

-  (let ((table-name (database-identifier name database)))

     (ecase if-does-not-exist
       (:ignore
     (ecase if-does-not-exist
       (:ignore

-       (unless (table-exists-p table-name :database database
-                               :owner owner)
+       (unless (table-exists-p name :database database :owner owner)

          (return-from drop-table nil)))
       (:error
        t))
          (return-from drop-table nil)))
       (:error
        t))

-
-    (let ((expr (etypecase name
-                  ;; keep quotes for strings for mixed-case names
-                  (string (format nil "DROP TABLE ~S" table-name))
-                  ((or symbol sql-ident)
-                   (concatenate 'string "DROP TABLE " table-name)))))
+  
+    (let ((expr (concatenate 'string "DROP TABLE " (escaped-database-identifier name database))))

       ;; Fixme: move to clsql-oracle
       (when (and (find-package 'clsql-oracle)
                  (eq :oracle (database-type database))
       ;; Fixme: move to clsql-oracle
       (when (and (find-package 'clsql-oracle)
                  (eq :oracle (database-type database))


@@ -101,7 +85,7 @@ an error is signalled if IF-DOES-NOT-EXIST is :error."
                                              (symbol-name '#:clsql-oracle)))))
         (setq expr (concatenate 'string expr " PURGE")))
 
                                              (symbol-name '#:clsql-oracle)))))
         (setq expr (concatenate 'string expr " PURGE")))
 

-      (execute-command expr :database database))))
+      (execute-command expr :database database)))

 
 (defun list-tables (&key (owner nil) (database *default-database*))
   "Returns a list of strings representing table names in DATABASE
 
 (defun list-tables (&key (owner nil) (database *default-database*))
   "Returns a list of strings representing table names in DATABASE


@@ -115,7 +99,7 @@ listed. If OWNER is :all then all tables are listed."
   (unless database (setf database *default-database*))
   (let ((name (database-identifier name database))
         (tables (list-tables :owner owner :database database)))
   (unless database (setf database *default-database*))
   (let ((name (database-identifier name database))
         (tables (list-tables :owner owner :database database)))

-    (when (member name tables :test #'string-equal)
+    (when (member name tables :test #'database-identifier-equal)

       t)))
 
 (defun table-exists-p (name &key (owner nil) (database *default-database*))
       t)))
 
 (defun table-exists-p (name &key (owner nil) (database *default-database*))


@@ -138,10 +122,7 @@ the columns of the view may be specified using the COLUMN-LIST
 parameter. The WITH-CHECK-OPTION is nil by default but if it has
 a non-nil value, then all insert/update commands on the view are
 checked to ensure that the new data satisfy the query AS."
 parameter. The WITH-CHECK-OPTION is nil by default but if it has
 a non-nil value, then all insert/update commands on the view are
 checked to ensure that the new data satisfy the query AS."

-  (let* ((view-name (etypecase name
-                      (symbol (sql-expression :attribute name))
-                      (string (sql-expression :attribute (make-symbol name)))
-                      (sql-ident name)))
+  (let* ((view-name (database-identifier name))

          (stmt (make-instance 'sql-create-view
                               :name view-name
                               :column-list column-list
          (stmt (make-instance 'sql-create-view
                               :name view-name
                               :column-list column-list


@@ -155,15 +136,14 @@ checked to ensure that the new data satisfy the query AS."
 *DEFAULT-DATABASE*. If the view does not exist and
 IF-DOES-NOT-EXIST is :ignore then DROP-VIEW returns nil whereas
 an error is signalled if IF-DOES-NOT-EXIST is :error."
 *DEFAULT-DATABASE*. If the view does not exist and
 IF-DOES-NOT-EXIST is :ignore then DROP-VIEW returns nil whereas
 an error is signalled if IF-DOES-NOT-EXIST is :error."

-  (let ((view-name (database-identifier name database)))

     (ecase if-does-not-exist
       (:ignore
     (ecase if-does-not-exist
       (:ignore

-       (unless (view-exists-p view-name :database database)
+       (unless (view-exists-p name :database database)

          (return-from drop-view)))
       (:error
        t))
          (return-from drop-view)))
       (:error
        t))

-    (let ((expr (concatenate 'string "DROP VIEW " view-name)))
-      (execute-command expr :database database))))
+    (let ((expr (concatenate 'string "DROP VIEW " (escaped-database-identifier name database))))
+      (execute-command expr :database database)))

 
 (defun list-views (&key (owner nil) (database *default-database*))
   "Returns a list of strings representing view names in DATABASE
 
 (defun list-views (&key (owner nil) (database *default-database*))
   "Returns a list of strings representing view names in DATABASE


@@ -181,7 +161,7 @@ is a string denoting a user name, only views owned by OWNER are
 examined. If OWNER is :all then all views are examined."
   (when (member (database-identifier name database)
                 (list-views :owner owner :database database)
 examined. If OWNER is :all then all views are examined."
   (when (member (database-identifier name database)
                 (list-views :owner owner :database database)

-                :test #'string-equal)
+                :test #'database-identifier-equal)

     t))
 
 
     t))
 
 


@@ -195,9 +175,10 @@ attributes to use in constructing the index NAME are specified by
 ATTRIBUTES. The UNIQUE argument is nil by default but if it has a
 non-nil value then the indexed attributes must have unique
 values."
 ATTRIBUTES. The UNIQUE argument is nil by default but if it has a
 non-nil value then the indexed attributes must have unique
 values."

-  (let* ((index-name (database-identifier name database))
-         (table-name (database-identifier on database))
-         (attributes (mapcar #'(lambda (a) (database-identifier a database)) (listify attributes)))
+  (let* ((index-name (escaped-database-identifier name database))
+         (table-name (escaped-database-identifier on database))
+         (attributes (mapcar #'(lambda (a) (escaped-database-identifier a database))
+                             (listify attributes)))

          (stmt (format nil "CREATE ~A INDEX ~A ON ~A (~{~A~^, ~})"
                        (if unique "UNIQUE" "")
                        index-name table-name attributes)))
          (stmt (format nil "CREATE ~A INDEX ~A ON ~A (~{~A~^, ~})"
                        (if unique "UNIQUE" "")
                        index-name table-name attributes)))


@@ -212,20 +193,22 @@ IF-DOES-NOT-EXIST is :ignore then DROP-INDEX returns nil whereas
 an error is signalled if IF-DOES-NOT-EXIST is :error. The
 argument ON allows the optional specification of a table to drop
 the index from."
 an error is signalled if IF-DOES-NOT-EXIST is :error. The
 argument ON allows the optional specification of a table to drop
 the index from."

-  (let ((index-name (database-identifier name database)))
-    (ecase if-does-not-exist
-      (:ignore
-       (unless (index-exists-p index-name :database database)
-         (return-from drop-index)))
-      (:error t))
-    (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))))
+  (ecase if-does-not-exist
+    (:ignore
+     (unless (index-exists-p name :database database)
+       (return-from drop-index)))
+    (:error t))
+  (let* ((db-type (database-underlying-type database))
+         (on (when on (escaped-database-identifier on database)))
+         (index-name (escaped-database-identifier name database))
+         (index-identifier
+           (cond ((db-type-use-fully-qualified-column-on-drop-index? db-type)
+                  (format nil "~A.~A"  on index-name))
+                 ((db-type-use-column-on-drop-index? db-type)
+                  (format nil "~A ON ~A" index-name on))
+                 (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
 
 (defun list-indexes (&key (owner nil) (database *default-database*) (on nil))
   "Returns a list of strings representing index names in DATABASE


@@ -240,12 +223,14 @@ expression representing a table name in DATABASE or a list of
 such table identifiers."
   (if (null on)
       (database-list-indexes database :owner owner)
 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)))))
+      (let ((tables (typecase on
+                      (cons on)
+                      (t (list on)))))
+        (reduce
+         #'append
+         (mapcar #'(lambda (table)
+                     (database-list-table-indexes table 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 index-exists-p (name &key (owner nil) (database *default-database*))
   "Tests for the existence of an SQL index called NAME in DATABASE


@@ -256,7 +241,7 @@ OWNER are examined. If OWNER is :all then all indexes are
 examined."
   (when (member (database-identifier name database)
                 (list-indexes :owner owner :database database)
 examined."
   (when (member (database-identifier name database)
                 (list-indexes :owner owner :database database)

-                :test #'string-equal)
+                :test #'database-identifier-equal)

     t))
 
 ;; Attributes
     t))
 
 ;; Attributes


@@ -324,7 +309,7 @@ nil by default which means that only attributes owned by users
 are listed. If OWNER is a string denoting a user name, only
 attributes owned by OWNER are listed. If OWNER is :all then all
 attributes are listed."
 are listed. If OWNER is a string denoting a user name, only
 attributes owned by OWNER are listed. If OWNER is :all then all
 attributes are listed."

-  (database-list-attributes (database-identifier name database) database
+  (database-list-attributes (escaped-database-identifier name database) database

                             :owner owner))
 
 (defun attribute-type (attribute table &key (owner nil)
                             :owner owner))
 
 (defun attribute-type (attribute table &key (owner nil)


@@ -338,8 +323,8 @@ 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."
 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-attribute-type (escaped-database-identifier attribute database)
+                           (escaped-database-identifier table database)

                            database
                            :owner owner))
 
                            database
                            :owner owner))
 


@@ -357,7 +342,7 @@ second element is its SQL type, the third is the type precision,
 the fourth is the scale of the attribute and the fifth is 1 if
 the attribute accepts null values and otherwise 0."
   (with-slots (attribute-cache) database
 the fourth is the scale of the attribute and the fifth is 1 if
 the attribute accepts null values and otherwise 0."
   (with-slots (attribute-cache) database

-    (let ((table-ident (database-identifier table database)))
+    (let ((table-ident (escaped-database-identifier table database)))

       (multiple-value-bind (val found) (gethash table-ident attribute-cache)
         (if (and found (second val))
             (second val)
       (multiple-value-bind (val found) (gethash table-ident attribute-cache)
         (if (and found (second val))
             (second val)


@@ -365,7 +350,7 @@ the attribute accepts null values and otherwise 0."
                                      (cons attribute
                                            (multiple-value-list
                                             (database-attribute-type
                                      (cons attribute
                                            (multiple-value-list
                                             (database-attribute-type

-                                             (database-identifier attribute
+                                             (escaped-database-identifier attribute

                                                                   database)
                                              table-ident
                                              database
                                                                   database)
                                              table-ident
                                              database


@@ -397,13 +382,12 @@ the attribute accepts null values and otherwise 0."
 *DEFAULT-DATABASE*. If the sequence does not exist and
 IF-DOES-NOT-EXIST is :ignore then DROP-SEQUENCE returns nil
 whereas an error is signalled if IF-DOES-NOT-EXIST is :error."
 *DEFAULT-DATABASE*. If the sequence does not exist and
 IF-DOES-NOT-EXIST is :ignore then DROP-SEQUENCE returns nil
 whereas an error is signalled if IF-DOES-NOT-EXIST is :error."

-  (let ((sequence-name (database-identifier name database)))
-    (ecase if-does-not-exist
-      (:ignore
-       (unless (sequence-exists-p sequence-name :database database)
-         (return-from drop-sequence)))
-      (:error t))
-    (database-drop-sequence sequence-name database))
+  (ecase if-does-not-exist
+    (:ignore
+     (unless (sequence-exists-p name :database database)
+       (return-from drop-sequence)))
+    (:error t))
+  (database-drop-sequence name database)

   (values))
 
 (defun list-sequences (&key (owner nil) (database *default-database*))
   (values))
 
 (defun list-sequences (&key (owner nil) (database *default-database*))


@@ -423,10 +407,13 @@ default which means that only sequences owned by users are
 examined. If OWNER is a string denoting a user name, only
 sequences owned by OWNER are examined. If OWNER is :all then all
 sequences are examined."
 examined. If OWNER is a string denoting a user name, only
 sequences owned by OWNER are examined. If OWNER is :all then all
 sequences are examined."

-  (when (member (database-identifier name database)
-                (list-sequences :owner owner :database database)
-                :test #'string-equal)
-    t))
+  (let ((seqs (list-sequences :owner owner :database database))
+        ;; handle symbols, we know the db will return strings
+        (n1 (database-identifier name database))
+        (n2 (%sequence-name-to-table name database)))
+    (when (or (member n1 seqs :test #'database-identifier-equal)
+              (member n2 seqs :test #'database-identifier-equal))
+      t)))

 
 (defun sequence-next (name &key (database *default-database*))
   "Increment and return the next value in the sequence called
 
 (defun sequence-next (name &key (database *default-database*))
   "Increment and return the next value in the sequence called