Browse files

Initial import

  • Loading branch information...
0 parents commit 905b4aa8c00aca92df5b8b8fbe604fb180c6aabe @madnificent committed Apr 16, 2009
Showing with 148 additions and 0 deletions.
  1. +5 −0 .gitignore
  2. +14 −0 database-versioning.asd
  3. +129 −0 versioning.lisp
@@ -0,0 +1,5 @@
@@ -0,0 +1,14 @@
+(defpackage :database-versioning.sysdef
+ (:use :common-lisp :asdf))
+(in-package :database-versioning.sysdef)
+(defsystem :database-versioning
+ :name "Database Versioning"
+ :author "Aad Versteden <>"
+ :version "1.0"
+ :maintainer "Aad Versteden <>"
+ :licence "MIT"
+ :description "System to version the database in roughly the same way rails migrations work."
+ :depends-on (:postmodern)
+ :components ((:file "versioning")))
@@ -0,0 +1,129 @@
+(defpackage :database-versioning
+ (:use :common-lisp
+ :postmodern)
+ (:export :*db-connection-parameters*
+ :def-migration
+ :def-query-migration
+ :def-queries-migration
+ :upgrade
+ :downgrade
+ :run-unregistered-migrations))
+(defpackage :migration-user
+ (:use :common-lisp
+ :database-versioning))
+(in-package :database-versioning)
+(defparameter *migrations* nil
+ "Contains all the migrations that can be executed")
+(defparameter *db-connection-parameters* '("database" "user" "password" "host")
+ "Set the connection settings here, is it will be used to connect to the needed database")
+(setf *db-connection-parameters* '("mycar_development" "mycar_dev" "mycar" "localhost"))
+(defmacro with-db (&body body)
+ `(postmodern:with-connection *db-connection-parameters*
+ ,@body))
+(defstruct migration
+ number subject execute revert)
+(defun def-migration (&key number subject execute revert)
+ "Creates the most basic form of a new migration.
+A migration is referred to by its number and subject. Each migration should differ in that combination.
+Execute must be the function to be called when the migration is applied.
+Revert must be the function to be called when the migration is reverted."
+ (push (make-migration :number number :execute execute :revert revert :subject subject) *migrations*))
+(defmacro def-query-migration (number subject &key execute revert)
+ "Creates a migration for an sql query.
+This only differs with def-migration in the way execute and revert are defined. In definition both execute and revert are wrapped inside (lambda () (with-db (execute <here be supplied content>))) which allows you to only write the query and not the extra stuff surrounding it. with-db sets up a database environment for the variables set in *db-connection-paramters*"
+ `(def-migration :number ,number :subject ,subject
+ :execute (lambda () (with-db (execute ,execute)))
+ :revert (lambda () (with-db (execute ,revert)))))
+(defmacro def-queries-migration (number subject &key ((:execute execute-queries)) ((:revert revert-queries)))
+ "Creates a migration for a range of sql queries.
+This is similar to def-migration, but instead of allowing one query, it allows you to supply a range of queries.
+(def-queries-migration 1239888485 \"example queries migration\"
+ :execute (\"CREATE TABLE application_user ( user_id SERIAL PRIMARY KEY, name text, email text )\"
+ \"CREATE TABLE user_books ( book_id SERIAL PRIMARY KEY, owner_id INTEGER REFERENCES application_user, title text )\")
+ :revert (\"DROP TABLE application_user, user_books CASCADE\"))"
+ `(def-migration :number ,number :subject ,subject
+ :execute (lambda () ,@(map 'list
+ (lambda (query)
+ `(with-db (execute ,query)))
+ execute-queries))
+ :revert (lambda () ,@(map 'list
+ (lambda (query)
+ `(with-db (execute ,query)))
+ revert-queries))))
+(defun schema-has-migration-p (migration)
+ "Checks whether or not the schema contains the given migration. The migration is stored by its number and its description."
+ (with-db
+ (handler-case (not (zerop (query (:select (:count '*)
+ :from 'schema_version
+ :where (:and (:= 'number (migration-number migration))
+ (:= 'subject (migration-subject migration))))
+ :single)))
+ (database-error ()
+ (format *debug-io* "No table schema_version found, creating...")
+ (with-transaction (setup-schema-version)
+ (query (:create-table "schema_version" ((number :type integer) (subject :type text))))
+ nil)))))
+(defun migration-schema-register (migration)
+ "Register a migration as to pretend it has been executed"
+ (with-db (query (:insert-into 'schema_version :set 'number (migration-number migration) 'subject (migration-subject migration)))))
+(defun migration-schema-revert (migration)
+ "Revert a migration as to pretend it was not executed"
+ (with-db (query (:delete-from 'schema-version
+ :where (:and (:= 'number (migration-number migration))
+ (:= 'subject (migration-subject migration)))))))
+(defun run-migration (migration &optional revert-p (register-p T))
+ "Runs a single migration with all possible options"
+ (format T "~&~A ~A:~A ... " (if revert-p "Revert" "Execute") (migration-number migration) (migration-subject migration))
+ (if revert-p
+ (if (or (not register-p) (schema-has-migration-p migration))
+ (progn
+ (funcall (migration-revert migration))
+ (when register-p (migration-schema-revert migration))
+ (format T "DONE~%"))
+ (format T "FAILED (migration not present)~%"))
+ (if (or (not register-p) (not (schema-has-migration-p migration)))
+ (progn
+ (funcall (migration-execute migration))
+ (when register-p (migration-schema-register migration))
+ (format T "DONE~%"))
+ (format T "FAILED (migration already present)~%"))))
+(defun run-unregistered-migrations (from to &optional (revert nil revert-p))
+Forcibly runs the given migrations without writing the changes in the schema.
+This is something you should never really need to run."
+ (unless revert-p
+ (setf revert (>= to from)))
+ (loop for migration in (sort (copy-list *migrations*) (if revert '> '<) :key 'migration-number) do
+ (if (funcall (if revert '>= '<=) from (migration-number migration) to)
+ (run-migration migration revert nil))))
+(defmacro downgrade (&optional (version 0))
+ "Downgrades the database to the given version.
+This will revert all migrations that have been run with a migration-number greater than <version>.
+The migrations are downgraded from the greatest available migration-number, to the lowest.
+When no version is given, 0 is assumed as that will clear the database (migration_schema will continue to exist)."
+ `(progn ,@(loop for migration in (sort (copy-list *migrations*) '> :key 'migration-number) collect
+ `(if (and ,(<= version (migration-number migration)) (schema-has-migration-p ,migration))
+ (run-migration ,migration T T)))))
+(defmacro upgrade (&optional (version nil))
+ "Upgrades the database to the given version.
+This will run all migrations that haven't been ran yet and that have a smaller migration-number than <version>.
+The migrations are upgraded from the smallest available migration-number to the largest available one (with a cap on <version>).
+When no version is given, all available migrations are executed."
+ `(progn ,@(loop for migration in (sort (copy-list *migrations*) '< :key 'migration-number) collect
+ `(if (and (not (schema-has-migration-p ,migration))
+ ,(or (not version) (>= version (migration-number migration))))
+ (run-migration ,migration nil T)))))

0 comments on commit 905b4aa

Please sign in to comment.