/src/lobos/analyzer.clj
Clojure | 200 lines | 160 code | 20 blank | 20 comment | 1 complexity | 335e9f115cb0d4f746f5de05ebbafd71 MD5 | raw file
1; Copyright (c) Nicolas Buduroi. All rights reserved. 2; The use and distribution terms for this software are covered by the 3; Eclipse Public License 1.0 which can be found in the file 4; epl-v10.html at the root of this distribution. By using this software 5; in any fashion, you are agreeing to be bound by the terms of this 6; license. 7; You must not remove this notice, or any other, from this software. 8 9(ns lobos.analyzer 10 "Analyze a database's meta-data to contruct an abstract schema." 11 (:refer-clojure :exclude [defonce replace]) 12 (:require (lobos [connectivity :as conn] 13 [schema :as schema])) 14 (:use (clojure [string :only [replace]]) 15 lobos.internal 16 lobos.metadata 17 lobos.utils) 18 (:import (java.sql DatabaseMetaData) 19 (lobos.schema Column 20 DataType 21 Expression 22 ForeignKeyConstraint 23 Index 24 Schema 25 Table 26 UniqueConstraint))) 27 28;; ----------------------------------------------------------------------------- 29 30;; ## Analyzer 31 32(def db-hierarchy 33 (atom (-> (make-hierarchy) 34 (derive :h2 ::standard) 35 (derive :mysql ::standard) 36 (derive :postgresql ::standard) 37 (derive :sqlite ::standard) 38 (derive :microsoft-sql-server ::standard)))) 39 40(defmulti analyze 41 "Analyzes the specified part of a schema and returns its abstract 42 equivalent." 43 (fn [dispatch-val & args] 44 (if (vector? dispatch-val) 45 dispatch-val 46 [(as-keyword (.getDatabaseProductName (db-meta))) 47 dispatch-val])) 48 :hierarchy db-hierarchy) 49 50;; ----------------------------------------------------------------------------- 51 52;; ## Default Analyzer 53 54(defmethod analyze [::standard Expression] 55 [_ expr] 56 (when expr 57 (Expression. 58 (cond (re-find #"^(.*)::(.*)$" expr) 59 (let [[_ & [value name]] (first (re-seq #"(.*)::(.*)" expr))] 60 (read-string (replace (str value) \' \"))) ;; HACK: to replace! 61 (re-find #"^\d+$" expr) (Integer/parseInt expr) 62 (re-find #"^'.*'$" expr) (second (re-matches #"^'(.*)'$" expr)) 63 ;; HACK: consider only uppercase unquoted strings to be functions 64 ;; because of http://bugs.mysql.com/bug.php?id=64614 65 ;; will need to do something more clever if that bug isn't 66 ;; fixed by the time work start on the Lobos 1.1 parser 67 (re-find #"^(\[A-Z]+)(\(\))?$" expr) 68 (let [[[_ func]] (re-seq #"([A-Z]+)(\(\))?" expr)] 69 (keyword func)) 70 :else (str expr))))) 71 72(defmethod analyze [::standard UniqueConstraint] 73 [_ sname tname cname index-meta] 74 (let [pkeys (primary-keys sname tname)] 75 (UniqueConstraint. 76 (keyword cname) 77 (if (pkeys (keyword cname)) 78 :primary-key 79 :unique) 80 (vec (map #(-> % :column_name keyword) 81 index-meta))))) 82 83(def action-rules 84 ;; HACK: keys coerce to short has Clojure 1.2 doesn't seems to handle 85 ;; keys of different type, even weirder 1.3 says those keys are Longs 86 ;; while 1.2 says Integers! 87 {(short DatabaseMetaData/importedKeyCascade) :cascade 88 (short DatabaseMetaData/importedKeySetNull) :set-null 89 (short DatabaseMetaData/importedKeyRestrict) :restrict 90 (short DatabaseMetaData/importedKeySetDefault) :set-default}) 91 92(defmethod analyze [::standard ForeignKeyConstraint] 93 [_ cname ref-meta] 94 (let [pcolumns (vec (map #(-> % :pkcolumn_name keyword) 95 ref-meta)) 96 fcolumns (vec (map #(-> % :fkcolumn_name keyword) 97 ref-meta)) 98 ptable (-> ref-meta first :pktable_name keyword) 99 on-delete (-> ref-meta first :delete_rule action-rules) 100 on-delete (when on-delete [:on-delete on-delete]) 101 on-update (-> ref-meta first :update_rule action-rules) 102 on-update (when on-delete [:on-update on-update])] 103 (ForeignKeyConstraint. 104 (keyword cname) 105 fcolumns 106 ptable 107 pcolumns 108 nil 109 (into {} [on-delete on-update])))) 110 111(defmethod analyze [::standard :constraints] 112 [_ sname tname] 113 (concat 114 (map (fn [[cname meta]] (analyze UniqueConstraint sname tname cname meta)) 115 (indexes-meta sname tname #(let [nu (:non_unique %)] 116 (or (false? nu) (= nu 0))))) 117 (map (fn [[cname meta]] (analyze ForeignKeyConstraint cname meta)) 118 (references-meta sname tname)))) 119 120(defmethod analyze [::standard Index] 121 [_ sname tname iname index-meta] 122 (let [pkeys (primary-keys sname tname)] 123 (Index. 124 (keyword iname) 125 tname 126 (vec (map #(-> % :column_name keyword) 127 index-meta)) 128 (when (-> index-meta first :non_unique not) 129 (list :unique))))) 130 131(defmethod analyze [::standard :indexes] 132 [_ sname tname] 133 (map (fn [[iname meta]] (analyze Index sname tname iname meta)) 134 (indexes-meta sname tname))) 135 136(defn analyze-data-type-args 137 "Returns a vector containing the data type arguments for the given 138 column meta data." 139 [dtype column-meta] 140 (condp contains? dtype 141 #{:nvarchar :varbinary :varchar} [(:column_size column-meta)] 142 #{:binary :blob :char :clob :nchar :nclob 143 :float :time :timestamp} [(:column_size column-meta)] 144 #{:decimal :numeric} (let [scale (:decimal_digits column-meta)] 145 (if (= scale 0) 146 [(:column_size column-meta)] 147 [(:column_size column-meta) scale])) 148 [])) 149 150(defmethod analyze [::standard DataType] 151 [_ column-meta] 152 (let [dtype (-> column-meta :type_name as-keyword)] 153 (schema/data-type 154 dtype 155 (analyze-data-type-args dtype column-meta)))) 156 157(defmethod analyze [::standard Column] 158 [_ column-meta] 159 (let [auto-inc (= (:is_autoincrement column-meta) "YES")] 160 (Column. (-> column-meta :column_name keyword) 161 (analyze DataType column-meta) 162 (when-not auto-inc 163 (analyze Expression (:column_def column-meta))) 164 ;; HACK: to revise, need to have nil instead of false for 165 ;; easier testing, could this cause problems? 166 (or auto-inc nil) 167 (or (= (:is_nullable column-meta) "NO") nil) 168 []))) 169 170(defmethod analyze [::standard Table] 171 [_ sname tname] 172 (schema/table* tname 173 (into {} (map #(let [c (analyze Column %)] 174 [(:cname c) c]) 175 (columns-meta sname tname))) 176 (into {} (map #(vector (:cname %) %) 177 (analyze :constraints sname tname))) 178 (into {} (map #(vector (:iname %) %) 179 (analyze :indexes sname tname))))) 180 181(defmethod analyze [::standard Schema] 182 [_ sname] 183 (apply schema/schema sname {:db-spec (db-meta-spec)} 184 (map #(analyze Table sname %) 185 (tables sname)))) 186 187(defn analyze-schema 188 [& args] 189 {:arglists '([connection-info? sname?])} 190 (let [[db-spec sname _] (optional-cnx-and-sname args)] 191 (with-db-meta db-spec 192 (autorequire-backend db-spec) 193 (let [sname (or (keyword sname) 194 (default-schema) 195 (first _))] 196 (if-let [schemas (schemas)] 197 (when (or (nil? sname) 198 ((set schemas) sname)) 199 (analyze Schema sname)) 200 (analyze Schema sname))))))