Added to-database-p keyword to view-classes-and-storable-slots (and added generic)

diff --git a/ChangeLog b/ChangeLog
index 8a4a23e1b069464978a49156677e14feeec7c99a..3944e590bf2101b983b02cdbfcecc6df5c5bca43 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2014-01-17 Russ Tyndall <russ@acceleration.net>
+       * oodml.lisp, generics.lisp - added
+       clsql-sys::view-classes-and-storable-slots generic (added method
+       previously).  Also added to-database-p keyword to allow overrides
+       to distinguish between the two situations. Mostly so that
+       clsql-helper:dirty-slots-mixin can filter slots when writing
+       values to the database but still allow all slots to be read from
+       the database
+

 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-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

diff --git a/sql/generics.lisp b/sql/generics.lisp
index c406a2b31de79224b941b89fd463f380f6fd7898..6ca064a79afc6c44ddea8c5a01d754054103dd5e 100644 (file)
--- a/sql/generics.lisp
+++ b/sql/generics.lisp
@@ -204,3 +204,9 @@ have different names in different database engines."))
    "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)")
   )
    "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)")
   )

+
+(defgeneric view-classes-and-storable-slots (view-class &key to-database-p)
+  (:documentation "A method that collects all the classes and storable slots
+   that need to be read from or written to the database.
+   to-database-p should be T if we are writing this object to the database
+   and nil when we are reading this object from the database"))

diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index 092bcd3e031a63fc11968ac686fde2275568af81..dbd5e6c5d1b2ba9db199d97f3cde08781c108969 100644 (file)
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -308,14 +308,20 @@
    the public api"
   (update-record-from-slots obj slot :database database))
 
    the public api"
   (update-record-from-slots obj slot :database database))
 

-(defmethod view-classes-and-storable-slots (class)
+(defmethod view-classes-and-storable-slots (class &key to-database-p)

   "Get a list of all the tables we need to update and the slots on them
 
    for non normalized classes we return the class and all its storable slots
 
    for normalized classes we return a list of direct slots and the class they
    came from for each normalized view class
   "Get a list of all the tables we need to update and the slots on them
 
    for non normalized classes we return the class and all its storable slots
 
    for normalized classes we return a list of direct slots and the class they
    came from for each normalized view class

+
+   to-database-p is provided so that we can read / write different data
+   to the database in different circumstances
+   (specifically clsql-helper:dirty-db-slots-mixin which only updates slots
+    that have changed )

   "
   "

+  (declare (ignore to-database-p))

   (setf class (to-class class))
   (let* (rtns)
     (labels ((storable-slots (class)
   (setf class (to-class class))
   (let* (rtns)
     (labels ((storable-slots (class)


@@ -359,7 +365,7 @@
    view-database slot on the object is nil then the object is assumed to be
    new and is inserted"
   (let ((database (choose-database-for-instance obj database))
    view-database slot on the object is nil then the object is assumed to be
    new and is inserted"
   (let ((database (choose-database-for-instance obj database))

-        (classes-and-slots (view-classes-and-storable-slots obj)))
+        (classes-and-slots (view-classes-and-storable-slots obj :to-database-p t)))

     (loop for class-and-slots in classes-and-slots
           do (%update-instance-helper class-and-slots obj database))
     (setf (slot-value obj 'view-database) database)
     (loop for class-and-slots in classes-and-slots
           do (%update-instance-helper class-and-slots obj database))
     (setf (slot-value obj 'view-database) database)


@@ -388,7 +394,8 @@
          Can we just call build-objects?, update-objects-joins?
   "
 
          Can we just call build-objects?, update-objects-joins?
   "
 

-  (let* ((classes-and-slots (view-classes-and-storable-slots instance))
+  (let* ((classes-and-slots (view-classes-and-storable-slots
+                             instance :to-database-p nil))

          (vd (choose-database-for-instance instance database)))
     (labels ((do-update (class-and-slots)
                (let* ((select-list (make-select-list class-and-slots
          (vd (choose-database-for-instance instance database)))
     (labels ((do-update (class-and-slots)
                (let* ((select-list (make-select-list class-and-slots


@@ -1003,7 +1010,8 @@
               ;; find the first class with slots for us to select (this should be)
               ;; the first of its classes / parent-classes with slots
               (first (reverse (view-classes-and-storable-slots
               ;; find the first class with slots for us to select (this should be)
               ;; the first of its classes / parent-classes with slots
               (first (reverse (view-classes-and-storable-slots

-                               (to-class class-and-slots)))))))
+                               (to-class class-and-slots)
+                                :to-database-p nil))))))

          (class (view-class class-and-slots))
          (join-slots (when do-joins-p (immediate-join-slots class))))
     (multiple-value-bind (slots sqls)
          (class (view-class class-and-slots))
          (join-slots (when do-joins-p (immediate-join-slots class))))
     (multiple-value-bind (slots sqls)