# HG changeset patch # User Steve Losh # Date 1712325765 14400 # Node ID 6b27e5b734d841f97cb26f96926aa62dc63f21b9 # Parent 9ca19318301fdbbe8348f840f7da50770e63e3a9 Get Postgres working, add CLI diff -r 9ca19318301f -r 6b27e5b734d8 .hgignore --- 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/ diff -r 9ca19318301f -r 6b27e5b734d8 Makefile --- 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/ diff -r 9ca19318301f -r 6b27e5b734d8 dbvolve.asd --- 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 " + + :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 " :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 " + + :depends-on (:dbvolve :dbvolve/sqlite :dbvolve/postmodern :adopt) + + :serial t + :components ((:module "src" :serial t + :components ((:file "cli"))))) diff -r 9ca19318301f -r 6b27e5b734d8 docs/01-usage.markdown --- 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] diff -r 9ca19318301f -r 6b27e5b734d8 src/cli.lisp --- /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)) diff -r 9ca19318301f -r 6b27e5b734d8 src/main.lisp --- 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)))))))) diff -r 9ca19318301f -r 6b27e5b734d8 src/package.lisp --- 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)) diff -r 9ca19318301f -r 6b27e5b734d8 src/postmodern.lisp --- /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)))) + diff -r 9ca19318301f -r 6b27e5b734d8 src/sqlite.lisp --- 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)) - diff -r 9ca19318301f -r 6b27e5b734d8 test/example-0/.placeholder diff -r 9ca19318301f -r 6b27e5b734d8 test/example-1/.placeholder diff -r 9ca19318301f -r 6b27e5b734d8 test/example-1/0000-users-table.sql --- /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'); diff -r 9ca19318301f -r 6b27e5b734d8 test/example-2/.placeholder diff -r 9ca19318301f -r 6b27e5b734d8 test/example-2/0000-users-table.sql --- /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 diff -r 9ca19318301f -r 6b27e5b734d8 test/example-2/0001-add-email.sql --- /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'; diff -r 9ca19318301f -r 6b27e5b734d8 test/example-3/.placeholder diff -r 9ca19318301f -r 6b27e5b734d8 test/example-3/0000-users-table.sql --- /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 diff -r 9ca19318301f -r 6b27e5b734d8 test/example-3/0001-add-email.sql --- /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 diff -r 9ca19318301f -r 6b27e5b734d8 test/example-3/0002-add-todos.sql --- /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); +