mirror of
https://github.com/unclebob/more-speech.git
synced 2024-09-30 02:21:02 +00:00
Migration 10 to XTDB
This commit is contained in:
parent
dae63cb63a
commit
cb7eea5bda
@ -3,9 +3,23 @@
|
||||
[more-speech.migrator :refer :all]
|
||||
[more-speech.config :as config]
|
||||
[clojure.java.io :as io]
|
||||
[more-speech.user-configuration :as user-configuration]))
|
||||
[more-speech.user-configuration :as user-configuration]
|
||||
[more-speech.db.gateway :as gateway]
|
||||
[more-speech.db.in-memory :as in-memory]))
|
||||
|
||||
(defn delete-dir
|
||||
[& fs]
|
||||
(when-let [f (first fs)]
|
||||
(when (file-exists? f)
|
||||
(if-let [cs (seq (.listFiles (io/file f)))]
|
||||
(recur (concat cs fs))
|
||||
(do
|
||||
(io/delete-file f)
|
||||
(recur (rest fs)))))))
|
||||
|
||||
(defn change-to-tmp-files []
|
||||
(when (file-exists? "tmp")
|
||||
(delete-dir "tmp"))
|
||||
(reset! config/private-directory "tmp")
|
||||
(reset! config/migration-filename "tmp/migration")
|
||||
(reset! config/nicknames-filename "tmp/nicknames") ;grandfathered
|
||||
@ -23,21 +37,8 @@
|
||||
(prn 'changed-to-tmp)
|
||||
)
|
||||
|
||||
|
||||
(defn delete-all-files-in [dir]
|
||||
(let [files (.listFiles (io/file dir))]
|
||||
(doseq [file files]
|
||||
(let [fname (str dir "/" (.getName file))]
|
||||
(delete-file fname))))
|
||||
)
|
||||
|
||||
(defn delete-all-tmp-files []
|
||||
(delete-all-files-in "tmp/messages")
|
||||
(delete-all-files-in "tmp"))
|
||||
|
||||
(defn revert-from-tmp []
|
||||
(delete-all-tmp-files)
|
||||
(delete-file "tmp")
|
||||
(delete-dir "tmp")
|
||||
(reset! config/private-directory "private")
|
||||
(reset! config/migration-filename "private/migration")
|
||||
(reset! config/nicknames-filename "private/nicknames") ;grandfathered
|
||||
@ -53,10 +54,13 @@
|
||||
(reset! config/contact-lists-filename "private/contact-lists")
|
||||
)
|
||||
|
||||
(declare db)
|
||||
|
||||
(describe "The Migrator"
|
||||
(with-stubs)
|
||||
(before-all (change-to-tmp-files))
|
||||
(after (delete-all-tmp-files))
|
||||
(after (delete-dir "tmp")
|
||||
(.mkdir (io/file "tmp")))
|
||||
(after-all (revert-from-tmp))
|
||||
|
||||
(context "the migration framework"
|
||||
@ -225,4 +229,75 @@
|
||||
(migration-9-contact-lists)
|
||||
(should (file-exists? @config/contact-lists-filename))
|
||||
(should= {} (read-string (slurp @config/contact-lists-filename)))))
|
||||
|
||||
(context "migration 10 XTDB database"
|
||||
(with db (in-memory/get-db))
|
||||
(before-all (config/set-db! :in-memory))
|
||||
(before (in-memory/clear-db @db))
|
||||
|
||||
(it "does not load profiles if no profile file is found"
|
||||
(with-redefs [gateway/add-profile (stub :add-profile)]
|
||||
(migration-10-load-profiles)
|
||||
(should-not-have-invoked :add-profile)))
|
||||
|
||||
(it "loads profiles"
|
||||
(spit @config/profiles-filename {1 {:name "user 1"}
|
||||
2 {:name "user 2"}})
|
||||
(migration-10-load-profiles)
|
||||
(should= {:name "user 1"} (gateway/get-profile @db 1))
|
||||
(should= {:name "user 2"} (gateway/get-profile @db 2))
|
||||
(should-not (file-exists? @config/profiles-filename))
|
||||
(should (file-exists? (str @config/profiles-filename ".migrated"))))
|
||||
|
||||
(it "does not load contacts if no contacts file is found"
|
||||
(with-redefs [gateway/add-contacts (stub :add-contacts)]
|
||||
(migration-10-load-contacts)
|
||||
(should-not-have-invoked :add-contacts)))
|
||||
|
||||
(it "loads contacts"
|
||||
(spit @config/contact-lists-filename
|
||||
{1 [{:pubkey 99 :petname "pet-99"}
|
||||
{:pubkey 98 :petname "pet-98"}]
|
||||
2 [{:pubkey 97 :petname "pet-97"}
|
||||
{:pubkey 96 :petname "pet-96"}]})
|
||||
(migration-10-load-contacts)
|
||||
(should= [{:pubkey 99 :petname "pet-99"}
|
||||
{:pubkey 98 :petname "pet-98"}]
|
||||
(gateway/get-contacts @db 1))
|
||||
(should= [{:pubkey 97 :petname "pet-97"}
|
||||
{:pubkey 96 :petname "pet-96"}]
|
||||
(gateway/get-contacts @db 2))
|
||||
(should-not (file-exists? @config/contact-lists-filename))
|
||||
(should (file-exists? (str @config/contact-lists-filename ".migrated"))))
|
||||
|
||||
(it "does not load events if there are no event files"
|
||||
(with-redefs [gateway/add-event (stub :add-event)]
|
||||
(migration-10-load-events)
|
||||
(should-not-have-invoked :add-event)))
|
||||
|
||||
(it "loads events from all matching event files"
|
||||
(let [dir @config/messages-directory
|
||||
f1 "/1-1jan23"
|
||||
f2 "/2-2jan23"
|
||||
path1 (str dir f1)
|
||||
path2 (str dir f2)
|
||||
renamed-dir (str @config/messages-directory ".migrated")]
|
||||
(.mkdir (io/file "tmp/messages"))
|
||||
(spit path1 [{:id 1 :content "c1"}
|
||||
{:id 2 :content "c2"}])
|
||||
(spit path2 [{:id 3 :content "c3"}
|
||||
{:id 4 :content "c4"}])
|
||||
(migration-10-load-events)
|
||||
(should= {:id 1 :content "c1"} (gateway/get-event @db 1))
|
||||
(should= {:id 2 :content "c2"} (gateway/get-event @db 2))
|
||||
(should= {:id 3 :content "c3"} (gateway/get-event @db 3))
|
||||
(should= {:id 4 :content "c4"} (gateway/get-event @db 4))
|
||||
(should-not (file-exists? @config/messages-directory))
|
||||
(should-not (file-exists? path1))
|
||||
(should-not (file-exists? path2))
|
||||
(should (file-exists? renamed-dir))
|
||||
(should (file-exists? (str renamed-dir f1 ".migrated")))
|
||||
(should (file-exists? (str renamed-dir f2 ".migrated")))
|
||||
(prn 'got-here)))
|
||||
)
|
||||
)
|
||||
|
@ -47,7 +47,7 @@
|
||||
;; https://daringfireball.net/2010/07/improved_regex_for_matching_urls
|
||||
(def url-pattern #"(?i)\b(?:(?:[a-z][\w-]+:(?:/{1,3}|[a-z0-9%])|www\d{0,3}[.]|[a-z0-9.\-]+[.][a-z]{2,4}/)(?:[^\s()<>]+|\(?:(?:[^\s()<>]+|(?:\(?:[^\s()<>]+\)))*\))+(?:\(?:(?:[^\s()<>]+|(?:\(?:[^\s()<>]+\)))*\)|[^\s`!()\[\]{};:'\".,<>?«»“”‘’]))")
|
||||
|
||||
(def production-db :in-memory)
|
||||
(def production-db :xtdb)
|
||||
(def db-type (atom nil))
|
||||
|
||||
(defn set-db! [type] (reset! db-type type))
|
||||
|
@ -20,8 +20,7 @@
|
||||
(config/test-run!))
|
||||
(if (config/is-test-run?)
|
||||
(config/set-db! :in-memory)
|
||||
(config/set-db! config/production-db)
|
||||
)
|
||||
(config/set-db! config/production-db))
|
||||
(migrator/migrate-to config/migration-level)
|
||||
(prn 'main 'loading-configuration)
|
||||
(data-storage/load-configuration)
|
||||
|
@ -8,7 +8,8 @@
|
||||
[elliptic-signature :as ecc]
|
||||
[event-handlers :as handlers]]
|
||||
[more-speech.data-storage :as data-storage]
|
||||
[more-speech.user-configuration :as user-configuration]))
|
||||
[more-speech.user-configuration :as user-configuration]
|
||||
[more-speech.db.gateway :as gateway]))
|
||||
|
||||
(defn file-exists? [fname]
|
||||
(.exists (io/file fname)))
|
||||
@ -20,6 +21,10 @@
|
||||
(when (file-exists? fname)
|
||||
(io/delete-file fname)))
|
||||
|
||||
(defn rename-file [fname to-fname]
|
||||
(when (file-exists? fname)
|
||||
(.renameTo (io/file fname) (io/file to-fname))))
|
||||
|
||||
;---The Migrations
|
||||
|
||||
(defn initial-migration []
|
||||
@ -118,6 +123,66 @@
|
||||
@config/contact-lists-filename {})
|
||||
)
|
||||
|
||||
;--- Migration 10 XTDB database conversion
|
||||
|
||||
(defn migrate-id-map-file [filename add-f]
|
||||
(when (file-exists? filename)
|
||||
(let [id-map (read-string (slurp filename))]
|
||||
(loop [ids (keys id-map)
|
||||
n-vals 0]
|
||||
(if (empty? ids)
|
||||
(prn n-vals 'from filename 'added)
|
||||
(let [id (first ids)
|
||||
a-val (get id-map id)]
|
||||
(when (zero? (rem n-vals 100))
|
||||
(prn n-vals 'id-map 'added))
|
||||
(add-f (config/get-db) id a-val)
|
||||
(recur (rest ids) (inc n-vals)))))
|
||||
(rename-file filename (str filename ".migrated"))))
|
||||
)
|
||||
|
||||
(defn migration-10-load-profiles []
|
||||
(migrate-id-map-file @config/profiles-filename gateway/add-profile))
|
||||
|
||||
(defn migration-10-load-contacts []
|
||||
(migrate-id-map-file @config/contact-lists-filename gateway/add-contacts))
|
||||
|
||||
(defn is-message-file? [file-name]
|
||||
(re-matches #"\d+\-\d+\w+\d+" file-name))
|
||||
|
||||
(defn load-event-file [file-name]
|
||||
(loop [events (read-string (slurp file-name))]
|
||||
(if (empty? events)
|
||||
nil
|
||||
(let [event (first events)
|
||||
id (:id event)]
|
||||
(gateway/add-event (config/get-db) id event)
|
||||
(recur (rest events))))))
|
||||
|
||||
(defn migration-10-load-events []
|
||||
(when (file-exists? @config/messages-directory)
|
||||
(let [message-directory (io/file @config/messages-directory)
|
||||
files (.listFiles message-directory)
|
||||
file-names (for [file files] (.getName file))
|
||||
file-names (filter is-message-file? file-names)]
|
||||
(loop [file-names file-names]
|
||||
(if (empty? file-names)
|
||||
(println "Done loading event files.\n")
|
||||
(let [file-name (first file-names)
|
||||
file-path (str @config/messages-directory "/" file-name)]
|
||||
(printf "Loading event file: %s\n" file-path)
|
||||
(load-event-file file-path)
|
||||
(rename-file file-path (str file-path ".migrated"))
|
||||
(recur (rest file-names)))))
|
||||
(rename-file @config/messages-directory (str @config/messages-directory ".migrated")))))
|
||||
|
||||
(defn migration-10-XTDB-converstion []
|
||||
(migration-10-load-profiles)
|
||||
(migration-10-load-contacts)
|
||||
(migration-10-load-events))
|
||||
|
||||
|
||||
|
||||
|
||||
;---------- The Migrations List -------
|
||||
|
||||
@ -130,6 +195,7 @@
|
||||
7 migration-7-break-messages-into-daily-files
|
||||
8 migration-8-user-configuration
|
||||
9 migration-9-contact-lists
|
||||
10 migration-10-XTDB-converstion
|
||||
}))
|
||||
|
||||
;--------------------------------------
|
||||
@ -166,3 +232,5 @@
|
||||
(recur (rest levels))))))
|
||||
(set-migration-level level))
|
||||
(throw (Exception. (format "Missing migrations %s." (vec missing-levels)))))))
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user