From 775a7dfa8c524a06c8f9021a8390d58ecbcacf9c Mon Sep 17 00:00:00 2001
From: Russ Tyndall <russ@acceleration.net>
Date: Fri, 17 Jan 2014 16:22:18 -0500
Subject: [PATCH] Added filter-select-list (for clsql-helper:recency-mixin) as
 an extensibility point for manipulating query->object operations

---
 ChangeLog         |  4 ++++
 sql/generics.lisp |  6 ++++++
 sql/oodml.lisp    | 41 ++++++++++++++++++++++++++---------------
 sql/package.lisp  |  5 +++++
 4 files changed, 41 insertions(+), 15 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 08575e6..8a4a23e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2014-01-17 Russ Tyndall <russ@acceleration.net>
+	* oodml.lisp, generics.lisp - added filter-select-list generic
+	  to allow fine grained control of generated query/object mappings
+	
 2014-01-07 Russ Tyndall <russ@acceleration.net>
 	* clsql-uffi.lisp, sqlite3 auto-increment support
 	* clsql-uffi.lisp, test-basic.lisp, fixes related to unsigned vs
diff --git a/sql/generics.lisp b/sql/generics.lisp
index 7f276fc..c406a2b 100644
--- a/sql/generics.lisp
+++ b/sql/generics.lisp
@@ -198,3 +198,9 @@ the arguments EXPR and DATABASE."))
   (:documentation "Given a column constraint returns its
 database-specific name. For example, auto-increment constraints can
 have different names in different database engines."))
+
+(defgeneric filter-select-list ( view-class clsql-sys::select-list database)
+  (:documentation
+   "Gives fine grained control over sql to be executed and mapped to slots
+    called with a dummy instance (so that class precedence can be used)")
+  )
diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index 1599f17..092bcd3 100644
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -391,7 +391,9 @@
   (let* ((classes-and-slots (view-classes-and-storable-slots instance))
          (vd (choose-database-for-instance instance database)))
     (labels ((do-update (class-and-slots)
-               (let* ((select-list (make-select-list class-and-slots :do-joins-p nil))
+               (let* ((select-list (make-select-list class-and-slots
+                                                     :do-joins-p nil
+                                                     :database database))
                       (view-table (sql-table select-list))
                       (view-qual (key-qualifier-for-instance
                                   instance :database vd
@@ -986,7 +988,13 @@
 (defmethod sql-table ((o select-list))
   (sql-expression :table (view-table o)))
 
-(defun make-select-list (class-and-slots &key (do-joins-p nil))
+(defmethod filter-select-list ((c clsql-sys::standard-db-object)
+                               (sl clsql-sys::select-list)
+                               database)
+  sl)
+
+(defun make-select-list (class-and-slots &key (do-joins-p nil)
+                                         (database *default-database*))
   "Make a select-list for the current class (or class-and-slots) object."
   (let* ((class-and-slots
            (etypecase class-and-slots
@@ -1006,18 +1014,21 @@
               finally (return (values slots sqls)))
       (unless slots
         (error "No slots of type :base in view-class ~A" (class-name class)))
-      (make-instance
-       'select-list
-       :view-class class
-       :select-list sqls
-       :slot-list slots
-       :join-slots join-slots
-       ;; only do a single layer of join objects
-       :joins (when do-joins-p
-                (loop for js in join-slots
-                      collect (make-select-list
-                               (join-slot-class js)
-                               :do-joins-p nil)))))))
+      (let ((sl (make-instance
+                 'select-list
+                 :view-class class
+                 :select-list sqls
+                 :slot-list slots
+                 :join-slots join-slots
+                 ;; only do a single layer of join objects
+                 :joins (when do-joins-p
+                          (loop for js in join-slots
+                                collect (make-select-list
+                                         (join-slot-class js)
+                                         :do-joins-p nil
+                                         :database database))))))
+        (filter-select-list (make-instance class) sl database)
+        sl))))
 
 (defun full-select-list ( select-lists )
   "Returns a list of sql-ref of things to select for the given classes
@@ -1099,7 +1110,7 @@
                  appending (loop for slot in (immediate-join-slots class)
                                  collect (join-slot-qualifier class slot))))
          (select-lists (loop for class in sclasses
-                             collect (make-select-list class :do-joins-p t)))
+                             collect (make-select-list class :do-joins-p t :database database)))
          (full-select-list (full-select-list select-lists))
          (where (clsql-ands (append (listify where) (listify join-where))))
          #|
diff --git a/sql/package.lisp b/sql/package.lisp
index a8a5111..470be84 100644
--- a/sql/package.lisp
+++ b/sql/package.lisp
@@ -382,6 +382,11 @@
          #:*default-string-length*
 
          ;; OODML (oodml.lisp)
+         #:select-list
+         #:filter-select-list
+         #:slot-list
+         #:joins
+         #:join-slots
          #:instance-refreshed
          #:update-objects-joins
          #:*default-update-objects-max-len*
-- 
2.34.1