sql/table.lisp

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