sql/fddl.lisp

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