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 database)
  24   (sql-escape (etypecase name
  25                 (string
  26                  (convert-to-db-default-case name database))
  27                 (sql-ident
  28                  (sql-output name database))
  29                 (symbol
  30                  (sql-output name database)))))
  31
  32
  33 ;; Tables
  34
  35 (defun create-table (name description &key (database *default-database*)
  36                           (constraints nil) (transactions t))
  37   "Creates a table called NAME, which may be a string, symbol or
  38 SQL table identifier, in DATABASE which defaults to
  39 *DEFAULT-DATABASE*. DESCRIPTION is a list whose elements are
  40 lists containing the attribute names, types, and other
  41 constraints such as not-null or primary-key for each column in
  42 the table.  CONSTRAINTS is a string representing an SQL table
  43 constraint expression or a list of such strings. With MySQL
  44 databases, if TRANSACTIONS is t an InnoDB table is created which
  45 supports transactions."
  46   (let* ((table-name (etypecase name
  47                        (symbol (sql-expression :attribute name))
  48                        (string (sql-expression :attribute (make-symbol name)))
  49                        (sql-ident name)))
  50          (stmt (make-instance 'sql-create-table
  51                               :name table-name
  52                               :columns description
  53                               :modifiers constraints
  54                               :transactions transactions)))
  55     (execute-command stmt :database database)))
  56
  57 (defun drop-table (name &key (if-does-not-exist :error)
  58                         (database *default-database*))
  59   "Drops the table called NAME from DATABASE which defaults to
  60 *DEFAULT-DATABASE*. If the table does not exist and
  61 IF-DOES-NOT-EXIST is :ignore then DROP-TABLE returns nil whereas
  62 an error is signalled if IF-DOES-NOT-EXIST is :error."
  63   (let ((table-name (database-identifier name database)))
  64     (ecase if-does-not-exist
  65       (:ignore
  66        (unless (table-exists-p table-name :database database)
  67          (return-from drop-table nil)))
  68       (:error
  69        t))
  70     (let ((expr (concatenate 'string "DROP TABLE " table-name
  71                              (if (eq :oracle (database-type database))
  72                                  " PURGE"
  73                                ""))))
  74       (execute-command expr :database database))))
  75
  76 (defun list-tables (&key (owner nil) (database *default-database*))
  77   "Returns a list of strings representing table names in DATABASE
  78 which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
  79 which means that only tables owned by users are listed. If OWNER
  80 is a string denoting a user name, only tables owned by OWNER are
  81 listed. If OWNER is :all then all tables are listed."
  82   (database-list-tables database :owner owner))
  83
  84 (defun table-exists-p (name &key (owner nil) (database *default-database*))
  85   "Tests for the existence of an SQL table called NAME in DATABASE
  86 which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
  87 which means that only tables owned by users are examined. If
  88 OWNER is a string denoting a user name, only tables owned by
  89 OWNER are examined. If OWNER is :all then all tables are
  90 examined."
  91   (when (member (database-identifier name database)
  92                 (list-tables :owner owner :database database)
  93                 :test #'string-equal)
  94     t))
  95
  96
  97 ;; Views
  98
  99 (defun create-view (name &key as column-list (with-check-option nil)
 100                          (database *default-database*))
 101   "Creates a view called NAME in DATABASE which defaults to
 102 *DEFAULT-DATABASE*. The view is created using the query AS and
 103 the columns of the view may be specified using the COLUMN-LIST
 104 parameter. The WITH-CHECK-OPTION is nil by default but if it has
 105 a non-nil value, then all insert/update commands on the view are
 106 checked to ensure that the new data satisfy the query AS."
 107   (let* ((view-name (etypecase name
 108                       (symbol (sql-expression :attribute name))
 109                       (string (sql-expression :attribute (make-symbol name)))
 110                       (sql-ident name)))
 111          (stmt (make-instance 'sql-create-view
 112                               :name view-name
 113                               :column-list column-list
 114                               :query as
 115                               :with-check-option with-check-option)))
 116     (execute-command stmt :database database)))
 117
 118 (defun drop-view (name &key (if-does-not-exist :error)
 119                        (database *default-database*))
 120   "Drops the view called NAME from DATABASE which defaults to
 121 *DEFAULT-DATABASE*. If the view does not exist and
 122 IF-DOES-NOT-EXIST is :ignore then DROP-VIEW returns nil whereas
 123 an error is signalled if IF-DOES-NOT-EXIST is :error."
 124   (let ((view-name (database-identifier name database)))
 125     (ecase if-does-not-exist
 126       (:ignore
 127        (unless (view-exists-p view-name :database database)
 128          (return-from drop-view)))
 129       (:error
 130        t))
 131     (let ((expr (concatenate 'string "DROP VIEW " view-name)))
 132       (execute-command expr :database database))))
 133
 134 (defun list-views (&key (owner nil) (database *default-database*))
 135   "Returns a list of strings representing view names in DATABASE
 136 which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
 137 which means that only views owned by users are listed. If OWNER
 138 is a string denoting a user name, only views owned by OWNER are
 139 listed. If OWNER is :all then all views are listed."
 140   (database-list-views database :owner owner))
 141
 142 (defun view-exists-p (name &key (owner nil) (database *default-database*))
 143   "Tests for the existence of an SQL view called NAME in DATABASE
 144 which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
 145 which means that only views owned by users are examined. If OWNER
 146 is a string denoting a user name, only views owned by OWNER are
 147 examined. If OWNER is :all then all views are examined."
 148   (when (member (database-identifier name database)
 149                 (list-views :owner owner :database database)
 150                 :test #'string-equal)
 151     t))
 152
 153
 154 ;; Indexes
 155
 156 (defun create-index (name &key on (unique nil) attributes
 157                           (database *default-database*))
 158   "Creates an index called NAME on the table specified by ON in
 159 DATABASE which default to *DEFAULT-DATABASE*. The table
 160 attributes to use in constructing the index NAME are specified by
 161 ATTRIBUTES. The UNIQUE argument is nil by default but if it has a
 162 non-nil value then the indexed attributes must have unique
 163 values."
 164   (let* ((index-name (database-identifier name database))
 165          (table-name (database-identifier on database))
 166          (attributes (mapcar #'(lambda (a) (database-identifier a database)) (listify attributes)))
 167          (stmt (format nil "CREATE ~A INDEX ~A ON ~A (~{~A~^, ~})"
 168                        (if unique "UNIQUE" "")
 169                        index-name table-name attributes)))
 170     (execute-command stmt :database database)))
 171
 172 (defun drop-index (name &key (if-does-not-exist :error)
 173                         (on nil)
 174                         (database *default-database*))
 175   "Drops the index called NAME in DATABASE which defaults to
 176 *DEFAULT-DATABASE*. If the index does not exist and
 177 IF-DOES-NOT-EXIST is :ignore then DROP-INDEX returns nil whereas
 178 an error is signalled if IF-DOES-NOT-EXIST is :error. The
 179 argument ON allows the optional specification of a table to drop
 180 the index from."
 181   (let ((index-name (database-identifier name database)))
 182     (ecase if-does-not-exist
 183       (:ignore
 184        (unless (index-exists-p index-name :database database)
 185          (return-from drop-index)))
 186       (:error t))
 187     (unless (db-type-use-column-on-drop-index?
 188              (database-underlying-type database))
 189       (setq on nil))
 190     (execute-command (format nil "DROP INDEX ~A~A" index-name
 191                              (if (null on) ""
 192                                  (concatenate 'string " ON "
 193                                               (database-identifier on database))))
 194                      :database database)))
 195
 196 (defun list-indexes (&key (owner nil) (database *default-database*))
 197   "Returns a list of strings representing index names in DATABASE
 198 which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
 199 which means that only indexes owned by users are listed. If OWNER
 200 is a string denoting a user name, only indexes owned by OWNER are
 201 listed. If OWNER is :all then all indexes are listed."
 202   (database-list-indexes database :owner owner))
 203
 204 (defun list-table-indexes (table &key (owner nil)
 205                                       (database *default-database*))
 206   "Returns a list of strings representing index names on the
 207 table specified by TABLE in DATABASE which defaults to
 208 *DEFAULT-DATABASE*. OWNER is nil by default which means that only
 209 indexes owned by users are listed. If OWNER is a string denoting
 210 a user name, only indexes owned by OWNER are listed. If OWNER
 211 is :all then all indexes are listed."
 212   (database-list-table-indexes (database-identifier table database)
 213                                database :owner owner))
 214
 215 (defun index-exists-p (name &key (owner nil) (database *default-database*))
 216   "Tests for the existence of an SQL index called NAME in DATABASE
 217 which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
 218 which means that only indexes owned by users are examined. If
 219 OWNER is a string denoting a user name, only indexes owned by
 220 OWNER are examined. If OWNER is :all then all indexes are
 221 examined."
 222   (when (member (database-identifier name database)
 223                 (list-indexes :owner owner :database database)
 224                 :test #'string-equal)
 225     t))
 226
 227 ;; Attributes
 228
 229 (defvar *cache-table-queries-default* nil
 230   "Specifies the default behaivour for caching of attribute
 231   types. Meaningful values are t, nil and :flush as described for
 232   the action argument to CACHE-TABLE-QUERIES.")
 233
 234 (defun cache-table-queries (table &key (action nil) (database *default-database*))
 235   "Controls the caching of attribute type information on the
 236 table specified by TABLE in DATABASE which defaults to
 237 *DEFAULT-DATABASE*. ACTION specifies the caching behaviour to
 238 adopt. If its value is t then attribute type information is
 239 cached whereas if its value is nil then attribute type
 240 information is not cached. If ACTION is :flush then all existing
 241 type information in the cache for TABLE is removed, but caching
 242 is still enabled. TABLE may be a string representing a table for
 243 which the caching action is to be taken while the caching action
 244 is applied to all tables if TABLE is t. Alternativly, when TABLE
 245 is :default, the default caching action specified by
 246 *CACHE-TABLE-QUERIES-DEFAULT* is applied to all table for which a
 247 caching action has not been explicitly set."
 248   (with-slots (attribute-cache) database
 249     (cond
 250       ((stringp table)
 251        (multiple-value-bind (val found) (gethash table attribute-cache)
 252          (cond
 253            ((and found (eq action :flush))
 254             (setf (gethash table attribute-cache) (list t nil)))
 255            ((and found (eq action t))
 256             (setf (gethash table attribute-cache) (list t (second val))))
 257            ((and found (null action))
 258             (setf (gethash table attribute-cache) (list nil nil)))
 259            ((not found)
 260             (setf (gethash table attribute-cache) (list action nil))))))
 261       ((eq table t)
 262        (maphash (lambda (k v)
 263                   (cond
 264                     ((eq action :flush)
 265                      (setf (gethash k attribute-cache) (list t nil)))
 266                     ((null action)
 267                      (setf (gethash k attribute-cache) (list nil nil)))
 268                     ((eq t action)
 269                      (setf (gethash k attribute-cache) (list t (second v))))))
 270                 attribute-cache))
 271       ((eq table :default)
 272        (maphash (lambda (k v)
 273                   (when (eq (first v) :unspecified)
 274                     (cond
 275                       ((eq action :flush)
 276                        (setf (gethash k attribute-cache) (list t nil)))
 277                       ((null action)
 278                        (setf (gethash k attribute-cache) (list nil nil)))
 279                       ((eq t action)
 280                        (setf (gethash k attribute-cache) (list t (second v)))))))
 281                 attribute-cache))))
 282   (values))
 283
 284
 285 (defun list-attributes (name &key (owner nil) (database *default-database*))
 286   "Returns a list of strings representing the attributes of table
 287 NAME in DATABASE which defaults to *DEFAULT-DATABASE*. OWNER is
 288 nil by default which means that only attributes owned by users
 289 are listed. If OWNER is a string denoting a user name, only
 290 attributes owned by OWNER are listed. If OWNER is :all then all
 291 attributes are listed."
 292   (database-list-attributes (database-identifier name database) database
 293                             :owner owner))
 294
 295 (defun attribute-type (attribute table &key (owner nil)
 296                                  (database *default-database*))
 297   "Returns a string representing the field type of the supplied
 298 attribute ATTRIBUTE in the table specified by TABLE in DATABASE
 299 which defaults to *DEFAULT-DATABASE*. OWNER is nil by default
 300 which means that the attribute specified by ATTRIBUTE, if it
 301 exists, must be user owned else nil is returned. If OWNER is a
 302 string denoting a user name, the attribute, if it exists, must be
 303 owned by OWNER else nil is returned, whereas if OWNER is :all
 304 then the attribute, if it exists, will be returned regardless of
 305 its owner."
 306   (database-attribute-type (database-identifier attribute database)
 307                            (database-identifier table database)
 308                            database
 309                            :owner owner))
 310
 311 (defun list-attribute-types (table &key (owner nil)
 312                                    (database *default-database*))
 313   "Returns a list containing information about the SQL types of
 314 each of the attributes in the table specified by TABLE in
 315 DATABASE which has a default value of *DEFAULT-DATABASE*. OWNER
 316 is nil by default which means that only attributes owned by users
 317 are listed. If OWNER is a string denoting a user name, only
 318 attributes owned by OWNER are listed. If OWNER is :all then all
 319 attributes are listed. The elements of the returned list are
 320 lists where the first element is the name of the attribute, the
 321 second element is its SQL type, the third is the type precision,
 322 the fourth is the scale of the attribute and the fifth is 1 if
 323 the attribute accepts null values and otherwise 0."
 324   (with-slots (attribute-cache) database
 325     (let ((table-ident (database-identifier table database)))
 326       (multiple-value-bind (val found) (gethash table-ident attribute-cache)
 327         (if (and found (second val))
 328             (second val)
 329             (let ((types (mapcar #'(lambda (attribute)
 330                                      (cons attribute
 331                                            (multiple-value-list
 332                                             (database-attribute-type
 333                                              (database-identifier attribute
 334                                                                   database)
 335                                              table-ident
 336                                              database
 337                                              :owner owner))))
 338                                  (list-attributes table :database database
 339                                                   :owner owner))))
 340               (cond
 341                 ((and (not found) (eq t *cache-table-queries-default*))
 342                  (setf (gethash table-ident attribute-cache)
 343                        (list :unspecified types)))
 344                 ((and found (eq t (first val))
 345                       (setf (gethash table-ident attribute-cache)
 346                             (list t types)))))
 347               types))))))
 348
 349
 350 ;; Sequences
 351
 352 (defun create-sequence (name &key (database *default-database*))
 353   "Creates a sequence called NAME in DATABASE which defaults to
 354 *DEFAULT-DATABASE*."
 355   (let ((sequence-name (database-identifier name database)))
 356     (database-create-sequence sequence-name database))
 357   (values))
 358
 359 (defun drop-sequence (name &key (if-does-not-exist :error)
 360                            (database *default-database*))
 361   "Drops the sequence called NAME from DATABASE which defaults to
 362 *DEFAULT-DATABASE*. If the sequence does not exist and
 363 IF-DOES-NOT-EXIST is :ignore then DROP-SEQUENCE returns nil
 364 whereas an error is signalled if IF-DOES-NOT-EXIST is :error."
 365   (let ((sequence-name (database-identifier name database)))
 366     (ecase if-does-not-exist
 367       (:ignore
 368        (unless (sequence-exists-p sequence-name :database database)
 369          (return-from drop-sequence)))
 370       (:error t))
 371     (database-drop-sequence sequence-name database))
 372   (values))
 373
 374 (defun list-sequences (&key (owner nil) (database *default-database*))
 375   "Returns a list of strings representing sequence names in
 376 DATABASE which defaults to *DEFAULT-DATABASE*. OWNER is nil by
 377 default which means that only sequences owned by users are
 378 listed. If OWNER is a string denoting a user name, only sequences
 379 owned by OWNER are listed. If OWNER is :all then all sequences
 380 are listed."
 381   (database-list-sequences database :owner owner))
 382
 383 (defun sequence-exists-p (name &key (owner nil)
 384                                (database *default-database*))
 385   "Tests for the existence of an SQL sequence called NAME in
 386 DATABASE which defaults to *DEFAULT-DATABASE*. OWNER is nil by
 387 default which means that only sequences owned by users are
 388 examined. If OWNER is a string denoting a user name, only
 389 sequences owned by OWNER are examined. If OWNER is :all then all
 390 sequences are examined."
 391   (when (member (database-identifier name database)
 392                 (list-sequences :owner owner :database database)
 393                 :test #'string-equal)
 394     t))
 395
 396 (defun sequence-next (name &key (database *default-database*))
 397   "Return the next value in the sequence called NAME in DATABASE
 398   which defaults to *DEFAULT-DATABASE*."
 399   (database-sequence-next (database-identifier name database) database))
 400
 401 (defun set-sequence-position (name position &key (database *default-database*))
 402   "Explicitly set the the position of the sequence called NAME in
 403 DATABASE, which defaults to *DEFAULT-DATABSE*, to POSITION."
 404   (database-set-sequence-position (database-identifier name database)
 405                                   position database))
 406
 407 (defun sequence-last (name &key (database *default-database*))
 408   "Return the last value of the sequence called NAME in DATABASE
 409   which defaults to *DEFAULT-DATABASE*."
 410   (database-sequence-last (database-identifier name database) database))
 411