sql/table.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; ======================================================================
   3 ;;;; File:    table.lisp
   4 ;;;; Updated: <04/04/2004 12:05:03 marcusp>
   5 ;;;; ======================================================================
   6 ;;;;
   7 ;;;; Description ==========================================================
   8 ;;;; ======================================================================
   9 ;;;;
  10 ;;;; The CLSQL Functional Data Definition Language (FDDL)
  11 ;;;; including functions for schema manipulation. Currently supported
  12 ;;;; SQL objects include tables, views, indexes, attributes and
  13 ;;;; sequences.
  14 ;;;;
  15 ;;;; ======================================================================
  16
  17 (in-package #:clsql-sys)
  18
  19
  20 ;; Utilities
  21
  22 (defun database-identifier (name)
  23   (sql-escape (etypecase name
  24                 (string
  25                  (string-upcase name))
  26                 (sql-ident
  27                  (sql-output name))
  28                 (symbol
  29                  (sql-output name)))))
  30
  31
  32 ;; Tables
  33
  34 (defvar *table-schemas* (make-hash-table :test #'equal)
  35   "Hash of schema name to table lists.")
  36
  37 (defun create-table (name description &key (database *default-database*)
  38                           (constraints nil))
  39   "Create a table called NAME, in DATABASE which defaults to
  40 *DEFAULT-DATABASE*, containing the attributes in DESCRIPTION which is
  41 a list containing lists of attribute-name and type information pairs."
  42   (let* ((table-name (etypecase name
  43                        (symbol (sql-expression :attribute name))
  44                        (string (sql-expression :attribute (make-symbol name)))
  45                        (sql-ident name)))
  46          (stmt (make-instance 'sql-create-table
  47                               :name table-name
  48                               :columns description
  49                               :modifiers constraints)))
  50     (pushnew table-name (gethash *default-schema* *table-schemas*)
  51              :test #'equal)
  52     (execute-command stmt :database database)))
  53
  54 (defun drop-table (name &key (if-does-not-exist :error)
  55                         (database *default-database*))
  56   "Drops table NAME from DATABASE which defaults to
  57 *DEFAULT-DATABASE*. If the table does not exist and IF-DOES-NOT-EXIST
  58 is :ignore then DROP-TABLE returns nil whereas an error is signalled
  59 if IF-DOES-NOT-EXIST is :error."
  60   (let ((table-name (database-identifier name)))
  61     (ecase if-does-not-exist
  62       (:ignore
  63        (unless (table-exists-p table-name :database database)
  64          (return-from drop-table nil)))
  65       (:error
  66        t))
  67     (let ((expr (concatenate 'string "DROP TABLE " table-name)))
  68       (execute-command expr :database database))))
  69
  70 (defun list-tables (&key (owner nil) (database *default-database*))
  71   "List all tables in DATABASE which defaults to
  72 *DEFAULT-DATABASE*. If OWNER is nil, only user-owned tables are
  73 considered. This is the default. If OWNER is :all , all tables are
  74 considered. If OWNER is a string, this denotes a username and only
  75 tables owned by OWNER are considered. Table names are returned as a
  76 list of strings."
  77   (database-list-tables database :owner owner))
  78
  79 (defun table-exists-p (name &key (owner nil) (database *default-database*))
  80   "Test for existence of an SQL table called NAME in DATABASE which
  81 defaults to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned
  82 tables are considered. This is the default. If OWNER is :all , all
  83 tables are considered. If OWNER is a string, this denotes a username
  84 and only tables owned by OWNER are considered. Table names are
  85 returned as a list of strings."
  86   (when (member (database-identifier name)
  87                 (list-tables :owner owner :database database)
  88                 :test #'string-equal)
  89     t))
  90
  91
  92 ;; Views
  93
  94 (defvar *view-schemas* (make-hash-table :test #'equal)
  95   "Hash of schema name to view lists.")
  96
  97 (defun create-view (name &key as column-list (with-check-option nil)
  98                          (database *default-database*))
  99   "Creates a view called NAME using the AS query and the optional
 100 COLUMN-LIST and WITH-CHECK-OPTION. The COLUMN-LIST argument is a list
 101 of columns to add to the view. The WITH-CHECK-OPTION adds 'WITH CHECK
 102 OPTION' to the resulting SQL. The default value of WITH-CHECK-OPTION
 103 is NIL. The default value of DATABASE is *DEFAULT-DATABASE*."
 104   (let* ((view-name (etypecase name
 105                       (symbol (sql-expression :attribute name))
 106                       (string (sql-expression :attribute (make-symbol name)))
 107                       (sql-ident name)))
 108          (stmt (make-instance 'sql-create-view
 109                               :name view-name
 110                               :column-list column-list
 111                               :query as
 112                               :with-check-option with-check-option)))
 113     (pushnew view-name (gethash *default-schema* *view-schemas*) :test #'equal)
 114     (execute-command stmt :database database)))
 115
 116 (defun drop-view (name &key (if-does-not-exist :error)
 117                        (database *default-database*))
 118   "Deletes view NAME from DATABASE which defaults to
 119 *DEFAULT-DATABASE*. If the view does not exist and IF-DOES-NOT-EXIST
 120 is :ignore then DROP-VIEW returns nil whereas an error is signalled if
 121 IF-DOES-NOT-EXIST is :error."
 122   (let ((view-name (database-identifier name)))
 123     (ecase if-does-not-exist
 124       (:ignore
 125        (unless (view-exists-p view-name :database database)
 126          (return-from drop-view)))
 127       (:error
 128        t))
 129     (let ((expr (concatenate 'string "DROP VIEW " view-name)))
 130       (execute-command expr :database database))))
 131
 132 (defun list-views (&key (owner nil) (database *default-database*))
 133   "List all views in DATABASE which defaults to *DEFAULT-DATABASE*. If
 134 OWNER is nil, only user-owned views are considered. This is the
 135 default. If OWNER is :all , all views are considered. If OWNER is a
 136 string, this denotes a username and only views owned by OWNER are
 137 considered. View names are returned as a list of strings."
 138   (database-list-views database :owner owner))
 139
 140 (defun view-exists-p (name &key (owner nil) (database *default-database*))
 141   "Test for existence of an SQL view called NAME in DATABASE which
 142 defaults to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned views
 143 are considered. This is the default. If OWNER is :all , all views are
 144 considered. If OWNER is a string, this denotes a username and only
 145 views owned by OWNER are considered. View names are returned as a list
 146 of strings."
 147   (when (member (database-identifier name)
 148                 (list-views :owner owner :database database)
 149                 :test #'string-equal)
 150     t))
 151
 152
 153 ;; Indexes
 154
 155 (defvar *index-schemas* (make-hash-table :test #'equal)
 156   "Hash of schema name to index lists.")
 157
 158 (defun create-index (name &key on (unique nil) attributes
 159                           (database *default-database*))
 160   "Creates an index called NAME on the table specified by ON. The
 161 attributes of the table to index are given by ATTRIBUTES. Setting
 162 UNIQUE to T includes UNIQUE in the SQL index command, specifying that
 163 the columns indexed must contain unique values. The default value of
 164 UNIQUE is nil. The default value of DATABASE is *DEFAULT-DATABASE*."
 165   (let* ((index-name (database-identifier name))
 166          (table-name (database-identifier on))
 167          (attributes (mapcar #'database-identifier (listify attributes)))
 168          (stmt (format nil "CREATE ~A INDEX ~A ON ~A (~{~A~^, ~})"
 169                        (if unique "UNIQUE" "")
 170                        index-name table-name attributes)))
 171     (pushnew index-name (gethash *default-schema* *index-schemas*))
 172     (execute-command stmt :database database)))
 173
 174 (defun drop-index (name &key (if-does-not-exist :error)
 175                         (on nil)
 176                         (database *default-database*))
 177   "Deletes index NAME from table FROM in DATABASE which defaults to
 178 *DEFAULT-DATABASE*. If the index does not exist and IF-DOES-NOT-EXIST
 179 is :ignore then DROP-INDEX returns nil whereas an error is signalled
 180 if IF-DOES-NOT-EXIST is :error. The argument ON allows the optional
 181 specification of a table to drop the index from."
 182   (let ((index-name (database-identifier name)))
 183     (ecase if-does-not-exist
 184       (:ignore
 185        (unless (index-exists-p index-name :database database)
 186          (return-from drop-index)))
 187       (:error t))
 188     (execute-command (format nil "DROP INDEX ~A~A" index-name
 189                              (if (null on) ""
 190                                  (concatenate 'string " ON "
 191                                               (database-identifier on))))
 192                      :database database)))
 193
 194 (defun list-indexes (&key (owner nil) (database *default-database*))
 195   "List all indexes in DATABASE, which defaults to
 196 *default-database*. If OWNER is :all , all indexs are considered. If
 197 OWNER is a string, this denotes a username and only indexs owned by
 198 OWNER are considered. Index names are returned as a list of strings."
 199   (database-list-indexes database :owner owner))
 200
 201 (defun index-exists-p (name &key (owner nil) (database *default-database*))
 202   "Test for existence of an index called NAME in DATABASE which
 203 defaults to *DEFAULT-DATABASE*. If OWNER is :all , all indexs are
 204 considered. If OWNER is a string, this denotes a username and only
 205 indexs owned by OWNER are considered. Index names are returned as a
 206 list of strings."
 207   (when (member (database-identifier name)
 208                 (list-indexes :owner owner :database database)
 209                 :test #'string-equal)
 210     t))
 211
 212 ;; Attributes
 213
 214 (defun list-attributes (name &key (owner nil) (database *default-database*))
 215   "List the attributes of a attribute called NAME in DATABASE which
 216 defaults to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned
 217 attributes are considered. This is the default. If OWNER is :all , all
 218 attributes are considered. If OWNER is a string, this denotes a
 219 username and only attributes owned by OWNER are considered. Attribute
 220 names are returned as a list of strings. Attributes are returned as a
 221 list of strings."
 222   (database-list-attributes (database-identifier name) database :owner owner))
 223
 224 (defun attribute-type (attribute table &key (owner nil)
 225                                  (database *default-database*))
 226   "Return the field type of the ATTRIBUTE in TABLE.  The optional
 227 keyword argument DATABASE specifies the database to query, defaulting
 228 to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned attributes are
 229 considered. This is the default. If OWNER is :all , all attributes are
 230 considered. If OWNER is a string, this denotes a username and only
 231 attributes owned by OWNER are considered. Attribute names are returned
 232 as a list of strings. Attributes are returned as a list of strings."
 233   (database-attribute-type (database-identifier attribute)
 234                            (database-identifier table)
 235                            database
 236                            :owner owner))
 237
 238 (defun list-attribute-types (table &key (owner nil)
 239                                    (database *default-database*))
 240   "Returns type information for the attributes in TABLE from DATABASE
 241 which has a default value of *default-database*. If OWNER is nil, only
 242 user-owned attributes are considered. This is the default. If OWNER is
 243 :all, all attributes are considered. If OWNER is a string, this
 244 denotes a username and only attributes owned by OWNER are
 245 considered. Returns a list in which each element is a list (attribute
 246 datatype). Attribute is a string denoting the atribute name. Datatype
 247 is the vendor-specific type returned by ATTRIBUTE-TYPE."
 248   (mapcar #'(lambda (type)
 249               (list type (attribute-type type table :database database
 250                                          :owner owner)))
 251           (list-attributes table :database database :owner owner)))
 252
 253 ;(defun add-attribute (table attribute &key (database *default-database*))
 254 ;  (database-add-attribute table attribute database))
 255
 256 ;(defun rename-attribute (table oldatt newname
 257 ;                               &key (database *default-database*))
 258 ;  (error "(rename-attribute ~a ~a ~a ~a) is not implemented"
 259 ;         table oldatt newname database))
 260
 261
 262 ;; Sequences
 263
 264 (defvar *sequence-schemas* (make-hash-table :test #'equal)
 265   "Hash of schema name to sequence lists.")
 266
 267 (defun create-sequence (name &key (database *default-database*))
 268   "Create a sequence called NAME in DATABASE which defaults to
 269 *DEFAULT-DATABASE*."
 270   (let ((sequence-name (database-identifier name)))
 271     (database-create-sequence sequence-name database)
 272     (pushnew sequence-name (gethash *default-schema* *sequence-schemas*)
 273              :test #'equal))
 274   (values))
 275
 276 (defun drop-sequence (name &key (if-does-not-exist :error)
 277                            (database *default-database*))
 278   "Drops sequence NAME from DATABASE which defaults to
 279 *DEFAULT-DATABASE*. If the sequence does not exist and
 280 IF-DOES-NOT-EXIST is :ignore then DROP-SEQUENCE returns nil whereas an
 281 error is signalled if IF-DOES-NOT-EXIST is :error."
 282   (let ((sequence-name (database-identifier name)))
 283     (ecase if-does-not-exist
 284       (:ignore
 285        (unless (sequence-exists-p sequence-name :database database)
 286          (return-from drop-sequence)))
 287       (:error t))
 288     (database-drop-sequence sequence-name database))
 289   (values))
 290
 291 (defun list-sequences (&key (owner nil) (database *default-database*))
 292   "List all sequences in DATABASE, which defaults to
 293 *default-database*. If OWNER is nil, only user-owned sequences are
 294 considered. This is the default. If OWNER is :all , all sequences are
 295 considered. If OWNER is a string, this denotes a username and only
 296 sequences owned by OWNER are considered. Sequence names are returned
 297 as a list of strings."
 298   (database-list-sequences database :owner owner))
 299
 300 (defun sequence-exists-p (name &key (owner nil)
 301                                (database *default-database*))
 302   "Test for existence of a sequence called NAME in DATABASE which
 303 defaults to *DEFAULT-DATABASE*."
 304   (when (member (database-identifier name)
 305                 (list-sequences :owner owner :database database)
 306                 :test #'string-equal)
 307     t))
 308
 309 (defun sequence-next (name &key (database *default-database*))
 310   "Return the next value in the sequence NAME in DATABASE."
 311   (database-sequence-next (database-identifier name) database))
 312
 313 (defun set-sequence-position (name position &key (database *default-database*))
 314   "Explicitly set the the position of the sequence NAME in DATABASE to
 315 POSITION."
 316   (database-set-sequence-position (database-identifier name) position database))
 317
 318 (defun sequence-last (name &key (database *default-database*))
 319   "Return the last value of the sequence NAME in DATABASE."
 320   (database-sequence-last (database-identifier name) database))