postmodern/namespace.lisp

   1 (in-package :postmodern)
   2
   3 (defmacro with-schema ((schema &key (strict t) (if-not-exist :create) (drop-after nil))
   4                        &body form)
   5   "A macro to set the schema search path of the postgresql
   6    database to include as first entry a specified schema.
   7
   8    calling with strict 't only the specified schema is set as current
   9    search path. All other schema are then not searched any more.
  10
  11    calling with if-not-exist set to :create the schema is created if
  12    this schema did not exist.
  13
  14    calling with drop-after set to 't the schema is removed after the
  15    execution of the body form.
  16
  17    example :
  18      (with-schema (:schema-name :strict nil :drop-after nil :if-not-exist :error)
  19             (foo 1)
  20             (foo 2))"
  21   `(do-with-schema ,schema (lambda () ,@form)
  22      :strict ,strict :if-not-exist ,if-not-exist :drop-after ,drop-after))
  23
  24 (defun do-with-schema (schema thunk &key strict if-not-exist drop-after)
  25   (let ((old-search-path (get-search-path)))
  26     (unwind-protect
  27          (progn
  28            (unless (schema-exist-p schema)
  29              (if (eq if-not-exist :create)
  30                  (create-schema schema)
  31                  (error 'database-error :message (format nil "Schema '~a' does not exist." schema))))
  32            (set-search-path (if strict (to-sql-name schema t) (concatenate 'string (to-sql-name schema t) "," old-search-path)))
  33            (funcall thunk))
  34       (set-search-path old-search-path)
  35       (when drop-after (drop-schema schema :cascade 't)))))
  36
  37 (defun get-search-path ()
  38   (query "SHOW search_path" :single))
  39
  40 (defun set-search-path (path)
  41   (execute (format nil "SET search_path TO ~a" path)))
  42
  43 (defun list-schemata ()
  44   "List all existing user defined schemata.
  45
  46   Note: The query uses the portable information_schema relations instead of pg_tables relations
  47   SELECT schema_name FROM information_schema.schemata where schema_name !~ '(pg_*)|information_schema' ORDER BY schema_name ;"
  48   (query (:select 'schema_name
  49           :from 'information_schema.schemata
  50           :where (:!~ 'schema_name "pg_.*|information_schema")) :column))
  51
  52 (defun schema-exist-p (name)
  53   "Predicate for schema existence"
  54   (query (:select (:exists (:select 'schema_name
  55                             :from 'information_schema.schemata
  56                             :where (:= 'schema_name (to-sql-name name))))) :single))
  57
  58 (defun create-schema (schema)
  59   "Creating a non existing schema.
  60    If the schema exists an error is raised."
  61   ;;(format t "creating schema: ~a" schema)
  62   (execute (format nil "CREATE SCHEMA ~a" (s-sql:to-sql-name schema t))))
  63
  64 (defun drop-schema (schema &key (cascade nil))
  65   "Drops an existing database schema 'schema'"
  66   (execute (format nil "DROP SCHEMA ~a ~:[~;CASCADE~]" (s-sql:to-sql-name schema t) cascade)))