/attic/model.clj

  1(ns adia.model
  2  (:use [clojure.contrib.sql :as sql])
  3  (:use adia.util)
  4  (:gen-class))
  5
  6(def *db-config* (ref {}))
  7
  8(def *db-entites* (ref {}))
  9
 10(defmacro with-conn [& body]
 11  `(sql/with-connection
 12     @*db-config*
 13     (sql/transaction
 14       ~@body)))
 15
 16(defn- query [query]
 17  (with-query-results 
 18    rs query
 19    (doall rs)))
 20
 21(defn col-def-to-sql [[name & col-def]]
 22  (condp = (first col-def)
 23    :string (if (= (count col-def) 2)
 24              (let [attrs (second col-def)]
 25                [name (str "VARCHAR(" 
 26                           (if (:length attrs)
 27                             (:length attrs)
 28                             "255")
 29                           ")")
 30                 (if (:unique (second col-def))
 31                   "UNIQUE"
 32                   "")])
 33              [name "VARCHAR(255)"])
 34    :int      [name "INT" "DEFAULT 0"]
 35    :password [name "VARCHAR(62)"]
 36    :email    [name "VARCHAR(80)"]
 37    :text     [name "MEDIUMTEXT"]
 38    ; else, entity reference
 39    [name "VARCHAR(36)"]))
 40
 41(defn sync-database-metadata [name]
 42  (with-conn
 43    (let [all-tables (mapcat vals (query ["SHOW TABLES"]))]
 44      (if-not (some #(= %1 (str name)) all-tables)
 45        (apply sql/create-table
 46               (keyword (str name))
 47               [:id "varchar(64)" "PRIMARY KEY"]
 48               (map col-def-to-sql ((*db-entites* name) :properties)))))))
 49
 50(defn persist!
 51  "Persists a given entity to the database"
 52  [ent]
 53  (let [kind       (:kind ent)
 54        clean-ent  (dissoc ent :kind)
 55        persisted  (:persisted ^ent)]
 56    (if persisted
 57      (sql/update-values
 58        (kind :tblname)
 59        ["id = ?" (:id ent)]
 60        clean-ent)
 61        ;(dissoc clean-ent :id))
 62      (sql/insert-values
 63        (kind :tblname)
 64        (keys clean-ent) (vals clean-ent))))
 65  (with-meta ent {:persisted true}))
 66
 67(defn retrieve
 68  "Retrieves an entity from the database"
 69  [kind id]
 70  (if-let [rs (query [(str "select * from " (kind :tblname) " where id = ?") id])]
 71    (do 
 72      (println (with-meta (assoc (first rs) :kind kind) {:persisted true}))
 73      (with-meta (assoc (first rs) :kind kind) {:persisted true}))
 74    nil))
 75
 76(defn find-all-by [kind & prop-value-pairs]
 77  (query (apply vector 
 78                (str "select * from " (kind :tblname) " where "
 79                     (reduce #(str %1 " AND " %2)
 80                             (map #(str "`" (keyword->str %1) "` = ?") (even-items prop-value-pairs))))
 81                (odd-items prop-value-pairs))))
 82
 83(defn find-by [kind & prop-value-pairs]
 84  (if-let [results (apply find-all-by kind prop-value-pairs)]
 85    (first results)
 86    nil))
 87
 88(defn retrieve-all
 89  "Retrieves an entity from the database"
 90  [kind]
 91  (query [(str "select * from " (kind :tblname))]))
 92
 93(defn set-db-config! [config]
 94  (dosync
 95    (ref-set *db-config* config)))
 96
 97(defn- bind-property [ent value spec]
 98  (let [column-type (second spec)]
 99    (condp = column-type
100      :string  (if (= (count spec) 3)
101                 (let [attrs (nth spec 2)]
102                   (if (and (:length attrs)
103                            (> (count value) (:length attrs)))
104                     (throw (RuntimeException. (str "Value '" value "' is too, long, maximum length: " (:length attrs)))))
105                   (if (:unique attrs)
106                     (if-let [duplicate (find-by (:kind ent) (first spec) value)]
107                       (if-not (= (:id ent) (:id duplicate))
108                         (throw (RuntimeException. (str "Value '" value "' is not unique."))))))
109                   value)
110                 value)
111      :int      (try
112                  (Integer/parseInt value)
113                  (catch NumberFormatException nfe (RuntimeException. (str "Value '" value "' is not a number."))))
114      :password (md5 value)
115      :text      value
116      :email    (if (re-matches #".+@.+\.[a-z]+" value)
117                  value
118                  (throw (RuntimeException. (str "'" value "' is not a valid e-mail address."))))
119      ; entity type
120      value ; for now, no checking
121      )))
122
123(defn- lookup-property [kind property-name]
124  (let [properties (filter #(= (first %1) property-name) (kind :properties))]
125    (if (empty? properties)
126      nil
127      (first properties))))
128
129(defn databind 
130  ([ent values-map selected-properties] 
131   (apply assoc ent 
132          (mapcat (fn [k] [k (bind-property ent (values-map k) (lookup-property (:kind ent) k))])
133                  selected-properties)))
134  ([ent values-map] (databind ent values-map (keys values-map))))
135
136(defmacro defent [name & properties]
137  `(do
138     (defn ~name
139       ([] (with-meta {:kind ~name
140                       :id (str (java.util.UUID/randomUUID))}
141                      {:persisted false}))
142       ([key#] ({:tblname    (str (quote ~name))
143                 :properties [~@properties]} key#))
144       ([k# v# & kvs# ] (with-meta
145                          (apply assoc {:kind ~name
146                                        :id (str (java.util.UUID/randomUUID))}
147                                 k# v# kvs#)
148                          {:persisted false})))
149     (dosync 
150       (commute *db-entites* assoc (quote ~name) ~name))
151     (sync-database-metadata (quote ~name))))