1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/test_contrib/test_sql.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,207 @@
     1.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
     1.5 +;;  distribution terms for this software are covered by the Eclipse Public
     1.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
     1.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
     1.8 +;;  using this software in any fashion, you are agreeing to be bound by the
     1.9 +;;  terms of this license.  You must not remove this notice, or any other,
    1.10 +;;  from this software.
    1.11 +;;
    1.12 +;;  test.clj
    1.13 +;;
    1.14 +;;  test/example for clojure.contrib.sql
    1.15 +;;
    1.16 +;;  scgilardi (gmail)
    1.17 +;;  Created 13 September 2008
    1.18 +
    1.19 +(ns clojure.contrib.test-sql
    1.20 +  (:use [clojure.contrib.sql :as sql :only ()]))
    1.21 +
    1.22 +(def db {:classname "org.apache.derby.jdbc.EmbeddedDriver"
    1.23 +         :subprotocol "derby"
    1.24 +         :subname "/tmp/clojure.contrib.sql.test.db"
    1.25 +         :create true})
    1.26 +
    1.27 +(defn create-fruit
    1.28 +  "Create a table"
    1.29 +  []
    1.30 +  (sql/create-table
    1.31 +   :fruit
    1.32 +   [:name "varchar(32)" "PRIMARY KEY"]
    1.33 +   [:appearance "varchar(32)"]
    1.34 +   [:cost :int]
    1.35 +   [:grade :real]))
    1.36 +
    1.37 +(defn drop-fruit
    1.38 +  "Drop a table"
    1.39 +  []
    1.40 +  (try
    1.41 +   (sql/drop-table :fruit)
    1.42 +   (catch Exception _)))
    1.43 +
    1.44 +(defn insert-rows-fruit
    1.45 +  "Insert complete rows"
    1.46 +  []
    1.47 +  (sql/insert-rows
    1.48 +   :fruit
    1.49 +   ["Apple" "red" 59 87]
    1.50 +   ["Banana" "yellow" 29 92.2]
    1.51 +   ["Peach" "fuzzy" 139 90.0]
    1.52 +   ["Orange" "juicy" 89 88.6]))
    1.53 +
    1.54 +(defn insert-values-fruit
    1.55 +  "Insert rows with values for only specific columns"
    1.56 +  []
    1.57 +  (sql/insert-values
    1.58 +   :fruit
    1.59 +   [:name :cost]
    1.60 +   ["Mango" 722]
    1.61 +   ["Feijoa" 441]))
    1.62 +
    1.63 +(defn insert-records-fruit
    1.64 +  "Insert records, maps from keys specifying columns to values"
    1.65 +  []
    1.66 +  (sql/insert-records
    1.67 +   :fruit
    1.68 +   {:name "Pomegranate" :appearance "fresh" :cost 585}
    1.69 +   {:name "Kiwifruit" :grade 93}))
    1.70 +
    1.71 +(defn db-write
    1.72 +  "Write initial values to the database as a transaction"
    1.73 +  []
    1.74 +  (sql/with-connection db
    1.75 +    (sql/transaction
    1.76 +     (drop-fruit)
    1.77 +     (create-fruit)
    1.78 +     (insert-rows-fruit)
    1.79 +     (insert-values-fruit)
    1.80 +     (insert-records-fruit)))
    1.81 +  nil)
    1.82 +
    1.83 +(defn db-read
    1.84 +  "Read the entire fruit table"
    1.85 +  []
    1.86 +  (sql/with-connection db
    1.87 +    (sql/with-query-results res
    1.88 +      ["SELECT * FROM fruit"]
    1.89 +      (doseq [rec res]
    1.90 +        (println rec)))))
    1.91 +
    1.92 +(defn db-update-appearance-cost
    1.93 +  "Update the appearance and cost of the named fruit"
    1.94 +  [name appearance cost]
    1.95 +  (sql/update-values
    1.96 +   :fruit
    1.97 +   ["name=?" name]
    1.98 +   {:appearance appearance :cost cost}))
    1.99 +
   1.100 +(defn db-update
   1.101 +  "Update two fruits as a transaction"
   1.102 +  []
   1.103 +  (sql/with-connection db
   1.104 +    (sql/transaction
   1.105 +     (db-update-appearance-cost "Banana" "bruised" 14)
   1.106 +     (db-update-appearance-cost "Feijoa" "green" 400)))
   1.107 +  nil)
   1.108 +
   1.109 +(defn db-update-or-insert
   1.110 +  "Updates or inserts a fruit"
   1.111 +  [record]
   1.112 +  (sql/with-connection db
   1.113 +    (sql/update-or-insert-values
   1.114 +     :fruit
   1.115 +     ["name=?" (:name record)]
   1.116 +     record)))
   1.117 +
   1.118 +(defn db-read-all
   1.119 +  "Return all the rows of the fruit table as a vector"
   1.120 +  []
   1.121 +  (sql/with-connection db
   1.122 +    (sql/with-query-results res
   1.123 +      ["SELECT * FROM fruit"]
   1.124 +      (into [] res))))
   1.125 +
   1.126 +(defn db-grade-range
   1.127 +  "Print rows describing fruit that are within a grade range"
   1.128 +  [min max]
   1.129 +  (sql/with-connection db
   1.130 +    (sql/with-query-results res
   1.131 +      [(str "SELECT name, cost, grade "
   1.132 +            "FROM fruit "
   1.133 +            "WHERE grade >= ? AND grade <= ?")
   1.134 +       min max]
   1.135 +      (doseq [rec res]
   1.136 +        (println rec)))))
   1.137 +
   1.138 +(defn db-grade-a 
   1.139 +  "Print rows describing all grade a fruit (grade between 90 and 100)"
   1.140 +  []
   1.141 +  (db-grade-range 90 100))
   1.142 +
   1.143 +(defn db-get-tables
   1.144 +  "Demonstrate getting table info"
   1.145 +  []
   1.146 +  (sql/with-connection db
   1.147 +    (into []
   1.148 +          (resultset-seq
   1.149 +           (-> (sql/connection)
   1.150 +               (.getMetaData)
   1.151 +               (.getTables nil nil nil (into-array ["TABLE" "VIEW"])))))))
   1.152 +
   1.153 +(defn db-exception
   1.154 +  "Demonstrate rolling back a partially completed transaction on exception"
   1.155 +  []
   1.156 +  (sql/with-connection db
   1.157 +    (sql/transaction
   1.158 +     (sql/insert-values
   1.159 +      :fruit
   1.160 +      [:name :appearance]
   1.161 +      ["Grape" "yummy"]
   1.162 +      ["Pear" "bruised"])
   1.163 +     ;; at this point the insert-values call is complete, but the transaction
   1.164 +     ;; is not. the exception will cause it to roll back leaving the database
   1.165 +     ;; untouched.
   1.166 +     (throw (Exception. "sql/test exception")))))
   1.167 +
   1.168 +(defn db-sql-exception
   1.169 +  "Demonstrate an sql exception"
   1.170 +  []
   1.171 +  (sql/with-connection db
   1.172 +    (sql/transaction
   1.173 +     (sql/insert-values
   1.174 +      :fruit
   1.175 +      [:name :appearance]
   1.176 +      ["Grape" "yummy"]
   1.177 +      ["Pear" "bruised"]
   1.178 +      ["Apple" "strange" "whoops"]))))
   1.179 +
   1.180 +(defn db-batchupdate-exception
   1.181 +  "Demonstrate a batch update exception"
   1.182 +  []
   1.183 +  (sql/with-connection db
   1.184 +    (sql/transaction
   1.185 +     (sql/do-commands
   1.186 +      "DROP TABLE fruit"
   1.187 +      "DROP TABLE fruit"))))
   1.188 +
   1.189 +(defn db-rollback
   1.190 +  "Demonstrate a rollback-only trasaction"
   1.191 +  []
   1.192 +  (sql/with-connection db
   1.193 +    (sql/transaction
   1.194 +     (prn "is-rollback-only" (sql/is-rollback-only))
   1.195 +     (sql/set-rollback-only)
   1.196 +     (sql/insert-values
   1.197 +      :fruit
   1.198 +      [:name :appearance]
   1.199 +      ["Grape" "yummy"]
   1.200 +      ["Pear" "bruised"])
   1.201 +     (prn "is-rollback-only" (sql/is-rollback-only))
   1.202 +     (sql/with-query-results res
   1.203 +       ["SELECT * FROM fruit"]
   1.204 +       (doseq [rec res]
   1.205 +         (println rec))))
   1.206 +    (prn)
   1.207 +    (sql/with-query-results res
   1.208 +      ["SELECT * FROM fruit"]
   1.209 +      (doseq [rec res]
   1.210 +        (println rec)))))