Added filter-select-list (for clsql-helper:recency-mixin) as an
authorRuss Tyndall <russ@acceleration.net>
Fri, 17 Jan 2014 21:22:18 +0000 (16:22 -0500)
committerRuss Tyndall <russ@acceleration.net>
Fri, 17 Jan 2014 21:22:40 +0000 (16:22 -0500)
extensibility point for manipulating query->object operations

ChangeLog
sql/generics.lisp
sql/oodml.lisp
sql/package.lisp

index 08575e6..8a4a23e 100644 (file)
--- 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
index 7f276fc..c406a2b 100644 (file)
@@ -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)")
+  )
index 1599f17..092bcd3 100644 (file)
   (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
 (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
               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
                  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))))
          #|
index a8a5111..470be84 100644 (file)
          #:*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*