Commits

Anonymous committed 6b3e928

accept entities vector instead of just one entity in find-rels
avoid N+1 Selects in find-rels
add unit test for the N+1 scenario

  • Participants
  • Parent commits 665f81c

Comments (0)

Files changed (2)

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

 
 ;;; ===== Relationship handling functions. Execute with in-db / in-txn
 
-(defn find-rels [^Entity entity ^EntityMetadata that-meta &
+(defn find-rels [entities-vec ^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))))
+   find-by-criteria function. This avoids N+1 Selects. Returns a map in the form
+   
+   {entity1 [e1-rel1 e1-rel2 ...]
+    entity2 [e2-rel1 e2-rel2 e2-rel3 ...]}
+   
+   Entities with no children are not included in the map."
+  (let [entities (into #{} (as-vector (if (map? entities-vec) [entities-vec]
+                                        entities-vec)))]
+    ;; error check
+    (if (or (nil? entities)  (empty? entities) (nil? (first entities))
+          (let [entity-meta  (get-meta (first entities))
+                invalid?    #(or (nil? %)
+                               (not= entity-meta (get-meta %)))]
+            (some invalid? entities)))
+      (throw (IllegalArgumentException.
+               "One or more non-null entities of same type expected")))
+    ;; actual processing
+    (let [entity         (first entities)
+          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 that-meta))
+          that-column    (:that-column rel-data)
+          this-column    (:this-column rel-data)
+          rel-col-values (map #(this-column %) entities)
+          ??-placeholder (apply str
+                           (interpose ", "
+                             (take (count entities) (repeat \?))))
+          add-rel-column (fn [few-cols]
+                           (if (some #(or (= that-column %) (= "*" %)) few-cols)
+                             few-cols
+                             (conj few-cols that-column)))
+          cols-vector    (add-rel-column (as-vector cols))
+          group-by-str   (if (and (some #(= count-col %) cols-vector)
+                               (< 1 (count entities)))
+                           (str " GROUP BY " (name that-column)))
+          ;; fetch relations
+          child-entities (find-by-criteria that-meta
+                           :cols  cols-vector
+                           :where (into (into
+                                          [(str (name that-column)
+                                             " IN (" ??-placeholder ")"
+                                             where-str group-by-str)]
+                                          rel-col-values)
+                                    where-arg))
+          find-parent    (fn [child-entity]
+                           (let [foreign-key (that-column child-entity)]
+                             (first (filter #(= (this-column %) foreign-key)
+                                      entities))))]
+      (group-by find-parent child-entities))))
 
 
 (defn save-deps [^Entity entity deps-vector]
   (let [rels (rel-meta entity)]
     (doseq [each rels]
       (if (:that-depends? each)
-        (let [c (find-rels entity (:that-entity each))]
+        (let [c ((find-rels entity (:that-entity each)) entity)]
           (doseq [each-child c]
             (delete-cascade each-child))))))
   (delete entity))

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

 
 (extend-entity BlogEntry
   blog-entry-meta
-  [(one-to-many :autoid  entry-comment-meta :entryid)])
+  [(one-to-many :autoid  entry-comment-meta :entryid)] )
 
 (extend-entity EntryComment
   entry-comment-meta
-  [(many-to-one :entryid blog-entry-meta    :autoid)])
+  [(many-to-one :entryid blog-entry-meta    :autoid)] )
 
 
 ;; =========================================================================
     (println label)
     (print-entities e)))
 
-(def db       db-mysql)
+(def db db-mysql)
 
 (defn not-nil? "Tells whether an object is not-nil" [obj] (not (nil? obj)))
 
 (defmacro fail-on-exception [& body]
   `(try ~@body
     (catch Exception ~'nee
+      (.printStackTrace ~'nee)
       (fail (.getMessage ~'nee)))))
 
 (defn print-test-title [title]
                            :whenposted (new java.util.Date)} ))
             newid (get-id-value saved)]
         (is (and (not-nil? newid) (not (zero? newid))))
-        (ppe "Saved row #3" saved)))
-    ))
+        (ppe "Saved row #3" saved)))))
 
 (deftest test-read-entry-table
   (print-test-title "test-read-entry-table")
     (println "** Fetching entry-comment graph **")
     (in-db db
       (let [e (find-by-id blog-entry-meta 1)
-            r (find-rels e entry-comment-meta)]
+            r ((find-rels e entry-comment-meta) e)]
         (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"])]
+            r ((find-rels e entry-comment-meta) e)
+            rc ((find-rels e entry-comment-meta :cols [:content :name :email]) e)
+            rw ((find-rels e entry-comment-meta :where ["email=?" "hey@nospam.com"]) e)
+            rb ((find-rels e entry-comment-meta :cols [:content :name :email]
+                 :where ["email=?" "hey@nospam.com"]) e)]
         (is (= 2 (count r)))
-        (is (= 3 (count (keys (first rc)))))
+        (is (<= 3 (count (keys (first rc)))))
         (is (= 1 (count rw)))
-        (is (and (= 3 (count (keys (first rb))))  (= 1 (count rb))))
+        (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)))))
+        (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-rels 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-rels entries entry-comment-meta :cols count-col)]
+        (ppe "\nAll entries:" entries)
+        (doseq [each entries]
+          (println (str "\nComments# for entry ID: " (:autoid each))
+            (read-count-col (comments each))))))))
 
 (deftest test-fetch-comment-siblings
   (print-test-title "test-fetch-comment-siblings")
     (println "** Fetching siblings **")
     (in-db db
       (let [e (find-by-id blog-entry-meta 2)
-            r (find-rels e entry-comment-meta)
+            r ((find-rels e entry-comment-meta) e)
             c (first r)
             s (find-siblings c e)
             sc (find-siblings c e :cols [:content :name :email])
     (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)
+            r2 ((find-rels e entry-comment-meta :cols count-col) e)
             c  (first r2)
             s  (find-siblings c e :cols count-col)
             sw (find-siblings c e :cols count-col :where ["name LIKE ?" "Phi%"])]
   (fail-on-exception
     (in-txn db
       (let [e (find-by-id blog-entry-meta 3)
-            r (find-rels e entry-comment-meta)
+            r ((find-rels e entry-comment-meta) e)
             c (first r)]
         (is (= 3 (count r)))
         (println "** Deleting comment **")
         (delete c)
-        (let [ra (find-rels e entry-comment-meta :cols count-col)]
+        (let [ra ((find-rels e entry-comment-meta :cols count-col) e)]
           (is (= 2 (read-count-col ra)))
           (println "** Deleting entry-comment graph **")
           (delete-cascade e)