Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Stuart Sierra February 01, 2010
file 208 lines (187 sloc) 5.212 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and
;; distribution terms for this software are covered by the Eclipse Public
;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
;; be found in the file epl-v10.html at the root of this distribution. By
;; using this software in any fashion, you are agreeing to be bound by the
;; terms of this license. You must not remove this notice, or any other,
;; from this software.
;;
;; test.clj
;;
;; test/example for clojure.contrib.sql
;;
;; scgilardi (gmail)
;; Created 13 September 2008

(ns clojure.contrib.test-sql
  (:use [clojure.contrib.sql :as sql :only ()]))

(def db {:classname "org.apache.derby.jdbc.EmbeddedDriver"
         :subprotocol "derby"
         :subname "/tmp/clojure.contrib.sql.test.db"
         :create true})

(defn create-fruit
  "Create a table"
  []
  (sql/create-table
   :fruit
   [:name "varchar(32)" "PRIMARY KEY"]
   [:appearance "varchar(32)"]
   [:cost :int]
   [:grade :real]))

(defn drop-fruit
  "Drop a table"
  []
  (try
   (sql/drop-table :fruit)
   (catch Exception _)))

(defn insert-rows-fruit
  "Insert complete rows"
  []
  (sql/insert-rows
   :fruit
   ["Apple" "red" 59 87]
   ["Banana" "yellow" 29 92.2]
   ["Peach" "fuzzy" 139 90.0]
   ["Orange" "juicy" 89 88.6]))

(defn insert-values-fruit
  "Insert rows with values for only specific columns"
  []
  (sql/insert-values
   :fruit
   [:name :cost]
   ["Mango" 722]
   ["Feijoa" 441]))

(defn insert-records-fruit
  "Insert records, maps from keys specifying columns to values"
  []
  (sql/insert-records
   :fruit
   {:name "Pomegranate" :appearance "fresh" :cost 585}
   {:name "Kiwifruit" :grade 93}))

(defn db-write
  "Write initial values to the database as a transaction"
  []
  (sql/with-connection db
    (sql/transaction
     (drop-fruit)
     (create-fruit)
     (insert-rows-fruit)
     (insert-values-fruit)
     (insert-records-fruit)))
  nil)

(defn db-read
  "Read the entire fruit table"
  []
  (sql/with-connection db
    (sql/with-query-results res
      ["SELECT * FROM fruit"]
      (doseq [rec res]
        (println rec)))))

(defn db-update-appearance-cost
  "Update the appearance and cost of the named fruit"
  [name appearance cost]
  (sql/update-values
   :fruit
   ["name=?" name]
   {:appearance appearance :cost cost}))

(defn db-update
  "Update two fruits as a transaction"
  []
  (sql/with-connection db
    (sql/transaction
     (db-update-appearance-cost "Banana" "bruised" 14)
     (db-update-appearance-cost "Feijoa" "green" 400)))
  nil)

(defn db-update-or-insert
  "Updates or inserts a fruit"
  [record]
  (sql/with-connection db
    (sql/update-or-insert-values
     :fruit
     ["name=?" (:name record)]
     record)))

(defn db-read-all
  "Return all the rows of the fruit table as a vector"
  []
  (sql/with-connection db
    (sql/with-query-results res
      ["SELECT * FROM fruit"]
      (into [] res))))

(defn db-grade-range
  "Print rows describing fruit that are within a grade range"
  [min max]
  (sql/with-connection db
    (sql/with-query-results res
      [(str "SELECT name, cost, grade "
            "FROM fruit "
            "WHERE grade >= ? AND grade <= ?")
       min max]
      (doseq [rec res]
        (println rec)))))

(defn db-grade-a
  "Print rows describing all grade a fruit (grade between 90 and 100)"
  []
  (db-grade-range 90 100))

(defn db-get-tables
  "Demonstrate getting table info"
  []
  (sql/with-connection db
    (into []
          (resultset-seq
           (-> (sql/connection)
               (.getMetaData)
               (.getTables nil nil nil (into-array ["TABLE" "VIEW"])))))))

(defn db-exception
  "Demonstrate rolling back a partially completed transaction on exception"
  []
  (sql/with-connection db
    (sql/transaction
     (sql/insert-values
      :fruit
      [:name :appearance]
      ["Grape" "yummy"]
      ["Pear" "bruised"])
     ;; at this point the insert-values call is complete, but the transaction
     ;; is not. the exception will cause it to roll back leaving the database
     ;; untouched.
     (throw (Exception. "sql/test exception")))))

(defn db-sql-exception
  "Demonstrate an sql exception"
  []
  (sql/with-connection db
    (sql/transaction
     (sql/insert-values
      :fruit
      [:name :appearance]
      ["Grape" "yummy"]
      ["Pear" "bruised"]
      ["Apple" "strange" "whoops"]))))

(defn db-batchupdate-exception
  "Demonstrate a batch update exception"
  []
  (sql/with-connection db
    (sql/transaction
     (sql/do-commands
      "DROP TABLE fruit"
      "DROP TABLE fruit"))))

(defn db-rollback
  "Demonstrate a rollback-only trasaction"
  []
  (sql/with-connection db
    (sql/transaction
     (prn "is-rollback-only" (sql/is-rollback-only))
     (sql/set-rollback-only)
     (sql/insert-values
      :fruit
      [:name :appearance]
      ["Grape" "yummy"]
      ["Pear" "bruised"])
     (prn "is-rollback-only" (sql/is-rollback-only))
     (sql/with-query-results res
       ["SELECT * FROM fruit"]
       (doseq [rec res]
         (println rec))))
    (prn)
    (sql/with-query-results res
      ["SELECT * FROM fruit"]
      (doseq [rec res]
        (println rec)))))
Something went wrong with that request. Please try again.