/attic/model.clj
Clojure | 151 lines | 132 code | 16 blank | 3 comment | 0 complexity | 35824a4824e4c3546b11e8dda01ca4e3 MD5 | raw file
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))))