Created

Embed URL

HTTPS clone URL

SSH clone URL

You can clone with HTTPS or SSH.

Download Gist

Datenbankzugriff (netz/lokal) per Context Oriented Programming

View cop_db.clj
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
;; ------------------------------------------------------------------------------------------ some context-oriented-programming-magic
(cop/deflayer local-layer)
(cop/deflayer net-layer)
;; make-writable
(cop/deflayered make-writable [& args] (apply du/make-writable args))
(cop/deflayered make-writable net-layer [& args] nil)
;; detach
(cop/deflayered detach [& args] (apply ad/detach args))
(cop/deflayered detach net-layer [& args] nil)
;; attach
(cop/deflayered attach [& args] (apply ad/attach args))
;; (cop/deflayered attach net-layer [& args] (apply ad/attach args))
;; copy-db
(cop/deflayered copy-db [& args] (apply dc/copy-db args))
(cop/deflayered copy-db net-layer [& args] nil)
;; make-temp-name
(cop/deflayered make-temp-name [temp-datapath db-name] (str temp-datapath "\\project"))
(cop/deflayered make-temp-name net-layer [temp-datapath db-name] db-name)
;; make-temp-name-server
(cop/deflayered make-temp-name-server [db-name-temp db-name-server] db-name-temp)
(cop/deflayered make-temp-name-server net-layer [db-name-temp db-name-server] db-name-server)
;; get-db-spec
(cop/deflayered get-db-spec [config db-spec db-name]
(assoc config :db-name db-name))
(cop/deflayered get-db-spec net-layer [config db-spec db-name]
(let [config (proceed config db-spec db-name)]
(if db-spec
(merge config db-spec)
(do
(println " FEHLER: db-spec für Netz-DB nicht vorhanden!")
config))))
;; ------------------------------------------------------------------------------------------
(defn checkout-from-tfs
"Wenn was gepatcht wurde, muss die DB gegebenenfalls ausgecheckt werden."
[tfs-checkout patches-still-missing db-name workspace non-substituted-workspace]
(when (and tfs-checkout patches-still-missing)
(let [filename-to-workspace-translator (fn [ws fn] (.replace fn non-substituted-workspace ws))]
(println (str " checking out " db-name))
(doseq [full-db-name (du/add-exts-to-datapath db-name)
:let [translated-filename (filename-to-workspace-translator workspace full-db-name)]]
(println (str " Ergebnis: " (ts/tf-checkout workspace translated-filename)))))))
(defn recheck-and-finish
"Prüft, ob jetzt alle Patches eingespielt wurden. Falls das der Fall ist, wird die bearbeitete Datenbank zurückkopiert
- falls nicht gibt es eine Fehlermeldung."
[config-single-db db-name-temp datapath-to-patch scripts-n-checks missing-patches]
(println "Performing CHECKs to determine success of patching:")
(let [patches-still-missing (seq (filter (partial check-after config-single-db db-name-temp) scripts-n-checks))]
(detach db-name-temp)
(if patches-still-missing
(do
(println " FEHLER - folgende Patches wurden nicht eingespielt:")
(doseq [{:keys [script]} patches-still-missing]
(println (str " " script)))
false)
(do
(println " SUCCESS - die folgenden Patches wurden erfolgreich eingespielt:")
(doseq [p missing-patches]
(println (str " " (:script p))))
(copy-db db-name-temp datapath-to-patch) ;; cop
true))))
(defn process-single-db [{:keys [scripts-n-checks db-def temp-datapath workspace non-substituted-workspace] :as config}]
(let [{:keys [db-name tfs-checkout patch-in-place db-spec db-name-server do-attach] :or {tfs-checkout false, patch-in-place false, do-attach true}} db-def]
(cop/with-layer (if patch-in-place net-layer local-layer)
(println (str "\n\n\nNow patching: " db-name))
(let [db-name-temp (make-temp-name temp-datapath db-name) ;; cop
db-name-temp-server (make-temp-name-server db-name-temp db-name-server) ;; cop
datapath-to-patch (fu/filepath db-name)
config-single-db (get-db-spec config db-spec db-name-temp)] ;; cop
(make-writable db-name) ;; cop
;; Datenbank MUSS kopiert werden - der Pfad (z.B. im TFS) könnte zu lang sein, als dass die Datenbank direkt angehängt werden könnte.
(detach db-name-temp) ;; cop
(copy-db db-name temp-datapath) ;; cop
(if do-attach
(attach db-name-temp db-name-temp-server)) ;; cop
(println "Performing CHECKs to determine patch-level:")
(if-let [missing-patches (seq (filter (partial check-before config-single-db db-name-temp-server) scripts-n-checks))]
(let [was-successfully-patched (->> missing-patches
(map (comp #(str % ".exe") :script))
(patch config-single-db))]
;; nur auschecken, wenn alle Patches erfolgreich waren...
(if was-successfully-patched
(checkout-from-tfs tfs-checkout missing-patches db-name workspace non-substituted-workspace))
(recheck-and-finish config-single-db db-name-temp-server datapath-to-patch scripts-n-checks missing-patches))
(do
(println " OK - die Datenbank ist auf dem aktuellen Patchlevel. Es müssen keine Patches eingespielt werden.")
(detach db-name-temp) ;; cop
))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.