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