1. Shantanu Kumar
  2. SQLRat

Commits

kumarshantanu  committed 282dde9

First import

  • Participants
  • Branches default

Comments (0)

Files changed (8)

File CHANGES

View file
+
+## 0.1 Alpha-1
+
+- Entity definitions, metadata, relations
+- CRUD functions for entities
+- Support for query by COUNT(*) function
+- Retrieve functions with chosen columns, WHERE clause
+- Relation functions (Persist, Retrieve, Delete)

File README

View file
+# sqlrat
+
+SQLRat is a Clojure (v1.2 or later) library to access relational
+databases using entity objects and to navigate entity relations
+in a stateless manner. Easy to use and flexible - you can also
+pass in native SQL for accessing the database.
+
+
+## Usage
+
+FIXME: write Maven/Lein dependency details here
+
+Examples for defining entities/relations and using them can be
+found in the unit test cases. There is a bunch of API functions
+to work using the entity definitions.
+
+Unit tests:
+src/test/clj/org/bituf/sqlrat/test/dbblog.clj
+
+Database configuration:
+src/test/clj/org/bituf/sqlrat/test/dbconfig.clj
+
+
+## Building/Installation
+
+If you want to build from sources, you may need to setup a database
+first. The default configuration points to MySQL database "sqlrat".
+
+You will need Maven 2 to build from sources. Execute the following:
+
+$ mvn clean package  # packages up a JAR in "target" dir
+$ mvn install        # to install to your local Maven repo
+$ mvn clojure:gendoc # generate Clojure API documentation
+
+
+## License
+
+Copyright (C) 2010 Shantanu Kumar (kumar.shantanu at gmail dot com)
+
+Distributed under the Apache 2 License.

File pom.xml

View file
+<project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+  xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/maven-v4_0_0.xsd">
+  <modelVersion>4.0.0</modelVersion>
+  <groupId>org.bituf</groupId>
+  <artifactId>sqlrat</artifactId>
+  <packaging>jar</packaging>
+  <version>0.1-SNAPSHOT</version>
+  <name>sqlrat</name>
+  <description>SQLRat is a Clojure library to access Relation databases.</description>
+  <url>http://code.google.com/p/bitumenframework/</url>
+  <repositories>
+    <repository>
+      <id>build.clojure.org</id>
+      <url>http://build.clojure.org/snapshots/</url>
+      <snapshots>
+        <enabled>true</enabled>
+      </snapshots>
+    </repository>
+    <repository>
+      <id>clojars.org</id>
+      <url>http://clojars.org/repo</url>
+    </repository>
+  </repositories>
+  <dependencies>
+    <dependency>
+      <groupId>junit</groupId>
+      <artifactId>junit</artifactId>
+      <version>3.8.1</version>
+      <scope>test</scope>
+    </dependency>
+    <dependency>
+      <groupId>org.clojure</groupId>
+      <artifactId>clojure</artifactId>
+      <version>1.2.0-RC3</version>
+      <optional>true</optional>
+    </dependency>
+    <dependency>
+      <groupId>org.clojure</groupId>
+      <artifactId>clojure-contrib</artifactId>
+      <version>1.2.0-RC3</version>
+      <optional>true</optional>
+    </dependency>
+    <!-- JDBC Drivers -->
+    <dependency><!-- Apache Derby -->
+      <groupId>org.apache.derby</groupId>
+      <artifactId>derbyclient</artifactId>
+      <version>10.2.2.0</version>
+      <scope>test</scope>
+    </dependency>
+    <dependency><!-- H2 Database -->
+      <groupId>com.h2database</groupId>
+      <artifactId>h2</artifactId>
+      <version>1.2.140</version>
+      <scope>test</scope>
+    </dependency>
+    <dependency><!-- HSQLDB -->
+      <groupId>hsqldb</groupId>
+      <artifactId>hsqldb</artifactId>
+      <version>1.7.1</version>
+      <scope>test</scope>
+    </dependency>
+    <dependency><!-- MySQL Database -->
+      <groupId>mysql</groupId>
+      <artifactId>mysql-connector-java</artifactId>
+      <version>5.1.13</version>
+      <scope>test</scope>
+    </dependency>
+    <dependency><!-- Postgresql -->
+      <groupId>postgresql</groupId>
+      <artifactId>postgresql</artifactId>
+      <!-- <version>8.4-701.jdbc3</version> -->
+      <version>8.4-701.jdbc4</version>
+      <scope>test</scope>
+    </dependency>
+    <dependency><!-- SQL Server / Sybase -->
+      <groupId>net.sourceforge.jtds</groupId>
+      <artifactId>jtds</artifactId>
+      <version>1.2.4</version>
+      <scope>test</scope>
+    </dependency>
+    <dependency><!-- Firebird (Jaybird) -->
+      <groupId>org.firebirdsql.jdbc</groupId>
+      <artifactId>jaybird</artifactId>
+      <version>2.1.6</version>
+      <scope>test</scope>
+    </dependency>
+    <!-- DB Connection Pool: C3P0 -->
+    <dependency><!-- C3P0 -->
+      <groupId>c3p0</groupId>
+      <artifactId>c3p0</artifactId>
+      <version>0.9.1</version>
+      <scope>test</scope>
+    </dependency>
+  </dependencies>
+  <build>
+    <plugins>
+      <plugin>
+        <groupId>com.theoryinpractise</groupId>
+        <artifactId>clojure-maven-plugin</artifactId>
+        <!--<version>1.3.3</version>-->
+        <executions>
+          <execution>
+            <id>compile</id>
+            <phase>compile</phase>
+            <goals>
+              <goal>compile</goal>
+            </goals>
+          </execution>
+          <execution>
+            <id>test-compile</id>
+            <phase>test-compile</phase>
+            <goals>
+              <goal>testCompile</goal>
+            </goals>
+          </execution>
+          <execution>
+            <id>test</id>
+            <phase>test</phase>
+            <goals>
+              <goal>test</goal>
+            </goals>
+          </execution>
+        </executions>
+        <configuration>
+          <clojureOptions>-Dbasedir=${basedir}</clojureOptions>
+          <sourceDirectories>
+            <sourceDirectory>src/main/clj</sourceDirectory>
+          </sourceDirectories>
+          <testSourceDirectories>
+            <testSourceDirectory>src/test/clj</testSourceDirectory>
+          </testSourceDirectories>
+          <testScript>${basedir}/src/test/script/runtests.clj</testScript>
+        </configuration>
+        
+      </plugin>
+    </plugins>
+  </build>
+</project>

File src/main/clj/org/bituf/sqlrat/entity.clj

View file
+(ns org.bituf.sqlrat.entity
+  (:use org.bituf.sqlrat.entity.internal)
+  (:use [clojure.contrib.sql :as sql :only ()]))
+
+
+(def *show-sql* true)
+(def *show-sql-results* false)
+
+
+; ===== Utility functions and macros =====
+
+(defmacro in-db [db & body]
+  `(sql/with-connection ~db
+    ~@body))
+
+
+(defmacro in-txn [db & body]
+  `(sql/with-connection ~db
+    (sql/transaction
+      ~@body)))
+
+
+(defn db-query [query-vec]
+  "Fetch rows from database table. Execute this with in-db or in-txn."
+  (if *show-sql* (mypp "Executing SQL..." query-vec))
+  (let [result (sql/with-query-results rows
+                 query-vec
+                 (if (nil? rows) nil (into [] rows)))]
+    (if *show-sql-results* (mypp "SQL Result..." result))
+    result))
+
+
+;(defn save-row [^Keyword table ^Map row ^Keyword id-column]
+;  "Save given row. Table should be specified as :tablename (keyword).
+;  Row is simply a map of :columnName to value. Execute with in-txn or in-db."
+;  (let [id=? (str (name id-column) "=?")]
+;    (sql/update-or-insert-values
+;        table
+;        [id=? (id-column row)]
+;        row)))
+
+(defn save-row [^Keyword table ^Map row ^Keyword id-column]
+  "Save given row. Table should be specified as :tablename (keyword).
+  Row is simply a map of :columnName to value. Execute with in-txn or in-db.
+  Returns the saved row, which may have generated ID (if applicable)."
+  (let [id=? (str (name id-column) "=?")]
+    (let [result (update-or-insert-values-returnid
+                   table [id=? (id-column row)] row)]
+      (let [generated-key (:generated_key (first result))]
+        (if (nil? generated-key) row
+          (assoc row id-column generated-key))))))
+
+
+;;; ===== Entity relationships =====
+
+;; relation of this table with another table
+(defrecord RelationMetadata
+  [this-column   ; (keyword) column in this entity
+   that-entity   ; EntityMetadata instance for the other entity
+   that-column   ; (keyword) column name in that entity
+   that-depends? ; whether the other entity depends on "this"
+   ] )
+
+
+(defprotocol Relation
+  (rel-meta [this] "Return a sequence of Relation objects"))
+
+
+(defn relation
+  ([^Keyword this-col ^EntityMetadata that-ent ^Keyword that-col that-depends?]
+    (RelationMetadata. this-col that-ent that-col that-depends?))
+  ([^Keyword this-col ^EntityMetadata that-ent ^Keyword that-col]
+    (RelationMetadata. this-col that-ent that-col false)))
+
+
+(defn one-to-many [^Keyword this-col ^EntityMetadata that-ent-meta ^Keyword that-col]
+  (relation this-col that-ent-meta that-col true))
+
+
+(defn many-to-one [^Keyword this-col ^EntityMetadata that-ent-meta ^Keyword that-col]
+  (relation this-col that-ent-meta that-col false))
+
+
+(def one-to-one-depends one-to-many)
+
+
+(def one-to-one         many-to-one)
+
+
+(defn rel-impl [rels-vector]
+  "Returns implementation for the Relation protocol."
+  {:rel-meta (fn [this] (as-vector rels-vector))} )
+
+
+;;; ===== Entity definition =====
+
+(defn to-row [entity]
+  "Default implementation for to-row-fn."
+  (into {} entity))
+
+
+(defmacro from-row [& entity-creator]
+  `#(~@entity-creator {} %))
+
+
+(defrecord EntityMetadata
+  [name ;; :entry (keyword) name of the entity
+   id   ;; :autoid (keyword) name of the ID column
+   from-row-fn] ;; factory fn: IN row, OUT entity
+                ;; (from-row Entity.)
+   ;;;
+   ;; ##### Optional items with examples #####
+   ;;
+   ;; ===== columns definition (required for create-table):
+   ;;
+   ;; :cols  [[:autoid     :int "NOT NULL PRIMARY KEY AUTO_INCREMENT"]
+   ;;         [:entryid    :int           "NOT NULL"]
+   ;;         [:content    "varchar(500)" "NOT NULL"]
+   ;;         [:whenposted "DATETIME"     "NOT NULL"]
+   ;;         [:isdeleted  "BOOLEAN"      "NOT NULL DEFAULT false"]
+   ;;         [:name       "varchar(30)"  "NOT NULL"]
+   ;;         [:email      "varchar(50)"  "NOT NULL"]
+   ;;         [:url        "varchar(100)"]]
+   ;;
+   ;; ===== to-row function to convert from entity to row
+   ;;       (default implementation is used if not specified)
+   ;;
+   ;; :to-row-fn  to-row
+   )
+
+
+(defn entity-meta [name id from-row-fn
+                   & {:keys [cols to-row-fn] :or {to-row-fn to-row}}]
+  "Factory function to create entity metadata."
+  (EntityMetadata. name id from-row-fn
+    {} {:cols cols :to-row-fn to-row-fn}))
+
+
+(defprotocol Entity ;; represents a database table row
+  (get-meta [this] "Get entity metadata"))
+
+
+(defn entity-impl [^EntityMetadata e-meta]
+  "Returns implementation for Entity protocol."
+  {:get-meta (fn [this] e-meta)} )
+
+
+(defn extend-entity
+  ([record ent-meta]
+    (extend record
+      Entity (entity-impl ent-meta)))
+  ([record ent-meta rel-metadata]
+    (extend record
+      Entity   (entity-impl ent-meta)
+      Relation (rel-impl rel-metadata))))
+
+
+(def count-col "COUNT(*) AS cnt")
+
+
+(defn read-count-col [row-or-entity]
+  (:cnt (first row-or-entity)))
+
+
+(defn get-id-column [entity]
+  "Return ID column from entity"
+  (:id (get-meta entity)))
+
+
+(defn get-id-value [entity]
+  "Return ID column value from entity"
+  ((get-id-column entity) entity))
+
+
+;;; ===== Functions to work on entity and entity metadata.
+;;;       Execute these with in-db / in-txn
+
+;; function that accepts the (rel-meta entity) and returns a map
+;; {:that-entity-name each-rel}
+(def dbrel-lookup-by-that-entity
+  (memoize
+    (fn [rels-vector]
+      (let [rel-vector (as-vector rels-vector)
+            that-map (transient {})]
+        (doseq [each rel-vector]
+          (assoc! that-map (:name (:that-entity each)) each))
+        (persistent! that-map)))))
+
+
+(defn create-table [^EntityMetadata entity-meta]
+  "Create the table."
+  (let [table-name (:name entity-meta)
+        cols-spec  (:cols entity-meta)]
+    (apply sql/create-table table-name cols-spec)))
+
+
+(defn drop-table [^EntityMetadata entity-meta]
+  "Drop the table."
+  (sql/drop-table (:name entity-meta)))
+
+
+(defn find-by-sql [^EntityMetadata entity-meta sql-vec]
+  "Find entities with custom SQL/criteria. This is a free-form style"
+  (let [sql-vector (as-vector sql-vec)
+        rows       (db-query sql-vector)]
+    (into [] (for [each rows] ((:from-row-fn entity-meta) each)))))
+
+
+(defn find-by-criteria [^EntityMetadata entity-meta &
+                        {:keys [cols where] :or {cols ["*"] where []}}]
+  "Find entities using :cols and/or :where attributes. Examples are below:
+   :cols [:title :content \"whenposted\"]
+   :where [\"whenposted < ? ORDER BY whenposted\" (new java.util.Date)]
+   "
+  (let [no-cols?     (or (nil? cols) (empty? cols))
+        no-where?    (or (nil? where) (empty? where))
+        cols-vector  (if no-cols? nil (as-vector cols))
+        cols-str     (if no-cols? "*"
+                       (.replace
+                         (apply str (interpose ", " cols-vector)) ":" ""))
+        from-str     (name (:name entity-meta))
+        where-vector (if no-where? nil (as-vector where))
+        where-str    (if no-where? "" (str " WHERE " (first where-vector)))
+        where-arg    (if no-where? [] (rest where-vector))
+        sql-vector   (into
+                       [(str "SELECT " cols-str " FROM " from-str where-str)]
+                       where-arg)]
+    (find-by-sql entity-meta sql-vector)))
+
+
+(defn find-by-id [^EntityMetadata entity-meta id &
+                  {:keys [cols where] :or {cols ["*"] where []}}]
+  "Find an entity of given type for a given ID. You can also pass :cols and
+   :where attributes as in find-by-criteria."
+  (let [no-where?    (or (nil? where) (empty? where))
+        where-vector (if no-where? nil (as-vector where))
+        where-str    (if no-where? "" (str " AND " (first where-vector)))
+        where-arg    (if no-where? [] (rest where-vector))
+        rows         (find-by-criteria entity-meta
+                       :cols  cols
+                       :where (into
+                                [(str (name (:id entity-meta)) "=?" where-str)
+                                 id]
+                                where-arg))]
+    (if (empty? rows)
+      nil
+      ((:from-row-fn entity-meta) (first rows)))))
+
+
+(defn save [^Entity entity]
+  "Save given entity"
+  (let [ent-meta (get-meta entity)
+        from-row-fn (:from-row-fn ent-meta)]
+    (from-row-fn
+      (save-row
+        (:name ent-meta) ((:to-row-fn ent-meta) entity) (:id ent-meta)))))
+
+
+(defn delete
+  ([entity-meta id]
+    "Delete by ID"
+    (sql/delete-rows (:name entity-meta)
+      [(str (name (:id entity-meta)) "=?") id]))
+  ([entity]
+    "Delete given entity"
+    (delete (get-meta entity) (get-id-value entity))))
+
+
+;;; ===== Relationship handling functions. Execute with in-db / in-txn
+
+(defn find-rels [^Entity entity ^EntityMetadata that-meta &
+                 {:keys [cols where] :or {cols ["*"] where []}}]
+  "Fetch related entities. You can use the :cols and :where attributes as in
+   find-by-criteria function."
+  (let [no-where?      (or (nil? where) (empty? where))
+        where-vector   (if no-where? nil (as-vector where))
+        where-str      (if no-where? "" (str " AND " (first where-vector)))
+        where-arg      (if no-where? [] (rest where-vector))
+        this-meta      (get-meta entity)
+        rels           (:rels this-meta)
+        that-table-map (dbrel-lookup-by-that-entity (rel-meta entity))
+        rel-data       (that-table-map (:name that-meta))
+        rel-col-name   (name (:that-column rel-data))
+        rel-col-value  ((:this-column rel-data) entity)]
+    (find-by-criteria that-meta
+      :cols  cols
+      :where (into [(str rel-col-name "=?" where-str) rel-col-value]
+               where-arg))))
+
+
+(defn save-deps [^Entity entity deps-vector]
+  "Save dependents (THAT table) -- 1-to-many (has-many) relationships"
+  (let [cvec (as-vector deps-vector)
+        rels (rel-meta entity)
+        that-table-map (dbrel-lookup-by-that-entity rels)]
+    (into [] (for [each cvec]
+      (if-let [each-rel (that-table-map (:name (get-meta each)))]
+        (let [child (assoc each
+                      (:that-column each-rel)
+                      ((:this-column each-rel) entity))]
+          (save child)))))))
+
+
+(defn find-siblings [^Entity entity ^Entity rel-entity &
+                     {:keys [cols where] :or {cols ["*"] where []}}]
+  "Fetch sibling entities - Many-to-1 relationships. You can use the :cols and
+   :where attributes as in find-by-criteria function."
+  (let [no-where?       (or (nil? where) (empty? where))
+        where-vector    (if no-where? nil (as-vector where))
+        where-str       (if no-where? "" (str " AND " (first where-vector)))
+        where-arg       (if no-where? [] (rest where-vector))
+        this-meta       (get-meta entity)
+        that-table-map  (dbrel-lookup-by-that-entity (rel-meta entity))
+        rel-data        (that-table-map (:name (get-meta rel-entity)))
+        this-table-name (name (:name this-meta))
+        this-col-name   (name (:this-column rel-data))
+        that-id-value   ((:that-column rel-data) rel-entity)]
+    (find-by-criteria this-meta
+      :cols  cols
+      :where (into [(str this-col-name "=?" where-str) that-id-value]
+                 where-arg))))
+
+
+(defn delete-cascade [entity]
+  [entity]
+  "Delete (cascaded) a given entity"
+  (let [rels (rel-meta entity)]
+    (doseq [each rels]
+      (if (:that-depends? each)
+        (let [c (find-rels entity (:that-entity each))]
+          (doseq [each-child c]
+            (delete-cascade each-child))))))
+  (delete entity))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; pretty-printing for rows
+
+(def max-col-print-width 40)
+(def delim " | ")
+
+(defn print-entities [entities]
+  "Print homogenous entities in a table format. Keys from the first entity are
+   used as title. Passing an empty sequence of entities prints nothing at all."
+  (if-let [rows (map to-row (as-vector (if (map? entities) [entities] entities)))]
+    (let [cols-count (count (first rows))
+          cols-width (atom (into [] (take cols-count (repeat 0))))
+          keys-as-str (map name (keys (first rows)))
+          keys-n-vals (conj (map vals rows) keys-as-str)
+          ;; translate non-printable chars http://hyperpolyglot.wikidot.com/lisp
+          xlate-np-chars (fn [fs]
+                           (let [xl {"\b" "\\b" "\f" "\\f" "\n" "\\n"
+                                     "\r" "\\r" "\t" "\\t"}
+                                 ks (keys xl)]
+                             (apply str
+                               (map #(let [s (str %)]
+                                       (if (.contains ks s) (get xl s) s))
+                                 fs))))
+          ;(fn [s] (.replace (.replace s "\n" "\\n") "\t" "\\t"))
+          ]
+      ;; pass #1 -- calculate width of columns
+      (doseq [each keys-n-vals]
+        (let [each-cols-width (map #(count (xlate-np-chars (str %))) each)
+              max-cols-width (map max each-cols-width @cols-width)]
+          ;; keep the maximum col width under limits
+          (reset! cols-width
+            (map min
+              max-cols-width (take cols-count (repeat max-col-print-width))))))
+      ;; pass #2 -- actually print the cols
+      (let [fixed-width-str (fn [text width]
+                              (let [padded-text (apply str (xlate-np-chars text)
+                                                  (take width (repeat \ )))]
+                                (apply str (take width padded-text))))
+            print-cols (fn [cols]
+                         (println
+                           (apply str
+                             (interpose delim
+                               (map fixed-width-str cols @cols-width)))))]
+        ;; print titles and rows
+        (print-cols keys-as-str) ;; column titles
+        (print-cols (map #(apply str (repeat % "-")) @cols-width)) ;; dashes
+        (doseq [each-row rows] ;; column values
+          (print-cols (map str (vals each-row))))))))

File src/main/clj/org/bituf/sqlrat/entity/internal.clj

View file
+(ns org.bituf.sqlrat.entity.internal
+  (:import java.sql.Statement)
+  (:use clojure.contrib.pprint)
+  (:use [clojure.contrib.sql :as sql :only ()]))
+
+
+(defn mypp ; My Pretty Print
+  ([obj]
+    (pprint obj))
+  ([title obj]
+    (println title)
+    (pprint obj)))
+
+
+(defn as-vector [anything]
+  (if (vector? anything) anything
+    (if (or (seq? anything) (set? anything)) (into [] anything)
+      (if (map? anything) (into [] (vals anything))
+        [anything]))))
+
+
+(defn do-prepared-insert
+  "Executes an (optionally parameterized) SQL prepared statement on the
+  open database connection. Each param-group is a seq of values for all of
+  the parameters."
+  [sql & param-groups]
+  (with-open [stmt (.prepareStatement (sql/connection) sql
+                     Statement/RETURN_GENERATED_KEYS)]
+    (doseq [param-group param-groups]
+      (doseq [[index value] (map vector (iterate inc 1) param-group)]
+        (.setObject stmt index value))
+      (.addBatch stmt))
+    (sql/transaction
+     (seq (.executeBatch stmt))
+     (into [] (resultset-seq (.getGeneratedKeys stmt))))))
+
+
+(defn update-or-insert-values-returnid
+  "Updates values on selected rows in a table, or inserts a new row when no
+  existing row matches the selection criteria. where-params is a vector
+  containing a string providing the (optionally parameterized) selection
+  criteria followed by values for any parameters. record is a map from
+  strings or keywords (identifying columns) to updated values."
+  [table where-params record]
+  (sql/transaction
+   (let [result (sql/update-values table where-params record)]
+     (if (zero? (first result))
+       (binding [sql/do-prepared do-prepared-insert]
+         (sql/insert-values table (keys record) (vals record)))
+       result))))

File src/test/clj/org/bituf/sqlrat/test/dbblog.clj

View file
+(ns org.bituf.sqlrat.test.dbblog
+  (:use org.bituf.sqlrat.entity)
+  (:use org.bituf.sqlrat.test.dbconfig)
+  (:use clojure.test))
+
+
+;; Section A -- Define types
+
+(defrecord BlogEntry [])
+(defrecord EntryComment [])
+
+;; Section B -- Define entity metadata
+
+(def blog-entry-meta
+  (entity-meta :entry :autoid (from-row BlogEntry.)
+    :cols [[:autoid     :int           "NOT NULL PRIMARY KEY AUTO_INCREMENT"]
+           [:title      "varchar(30)"  "NOT NULL"]
+           [:content    "varchar(500)" "NOT NULL"]
+           [:whenposted "DATETIME"     "NOT NULL"]
+           [:isdeleted  "BOOLEAN"      "NOT NULL DEFAULT false"]] ))
+
+(def entry-comment-meta
+  (entity-meta :comment :autoid (from-row EntryComment.)
+    :cols [[:autoid     :int           "NOT NULL PRIMARY KEY AUTO_INCREMENT"]
+           [:entryid    :int           "NOT NULL"]
+           [:content    "varchar(500)" "NOT NULL"]
+           [:name       "varchar(50)"  "NOT NULL"]
+           [:email      "varchar(50)"  "NOT NULL"]
+           [:url        "varchar(100)"]
+           [:whenposted "DATETIME"     "NOT NULL"]
+           [:isdeleted  "BOOLEAN"      "NOT NULL DEFAULT false"]] ))
+
+;; Section C -- implement SQL protocol implementations on entities
+
+(extend-entity BlogEntry
+  blog-entry-meta
+  [(one-to-many :autoid  entry-comment-meta :entryid)])
+
+(extend-entity EntryComment
+  entry-comment-meta
+  [(many-to-one :entryid blog-entry-meta    :autoid)])
+
+
+;; =========================================================================
+
+(defn ppe ;; pretty-print-entities
+  ([e]
+    (print-entities e))
+  ([label e]
+    (println label)
+    (print-entities e)))
+
+(def db       db-mysql)
+
+(defn not-nil? "Tells whether an object is not-nil" [obj] (not (nil? obj)))
+
+(defn fail "Fails a test, with message" [msg] (println msg) (is false))
+
+(defmacro fail-on-exception [& body]
+  `(try ~@body
+    (catch Exception ~'nee
+      (fail (.getMessage ~'nee)))))
+
+(defn print-test-title [title]
+  (println (str "
+=======================================
+     " title "
+=======================================")))
+
+
+
+;; ========================================================
+;;                     Test Cases Start
+;; ========================================================
+
+(deftest test-recreate-tables
+  (print-test-title "test-recreate-tables")
+  (fail-on-exception
+    (in-db db
+      (println "** Dropping tables **")
+      (try
+        (drop-table blog-entry-meta)
+        (catch Exception e
+          (println (str "Error dropping table " (:name blog-entry-meta) ": "
+                     (.getMessage e) " [Ignored]"))))
+      (try
+        (drop-table entry-comment-meta)
+        (catch Exception e
+          (println (str "Error dropping table " (:name entry-comment-meta) ": "
+                     (.getMessage e) " [Ignored]"))))
+      (println "** Creating tables **")
+      (create-table entry-comment-meta)
+      (create-table blog-entry-meta))))
+
+
+(deftest test-populate-entry-table
+  (print-test-title "test-populate-entry-table")
+  (fail-on-exception
+    (println "** Populating entry table **")
+    (in-txn db
+      (let [saved (save (BlogEntry. {}
+                          {:title "Test"
+                           :content "Hello World"
+                           :whenposted (new java.util.Date)} ))
+            newid (get-id-value saved)]
+        (is (and (not-nil? newid) (not (zero? newid))))
+        (ppe "Saved row #1" saved)
+        (let [saved-again (save (assoc saved :title "Test Updated"))
+              newid-again (get-id-value saved-again)]
+          (is (= newid newid-again))
+          (ppe "Saved again (updated) row #1" saved-again))))
+    (in-txn db
+      (let [saved (save (BlogEntry. {}
+                          {:title "Second post"
+                           :content "Amarnath Trip"
+                           :whenposted (new java.util.Date)} ))
+            newid (get-id-value saved)]
+        (is (and (not-nil? newid) (not (zero? newid))))
+        (ppe "Saved row #2" saved)))
+    (in-txn db
+      (let [saved (save (BlogEntry. {}
+                          {:title "Third post"
+                           :content "Will be deleted"
+                           :whenposted (new java.util.Date)} ))
+            newid (get-id-value saved)]
+        (is (and (not-nil? newid) (not (zero? newid))))
+        (ppe "Saved row #3" saved)))
+    ))
+
+(deftest test-read-entry-table
+  (print-test-title "test-read-entry-table")
+  (fail-on-exception
+    (println "** Reading entry table **")
+    (in-db db
+      (let [e1 (find-by-id blog-entry-meta 1)
+            e2 (find-by-id blog-entry-meta 2)
+            en (find-by-id blog-entry-meta 11)
+            ea (find-by-criteria blog-entry-meta)]
+        (is (= 1 (get-id-value e1)))
+        (ppe "\nRow 1:" e1)
+        (is (= 2 (get-id-value e2)))
+        (ppe "\nRow 2:" e2)
+        (is (nil? en))
+        (ppe "\nRow 11 (non-existent):" en)
+        (is (= 3 (count ea)))
+        (ppe "\nAll rows:" ea)))))
+
+(deftest test-populate-comment-table
+  (print-test-title "test-populate-comment-table")
+  (fail-on-exception
+    (println "** Populating comment table **")
+    (in-txn db
+      (let [e (find-by-id blog-entry-meta 1)
+            c (EntryComment. {}
+                {:content "Comment #1"
+                 :whenposted (new java.util.Date)
+                 :name "Shantanu"
+                 :email "no@spam.com"} )
+            saved (save-deps e [c])]
+        (is (= 1 (count saved)))
+        (is (not (zero? (get-id-value (first saved)))))
+        (ppe "Saved 1 child for entry (ID=1)" saved))
+      (let [e (find-by-id blog-entry-meta 2)
+            c1 (EntryComment. {}
+                 {:content "Comment #2"
+                  :whenposted (new java.util.Date)
+                  :name "Phil\nNewline and \tTab"
+                  :email "hey@nospam.com"} )
+            c2 (EntryComment. {}
+                 {:content "Comment #3"
+                  :whenposted (new java.util.Date)
+                  :name "Dominic"
+                  :email "please@nospam.com"} )
+            saved (save-deps e [c1 c2])]
+        (is (= 2 (count saved)))
+        (is (not (zero? (get-id-value (first saved)))))
+        (is (not (zero? (get-id-value (second saved)))))
+        (ppe "Saved 2 children for entry (ID=2)" saved))
+      (let [e (find-by-id blog-entry-meta 3)
+            c1 (EntryComment. {}
+                 {:content "Comment #4"
+                  :whenposted (new java.util.Date)
+                  :name "Nathan"
+                  :email "nathan@nospam.com"} )
+            c2 (EntryComment. {}
+                 {:content "Comment #5"
+                  :whenposted (new java.util.Date)
+                  :name "Sherlyn"
+                  :email "sheri@nospam.com"} )
+            c3 (EntryComment. {}
+                 {:content "Comment #6"
+                  :whenposted (new java.util.Date)
+                  :name "Abdul"
+                  :email "mdabdul@nospam.com"} )
+            saved (save-deps e [c1 c2 c3])]
+        (is (= 3 (count saved)))
+        (is (not (zero? (get-id-value (first saved)))))
+        (is (not (zero? (get-id-value (second saved)))))
+        (is (not (zero? (get-id-value (saved 2)))))
+        (ppe "Saved 3 children for entry (ID=3)" saved)))))
+
+(deftest test-fetch-entry-comment-graph
+  (print-test-title "test-fetch-entry-comment-graph")
+  (fail-on-exception
+    (println "** Fetching entry-comment graph **")
+    (in-db db
+      (let [e (find-by-id blog-entry-meta 1)
+            r (find-rels e entry-comment-meta)]
+        (is (= 1 (count r)))
+        (ppe "\nEntry:" e)
+        (ppe "\nRelations:" r))
+      (let [e (find-by-id blog-entry-meta 2)
+            r (find-rels e entry-comment-meta)
+            rc (find-rels e entry-comment-meta :cols [:content :name :email])
+            rw (find-rels e entry-comment-meta :where ["email=?" "hey@nospam.com"])
+            rb (find-rels e entry-comment-meta :cols [:content :name :email]
+                 :where ["email=?" "hey@nospam.com"])]
+        (is (= 2 (count r)))
+        (is (= 3 (count (keys (first rc)))))
+        (is (= 1 (count rw)))
+        (is (and (= 3 (count (keys (first rb))))  (= 1 (count rb))))
+        (ppe "\nEntry:" e)
+        (ppe "\nRelations:" r)
+        (ppe "\nRelations with selected columns:" rc)
+        (ppe "\nRelations with WHERE clause:" rw)
+        (ppe "\nRelations with selected columns and WHERE clause:" rb)))))
+
+(deftest test-fetch-comment-siblings
+  (print-test-title "test-fetch-comment-siblings")
+  (fail-on-exception
+    (println "** Fetching siblings **")
+    (in-db db
+      (let [e (find-by-id blog-entry-meta 2)
+            r (find-rels e entry-comment-meta)
+            c (first r)
+            s (find-siblings c e)
+            sc (find-siblings c e :cols [:content :name :email])
+            sw (find-siblings c e :where ["name LIKE ?" "Phi%"])
+            sb (find-siblings c e :cols [:content :name :email] :where ["name LIKE ?" "Phi%"])]
+        (is (= 2 (count s)))
+        (is (= 3 (count (keys (first sc)))))
+        (is (= 1 (count sw)))
+        (is (and (= 3 (count (keys (first sb)))) (= 1 (count sb))))
+        (ppe "\nChild: " c)
+        (ppe "\nSiblings:" s)
+        (ppe "\nSiblings with selected columns:" sc)
+        (ppe "\nSiblings with WHERE clause:" sw)
+        (ppe "\nSiblings with selected columns and WHERE clause:" sb)))))
+
+(deftest test-count-function
+  (print-test-title "test-count-function")
+  (fail-on-exception
+    (println "** Counting by criteria **")
+    (in-db db
+      (let [r1 (find-by-criteria blog-entry-meta :cols count-col)
+            e  (find-by-id blog-entry-meta 2)
+            r2 (find-rels e entry-comment-meta :cols count-col)
+            c  (first r2)
+            s  (find-siblings c e :cols count-col)
+            sw (find-siblings c e :cols count-col :where ["name LIKE ?" "Phi%"])]
+        (is (= 3 (read-count-col r1)))
+        (is (= 2 (read-count-col r2)))
+        (is (= 2 (read-count-col s)))
+        (is (= 1 (read-count-col sw)))))))
+
+(deftest test-delete-entities
+  (print-test-title "test-delete-entities")
+  (fail-on-exception
+    (in-txn db
+      (let [e (find-by-id blog-entry-meta 3)
+            r (find-rels e entry-comment-meta)
+            c (first r)]
+        (is (= 3 (count r)))
+        (println "** Deleting comment **")
+        (delete c)
+        (let [ra (find-rels e entry-comment-meta :cols count-col)]
+          (is (= 2 (read-count-col ra)))
+          (println "** Deleting entry-comment graph **")
+          (delete-cascade e)
+          (let [ne (find-by-id blog-entry-meta 3)]
+            (is (nil? ne))))))))
+
+(defn test-ns-hook []
+  (test-recreate-tables)
+  (test-populate-entry-table)
+  (test-read-entry-table)
+  (test-populate-comment-table)
+  (test-fetch-entry-comment-graph)
+  (test-fetch-comment-siblings)
+  (test-count-function)
+  (test-delete-entities))

File src/test/clj/org/bituf/sqlrat/test/dbconfig.clj

View file
+(ns org.bituf.sqlrat.test.dbconfig
+  (:use clojure.contrib.sql)
+  (:import javax.sql.DataSource)
+  (:import com.mchange.v2.c3p0.DataSources)
+  (:import org.postgresql.ds.PGPoolingDataSource))
+
+
+; === Derby Config ===
+;
+(def db-derby (let [db-path "c:/derby/myblog"]
+  { :classname "org.apache.derby.jdbc.EmbeddedDriver"
+    :subprotocol "derby"
+    :subname db-path
+    :create true }))
+
+; === H2 config ===
+;
+(def db-h2
+  (let [db-protocol "mem"
+        ;db-protocol "tcp"            ; "file|mem|tcp"
+        db-host     "sample"
+        ;db-host     "localhost:9092" ; "path|host:port"
+        db-name     "Sample"]
+    { :classname   "org.h2.Driver" ; must be in classpath
+      :subprotocol "h2"
+      :subname (str db-protocol "://" db-host "/" db-name)
+      ; Any additional keys are passed to the driver
+      ; as driver-specific properties.
+      :user     "sa"
+      :password "" }))
+
+; === MySQL config ===
+;
+(def db-mysql
+  (let [db-host "localhost"
+        db-port 3306
+        db-name "sqlrat"]
+    { :classname "com.mysql.jdbc.Driver" ; must be in classpath
+      :subprotocol "mysql"
+      :subname (str "//" db-host ":" db-port "/" db-name)
+      ; Any additional keys are passed to the driver
+      ; as driver-specific properties.
+      :user     "root"
+      :password "" }))
+
+; === PostgreSQL config ===
+;
+(def db-pgsql
+  (let [db-host "localhost"
+        db-port 5432
+        db-name "a_database"]
+    { :classname "org.postgresql.Driver" ; must be in classpath
+      :subprotocol "postgresql"
+      :subname (str "//" db-host ":" db-port "/" db-name)
+      ; Any additional keys are passed to the driver
+      ; as driver-specific properties.
+      :user "a_user"
+      :password "secret" }))
+
+; === PostgreSQL DataSource config ===
+;
+(def ds-pgsql
+  (let [db-host "localhost"
+        db-name "example"
+        db-user "username"
+        db-pass "notTelling"]
+    { :datasource (doto (new PGPoolingDataSource)
+                    (.setServerName   db-host)
+                    (.setDatabaseName db-name)
+                    (.setUser         db-user)
+                    (.setPassword     db-pass)
+                    (.setMaxConnections 3)) }))
+
+; === Oracle config ===
+;
+(def db-oracle
+  { :classname "oracle.jdbc.driver.OracleDriver" ; must be in classpath
+    :subprotocol "oracle:thin"
+    :subname "@localhost:1521"
+    ; Any additional keys are passed to the driver
+    ; as driver-specific properties.
+    :user "???"
+    :password "???" })
+
+; === Oracle DataSource config ===
+;
+(def ds-oracle
+  { :datasource (DataSources/pooledDataSource
+                  (DataSources/unpooledDataSource
+                    "jdbc:oracle:thin:USER/PASS@HOST_IP:PORT:SCHEMA")) })

File src/test/script/runtests.clj

View file
+(ns runtests
+  (:use org.bituf.sqlrat.test.dbblog)
+  (:use clojure.test))
+
+
+(binding [org.bituf.sqlrat.entity/*show-sql* true
+          org.bituf.sqlrat.entity/*show-sql-results* true]
+  (run-tests
+    'org.bituf.sqlrat.test.dbblog))
+