Commit c7ab9f24 authored by Bruno Burke's avatar Bruno Burke 🍔

use storage protocol for git storage

parent e25db3ce
Pipeline #59848 passed with stages
in 1 minute and 4 seconds
(defproject document-storage "0.1.8"
(defproject document-storage "0.2.0"
:description "FIXME: write description"
:url "http://example.com/FIXME"
:license {:name "Eclipse Public License"
......
(ns document-storage.core
(:require [clj-jgit.porcelain :as jp]
[clojure.tools.logging :as log]
[clojure.java.io :as io]
[clojure.edn :refer [read-string]]
[document-storage.query :refer [query-fits? update-queries update-queries-remove-document]]
[document-storage.versioning :as versioning]
[document-storage.repository :refer [repositories init-repository valid-id?
default-repository
no-commit-repository?
cached-repository?
get-file-path
get-repo
get-repo-data
get-repository-path]]
[document-storage.views :refer [get-views generate-views]]
[fipp.edn :refer [pprint] :rename {pprint fipp}]))
(defonce repo-dir (atom ""))
(defonce upstream-ssh-identity "upstream")
(defonce storage-directory (atom ""))
(defonce cache (atom {}))
(defn load-config [dir]
(-> dir
(str "/config.edn")
slurp
read-string))
(defn init-storage [dir]
(log/info "Init Storage in " dir)
(reset! storage-directory dir)
(if-let [config (load-config dir)]
(doseq [repo (keys (:repositories config))]
(swap! repositories
assoc repo
(merge {:directory (str dir "/" (name repo))
:unsaved-files []
:git-repo (init-repository (str dir "/" (name repo)))}
(get (:repositories config) repo))))
(log/error "Unable to initialize Document Storage - no config!")))
(defn reset-cache! []
(reset! cache {}))
(defn- commit-document-change [message repository]
(jp/git-commit (get-repo repository) message
:committer {:name "Document-Manager" :email "burke@fh-muenster.de"}))
(defn cache-document [repository id doc]
(swap! cache update-in [repository :documents] assoc id doc)
doc)
(defn cache-query [repository query result]
(swap! cache update-in [repository :queries] assoc query (into #{} (keys result)))
result)
(defn uncache-document [repository id]
(swap! cache update-in [repository :queries] update-queries-remove-document id)
(swap! cache update-in [repository :documents] dissoc id))
(defn update-cache-document [repository id document]
(swap! cache update-in [repository :queries] update-queries id document)
(swap! cache assoc-in [repository :documents id] document))
(defn load-document [id & {:keys [repository] :or {repository default-repository}}]
(let [cached-repository (cached-repository? repository)]
(or
(and cached-repository (get-in @cache [repository :documents id]))
(when (valid-id? id repository)
(let [result (read-string (slurp (get-file-path id repository)))]
(generate-views repository id result)
(if cached-repository
(cache-document repository id result)
result
))))))
(defn get-document-size [id & {:keys [repository] :or {repository default-repository}}]
(when (valid-id? id repository)
(let [file (io/file (get-file-path id repository))]
(when (.isFile file)
(.length file)))))
(defn save-document [id document & {:keys [repository] :or {repository default-repository}}]
(let [file-path (get-file-path id repository)
document-str (with-out-str (fipp document))]
(when-not (and (valid-id? id repository)
(= (slurp file-path) document-str))
(update-cache-document repository id document)
(generate-views repository id document)
(with-open [w (io/writer file-path)]
(.write w document-str))
(when-not (no-commit-repository? repository)
(jp/git-add (get-repo repository) id)
(commit-document-change (str "saved new version of " id) repository)))))
(defn delete-document [id & {:keys [repository] :or {repository default-repository}}]
(when (valid-id? id repository)
(uncache-document repository id)
(io/delete-file (get-file-path id :units) true)
(jp/git-rm (get-repo repository) id)
(commit-document-change (str "deleted document " id) repository)))
(defn list-documents [& {:keys [repository] :or {repository default-repository}}]
(let [repo-path (get-repository-path repository)
files (->> (io/file repo-path)
.listFiles
(filter #(.isFile %))
(map #(.getName %))
)]
files))
(defn find-documents [query & {:keys [repository] :or {repository default-repository}}]
(let [docs (list-documents :repository repository)
cached-repository (cached-repository? repository)]
(or (when cached-repository
(when-let [cached-query (get-in @cache [repository :queries query])]
(into {} (map (fn [fname]
(let [doc (load-document fname :repository repository)]
[fname doc]))
cached-query))))
(let [result (into {} (keep (fn [fname]
(let [doc (load-document fname :repository repository)]
(when (query-fits? doc query)
[fname doc]
)
))
docs))]
(if cached-repository
(cache-query repository query result)
result)))))
(defn get-upstreams [repo-name]
(-> (get-repo-data repo-name)
:upstreams))
(defn init-upstreams [repo-name]
(let [git (get-repo repo-name)
upstreams (get-upstreams :default)]
(doseq [[id {:keys [url]}] upstreams]
(jp/git-remote-remove git (name id))
(jp/git-remote-add git (name id) url)
)
)
)
(defn push-upstreams [repo-name]
(let [git (get-repo repo-name)
upstreams (jp/git-remote-list git)]
(jp/with-identity {:name (str @storage-directory "/" upstream-ssh-identity) :exclusive true}
(doseq [[id urls] upstreams]
(jp/git-push git :remote id)
))
)
)
(defn shutdown []
(pmap (fn [[id repo]]
(push-upstreams id)
) @repositories))
(defn list-versions [id & {:keys [repository]
:or {repository default-repository}}]
(let [repo (get-repo repository)]
(versioning/list-commits repo id)))
(defn load-version [id version & {:keys [repository]
:or {repository default-repository}}]
(let [versions (list-versions id :repository repository)
repo (get-repo repository)]
(when-let [commit (-> (filter #(= (:version %) version) versions)
first :commit)]
(versioning/load-revision commit repo id))))
(:require [document-storage.git.core :as dsgit]))
(defn make-git-ds [directory]
(.init-storage (dsgit/->git-storage {:dir directory})))
(ns document-storage.git.core
(:require [clj-jgit.porcelain :as jp]
[clojure.tools.logging :as log]
[clojure.java.io :as io]
[clojure.edn :refer [read-string]]
[document-storage.git.query :refer [query-fits? update-queries update-queries-remove-document]]
[document-storage.git.versioning :as versioning]
[document-storage.git.repository :refer [repositories init-repository valid-id?
default-repository
no-commit-repository?
cached-repository?
get-file-path
get-repo
get-repo-data
get-repository-path]]
[document-storage.git.views :refer [get-views generate-views]]
[fipp.edn :refer [pprint] :rename {pprint fipp}]
[document-storage.protocol :as protocol]))
(defonce repo-dir (atom ""))
(defonce upstream-ssh-identity "upstream")
(defonce storage-directory (atom ""))
(defonce cache (atom {}))
(defn load-config [dir]
(-> dir
(str "/config.edn")
slurp
read-string))
(defn reset-cache! []
(reset! cache {}))
(defn- commit-document-change [message repository]
(jp/git-commit (get-repo repository) message
:committer {:name "Document-Manager" :email "burke@fh-muenster.de"}))
(defn cache-document [repository id doc]
(swap! cache update-in [repository :documents] assoc id doc)
doc)
(defn cache-query [repository query result]
(swap! cache update-in [repository :queries] assoc query (into #{} (keys result)))
result)
(defn uncache-document [repository id]
(swap! cache update-in [repository :queries] update-queries-remove-document id)
(swap! cache update-in [repository :documents] dissoc id))
(defn update-cache-document [repository id document]
(swap! cache update-in [repository :queries] update-queries id document)
(swap! cache assoc-in [repository :documents id] document))
(defn get-upstreams [repo-name]
(-> (get-repo-data repo-name)
:upstreams))
(defn init-upstreams [repo-name]
(let [git (get-repo repo-name)
upstreams (get-upstreams :default)]
(doseq [[id {:keys [url]}] upstreams]
(jp/git-remote-remove git (name id))
(jp/git-remote-add git (name id) url)
)
)
)
(defn push-upstreams [repo-name]
(let [git (get-repo repo-name)
upstreams (jp/git-remote-list git)]
(jp/with-identity {:name (str @storage-directory "/" upstream-ssh-identity) :exclusive true}
(doseq [[id urls] upstreams]
(jp/git-push git :remote id)
))
)
)
(defrecord git-storage [options]
protocol/storage
(init-storage [{{:keys [dir] :as options} :options :as this}]
(println options)
(log/info "Init Storage in " dir)
(reset! storage-directory dir)
(if-let [config (load-config dir)]
(do
(doseq [repo (keys (:repositories config))]
(swap! repositories
assoc repo
(merge {:directory (str dir "/" (name repo))
:unsaved-files []
:git-repo (init-repository (str dir "/" (name repo)))}
(get (:repositories config) repo))))
(update this :options
assoc
:repositories @repositories
:cache (atom {})))
(log/error "Unable to initialize Document Storage - no config!")))
(load-document [this id repository]
(let [cached-repository (cached-repository? repository)]
(or
(and cached-repository (get-in @cache [repository :documents id]))
(when (valid-id? id repository)
(let [result (read-string (slurp (get-file-path id repository)))]
(generate-views repository id result)
(if cached-repository
(cache-document repository id result)
result
))))))
(get-document-size [this id repository]
(when (valid-id? id repository)
(let [file (io/file (get-file-path id repository))]
(when (.isFile file)
(.length file)))))
(save-document [this id document repository]
(let [file-path (get-file-path id repository)
document-str (with-out-str (fipp document))]
(when-not (and (valid-id? id repository)
(= (slurp file-path) document-str))
(update-cache-document repository id document)
(generate-views repository id document)
(with-open [w (io/writer file-path)]
(.write w document-str))
(when-not (no-commit-repository? repository)
(jp/git-add (get-repo repository) id)
(commit-document-change (str "saved new version of " id) repository)))))
(delete-document [this id repository]
(when (valid-id? id repository)
(uncache-document repository id)
(io/delete-file (get-file-path id :units) true)
(jp/git-rm (get-repo repository) id)
(commit-document-change (str "deleted document " id) repository)))
(list-documents [this repository]
(let [repo-path (get-repository-path repository)
files (->> (io/file repo-path)
.listFiles
(filter #(.isFile %))
(map #(.getName %))
)]
files))
(find-documents [this query repository]
(let [docs (.list-documents this :repository repository)
cached-repository (cached-repository? repository)]
(or (when cached-repository
(when-let [cached-query (get-in @cache [repository :queries query])]
(into {} (map (fn [fname]
(let [doc (.load-document this fname :repository repository)]
[fname doc]))
cached-query))))
(let [result (into {} (keep (fn [fname]
(let [doc (.load-document this fname :repository repository)]
(when (query-fits? doc query)
[fname doc]
)
))
docs))]
(if cached-repository
(cache-query repository query result)
result)))))
(shutdown [this]
(pmap (fn [[id repo]]
(push-upstreams id)
) @repositories))
(list-versions [this id repository]
(let [repo (get-repo repository)]
(versioning/list-commits repo id)))
(load-version [this id version repository]
(let [versions (.list-versions this id :repository repository)
repo (get-repo repository)]
(when-let [commit (-> (filter #(= (:version %) version) versions)
first :commit)]
(versioning/load-revision commit repo id))))
)
(ns document-storage.query)
(ns document-storage.git.query)
(defn query-fits? [data query]
(reduce (fn [a b]
......
(ns document-storage.repository
(ns document-storage.git.repository
(:require [clj-jgit.porcelain :as jp]
[clojure.tools.logging :as log]
[clojure.java.io :as io]))
......
(ns document-storage.versioning
(ns document-storage.git.versioning
(:require [clj-jgit.porcelain :as jp]
[clj-jgit.internal :refer [resolve-object]]
[clojure.edn :refer [read-string]])
......
(ns document-storage.views
(:require [document-storage.repository :refer [repositories default-repository]]))
(ns document-storage.git.views
(:require [document-storage.git.repository :refer [repositories default-repository]]))
(defonce view-cache (atom {}))
......
(ns document-storage.protocol)
(defprotocol storage
"Base Protocol for document storages"
(load-document [ds id repository] "Load document from a repository")
(save-document [ds id document repository] "Save new/initial version of document in a repository")
(delete-document [ds id repository] "Delete a specific document in a repository")
(list-documents [ds repository] "List all documents in a repository")
(find-documents [ds query repository] "Find documents with a given query in a repository")
(list-versions [ds id repository] "List all version of a specific document in a repository")
(load-version [ds id version repository] "Load a specific document version in a repository")
(get-document-size [ds id repository] "Calculate the current document size")
(init-storage [ds] "Start a document storage")
(shutdown [ds] "Stop a document storage"))
(ns document-storage.core-test
(ns document-storage.git.core-test
(:require [clojure.test :refer :all]
[document-storage.core :as ds]
[document-storage.views :as dsv]
[document-storage.git.views :as dsv]
[clojure.java.io :as io]
[fipp.edn :refer [pprint] :rename {pprint fipp}]))
[fipp.edn :refer [pprint] :rename {pprint fipp}]
[document-storage.git.core :as dsgit]
[document-storage.protocol :as dsprot]))
(def ds-atom (atom nil))
(defn create-storage [directory]
(let [config-file (str directory "/" "config.edn")
......@@ -25,7 +29,7 @@
(defn storage-fixture [f]
(create-storage "teststorage")
(ds/init-storage "teststorage")
(reset! ds-atom (ds/make-git-ds "teststorage"))
(f)
(destroy-storage "teststorage"))
......@@ -33,12 +37,12 @@
(deftest simple-test
(testing "save basic structure and load it"
(let [structure {:a 5 :c [1 2 3 4 99 5 -4]}
(let [structure {:a 7 :c [1 2 3 4 99 5 -4] :v 3}
id "simple-test1"
repo :testrepo]
(ds/save-document id structure :repository repo)
(.save-document @ds-atom id structure repo)
(is (= structure
(ds/load-document id :repository repo))))))
(.load-document @ds-atom id repo))))))
(deftest views-test
......@@ -56,9 +60,9 @@
:c-copy (:c d)})]
(dsv/add-view repo :fn1 fn1)
(dsv/add-view repo :fn2 fn2)
(ds/save-document id structure :repository repo)
(.save-document @ds-atom id structure repo)
(is (= structure
(ds/load-document id :repository repo)))
(.load-document @ds-atom id repo)))
(let [views (dsv/load-views id :repository repo)
v1 (:fn1 views)
v2 (:fn2 views)]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment