;; Utilities
-(defun database-identifier (name)
+(defun database-identifier (name database)
(sql-escape (etypecase name
- (string
- (string-upcase name))
- (sql-ident
- (sql-output name))
- (symbol
- (sql-output name)))))
+ ;; honor case of strings
+ (string name
+ #+nil (convert-to-db-default-case name database))
+ (sql-ident (sql-output name database))
+ (symbol (sql-output name database)))))
;; Tables
(defun create-table (name description &key (database *default-database*)
- (constraints nil))
- "Create a table called NAME, in DATABASE which defaults to
-*DEFAULT-DATABASE*, containing the attributes in DESCRIPTION which is
-a list containing lists of attribute-name and type information pairs."
+ (constraints nil) (transactions t))
+ "Creates a table called NAME, which may be a string, symbol or
+SQL table identifier, in DATABASE which defaults to
+*DEFAULT-DATABASE*. DESCRIPTION is a list whose elements are
+lists containing the attribute names, types, and other
+constraints such as not-null or primary-key for each column in
+the table. CONSTRAINTS is a string representing an SQL table
+constraint expression or a list of such strings. With MySQL
+databases, if TRANSACTIONS is t an InnoDB table is created which
+supports transactions."
(let* ((table-name (etypecase name
(symbol (sql-expression :attribute name))
- (string (sql-expression :attribute (make-symbol name)))
+ (string (sql-expression :attribute name))
(sql-ident name)))
(stmt (make-instance 'sql-create-table
:name table-name
:columns description
- :modifiers constraints)))
+ :modifiers constraints
+ :transactions transactions)))
(execute-command stmt :database database)))
(defun drop-table (name &key (if-does-not-exist :error)
- (database *default-database*))
- "Drops table 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 an error is signalled
-if IF-DOES-NOT-EXIST is :error."
- (let ((table-name (database-identifier name)))
+ (database *default-database*))
+ "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
+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)
(return-from drop-table nil)))
(:error
t))
+
+ ;; Fixme: move to clsql-oracle
(let ((expr (concatenate 'string "DROP TABLE " table-name)))
+ (when (and (find-package 'clsql-oracle)
+ (eq :oracle (database-type database))
+ (eql 10 (slot-value database
+ (intern (symbol-name '#:major-server-version)
+ (symbol-name '#:clsql-oracle)))))
+ (setq expr (concatenate 'string expr " PURGE")))
+
(execute-command expr :database database))))
(defun list-tables (&key (owner nil) (database *default-database*))
- "List all tables in DATABASE which defaults to
-*DEFAULT-DATABASE*. If OWNER is nil, only user-owned tables are
-considered. This is the default. If OWNER is :all , all tables are
-considered. If OWNER is a string, this denotes a username and only
-tables owned by OWNER are considered. Table names are returned as a
-list of strings."
+ "Returns a list of strings representing table names in DATABASE
+which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
+which means that only tables owned by users are listed. If OWNER
+is a string denoting a user name, only tables owned by OWNER are
+listed. If OWNER is :all then all tables are listed."
(database-list-tables database :owner owner))
(defun table-exists-p (name &key (owner nil) (database *default-database*))
- "Test for existence of an SQL table called NAME in DATABASE which
-defaults to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned
-tables are considered. This is the default. If OWNER is :all , all
-tables are considered. If OWNER is a string, this denotes a username
-and only tables owned by OWNER are considered. Table names are
-returned as a list of strings."
- (when (member (database-identifier name)
+ "Tests for the existence of an SQL table called NAME in DATABASE
+which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
+which means that only tables owned by users are examined. If
+OWNER is a string denoting a user name, only tables owned by
+OWNER are examined. If OWNER is :all then all tables are
+examined."
+ (when (member (database-identifier name database)
(list-tables :owner owner :database database)
:test #'string-equal)
t))
(defun create-view (name &key as column-list (with-check-option nil)
(database *default-database*))
- "Creates a view called NAME using the AS query and the optional
-COLUMN-LIST and WITH-CHECK-OPTION. The COLUMN-LIST argument is a list
-of columns to add to the view. The WITH-CHECK-OPTION adds 'WITH CHECK
-OPTION' to the resulting SQL. The default value of WITH-CHECK-OPTION
-is NIL. The default value of DATABASE is *DEFAULT-DATABASE*."
+ "Creates a view called NAME in DATABASE which defaults to
+*DEFAULT-DATABASE*. The view is created using the query AS and
+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)))
(defun drop-view (name &key (if-does-not-exist :error)
(database *default-database*))
- "Deletes view NAME from DATABASE which defaults to
-*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)))
+ "Drops the view called NAME from DATABASE which defaults to
+*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)
(execute-command expr :database database))))
(defun list-views (&key (owner nil) (database *default-database*))
- "List all views in DATABASE which defaults to *DEFAULT-DATABASE*. If
-OWNER is nil, only user-owned views are considered. This is the
-default. If OWNER is :all , all views are considered. If OWNER is a
-string, this denotes a username and only views owned by OWNER are
-considered. View names are returned as a list of strings."
+ "Returns a list of strings representing view names in DATABASE
+which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
+which means that only views owned by users are listed. If OWNER
+is a string denoting a user name, only views owned by OWNER are
+listed. If OWNER is :all then all views are listed."
(database-list-views database :owner owner))
(defun view-exists-p (name &key (owner nil) (database *default-database*))
- "Test for existence of an SQL view called NAME in DATABASE which
-defaults to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned views
-are considered. This is the default. If OWNER is :all , all views are
-considered. If OWNER is a string, this denotes a username and only
-views owned by OWNER are considered. View names are returned as a list
-of strings."
- (when (member (database-identifier name)
+ "Tests for the existence of an SQL view called NAME in DATABASE
+which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
+which means that only views owned by users are examined. If OWNER
+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)
t))
(defun create-index (name &key on (unique nil) attributes
(database *default-database*))
- "Creates an index called NAME on the table specified by ON. The
-attributes of the table to index are given by ATTRIBUTES. Setting
-UNIQUE to T includes UNIQUE in the SQL index command, specifying that
-the columns indexed must contain unique values. The default value of
-UNIQUE is nil. The default value of DATABASE is *DEFAULT-DATABASE*."
- (let* ((index-name (database-identifier name))
- (table-name (database-identifier on))
- (attributes (mapcar #'database-identifier (listify attributes)))
+ "Creates an index called NAME on the table specified by ON in
+DATABASE which default to *DEFAULT-DATABASE*. The table
+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)))
(stmt (format nil "CREATE ~A INDEX ~A ON ~A (~{~A~^, ~})"
(if unique "UNIQUE" "")
index-name table-name attributes)))
(defun drop-index (name &key (if-does-not-exist :error)
(on nil)
(database *default-database*))
- "Deletes index NAME from table FROM in DATABASE which defaults to
-*DEFAULT-DATABASE*. If the index does not exist and 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)))
+ "Drops the index called NAME in DATABASE which defaults to
+*DEFAULT-DATABASE*. If the index does not exist and
+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))
- (unless (db-use-column-on-drop-index? database)
+ (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-identifier on database))))
:database database)))
(defun list-indexes (&key (owner nil) (database *default-database*))
- "List all indexes in DATABASE, which defaults to
-*default-database*. If OWNER is :all , all indexs are considered. If
-OWNER is a string, this denotes a username and only indexs owned by
-OWNER are considered. Index names are returned as a list of strings."
+ "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*))
- "List all indexes in DATABASE for a TABLE, which defaults to
-*default-database*. If OWNER is :all , all indexs are considered. If
-OWNER is a string, this denotes a username and only indexs owned by
-OWNER are considered. Index names are returned as a list of strings."
- (database-list-table-indexes (database-identifier table)
+ "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))
(defun index-exists-p (name &key (owner nil) (database *default-database*))
- "Test for existence of an index called NAME in DATABASE which
-defaults to *DEFAULT-DATABASE*. If OWNER is :all , all indexs are
-considered. If OWNER is a string, this denotes a username and only
-indexs owned by OWNER are considered. Index names are returned as a
-list of strings."
- (when (member (database-identifier name)
+ "Tests for the existence of an SQL index called NAME in DATABASE
+which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
+which means that only indexes owned by users are examined. If
+OWNER is a string denoting a user name, only indexes owned by
+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)
t))
;; Attributes
+(defvar *cache-table-queries-default* nil
+ "Specifies the default behaivour for caching of attribute
+ types. Meaningful values are t, nil and :flush as described for
+ the action argument to CACHE-TABLE-QUERIES.")
+
+(defun cache-table-queries (table &key (action nil) (database *default-database*))
+ "Controls the caching of attribute type information on the
+table specified by TABLE in DATABASE which defaults to
+*DEFAULT-DATABASE*. ACTION specifies the caching behaviour to
+adopt. If its value is t then attribute type information is
+cached whereas if its value is nil then attribute type
+information is not cached. If ACTION is :flush then all existing
+type information in the cache for TABLE is removed, but caching
+is still enabled. TABLE may be a string representing a table for
+which the caching action is to be taken while the caching action
+is applied to all tables if TABLE is t. Alternativly, when TABLE
+is :default, the default caching action specified by
+*CACHE-TABLE-QUERIES-DEFAULT* is applied to all table for which a
+caching action has not been explicitly set."
+ (with-slots (attribute-cache) database
+ (cond
+ ((stringp table)
+ (multiple-value-bind (val found) (gethash table attribute-cache)
+ (cond
+ ((and found (eq action :flush))
+ (setf (gethash table attribute-cache) (list t nil)))
+ ((and found (eq action t))
+ (setf (gethash table attribute-cache) (list t (second val))))
+ ((and found (null action))
+ (setf (gethash table attribute-cache) (list nil nil)))
+ ((not found)
+ (setf (gethash table attribute-cache) (list action nil))))))
+ ((eq table t)
+ (maphash (lambda (k v)
+ (cond
+ ((eq action :flush)
+ (setf (gethash k attribute-cache) (list t nil)))
+ ((null action)
+ (setf (gethash k attribute-cache) (list nil nil)))
+ ((eq t action)
+ (setf (gethash k attribute-cache) (list t (second v))))))
+ attribute-cache))
+ ((eq table :default)
+ (maphash (lambda (k v)
+ (when (eq (first v) :unspecified)
+ (cond
+ ((eq action :flush)
+ (setf (gethash k attribute-cache) (list t nil)))
+ ((null action)
+ (setf (gethash k attribute-cache) (list nil nil)))
+ ((eq t action)
+ (setf (gethash k attribute-cache) (list t (second v)))))))
+ attribute-cache))))
+ (values))
+
+
(defun list-attributes (name &key (owner nil) (database *default-database*))
- "List the attributes of a attribute called NAME in DATABASE which
-defaults to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned
-attributes are considered. This is the default. If OWNER is :all , all
-attributes are considered. If OWNER is a string, this denotes a
-username and only attributes owned by OWNER are considered. Attribute
-names are returned as a list of strings. Attributes are returned as a
-list of strings."
- (database-list-attributes (database-identifier name) database :owner owner))
+ "Returns a list of strings representing the attributes of table
+NAME in DATABASE which defaults to *DEFAULT-DATABASE*. OWNER is
+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
+ :owner owner))
(defun attribute-type (attribute table &key (owner nil)
(database *default-database*))
- "Return the field type of the ATTRIBUTE in TABLE. The optional
-keyword argument DATABASE specifies the database to query, defaulting
-to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned attributes are
-considered. This is the default. If OWNER is :all , all attributes are
-considered. If OWNER is a string, this denotes a username and only
-attributes owned by OWNER are considered. Attribute names are returned
-as a list of strings. Attributes are returned as a list of strings."
- (database-attribute-type (database-identifier attribute)
- (database-identifier table)
+ "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."
+ (database-attribute-type (database-identifier attribute database)
+ (database-identifier table database)
database
:owner owner))
(defun list-attribute-types (table &key (owner nil)
(database *default-database*))
- "Returns type information for the attributes in TABLE from DATABASE
-which has a default value of *default-database*. If OWNER is nil, only
-user-owned attributes are considered. This is the default. If OWNER is
-:all, all attributes are considered. If OWNER is a string, this
-denotes a username and only attributes owned by OWNER are
-considered. Returns a list in which each element is a list (attribute
-datatype). Attribute is a string denoting the atribute name. Datatype
-is the vendor-specific type returned by ATTRIBUTE-TYPE."
- (mapcar #'(lambda (type)
- (list type (attribute-type type table :database database
- :owner owner)))
- (list-attributes table :database database :owner owner)))
-
-;(defun add-attribute (table attribute &key (database *default-database*))
-; (database-add-attribute table attribute database))
-
-;(defun rename-attribute (table oldatt newname
-; &key (database *default-database*))
-; (error "(rename-attribute ~a ~a ~a ~a) is not implemented"
-; table oldatt newname database))
-
+ "Returns a list containing information about the SQL types of
+each of the attributes in the table specified by TABLE in
+DATABASE which has a default value of *DEFAULT-DATABASE*. OWNER
+is 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. The elements of the returned list are
+lists where the first element is the name of the attribute, the
+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)))
+ (multiple-value-bind (val found) (gethash table-ident attribute-cache)
+ (if (and found (second val))
+ (second val)
+ (let ((types (mapcar #'(lambda (attribute)
+ (cons attribute
+ (multiple-value-list
+ (database-attribute-type
+ (database-identifier attribute
+ database)
+ table-ident
+ database
+ :owner owner))))
+ (list-attributes table :database database
+ :owner owner))))
+ (cond
+ ((and (not found) (eq t *cache-table-queries-default*))
+ (setf (gethash table-ident attribute-cache)
+ (list :unspecified types)))
+ ((and found (eq t (first val))
+ (setf (gethash table-ident attribute-cache)
+ (list t types)))))
+ types))))))
+
;; Sequences
(defun create-sequence (name &key (database *default-database*))
- "Create a sequence called NAME in DATABASE which defaults to
+ "Creates a sequence called NAME in DATABASE which defaults to
*DEFAULT-DATABASE*."
- (let ((sequence-name (database-identifier name)))
+ (let ((sequence-name (database-identifier name database)))
(database-create-sequence sequence-name database))
(values))
(defun drop-sequence (name &key (if-does-not-exist :error)
(database *default-database*))
- "Drops sequence NAME from DATABASE which defaults to
+ "Drops the sequence called NAME from DATABASE which defaults to
*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)))
+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)
(values))
(defun list-sequences (&key (owner nil) (database *default-database*))
- "List all sequences in DATABASE, which defaults to
-*default-database*. If OWNER is nil, only user-owned sequences are
-considered. This is the default. If OWNER is :all , all sequences are
-considered. If OWNER is a string, this denotes a username and only
-sequences owned by OWNER are considered. Sequence names are returned
-as a list of strings."
+ "Returns a list of strings representing sequence names in
+DATABASE which defaults to *DEFAULT-DATABASE*. OWNER is nil by
+default which means that only sequences owned by users are
+listed. If OWNER is a string denoting a user name, only sequences
+owned by OWNER are listed. If OWNER is :all then all sequences
+are listed."
(database-list-sequences database :owner owner))
(defun sequence-exists-p (name &key (owner nil)
(database *default-database*))
- "Test for existence of a sequence called NAME in DATABASE which
-defaults to *DEFAULT-DATABASE*."
- (when (member (database-identifier name)
+ "Tests for the existence of an SQL sequence called NAME in
+DATABASE which defaults to *DEFAULT-DATABASE*. OWNER is nil by
+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))
(defun sequence-next (name &key (database *default-database*))
- "Return the next value in the sequence NAME in DATABASE."
- (database-sequence-next (database-identifier name) database))
+ "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 NAME in DATABASE to
-POSITION."
- (database-set-sequence-position (database-identifier name) position database))
+ "Explicitly set the the position of the sequence called NAME in
+DATABASE, which defaults to *DEFAULT-DATABSE*, to POSITION."
+ (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 NAME in DATABASE."
- (database-sequence-last (database-identifier name) database))
+ "Return the last value of the sequence called NAME in DATABASE
+ which defaults to *DEFAULT-DATABASE*."
+ (database-sequence-last (database-identifier name database) database))
+
projects / clsql.git / blobdiff