--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; ======================================================================
+;;;; File: table.lisp
+;;;; Updated: <04/04/2004 12:05:03 marcusp>
+;;;; ======================================================================
+;;;;
+;;;; Description ==========================================================
+;;;; ======================================================================
+;;;;
+;;;; The CLSQL-USQL Functional Data Definition Language (FDDL)
+;;;; including functions for schema manipulation. Currently supported
+;;;; SQL objects include tables, views, indexes, attributes and
+;;;; sequences.
+;;;;
+;;;; ======================================================================
+
+(in-package :clsql-usql-sys)
+
+
+;; Utilities
+
+(defun database-identifier (name)
+ (sql-escape (etypecase name
+ (string
+ (string-upcase name))
+ (sql-ident
+ (sql-output name))
+ (symbol
+ (sql-output name)))))
+
+
+;; Tables
+
+(defvar *table-schemas* (make-hash-table :test #'equal)
+ "Hash of schema name to table lists.")
+
+(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."
+ (let* ((table-name (etypecase name
+ (symbol (sql-expression :attribute name))
+ (string (sql-expression :attribute (make-symbol name)))
+ (sql-ident name)))
+ (stmt (make-instance 'sql-create-table
+ :name table-name
+ :columns description
+ :modifiers constraints)))
+ (pushnew table-name (gethash *default-schema* *table-schemas*)
+ :test #'equal)
+ (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)))
+ (ecase if-does-not-exist
+ (:ignore
+ (unless (table-exists-p table-name :database database)
+ (return-from drop-table nil)))
+ (:error
+ t))
+ (let ((expr (concatenate 'string "DROP TABLE " table-name)))
+ (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."
+ (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)
+ (list-tables :owner owner :database database)
+ :test #'string-equal)
+ t))
+
+
+;; Views
+
+(defvar *view-schemas* (make-hash-table :test #'equal)
+ "Hash of schema name to view lists.")
+
+(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*."
+ (let* ((view-name (etypecase name
+ (symbol (sql-expression :attribute name))
+ (string (sql-expression :attribute (make-symbol name)))
+ (sql-ident name)))
+ (stmt (make-instance 'sql-create-view
+ :name view-name
+ :column-list column-list
+ :query as
+ :with-check-option with-check-option)))
+ (pushnew view-name (gethash *default-schema* *view-schemas*) :test #'equal)
+ (execute-command stmt :database database)))
+
+(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)))
+ (ecase if-does-not-exist
+ (:ignore
+ (unless (view-exists-p view-name :database database)
+ (return-from drop-view)))
+ (:error
+ t))
+ (let ((expr (concatenate 'string "DROP VIEW " view-name)))
+ (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."
+ (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)
+ (list-views :owner owner :database database)
+ :test #'string-equal)
+ t))
+
+
+;; Indexes
+
+(defvar *index-schemas* (make-hash-table :test #'equal)
+ "Hash of schema name to index lists.")
+
+(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)))
+ (stmt (format nil "CREATE ~A INDEX ~A ON ~A (~{~A~^, ~})"
+ (if unique "UNIQUE" "")
+ index-name table-name attributes)))
+ (pushnew index-name (gethash *default-schema* *index-schemas*))
+ (execute-command stmt :database database)))
+
+(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)))
+ (ecase if-does-not-exist
+ (:ignore
+ (unless (index-exists-p index-name :database database)
+ (return-from drop-index)))
+ (:error t))
+ (execute-command (format nil "DROP INDEX ~A~A" index-name
+ (if (null on) ""
+ (concatenate 'string " ON "
+ (database-identifier on))))
+ :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."
+ (database-list-indexes 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)
+ (list-indexes :owner owner :database database)
+ :test #'string-equal)
+ t))
+
+;; Attributes
+
+(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))
+
+(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)
+ 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))
+
+
+;; Sequences
+
+(defvar *sequence-schemas* (make-hash-table :test #'equal)
+ "Hash of schema name to sequence lists.")
+
+(defun create-sequence (name &key (database *default-database*))
+ "Create a sequence called NAME in DATABASE which defaults to
+*DEFAULT-DATABASE*."
+ (let ((sequence-name (database-identifier name)))
+ (database-create-sequence sequence-name database)
+ (pushnew sequence-name (gethash *default-schema* *sequence-schemas*)
+ :test #'equal))
+ (values))
+
+(defun drop-sequence (name &key (if-does-not-exist :error)
+ (database *default-database*))
+ "Drops sequence 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)))
+ (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))
+ (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."
+ (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)
+ (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))
+
+(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))
+
+(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))
\ No newline at end of file
projects / clsql.git / blobdiff