Added filter-select-list (for clsql-helper:recency-mixin) as an

extensibility point for manipulating query->object operations

diff --git a/ChangeLog b/ChangeLog
index 08575e6e8dbe84e6e1069c5964f0deaca36a41d3..8a4a23e1b069464978a49156677e14feeec7c99a 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
 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 7f276fc196e397a68444c479135949e7ebe929a2..c406a2b31de79224b941b89fd463f380f6fd7898 100644 (file)
--- 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."))
   (: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 1599f17e6fcf00b38cf15089811d23410e9c8fc9..092bcd3e031a63fc11968ac686fde2275568af81 100644 (file)
--- 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* ((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
                       (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)))
 
 (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
   "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)))
               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
 
 (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
                  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))))
          #|
          (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 a8a511185ea34c1a9cd9de847b5278cdf758fc51..470be84e22d06ec30ea0dac20c305ac861f3f3c9 100644 (file)
--- a/sql/package.lisp
+++ b/sql/package.lisp
@@ -382,6 +382,11 @@
          #:*default-string-length*
 
          ;; OODML (oodml.lisp)
          #:*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*
          #:instance-refreshed
          #:update-objects-joins
          #:*default-update-objects-max-len*