/attic/model.clj

http://github.com/zefhemel/adia · Clojure · 151 lines · 132 code · 16 blank · 3 comment · 15 complexity · 35824a4824e4c3546b11e8dda01ca4e3 MD5 · raw file

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