rlm@10: ;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
rlm@10: ;;  distribution terms for this software are covered by the Eclipse Public
rlm@10: ;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
rlm@10: ;;  be found in the file epl-v10.html at the root of this distribution.  By
rlm@10: ;;  using this software in any fashion, you are agreeing to be bound by the
rlm@10: ;;  terms of this license.  You must not remove this notice, or any other,
rlm@10: ;;  from this software.
rlm@10: ;;
rlm@10: ;;  test.clj
rlm@10: ;;
rlm@10: ;;  test/example for clojure.contrib.sql
rlm@10: ;;
rlm@10: ;;  scgilardi (gmail)
rlm@10: ;;  Created 13 September 2008
rlm@10: 
rlm@10: (ns clojure.contrib.test-sql
rlm@10:   (:use [clojure.contrib.sql :as sql :only ()]))
rlm@10: 
rlm@10: (def db {:classname "org.apache.derby.jdbc.EmbeddedDriver"
rlm@10:          :subprotocol "derby"
rlm@10:          :subname "/tmp/clojure.contrib.sql.test.db"
rlm@10:          :create true})
rlm@10: 
rlm@10: (defn create-fruit
rlm@10:   "Create a table"
rlm@10:   []
rlm@10:   (sql/create-table
rlm@10:    :fruit
rlm@10:    [:name "varchar(32)" "PRIMARY KEY"]
rlm@10:    [:appearance "varchar(32)"]
rlm@10:    [:cost :int]
rlm@10:    [:grade :real]))
rlm@10: 
rlm@10: (defn drop-fruit
rlm@10:   "Drop a table"
rlm@10:   []
rlm@10:   (try
rlm@10:    (sql/drop-table :fruit)
rlm@10:    (catch Exception _)))
rlm@10: 
rlm@10: (defn insert-rows-fruit
rlm@10:   "Insert complete rows"
rlm@10:   []
rlm@10:   (sql/insert-rows
rlm@10:    :fruit
rlm@10:    ["Apple" "red" 59 87]
rlm@10:    ["Banana" "yellow" 29 92.2]
rlm@10:    ["Peach" "fuzzy" 139 90.0]
rlm@10:    ["Orange" "juicy" 89 88.6]))
rlm@10: 
rlm@10: (defn insert-values-fruit
rlm@10:   "Insert rows with values for only specific columns"
rlm@10:   []
rlm@10:   (sql/insert-values
rlm@10:    :fruit
rlm@10:    [:name :cost]
rlm@10:    ["Mango" 722]
rlm@10:    ["Feijoa" 441]))
rlm@10: 
rlm@10: (defn insert-records-fruit
rlm@10:   "Insert records, maps from keys specifying columns to values"
rlm@10:   []
rlm@10:   (sql/insert-records
rlm@10:    :fruit
rlm@10:    {:name "Pomegranate" :appearance "fresh" :cost 585}
rlm@10:    {:name "Kiwifruit" :grade 93}))
rlm@10: 
rlm@10: (defn db-write
rlm@10:   "Write initial values to the database as a transaction"
rlm@10:   []
rlm@10:   (sql/with-connection db
rlm@10:     (sql/transaction
rlm@10:      (drop-fruit)
rlm@10:      (create-fruit)
rlm@10:      (insert-rows-fruit)
rlm@10:      (insert-values-fruit)
rlm@10:      (insert-records-fruit)))
rlm@10:   nil)
rlm@10: 
rlm@10: (defn db-read
rlm@10:   "Read the entire fruit table"
rlm@10:   []
rlm@10:   (sql/with-connection db
rlm@10:     (sql/with-query-results res
rlm@10:       ["SELECT * FROM fruit"]
rlm@10:       (doseq [rec res]
rlm@10:         (println rec)))))
rlm@10: 
rlm@10: (defn db-update-appearance-cost
rlm@10:   "Update the appearance and cost of the named fruit"
rlm@10:   [name appearance cost]
rlm@10:   (sql/update-values
rlm@10:    :fruit
rlm@10:    ["name=?" name]
rlm@10:    {:appearance appearance :cost cost}))
rlm@10: 
rlm@10: (defn db-update
rlm@10:   "Update two fruits as a transaction"
rlm@10:   []
rlm@10:   (sql/with-connection db
rlm@10:     (sql/transaction
rlm@10:      (db-update-appearance-cost "Banana" "bruised" 14)
rlm@10:      (db-update-appearance-cost "Feijoa" "green" 400)))
rlm@10:   nil)
rlm@10: 
rlm@10: (defn db-update-or-insert
rlm@10:   "Updates or inserts a fruit"
rlm@10:   [record]
rlm@10:   (sql/with-connection db
rlm@10:     (sql/update-or-insert-values
rlm@10:      :fruit
rlm@10:      ["name=?" (:name record)]
rlm@10:      record)))
rlm@10: 
rlm@10: (defn db-read-all
rlm@10:   "Return all the rows of the fruit table as a vector"
rlm@10:   []
rlm@10:   (sql/with-connection db
rlm@10:     (sql/with-query-results res
rlm@10:       ["SELECT * FROM fruit"]
rlm@10:       (into [] res))))
rlm@10: 
rlm@10: (defn db-grade-range
rlm@10:   "Print rows describing fruit that are within a grade range"
rlm@10:   [min max]
rlm@10:   (sql/with-connection db
rlm@10:     (sql/with-query-results res
rlm@10:       [(str "SELECT name, cost, grade "
rlm@10:             "FROM fruit "
rlm@10:             "WHERE grade >= ? AND grade <= ?")
rlm@10:        min max]
rlm@10:       (doseq [rec res]
rlm@10:         (println rec)))))
rlm@10: 
rlm@10: (defn db-grade-a 
rlm@10:   "Print rows describing all grade a fruit (grade between 90 and 100)"
rlm@10:   []
rlm@10:   (db-grade-range 90 100))
rlm@10: 
rlm@10: (defn db-get-tables
rlm@10:   "Demonstrate getting table info"
rlm@10:   []
rlm@10:   (sql/with-connection db
rlm@10:     (into []
rlm@10:           (resultset-seq
rlm@10:            (-> (sql/connection)
rlm@10:                (.getMetaData)
rlm@10:                (.getTables nil nil nil (into-array ["TABLE" "VIEW"])))))))
rlm@10: 
rlm@10: (defn db-exception
rlm@10:   "Demonstrate rolling back a partially completed transaction on exception"
rlm@10:   []
rlm@10:   (sql/with-connection db
rlm@10:     (sql/transaction
rlm@10:      (sql/insert-values
rlm@10:       :fruit
rlm@10:       [:name :appearance]
rlm@10:       ["Grape" "yummy"]
rlm@10:       ["Pear" "bruised"])
rlm@10:      ;; at this point the insert-values call is complete, but the transaction
rlm@10:      ;; is not. the exception will cause it to roll back leaving the database
rlm@10:      ;; untouched.
rlm@10:      (throw (Exception. "sql/test exception")))))
rlm@10: 
rlm@10: (defn db-sql-exception
rlm@10:   "Demonstrate an sql exception"
rlm@10:   []
rlm@10:   (sql/with-connection db
rlm@10:     (sql/transaction
rlm@10:      (sql/insert-values
rlm@10:       :fruit
rlm@10:       [:name :appearance]
rlm@10:       ["Grape" "yummy"]
rlm@10:       ["Pear" "bruised"]
rlm@10:       ["Apple" "strange" "whoops"]))))
rlm@10: 
rlm@10: (defn db-batchupdate-exception
rlm@10:   "Demonstrate a batch update exception"
rlm@10:   []
rlm@10:   (sql/with-connection db
rlm@10:     (sql/transaction
rlm@10:      (sql/do-commands
rlm@10:       "DROP TABLE fruit"
rlm@10:       "DROP TABLE fruit"))))
rlm@10: 
rlm@10: (defn db-rollback
rlm@10:   "Demonstrate a rollback-only trasaction"
rlm@10:   []
rlm@10:   (sql/with-connection db
rlm@10:     (sql/transaction
rlm@10:      (prn "is-rollback-only" (sql/is-rollback-only))
rlm@10:      (sql/set-rollback-only)
rlm@10:      (sql/insert-values
rlm@10:       :fruit
rlm@10:       [:name :appearance]
rlm@10:       ["Grape" "yummy"]
rlm@10:       ["Pear" "bruised"])
rlm@10:      (prn "is-rollback-only" (sql/is-rollback-only))
rlm@10:      (sql/with-query-results res
rlm@10:        ["SELECT * FROM fruit"]
rlm@10:        (doseq [rec res]
rlm@10:          (println rec))))
rlm@10:     (prn)
rlm@10:     (sql/with-query-results res
rlm@10:       ["SELECT * FROM fruit"]
rlm@10:       (doseq [rec res]
rlm@10:         (println rec)))))