Source

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

Full commit
(ns org.bituf.sqlrat.test.dbblog
  (:use org.bituf.sqlrat.entity)
  (:use org.bituf.sqlrat.clause)
  (:use org.bituf.sqlrat.test.dbconfig)
  (:use org.bituf.sqlrat.test.util)
  (: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
  ([es]
    (assert (vector? es))
    (print-entities es))
  ([label e]
    (println label)
    (print-entities e)))

(def db db-mysql)


;; ========================================================
;;                     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))
        (println "\nRow 11 (non-existent):" en)
        (is (= 3 (count ea)))
        (ppe "\nAll rows:" ea))
      (with-find-by-criteria-results rows blog-entry-meta {}
        (let [all (into [] rows)]
          (is (= 3 (count all)))
          (ppe "##with-find-by-criteria-results##" all))))))


(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)
            s (find-entity-rels-map [e] entry-comment-meta)
            _ (do (println "Debug in dblog.clj START")
                (println s)
                (println "Debug in dblog.clj END"))
            r (s e)]
        (is (= 1 (count r)))
        (ppe "\nEntry:" [e])
        (ppe "\nRelations:" r)
        ;; lazy-version
        (with-find-rels-results res [e] entry-comment-meta {}
          (let [all (into [] res)]
            (is (= 1 (count all))))))
      (let [e  (find-by-id blog-entry-meta 2)
            r  ((find-entity-rels-map [e] entry-comment-meta) e)
            rc ((find-entity-rels-map [e] entry-comment-meta
                  {:cols [:content :name :email]}) e)
            rw ((find-entity-rels-map [e] entry-comment-meta
                  {:where (as-clause ["email=?" "hey@nospam.com"])}) e)
            rb ((find-entity-rels-map [e] entry-comment-meta
                  {:cols [:content :name :email]
                   :where (as-clause ["email=?" "hey@nospam.com"])}) e)]
        (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))
      (println "\n*** Avoiding N+1 selects ***")
      (let [entries (find-by-criteria blog-entry-meta)
            comments (find-entity-rels-map entries entry-comment-meta)]
        (ppe "\nAll entries:" entries)
        (doseq [each entries]
          (ppe (str "\nComments for entry ID: " (:autoid each))
            (comments each))))
      (let [entries (find-by-criteria blog-entry-meta)
            comments (find-entity-rels-map entries entry-comment-meta
                       {:cols [count-col]})]
        (ppe "\nAll entries:" entries)
        (doseq [each entries]
          (println (str "\nComments# for entry ID: " (:autoid each))
            (read-first-count-col (comments each))))))))


(deftest test-comment-groupby-other
  (print-test-title "test-comment-groupby-other")
  (fail-on-exception
    (println "** Fetching comments using GROUP BY and LIMIT **")
    (in-db db
      (let [entries (find-by-criteria blog-entry-meta)
            comments (find-entity-rels-map entries entry-comment-meta
                       {:cols [count-col] :other (limit 1 2)} )]
        (is (= 3 (count entries)))
        (ppe "\nAll entries:" entries)
        (doseq [each entries]
          (is (= (read-first-count-col (comments each)) ({2 2 3 3} (:autoid each))))
          (println (str "\nComments# for entry ID: " (:autoid each))
            (read-first-count-col (comments each))))))))


(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-entity-rels-map [e] entry-comment-meta) e)
            c (first r)
            s (find-siblings c (get-meta e))
            sc (find-siblings c (get-meta e) {:cols  [:content :name :email]})
            sw (find-siblings c (get-meta e) {:where (as-clause
                                                       ["name LIKE ?" "Phi%"])})
            sb (find-siblings c (get-meta e) {:cols  [:content :name :email]
                                              :where (as-clause
                                                       ["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)
        ;; lazy version
        (with-find-siblings-results ses c blog-entry-meta {}
          (let [all (into [] ses)]
            (is (= 2 (count ses)))))))))


(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-entity-rels-map [e] entry-comment-meta {:cols [count-col]}) e)
            c  (first r2)
            s  (find-siblings c (get-meta e) {:cols [count-col]})
            sw (find-siblings c (get-meta e) {:cols  [count-col]
                                              :where (as-clause
                                                       ["name LIKE ?" "Phi%"])})]
        (is (= 3 (read-first-count-col r1)))
        (is (= 2 (read-first-count-col r2)))
        (is (= 2 (read-first-count-col s)))
        (is (= 1 (read-first-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-entity-rels-map [e] entry-comment-meta) e)
            c (first r)]
        (is (= 3 (count r)))
        (println "** Deleting comment **")
        (delete c)
        (let [ra ((find-entity-rels-map [e] entry-comment-meta
                    {:cols [count-col]}) e)]
          (is (= 2 (read-first-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-comment-groupby-other)
  (test-fetch-comment-siblings)
  (test-count-function)
  (test-delete-entities))