X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Ffddl.lisp;h=267ee290f1dfe583650f68a39e2c73e4f4d55119;hp=2c28ab2bc212884195c2059cc141cbf6d89f3023;hb=dc107d34212597ed1272cfa21138d384e71b00d2;hpb=8535462c3fdef182cd226770e6e07160f380acac diff --git a/sql/fddl.lisp b/sql/fddl.lisp index 2c28ab2..267ee29 100644 --- a/sql/fddl.lisp +++ b/sql/fddl.lisp @@ -16,16 +16,6 @@ (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*)) @@ -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." - (let ((table-name (database-identifier name database))) (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)) - - (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)) @@ -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"))) - (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 @@ -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))) - (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*)) @@ -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." - (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 @@ -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." - (let ((view-name (database-identifier name database))) (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)) - (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 @@ -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) - :test #'string-equal) + :test #'database-identifier-equal) 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." - (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))) @@ -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." - (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 @@ -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) - (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 @@ -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) - :test #'string-equal) + :test #'database-identifier-equal) 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." - (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) @@ -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." - (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)) @@ -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 - (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) @@ -365,7 +350,7 @@ the attribute accepts null values and otherwise 0." (cons attribute (multiple-value-list (database-attribute-type - (database-identifier attribute + (escaped-database-identifier attribute 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." - (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*)) @@ -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." - (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