Mercurial > lasercutter

annotate src/clojure/contrib/test_contrib/test_sql.clj @ 10:ef7dbbd6452c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
added clojure source goodness
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Aug 2010 06:25:44 -0400
parents
children
rev   line source
rlm@10 1 ;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and
rlm@10 2 ;; distribution terms for this software are covered by the Eclipse Public
rlm@10 3 ;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
rlm@10 4 ;; be found in the file epl-v10.html at the root of this distribution. By
rlm@10 5 ;; using this software in any fashion, you are agreeing to be bound by the
rlm@10 6 ;; terms of this license. You must not remove this notice, or any other,
rlm@10 7 ;; from this software.
rlm@10 8 ;;
rlm@10 9 ;; test.clj
rlm@10 10 ;;
rlm@10 11 ;; test/example for clojure.contrib.sql
rlm@10 12 ;;
rlm@10 13 ;; scgilardi (gmail)
rlm@10 14 ;; Created 13 September 2008
rlm@10 15
rlm@10 16 (ns clojure.contrib.test-sql
rlm@10 17 (:use [clojure.contrib.sql :as sql :only ()]))
rlm@10 18
rlm@10 19 (def db {:classname "org.apache.derby.jdbc.EmbeddedDriver"
rlm@10 20 :subprotocol "derby"
rlm@10 21 :subname "/tmp/clojure.contrib.sql.test.db"
rlm@10 22 :create true})
rlm@10 23
rlm@10 24 (defn create-fruit
rlm@10 25 "Create a table"
rlm@10 26 []
rlm@10 27 (sql/create-table
rlm@10 28 :fruit
rlm@10 29 [:name "varchar(32)" "PRIMARY KEY"]
rlm@10 30 [:appearance "varchar(32)"]
rlm@10 31 [:cost :int]
rlm@10 32 [:grade :real]))
rlm@10 33
rlm@10 34 (defn drop-fruit
rlm@10 35 "Drop a table"
rlm@10 36 []
rlm@10 37 (try
rlm@10 38 (sql/drop-table :fruit)
rlm@10 39 (catch Exception _)))
rlm@10 40
rlm@10 41 (defn insert-rows-fruit
rlm@10 42 "Insert complete rows"
rlm@10 43 []
rlm@10 44 (sql/insert-rows
rlm@10 45 :fruit
rlm@10 46 ["Apple" "red" 59 87]
rlm@10 47 ["Banana" "yellow" 29 92.2]
rlm@10 48 ["Peach" "fuzzy" 139 90.0]
rlm@10 49 ["Orange" "juicy" 89 88.6]))
rlm@10 50
rlm@10 51 (defn insert-values-fruit
rlm@10 52 "Insert rows with values for only specific columns"
rlm@10 53 []
rlm@10 54 (sql/insert-values
rlm@10 55 :fruit
rlm@10 56 [:name :cost]
rlm@10 57 ["Mango" 722]
rlm@10 58 ["Feijoa" 441]))
rlm@10 59
rlm@10 60 (defn insert-records-fruit
rlm@10 61 "Insert records, maps from keys specifying columns to values"
rlm@10 62 []
rlm@10 63 (sql/insert-records
rlm@10 64 :fruit
rlm@10 65 {:name "Pomegranate" :appearance "fresh" :cost 585}
rlm@10 66 {:name "Kiwifruit" :grade 93}))
rlm@10 67
rlm@10 68 (defn db-write
rlm@10 69 "Write initial values to the database as a transaction"
rlm@10 70 []
rlm@10 71 (sql/with-connection db
rlm@10 72 (sql/transaction
rlm@10 73 (drop-fruit)
rlm@10 74 (create-fruit)
rlm@10 75 (insert-rows-fruit)
rlm@10 76 (insert-values-fruit)
rlm@10 77 (insert-records-fruit)))
rlm@10 78 nil)
rlm@10 79
rlm@10 80 (defn db-read
rlm@10 81 "Read the entire fruit table"
rlm@10 82 []
rlm@10 83 (sql/with-connection db
rlm@10 84 (sql/with-query-results res
rlm@10 85 ["SELECT * FROM fruit"]
rlm@10 86 (doseq [rec res]
rlm@10 87 (println rec)))))
rlm@10 88
rlm@10 89 (defn db-update-appearance-cost
rlm@10 90 "Update the appearance and cost of the named fruit"
rlm@10 91 [name appearance cost]
rlm@10 92 (sql/update-values
rlm@10 93 :fruit
rlm@10 94 ["name=?" name]
rlm@10 95 {:appearance appearance :cost cost}))
rlm@10 96
rlm@10 97 (defn db-update
rlm@10 98 "Update two fruits as a transaction"
rlm@10 99 []
rlm@10 100 (sql/with-connection db
rlm@10 101 (sql/transaction
rlm@10 102 (db-update-appearance-cost "Banana" "bruised" 14)
rlm@10 103 (db-update-appearance-cost "Feijoa" "green" 400)))
rlm@10 104 nil)
rlm@10 105
rlm@10 106 (defn db-update-or-insert
rlm@10 107 "Updates or inserts a fruit"
rlm@10 108 [record]
rlm@10 109 (sql/with-connection db
rlm@10 110 (sql/update-or-insert-values
rlm@10 111 :fruit
rlm@10 112 ["name=?" (:name record)]
rlm@10 113 record)))
rlm@10 114
rlm@10 115 (defn db-read-all
rlm@10 116 "Return all the rows of the fruit table as a vector"
rlm@10 117 []
rlm@10 118 (sql/with-connection db
rlm@10 119 (sql/with-query-results res
rlm@10 120 ["SELECT * FROM fruit"]
rlm@10 121 (into [] res))))
rlm@10 122
rlm@10 123 (defn db-grade-range
rlm@10 124 "Print rows describing fruit that are within a grade range"
rlm@10 125 [min max]
rlm@10 126 (sql/with-connection db
rlm@10 127 (sql/with-query-results res
rlm@10 128 [(str "SELECT name, cost, grade "
rlm@10 129 "FROM fruit "
rlm@10 130 "WHERE grade >= ? AND grade <= ?")
rlm@10 131 min max]
rlm@10 132 (doseq [rec res]
rlm@10 133 (println rec)))))
rlm@10 134
rlm@10 135 (defn db-grade-a
rlm@10 136 "Print rows describing all grade a fruit (grade between 90 and 100)"
rlm@10 137 []
rlm@10 138 (db-grade-range 90 100))
rlm@10 139
rlm@10 140 (defn db-get-tables
rlm@10 141 "Demonstrate getting table info"
rlm@10 142 []
rlm@10 143 (sql/with-connection db
rlm@10 144 (into []
rlm@10 145 (resultset-seq
rlm@10 146 (-> (sql/connection)
rlm@10 147 (.getMetaData)
rlm@10 148 (.getTables nil nil nil (into-array ["TABLE" "VIEW"])))))))
rlm@10 149
rlm@10 150 (defn db-exception
rlm@10 151 "Demonstrate rolling back a partially completed transaction on exception"
rlm@10 152 []
rlm@10 153 (sql/with-connection db
rlm@10 154 (sql/transaction
rlm@10 155 (sql/insert-values
rlm@10 156 :fruit
rlm@10 157 [:name :appearance]
rlm@10 158 ["Grape" "yummy"]
rlm@10 159 ["Pear" "bruised"])
rlm@10 160 ;; at this point the insert-values call is complete, but the transaction
rlm@10 161 ;; is not. the exception will cause it to roll back leaving the database
rlm@10 162 ;; untouched.
rlm@10 163 (throw (Exception. "sql/test exception")))))
rlm@10 164
rlm@10 165 (defn db-sql-exception
rlm@10 166 "Demonstrate an sql exception"
rlm@10 167 []
rlm@10 168 (sql/with-connection db
rlm@10 169 (sql/transaction
rlm@10 170 (sql/insert-values
rlm@10 171 :fruit
rlm@10 172 [:name :appearance]
rlm@10 173 ["Grape" "yummy"]
rlm@10 174 ["Pear" "bruised"]
rlm@10 175 ["Apple" "strange" "whoops"]))))
rlm@10 176
rlm@10 177 (defn db-batchupdate-exception
rlm@10 178 "Demonstrate a batch update exception"
rlm@10 179 []
rlm@10 180 (sql/with-connection db
rlm@10 181 (sql/transaction
rlm@10 182 (sql/do-commands
rlm@10 183 "DROP TABLE fruit"
rlm@10 184 "DROP TABLE fruit"))))
rlm@10 185
rlm@10 186 (defn db-rollback
rlm@10 187 "Demonstrate a rollback-only trasaction"
rlm@10 188 []
rlm@10 189 (sql/with-connection db
rlm@10 190 (sql/transaction
rlm@10 191 (prn "is-rollback-only" (sql/is-rollback-only))
rlm@10 192 (sql/set-rollback-only)
rlm@10 193 (sql/insert-values
rlm@10 194 :fruit
rlm@10 195 [:name :appearance]
rlm@10 196 ["Grape" "yummy"]
rlm@10 197 ["Pear" "bruised"])
rlm@10 198 (prn "is-rollback-only" (sql/is-rollback-only))
rlm@10 199 (sql/with-query-results res
rlm@10 200 ["SELECT * FROM fruit"]
rlm@10 201 (doseq [rec res]
rlm@10 202 (println rec))))
rlm@10 203 (prn)
rlm@10 204 (sql/with-query-results res
rlm@10 205 ["SELECT * FROM fruit"]
rlm@10 206 (doseq [rec res]
rlm@10 207 (println rec)))))