/src/lobos/analyzer.clj

  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))))))