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   "Create a table called NAME, in DATABASE which defaults to
  38 *DEFAULT-DATABASE*, containing the attributes in DESCRIPTION which is
  39 a list containing lists of attribute-name and type information pairs."
  40   (let* ((table-name (etypecase name
  41                        (symbol (sql-expression :attribute name))
  42                        (string (sql-expression :attribute (make-symbol name)))
  43                        (sql-ident name)))
  44          (stmt (make-instance 'sql-create-table
  45                               :name table-name
  46                               :columns description
  47                               :modifiers constraints
  48                               :transactions transactions)))
  49     (execute-command stmt :database database)))
  50
  51 (defun drop-table (name &key (if-does-not-exist :error)
  52                         (database *default-database*))
  53   "Drops table NAME from DATABASE which defaults to
  54 *DEFAULT-DATABASE*. If the table does not exist and IF-DOES-NOT-EXIST
  55 is :ignore then DROP-TABLE returns nil whereas an error is signalled
  56 if IF-DOES-NOT-EXIST is :error."
  57   (let ((table-name (database-identifier name database)))
  58     (ecase if-does-not-exist
  59       (:ignore
  60        (unless (table-exists-p table-name :database database)
  61          (return-from drop-table nil)))
  62       (:error
  63        t))
  64     (let ((expr (concatenate 'string "DROP TABLE " table-name
  65                              (if (eq :oracle (database-type database))
  66                                  " PURGE"
  67                                ""))))
  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 database)
  87                 (list-tables :owner owner :database database)
  88                 :test #'string-equal)
  89     t))
  90
  91
  92 ;; Views
  93
  94 (defun create-view (name &key as column-list (with-check-option nil)
  95                          (database *default-database*))
  96   "Creates a view called NAME using the AS query and the optional
  97 COLUMN-LIST and WITH-CHECK-OPTION. The COLUMN-LIST argument is a list
  98 of columns to add to the view. The WITH-CHECK-OPTION adds 'WITH CHECK
  99 OPTION' to the resulting SQL. The default value of WITH-CHECK-OPTION
 100 is NIL. The default value of DATABASE is *DEFAULT-DATABASE*."
 101   (let* ((view-name (etypecase name
 102                       (symbol (sql-expression :attribute name))
 103                       (string (sql-expression :attribute (make-symbol name)))
 104                       (sql-ident name)))
 105          (stmt (make-instance 'sql-create-view
 106                               :name view-name
 107                               :column-list column-list
 108                               :query as
 109                               :with-check-option with-check-option)))
 110     (execute-command stmt :database database)))
 111
 112 (defun drop-view (name &key (if-does-not-exist :error)
 113                        (database *default-database*))
 114   "Deletes view NAME from DATABASE which defaults to
 115 *DEFAULT-DATABASE*. If the view does not exist and IF-DOES-NOT-EXIST
 116 is :ignore then DROP-VIEW returns nil whereas an error is signalled if
 117 IF-DOES-NOT-EXIST is :error."
 118   (let ((view-name (database-identifier name database)))
 119     (ecase if-does-not-exist
 120       (:ignore
 121        (unless (view-exists-p view-name :database database)
 122          (return-from drop-view)))
 123       (:error
 124        t))
 125     (let ((expr (concatenate 'string "DROP VIEW " view-name)))
 126       (execute-command expr :database database))))
 127
 128 (defun list-views (&key (owner nil) (database *default-database*))
 129   "List all views in DATABASE which defaults to *DEFAULT-DATABASE*. If
 130 OWNER is nil, only user-owned views are considered. This is the
 131 default. If OWNER is :all , all views are considered. If OWNER is a
 132 string, this denotes a username and only views owned by OWNER are
 133 considered. View names are returned as a list of strings."
 134   (database-list-views database :owner owner))
 135
 136 (defun view-exists-p (name &key (owner nil) (database *default-database*))
 137   "Test for existence of an SQL view called NAME in DATABASE which
 138 defaults to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned views
 139 are considered. This is the default. If OWNER is :all , all views are
 140 considered. If OWNER is a string, this denotes a username and only
 141 views owned by OWNER are considered. View names are returned as a list
 142 of strings."
 143   (when (member (database-identifier name database)
 144                 (list-views :owner owner :database database)
 145                 :test #'string-equal)
 146     t))
 147
 148
 149 ;; Indexes
 150
 151 (defun create-index (name &key on (unique nil) attributes
 152                           (database *default-database*))
 153   "Creates an index called NAME on the table specified by ON. The
 154 attributes of the table to index are given by ATTRIBUTES. Setting
 155 UNIQUE to T includes UNIQUE in the SQL index command, specifying that
 156 the columns indexed must contain unique values. The default value of
 157 UNIQUE is nil. The default value of DATABASE is *DEFAULT-DATABASE*."
 158   (let* ((index-name (database-identifier name database))
 159          (table-name (database-identifier on database))
 160          (attributes (mapcar #'(lambda (a) (database-identifier a database)) (listify attributes)))
 161          (stmt (format nil "CREATE ~A INDEX ~A ON ~A (~{~A~^, ~})"
 162                        (if unique "UNIQUE" "")
 163                        index-name table-name attributes)))
 164     (execute-command stmt :database database)))
 165
 166 (defun drop-index (name &key (if-does-not-exist :error)
 167                         (on nil)
 168                         (database *default-database*))
 169   "Deletes index NAME from table FROM in DATABASE which defaults to
 170 *DEFAULT-DATABASE*. If the index does not exist and IF-DOES-NOT-EXIST
 171 is :ignore then DROP-INDEX returns nil whereas an error is signalled
 172 if IF-DOES-NOT-EXIST is :error. The argument ON allows the optional
 173 specification of a table to drop the index from."
 174   (let ((index-name (database-identifier name database)))
 175     (ecase if-does-not-exist
 176       (:ignore
 177        (unless (index-exists-p index-name :database database)
 178          (return-from drop-index)))
 179       (:error t))
 180     (unless (db-type-use-column-on-drop-index?
 181              (database-underlying-type database))
 182       (setq on nil))
 183     (execute-command (format nil "DROP INDEX ~A~A" index-name
 184                              (if (null on) ""
 185                                  (concatenate 'string " ON "
 186                                               (database-identifier on database))))
 187                      :database database)))
 188
 189 (defun list-indexes (&key (owner nil) (database *default-database*))
 190   "List all indexes in DATABASE, which defaults to
 191 *default-database*. If OWNER is :all , all indexs are considered. If
 192 OWNER is a string, this denotes a username and only indexs owned by
 193 OWNER are considered. Index names are returned as a list of strings."
 194   (database-list-indexes database :owner owner))
 195
 196 (defun list-table-indexes (table &key (owner nil)
 197                                       (database *default-database*))
 198   "List all indexes in DATABASE for a TABLE, which defaults to
 199 *default-database*. If OWNER is :all , all indexs are considered. If
 200 OWNER is a string, this denotes a username and only indexs owned by
 201 OWNER are considered. Index names are returned as a list of strings."
 202   (database-list-table-indexes (database-identifier table database)
 203                                database :owner owner))
 204
 205 (defun index-exists-p (name &key (owner nil) (database *default-database*))
 206   "Test for existence of an index called NAME in DATABASE which
 207 defaults to *DEFAULT-DATABASE*. If OWNER is :all , all indexs are
 208 considered. If OWNER is a string, this denotes a username and only
 209 indexs owned by OWNER are considered. Index names are returned as a
 210 list of strings."
 211   (when (member (database-identifier name database)
 212                 (list-indexes :owner owner :database database)
 213                 :test #'string-equal)
 214     t))
 215
 216 ;; Attributes
 217
 218 (defvar *cache-table-queries-default* "Default atribute type caching behavior.")
 219
 220 (defun cache-table-queries (table &key (action nil) (database *default-database*))
 221   "Provides per-table control on the caching in a particular database
 222 connection of attribute type information using during update
 223 operations. If TABLE is a string, it is the name of the table for
 224 which caching is to be altered. If TABLE is t, then the action applies
 225 to all tables. If TABLE is :default, then the default caching action
 226 is set for those tables which do not have an explicit setting. ACTION
 227 specifies the caching action. The value t means cache the attribute
 228 type information. The value nil means do not cache the attribute type
 229 information. If TABLE is :default, the setting applies to all tables
 230 which do not have an explicit setup. The value :flush means remove any
 231 existing cache for table in database, but continue to cache. This
 232 function should be called with action :flush when the attribute
 233 specifications in table have changed."
 234   (with-slots (attribute-cache) database
 235     (cond
 236       ((stringp table)
 237        (multiple-value-bind (val found) (gethash table attribute-cache)
 238          (cond
 239            ((and found (eq action :flush))
 240             (setf (gethash table attribute-cache) (list t nil)))
 241            ((and found (eq action t))
 242             (setf (gethash table attribute-cache) (list t (second val))))
 243            ((and found (null action))
 244             (setf (gethash table attribute-cache) (list nil nil)))
 245            ((not found)
 246             (setf (gethash table attribute-cache) (list action nil))))))
 247       ((eq table t)
 248        (maphash (lambda (k v)
 249                   (cond
 250                     ((eq action :flush)
 251                      (setf (gethash k attribute-cache) (list t nil)))
 252                     ((null action)
 253                      (setf (gethash k attribute-cache) (list nil nil)))
 254                     ((eq t action)
 255                      (setf (gethash k attribute-cache) (list t (second v))))))
 256                 attribute-cache))
 257       ((eq table :default)
 258        (maphash (lambda (k v)
 259                   (when (eq (first v) :unspecified)
 260                     (cond
 261                       ((eq action :flush)
 262                        (setf (gethash k attribute-cache) (list t nil)))
 263                       ((null action)
 264                        (setf (gethash k attribute-cache) (list nil nil)))
 265                       ((eq t action)
 266                        (setf (gethash k attribute-cache) (list t (second v)))))))
 267                 attribute-cache))))
 268   (values))
 269
 270
 271 (defun list-attributes (name &key (owner nil) (database *default-database*))
 272   "List the attributes of a attribute called NAME in DATABASE which
 273 defaults to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned
 274 attributes are considered. This is the default. If OWNER is :all , all
 275 attributes are considered. If OWNER is a string, this denotes a
 276 username and only attributes owned by OWNER are considered. Attribute
 277 names are returned as a list of strings. Attributes are returned as a
 278 list of strings."
 279   (database-list-attributes (database-identifier name database) database :owner owner))
 280
 281 (defun attribute-type (attribute table &key (owner nil)
 282                                  (database *default-database*))
 283   "Return the field type of the ATTRIBUTE in TABLE.  The optional
 284 keyword argument DATABASE specifies the database to query, defaulting
 285 to *DEFAULT-DATABASE*. If OWNER is nil, only user-owned attributes are
 286 considered. This is the default. If OWNER is :all , all attributes are
 287 considered. If OWNER is a string, this denotes a username and only
 288 attributes owned by OWNER are considered. Attribute names are returned
 289 as a list of strings. Attributes are returned as a list of strings."
 290   (database-attribute-type (database-identifier attribute database)
 291                            (database-identifier table database)
 292                            database
 293                            :owner owner))
 294
 295 (defun list-attribute-types (table &key (owner nil)
 296                                    (database *default-database*))
 297   "Returns type information for the attributes in TABLE from DATABASE
 298 which has a default value of *default-database*. If OWNER is nil, only
 299 user-owned attributes are considered. This is the default. If OWNER is
 300 :all, all attributes are considered. If OWNER is a string, this
 301 denotes a username and only attributes owned by OWNER are
 302 considered. Returns a list in which each element is a list (attribute
 303 datatype). Attribute is a string denoting the atribute name. Datatype
 304 is the vendor-specific type returned by ATTRIBUTE-TYPE."
 305   (with-slots (attribute-cache) database
 306     (let ((table-ident (database-identifier table database)))
 307       (multiple-value-bind (val found) (gethash table-ident attribute-cache)
 308         (if (and found (second val))
 309             (second val)
 310             (let ((types (mapcar #'(lambda (attribute)
 311                                      (cons attribute
 312                                            (multiple-value-list
 313                                             (database-attribute-type
 314                                              (database-identifier attribute database)
 315                                              table-ident
 316                                              database
 317                                              :owner owner))))
 318                                  (list-attributes table :database database :owner owner))))
 319               (cond
 320                 ((and (not found) (eq t *cache-table-queries-default*))
 321                  (setf (gethash table-ident attribute-cache) (list :unspecified types)))
 322                 ((and found (eq t (first val))
 323                       (setf (gethash table-ident attribute-cache) (list t types)))))
 324               types))))))
 325
 326
 327 ;; Sequences
 328
 329 (defun create-sequence (name &key (database *default-database*))
 330   "Create a sequence called NAME in DATABASE which defaults to
 331 *DEFAULT-DATABASE*."
 332   (let ((sequence-name (database-identifier name database)))
 333     (database-create-sequence sequence-name database))
 334   (values))
 335
 336 (defun drop-sequence (name &key (if-does-not-exist :error)
 337                            (database *default-database*))
 338   "Drops sequence NAME from DATABASE which defaults to
 339 *DEFAULT-DATABASE*. If the sequence does not exist and
 340 IF-DOES-NOT-EXIST is :ignore then DROP-SEQUENCE returns nil whereas an
 341 error is signalled if IF-DOES-NOT-EXIST is :error."
 342   (let ((sequence-name (database-identifier name database)))
 343     (ecase if-does-not-exist
 344       (:ignore
 345        (unless (sequence-exists-p sequence-name :database database)
 346          (return-from drop-sequence)))
 347       (:error t))
 348     (database-drop-sequence sequence-name database))
 349   (values))
 350
 351 (defun list-sequences (&key (owner nil) (database *default-database*))
 352   "List all sequences in DATABASE, which defaults to
 353 *default-database*. If OWNER is nil, only user-owned sequences are
 354 considered. This is the default. If OWNER is :all , all sequences are
 355 considered. If OWNER is a string, this denotes a username and only
 356 sequences owned by OWNER are considered. Sequence names are returned
 357 as a list of strings."
 358   (database-list-sequences database :owner owner))
 359
 360 (defun sequence-exists-p (name &key (owner nil)
 361                                (database *default-database*))
 362   "Test for existence of a sequence called NAME in DATABASE which
 363 defaults to *DEFAULT-DATABASE*."
 364   (when (member (database-identifier name database)
 365                 (list-sequences :owner owner :database database)
 366                 :test #'string-equal)
 367     t))
 368
 369 (defun sequence-next (name &key (database *default-database*))
 370   "Return the next value in the sequence NAME in DATABASE."
 371   (database-sequence-next (database-identifier name database) database))
 372
 373 (defun set-sequence-position (name position &key (database *default-database*))
 374   "Explicitly set the the position of the sequence NAME in DATABASE to
 375 POSITION."
 376   (database-set-sequence-position (database-identifier name database) position database))
 377
 378 (defun sequence-last (name &key (database *default-database*))
 379   "Return the last value of the sequence NAME in DATABASE."
 380   (database-sequence-last (database-identifier name database) database))
 381
 382 ;;; Remote Joins
 383
 384 (defvar *default-update-objects-max-len* nil
 385   "The default maximum number of objects supplying data for a query when updating remote joins.")
 386