Mercurial > lasercutter

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