Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Browse files

Adds a very simplistic one-way sql migration system.

Exposes two new symbols: *migration-table-name* and migrations.

The migrations functions accepts a list of strings that will modify
the db, in the order they are provided.  The *migration-table-name*
stores meta-data about the migrations, notable the md5 hash of the migration,
the migration query, and when it was run.

Future invocations check the *migration-table-name* for a matching hash and
only run the query if that's not found.

migrations is meant to be run at application start up or deployment time.

refs gainesville-green:#809 (.25)
refs ADWolf:#675 (.25)
  • Loading branch information...
commit afaa57e36ff9a0a11518de1e87edf2d552800c0f 1 parent 6022c1b
@ryepup ryepup authored
Showing with 43 additions and 2 deletions.
  1. +4 −2 clsql-helper.asd
  2. +4 −0 date.lisp
  3. +35 −0 migrations.lisp
6 clsql-helper.asd
@@ -14,9 +14,11 @@
:serial T
:components ((:file "date")
(:file "clsql")
- (:file "connections"))
+ (:file "connections")
+ (:file "migrations"))
:depends-on (:iterate :clsql :closer-mop :cl-ppcre
- :cl-interpol :symbol-munger :alexandria))
+ :cl-interpol :symbol-munger :alexandria
+ :md5))
(defsystem :clsql-helper-test
:description "Tests for a library providing a clutch of utilities to make
4 date.lisp
@@ -32,6 +32,10 @@
+ ;;migration functions
+ #:*migration-table-name*
+ #:migrations
;; Put clsql into the features list so that we can
35 migrations.lisp
@@ -0,0 +1,35 @@
+(in-package #:clsql-helper)
+(defvar *migration-table-name* "clsql_helper_migrations"
+ "the table name to use for migrations")
+(defun ensure-migration-table ()
+ (unless (clsql-sys:table-exists-p *migration-table-name*)
+ (clsql-sys:create-table
+ *migration-table-name*
+ '(([hash] longchar :not-null :unique)
+ ([query] longchar :not-null)
+ ([date-entered] clsql-sys:wall-time :not-null)))))
+(defun migration-done-p (hash)
+ (clsql:select [date-entered] :from *migration-table-name*
+ :where [= [hash] hash]
+ :flatp T))
+(defun sql-hash (sql-statement)
+ (format nil "~{~x~}"
+ (coerce (md5:md5sum-sequence sql-statement) 'list)))
+(defun migrate (sql-statement &aux (hash (sql-hash sql-statement)))
+ (unless (migration-done-p hash)
+ (clsql-sys:insert-records
+ :into *migration-table-name*
+ :attributes (list [hash] [query] [date-entered])
+ :values (list hash sql-statement (clsql-helper:current-sql-time)))
+ (clsql-sys:execute-command sql-statement)))
+(defun migrations (&rest sql-statements)
+ (unless clsql-sys:*default-database* (error "must have a database connection open."))
+ (ensure-migration-table)
+ (mapc #'migrate sql-statements))

0 comments on commit afaa57e

Please sign in to comment.
Something went wrong with that request. Please try again.