--- a/.hgignore Thu Apr 04 11:14:24 2024 -0400
+++ b/.hgignore Fri Apr 05 10:02:45 2024 -0400
@@ -4,3 +4,5 @@
*.png
docs/build
*.sqlite
+bin/
+man/
--- a/Makefile Thu Apr 04 11:14:24 2024 -0400
+++ b/Makefile Fri Apr 05 10:02:45 2024 -0400
@@ -5,6 +5,8 @@
docfiles = $(shell ls docs/*.markdown)
apidocs = $(shell ls docs/*reference*.markdown)
+all: bin/dbvolve
+
# Testing ---------------------------------------------------------------------
test: test-sbcl test-ccl test-ecl test-abcl
@@ -38,3 +40,11 @@
rsync --delete -a ./docs/build/ ~/src/docs.stevelosh.com/dbvolvet
hg -R ~/src/docs.stevelosh.com commit -Am 'dbvolvet: Update site.'
hg -R ~/src/docs.stevelosh.com push
+
+# CLI -------------------------------------------------------------------------
+bin/dbvolve: $(sourcefiles)
+ mkdir -p bin
+ mkdir -p man
+ sbcl-raw --noinform --disable-debugger --eval '(ql:quickload :dbvolve/cli)' --eval '(dbvolve/cli:build)'
+ mv ./dbvolve bin/
+ mv ./dbvolve.1 man/
--- a/dbvolve.asd Thu Apr 04 11:14:24 2024 -0400
+++ b/dbvolve.asd Fri Apr 05 10:02:45 2024 -0400
@@ -13,8 +13,18 @@
:components ((:file "package")
(:file "main")))))
+(asdf:defsystem :dbvolve/postmodern
+ :description "DBvolve for Postmodern."
+ :author "Steve Losh <steve@stevelosh.com>"
+
+ :depends-on (:dbvolve :postmodern)
+
+ :serial t
+ :components ((:module "src" :serial t
+ :components ((:file "postmodern")))))
+
(asdf:defsystem :dbvolve/sqlite
- :description "DBvolve for sqlite."
+ :description "DBvolve for cl-sqlite."
:author "Steve Losh <steve@stevelosh.com>"
:depends-on (:dbvolve :sqlite)
@@ -22,3 +32,13 @@
:serial t
:components ((:module "src" :serial t
:components ((:file "sqlite")))))
+
+(asdf:defsystem :dbvolve/cli
+ :description "CLI program for DBvolve."
+ :author "Steve Losh <steve@stevelosh.com>"
+
+ :depends-on (:dbvolve :dbvolve/sqlite :dbvolve/postmodern :adopt)
+
+ :serial t
+ :components ((:module "src" :serial t
+ :components ((:file "cli")))))
--- a/docs/01-usage.markdown Thu Apr 04 11:14:24 2024 -0400
+++ b/docs/01-usage.markdown Fri Apr 05 10:02:45 2024 -0400
@@ -3,7 +3,6 @@
DBvolve is a lightweight library for evolving a database schema over time. It
might be called a "database migration library" except that "migrations" are
-round-trip, and DBvolve explicitly and intentionally does not support backwards
-migrations.
+round-trip, and DBvolve intentionally does not support backwards migrations.
[TOC]
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cli.lisp Fri Apr 05 10:02:45 2024 -0400
@@ -0,0 +1,202 @@
+(defpackage :dbvolve/cli
+ (:use :cl)
+ (:export :toplevel :build))
+
+(in-package :dbvolve/cli)
+
+
+;;;; Configuration ------------------------------------------------------------
+(defparameter *version* "0.0.1")
+
+
+;;;; Run ----------------------------------------------------------------------
+(defun database (options)
+ (ecase (gethash 'database options)
+ (:sqlite (sqlite:connect (or (gethash 'dbi-path options)
+ (error "--db-path is required for sqlite"))))
+ (:postgres (postmodern:connect
+ (or (gethash 'dbi-database options)
+ (error "--db-database is required for Postgres"))
+ (or (gethash 'dbi-user options)
+ (error "--db-user is required for Postgres"))
+ (or (gethash 'dbi-password options)
+ (error "--db-password is required for Postgres"))
+ (or (gethash 'dbi-host options)
+ (error "--db-host is required for Postgres"))
+ :port (or (gethash 'dbi-port options)
+ (error "--db-port is required for Postgres"))))
+ (:fake :fake)))
+
+(defun run (evolutions-path options)
+ (let ((db (database options)))
+ (dbvolve:evolve db evolutions-path)))
+
+
+;;;; User Interface -----------------------------------------------------------
+(defparameter *examples*
+ '(("Evolve a sqlite3 database:" . "dbvolve path/to/evolutions/ --sqlite --db-path foo.sqlite")
+ ("Evolve a Postgres database:" . "dbvolve path/to/evolutions/ --postgres --db-user user --db-host localhost --db-port 5432 --db-database testdb --db-password-command 'retrieve-secret.sh testdb-password'")))
+
+
+(defparameter *option-help*
+ (adopt:make-option 'help
+ :help "Display help and exit."
+ :long "help"
+ :short #\h
+ :reduce (constantly t)))
+
+(defparameter *option-version*
+ (adopt:make-option 'version
+ :help "Display version information and exit."
+ :long "version"
+ :reduce (constantly t)))
+
+(defparameter *option-db-sqlite*
+ (adopt:make-option 'sqlite
+ :result-key 'database
+ :help "Connect to a sqlite3 database at PATH. Requires --db-path."
+ :long "sqlite"
+ :reduce (constantly :sqlite)))
+
+(defparameter *option-db-postgres*
+ (adopt:make-option 'postgres
+ :result-key 'database
+ :help "Connect to a Postgres database. Requires --db-user, etc."
+ :long "postgres"
+ :reduce (constantly :postgres)))
+
+(defparameter *option-db-fake*
+ (adopt:make-option 'fake
+ :result-key 'database
+ :help "Connect to a fake database and dump SQL to standard output."
+ :long "fake"
+ :reduce (constantly :fake)))
+
+(defparameter *option-dbi-path*
+ (adopt:make-option 'dbi-path
+ :help "Connect to database file at PATH."
+ :parameter "PATH"
+ :long "db-path"
+ :reduce #'adopt:last))
+
+(defparameter *option-dbi-host*
+ (adopt:make-option 'dbi-host
+ :help "Connect to database running at HOST."
+ :parameter "HOST"
+ :long "db-host"
+ :reduce #'adopt:last))
+
+(defparameter *option-dbi-user*
+ (adopt:make-option 'dbi-user
+ :help "Connect to database as USER."
+ :parameter "USER"
+ :long "db-user"
+ :reduce #'adopt:last))
+
+(defparameter *option-dbi-password*
+ (adopt:make-option 'dbi-password
+ :result-key 'dbi-password
+ :help "Connect to database with password PASS."
+ :parameter "PASS"
+ :long "db-password"
+ :reduce #'adopt:last))
+
+(defparameter *option-dbi-password-file*
+ (adopt:make-option 'dbi-password-file
+ :result-key 'dbi-password
+ :help "Connect to database with password read from PATH."
+ :parameter "PATH"
+ :long "db-password-file"
+ :key (lambda (path)
+ (string-trim '(#\newline) (uiop:read-file-string path)))
+ :reduce #'adopt:last))
+
+(defparameter *option-dbi-password-command*
+ (adopt:make-option 'dbi-password
+ :result-key 'dbi-password
+ :help "Connect to database with password output on stdout from CMD."
+ :parameter "CMD"
+ :long "db-password-command"
+ :key (lambda (cmd)
+ (uiop:run-program cmd :output '(:string :stripped t)))
+ :reduce #'adopt:last))
+
+(defparameter *option-dbi-port*
+ (adopt:make-option 'dbi-port
+ :help "Connect to database on port PORT."
+ :parameter "PORT"
+ :long "db-port"
+ :key #'parse-integer
+ :reduce #'adopt:last))
+
+(defparameter *option-dbi-database*
+ (adopt:make-option 'dbi-database
+ :help "Connect to database named DB."
+ :parameter "DB"
+ :long "db-database"
+ :reduce #'adopt:last))
+
+(defparameter *group-databases*
+ (adopt:make-group 'databases
+ :title "Databases"
+ :options (list *option-db-sqlite*
+ *option-db-postgres*
+ *option-db-fake*)))
+
+(defparameter *group-database-info*
+ (adopt:make-group 'database-info
+ :title "Database Info"
+ :options (list
+ *option-dbi-path*
+ *option-dbi-database*
+ *option-dbi-host*
+ *option-dbi-port*
+ *option-dbi-user*
+ *option-dbi-password*
+ *option-dbi-password-file*
+ *option-dbi-password-command*)))
+
+
+(adopt:define-string *help-text*
+ "Command line interface to the Common Lisp DBvolve library.")
+
+(defparameter *ui*
+ (adopt:make-interface
+ :name "dbvolve"
+ :usage "[OPTIONS] PATH"
+ :summary "evolve a database"
+ :help *help-text*
+ :examples *examples*
+ :contents (list *option-help*
+ *option-version*
+ *group-databases*
+ *group-database-info*)))
+
+(defun toplevel ()
+ (handler-case
+ (multiple-value-bind (arguments options) (adopt:parse-options *ui*)
+ (when (gethash 'help options)
+ (adopt:print-help-and-exit *ui*))
+ (when (gethash 'version options)
+ (write-line *version*)
+ (adopt:exit))
+ (cond ((null arguments)
+ (error "PATH to evolutions directory is required."))
+ ((> (length arguments) 1)
+ (error "Exactly one PATH to evolutions directory is required, got: ~S" arguments)))
+ (let ((db (gethash 'database options))
+ (evolutions (first arguments)))
+ (when (null db)
+ (error "No database specified."))
+ (run evolutions options)))
+ (error (c) (adopt:print-error-and-exit c))))
+
+
+(defun build ()
+ (with-open-file (f "dbvolve.1" :direction :output :if-exists :supersede)
+ (adopt:print-manual *ui* :stream f))
+ (sb-ext:save-lisp-and-die "dbvolve"
+ :executable t
+ :compression t
+ :save-runtime-options t
+ :toplevel 'toplevel))
--- a/src/main.lisp Thu Apr 04 11:14:24 2024 -0400
+++ b/src/main.lisp Fri Apr 05 10:02:45 2024 -0400
@@ -1,5 +1,13 @@
(in-package :dbvolve)
+;;;; Logging -----------------------------------------------------------------
+(defparameter *log-stream* *error-output*)
+
+(defun logging (format-string &rest arguments)
+ (when *log-stream*
+ (apply #'format *log-stream* format-string arguments)))
+
+
;;;; Data ---------------------------------------------------------------------
(defclass evolution ()
((id :initarg :id :accessor id)
@@ -56,7 +64,7 @@
(result (sort (coerce parsed 'vector) #'< :key #'id)))
(if (plusp (length result))
(check-evolutions result)
- (warn "Could not find any evolutions in ~S." path))
+ (logging "Could not find any evolutions in ~S." path))
result))
@@ -65,73 +73,78 @@
(defgeneric create-metadata-table (db))
(defgeneric lock-metadata-table (db))
(defgeneric find-current-number (db))
-(defgeneric dump-current-state (db))
(defgeneric run-evolution (db evolution))
(defgeneric record-evolution (db evolution))
-(defgeneric commit (db))
;;;; Stub Implementation ------------------------------------------------------
-(defmethod call-with-new-transaction ((db null) thunk)
- (funcall thunk))
-
-(defmethod create-metadata-table ((db null))
- (write-line "
- CREATE TABLE IF NOT EXISTS dbvolve (
- id BIGINT PRIMARY KEY,
- name TEXT NOT NULL,
- created TIMESTAMPTZ NOT NULL DEFAULT now()
- );
- "))
+(defmethod call-with-new-transaction ((db (eql :fake)) thunk)
+ (let ((ok nil))
+ (unwind-protect (progn
+ (funcall thunk)
+ (setf ok t))
+ (if ok
+ (write-line "COMMIT;")
+ (write-line "ROLLBACK;")))))
-(defmethod lock-metadata-table ((db null))
- (write-line "LOCK TABLE dvolve;")
- )
+(defmethod create-metadata-table ((db (eql :fake)))
+ (write-line (format nil "~
+CREATE TABLE IF NOT EXISTS dbvolve (
+ id BIGINT PRIMARY KEY,
+ name TEXT NOT NULL,
+ created TIMESTAMPTZ NOT NULL DEFAULT now()
+);")))
-(defmethod find-current-number ((db null))
+(defmethod lock-metadata-table ((db (eql :fake)))
+ (write-line "LOCK TABLE dvolve;"))
+
+(defmethod find-current-number ((db (eql :fake)))
(write-line "SELECT max(id) FROM dbvolve;")
- 1)
+ nil)
-(defmethod dump-current-state ((db null))
- (write-line "SELECT * FROM dbvolve;"))
-
-(defmethod run-evolution ((db null) (evolution evolution/sql))
+(defmethod run-evolution ((db (eql :fake)) (evolution evolution/sql))
(write-line (uiop:read-file-string (path evolution))))
-(defmethod record-evolution ((db null) evolution)
+(defmethod record-evolution ((db (eql :fake)) evolution)
(write-line (format nil "INSERT INTO dbvolve (id, name, file) VALUES (~S, ~S);"
(id evolution)
(name evolution))))
-(defmethod commit ((db null)))
-
;;;; API ----------------------------------------------------------------------
(defun evolve% (database evolutions)
- (dolist (evolution evolutions)
- (format t "~%Running ~A.~%" evolution)
- (run-evolution database evolution)
- (record-evolution database evolution)
- (format t "Finished ~A.~%" evolution)))
+ (map nil (lambda (evolution)
+ (logging " Running ~A.~%" evolution)
+ (run-evolution database evolution)
+ (record-evolution database evolution)
+ (logging " Finished ~A.~%" evolution))
+ evolutions))
(defun evolve (database evolutions-path)
(let* ((path (uiop:parse-native-namestring evolutions-path :ensure-directory t))
(evolutions (find-evolutions path)))
- (if (zerop (length evolutions))
- (warn "No evolutions found in ~S, doing nothing." evolutions-path)
- (let ((n (length evolutions)))
- (call-with-new-transaction
- database
- (lambda ()
- (create-metadata-table database)
- (lock-metadata-table database)
- (let* ((current (find-current-number database))
- (start (1+ current)))
- (format t "Found ~D evolution~:P, DB has ~D, running ~D evolution~:P.~%"
- n (1+ current) (- n start))
- (evolve% database (subseq evolutions start))
- (commit)
- (format t "Finished running ~D evolution~:P successfully.~%" n))))))))
+ (when (zerop (length evolutions))
+ (logging "No evolutions found in ~S, doing nothing." evolutions-path)
+ (return-from evolve))
+ (let ((n (length evolutions)))
+ (call-with-new-transaction
+ database
+ (lambda ()
+ (logging "Creating metadata table if needed.~%")
+ (create-metadata-table database)
+ (logging "Obtaining table lock.~%")
+ (lock-metadata-table database)
+ (let* ((current (or (find-current-number database) -1))
+ (dbn (1+ current))
+ (start (1+ current)))
+ (when (> dbn n)
+ (logging "Found ~D evolution~:P but DB has ~D, not running anything.~%"
+ n dbn)
+ (return-from evolve))
+ (logging "Found ~D evolution~:P, DB has ~D, running ~D evolution~:P.~%"
+ n dbn (- n dbn))
+ (evolve% database (subseq evolutions start))
+ (logging "Finished running ~D evolution~:P successfully.~%" (- n dbn))))))))
--- a/src/package.lisp Thu Apr 04 11:14:24 2024 -0400
+++ b/src/package.lisp Fri Apr 05 10:02:45 2024 -0400
@@ -1,4 +1,19 @@
-(defpackage :dbvolve
+(defpackage :dbvolve/protocol
(:use :cl)
(:export
- ))
+ :call-with-new-transaction
+ :create-metadata-table
+ :lock-metadata-table
+ :find-current-number
+ :run-evolution
+ :record-evolution
+
+ :evolution
+ :evolution/sql
+ :id
+ :name
+ :path))
+
+(defpackage :dbvolve
+ (:use :cl :dbvolve/protocol)
+ (:export :evolve))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/postmodern.lisp Fri Apr 05 10:02:45 2024 -0400
@@ -0,0 +1,44 @@
+(defpackage :dbvolve/postmodern
+ (:use :cl :dbvolve/protocol)
+ (:export))
+
+(in-package :dbvolve/postmodern)
+
+;;;; Implementation -----------------------------------------------------------
+(defmethod dbvolve/protocol:call-with-new-transaction ((db postmodern:database-connection) thunk)
+ (let ((postmodern:*database* db))
+ (postmodern:with-transaction ()
+ (funcall thunk))))
+
+(defmethod dbvolve/protocol:create-metadata-table ((db postmodern:database-connection))
+ (let ((postmodern:*database* db))
+ (postmodern:execute "CREATE TABLE IF NOT EXISTS dbvolve (
+ id BIGSERIAL PRIMARY KEY,
+ name TEXT NOT NULL,
+ created TIMESTAMPTZ NOT NULL DEFAULT now()
+ )")))
+
+(defmethod dbvolve/protocol:lock-metadata-table ((db postmodern:database-connection))
+ (let ((postmodern:*database* db))
+ (postmodern:execute "LOCK TABLE dbvolve;"))
+ (values))
+
+(defmethod dbvolve/protocol:find-current-number ((db postmodern:database-connection))
+ (let ((postmodern:*database* db))
+ (destructuring-bind ((result))
+ (postmodern:query "SELECT max(id) FROM dbvolve;")
+ (if (eql :null result)
+ -1
+ result))))
+
+(defmethod dbvolve/protocol:run-evolution
+ ((db postmodern:database-connection) (evolution dbvolve/protocol:evolution/sql))
+ (let ((postmodern:*database* db))
+ (postmodern:execute-file (dbvolve/protocol:path evolution))))
+
+(defmethod dbvolve/protocol:record-evolution ((db postmodern:database-connection) evolution)
+ (let ((postmodern:*database* db))
+ (postmodern:execute "INSERT INTO dbvolve (id, name) VALUES ($1, $2);"
+ (dbvolve/protocol:id evolution)
+ (dbvolve/protocol:name evolution))))
+
--- a/src/sqlite.lisp Thu Apr 04 11:14:24 2024 -0400
+++ b/src/sqlite.lisp Fri Apr 05 10:02:45 2024 -0400
@@ -6,7 +6,7 @@
;;;; Implementation -----------------------------------------------------------
-(defmethod dbvolve::call-with-new-transaction ((db sqlite:sqlite-handle) thunk)
+(defmethod dbvolve/protocol:call-with-new-transaction ((db sqlite:sqlite-handle) thunk)
(let ((ok nil))
(sqlite:execute-non-query db "BEGIN TRANSACTION EXCLUSIVE")
(unwind-protect (progn (funcall thunk)
@@ -15,7 +15,7 @@
(sqlite:execute-non-query db "COMMIT TRANSACTION")
(sqlite:execute-non-query db "ROLLBACK TRANSACTION")))))
-(defmethod dbvolve::create-metadata-table ((db sqlite:sqlite-handle))
+(defmethod dbvolve/protocol:create-metadata-table ((db sqlite:sqlite-handle))
(sqlite:execute-non-query db
"CREATE TABLE IF NOT EXISTS dbvolve (
id BIGINT PRIMARY KEY,
@@ -23,27 +23,20 @@
created TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP
)"))
-(defmethod dbvolve::lock-metadata-table ((db sqlite:sqlite-handle))
+(defmethod dbvolve/protocol:lock-metadata-table ((db sqlite:sqlite-handle))
;; noop due to transaction-based locking
(values))
-(defmethod dbvolve::find-current-number ((db sqlite:sqlite-handle))
+(defmethod dbvolve/protocol:find-current-number ((db sqlite:sqlite-handle))
(or (sqlite:execute-single db "SELECT max(id) FROM dbvolve;") -1))
-(defmethod dbvolve::dump-current-state ((db sqlite:sqlite-handle))
- (sqlite:execute-to-list db "SELECT * FROM dbvolve;"))
+(defmethod dbvolve/protocol:run-evolution
+ ((db sqlite:sqlite-handle) (evolution dbvolve/protocol:evolution/sql))
+ (sqlite:execute-script db
+ (uiop:read-file-string (dbvolve/protocol:path evolution))))
-(defmethod dbvolve::run-evolution
- ((db sqlite:sqlite-handle) (evolution dbvolve::evolution/sql))
- (sqlite:execute-script db
- (uiop:read-file-string (dbvolve::path evolution))))
-
-(defmethod dbvolve::record-evolution ((db sqlite:sqlite-handle) evolution)
+(defmethod dbvolve/protocol:record-evolution ((db sqlite:sqlite-handle) evolution)
(sqlite:execute-non-query db
"INSERT INTO dbvolve (id, name) VALUES (?, ?);"
- (dbvolve::id evolution) (dbvolve::name evolution)))
+ (dbvolve/protocol:id evolution) (dbvolve/protocol:name evolution)))
-(defmethod dbvolve::commit ((db sqlite:sqlite-handle))
- ;; noop, handled by transaction wrapper
- (values))
-
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/test/example-1/0000-users-table.sql Fri Apr 05 10:02:45 2024 -0400
@@ -0,0 +1,6 @@
+CREATE TABLE users (
+ id INTEGER PRIMARY KEY,
+ name TEXT NOT NULL
+);
+
+INSERT INTO users (id, name) VALUES (0, 'sjl');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/test/example-2/0000-users-table.sql Fri Apr 05 10:02:45 2024 -0400
@@ -0,0 +1,1 @@
+../example-1/0000-users-table.sql
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/test/example-2/0001-add-email.sql Fri Apr 05 10:02:45 2024 -0400
@@ -0,0 +1,3 @@
+ALTER TABLE users ADD COLUMN email TEXT NOT NULL DEFAULT '';
+
+UPDATE users SET email = 'steve@stevelosh.com' WHERE NAME = 'sjl';
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/test/example-3/0000-users-table.sql Fri Apr 05 10:02:45 2024 -0400
@@ -0,0 +1,1 @@
+../example-1/0000-users-table.sql
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/test/example-3/0001-add-email.sql Fri Apr 05 10:02:45 2024 -0400
@@ -0,0 +1,1 @@
+../example-2/0001-add-email.sql
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/test/example-3/0002-add-todos.sql Fri Apr 05 10:02:45 2024 -0400
@@ -0,0 +1,12 @@
+CREATE TABLE todos (
+ id INTEGER PRIMARY KEY,
+ user_id INTEGER NOT NULL,
+ done BOOLEAN NOT NULL,
+ content TEXT,
+
+ FOREIGN KEY (user_id) REFERENCES users(id)
+);
+
+INSERT INTO todos (id, user_id, content, done) VALUES (0, 0, 'Write DBvolve skeleton.', TRUE);
+INSERT INTO todos (id, user_id, content, done) VALUES (1, 0, 'Write DBvolve test suite.', FALSE);
+