Support slave clog-one-rows to handle one to many relationships

source/clog-dbi.lisp

@@ -44,7 +44,7 @@ CLOG-Builder. If not using builder use to connect:
 					       :auto-place auto-place)
 			       'clog-database)))
     new-obj))
-    
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; database-connection ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -97,6 +97,14 @@ CLOG-Builder. If not using builder use to connect:
     :accessor queryid
     :initform nil
     :documentation "Current query (private)")
+   (slave-to-slot
+    :accessor slave-to-slot
+    :initform nil
+    :documentation "Slot to watch on fetch by master row (private)")
+   (slaves
+    :accessor slaves
+    :initform nil
+    :documentation "List of slaves to call get-row")
    (on-fetch
     :accessor on-fetch
     :initform nil
@@ -109,8 +117,9 @@ CLOG-Builder. If not using builder use to connect:
 
 (defgeneric create-one-row (clog-obj &key clog-database
 				       hidden class html-id auto-place)
-  (:documentation "Create a new CLOG-One-Row element. A CLOG Database
+  (:documentation "Create a new CLOG-One-Row element. If CLOG-OBJ is
-must be a parent to CLOG-One-Row."))
+of type-of CLOG-DATABASE it is used as database source unless
+:CLOG-DATABASE is set."))
 
 (defmethod create-one-row ((obj clog-obj) &key (clog-database nil)
 					    (hidden nil)
@@ -122,6 +131,8 @@ must be a parent to CLOG-One-Row."))
 					       :html-id html-id
 					       :auto-place auto-place)
 			       'clog-one-row)))
+    (when (and (typep obj 'clog-database) (not clog-database))
+      (setf clog-database obj))
     (setf (clog-database new-obj) clog-database)
     new-obj))
 
@@ -142,27 +153,47 @@ CLOG-ONE-ROW's table-name using where-clause and table-columns.
 row-id-name is required. All PANEL items or custom rows on panel will
 be set using DATA-LOAD-PLIST."))
 (defmethod get-row ((obj clog-one-row) panel)
-  (setf (queryid obj) (dbi:execute
+  (let ((where (where-clause obj)))
-		       (dbi:prepare
+    (when (slave-to-slot obj)
-			(database-connection (clog-database obj))
+      (let ((field (slave-to-slot obj))
-			(sql-select (table-name obj)
+	    (data  (car (data-write-list panel (list (slave-to-slot obj))))))
-				    (table-columns obj)
+	(when (consp (slave-to-slot obj))
-				    :where (where-clause obj)
+	  (setf flield (car field)))
-				    :order-by (order-by obj)
+	(setf where (format nil "~A='~A'~A"
-				    :limit (limit obj)))))
+				field
-  (next-row obj panel))
+				data
+				(if (equal where "")
+				    ""
+				    (format nil " and ~A" where))))))
+    (setf (queryid obj) (dbi:execute
+			 (dbi:prepare
+			  (database-connection (clog-database obj))
+			  (sql-select (table-name obj)
+				      (table-columns obj)
+				      :where where
+				      :order-by (order-by obj)
+				      :limit (limit obj))))))
+    (next-row obj panel))
 
 (defgeneric next-row (clog-one-row panel)
   (:documentation "Get next row from a database table based on query
 made for get-row. All PANEL items or custom rows on panel will be set
 using DATA-LOAD-PLIST."))
 (defmethod next-row ((obj clog-one-row) panel)
+  (dolist (slave (slaves obj))
+    (clear-row slave panel))
   (setf (last-fetch obj) (dbi:fetch (queryid obj)))
   (when (on-fetch obj)
     (funcall (on-fetch obj) obj))
   (setf (rowid obj) (data-load-plist panel
 				     (last-fetch obj)
-				     :row-id-name (row-id-name obj))))
+				     :row-id-name (row-id-name obj)))
+  (if (rowid obj)
+      (dolist (slave (slaves obj))
+	(get-row slave panel))
+      (unless (slave-to-slot obj)
+	(clear-row obj panel)))
+  (rowid obj))
 
 (defgeneric insert-row (clog-one-row panel)
   (:documentation "Insert new row in to database table based on
@@ -207,6 +238,13 @@ using DATA-WRITE-PLIST based on table-columns."))
     (setf (last-fetch obj) nil)
     (setf (rowid obj) nil)))
 
+(defgeneric set-master-one-row (clog-one-row master-one-row slot-name)
+  (:documentation "Set CLOG-ONE-ROW to get-row setting a while-clause
+ to follow slot-name of panel when MASTER-ONE-ROW calls next-row."))
+(defmethod set-master-one-row ((obj clog-one-row) master-one-row slot-name)
+  (push obj (slaves master-one-row))
+  (setf (slave-to-slot obj) slot-name))
+
 (defgeneric set-on-fetch (clog-one-row on-fetch-handler)
   (:documentation "Set the ON-FETCH-HANDLER for CLOG-ONE-ROW. If ON-FETCH-HANDLER
 is nil unbind the event. The on-fetch event is called after the row was fetched

source/clog.lisp

@@ -544,25 +544,26 @@ embedded in a native template application.)"
   (create-database       generic-function)
   (database-connection   generic-function)
 
-  (clog-one-row   class)
+  (clog-one-row       class)
-  (set-on-fetch   generic-function)
+  (set-on-fetch       generic-function)
-  (create-one-row generic-function)
+  (set-master-one-row generic-function)
-  (clog-database  generic-function)
+  (create-one-row     generic-function)
-  (table-name     generic-function)
+  (clog-database      generic-function)
-  (where-clause   generic-function)
+  (table-name         generic-function)
-  (order-by       generic-function)
+  (where-clause       generic-function)
-  (limit          generic-function)
+  (order-by           generic-function)
-  (row-id-name    generic-function)
+  (limit              generic-function)
-  (rowid          generic-function)
+  (row-id-name        generic-function)
-  (table-columns  generic-function)
+  (rowid              generic-function)
-  (last-fetch     generic-function)
+  (table-columns      generic-function)
-  (query-row      generic-function)
+  (last-fetch         generic-function)
-  (get-row        generic-function)
+  (query-row          generic-function)
-  (next-row       generic-function)
+  (get-row            generic-function)
-  (insert-row     generic-function)
+  (next-row           generic-function)
-  (update-row     generic-function)
+  (insert-row         generic-function)
-  (clear-row      generic-function)
+  (update-row         generic-function)
-  (delete-row     generic-function))
+  (clear-row          generic-function)
+  (delete-row         generic-function))
 
 (defsection @clog-panels (:title "CLOG Panels")
   "CLOG-Panel - CLOG Panels"

tools/clog-builder-settings.lisp

@@ -1369,39 +1369,53 @@
 			(setf (attribute control "data-clog-one-row-where") "")
 			(setf (attribute control "data-clog-one-row-order") "")
 			(setf (attribute control "data-clog-one-row-limit") "")
+			(setf (attribute control "data-clog-one-row-master") "")
 			(setf (attribute control "data-clog-one-row-id-name") "rowid")
 			(setf (attribute control "data-clog-one-row-columns") "rowid"))
      :on-setup       ,(lambda (control control-record)
 			(declare (ignore control-record))
-			(format nil "(setf (clog-database target) (~A panel)) ~
+			(let ((parent (attribute (parent-element control) "data-clog-name"))
-                                     (setf (table-name target) \"~A\") ~
+			      (master (attribute control "data-clog-one-row-master")))
-                                     (setf (where-clause target) \"~A\") ~
+			  (when (equal master "")
-                                     (setf (order-by target) \"~A\") ~
+			    (setf master nil))
-                                     (setf (limit target) \"~A\") ~
+			  (format nil "(setf (clog-database target) ~A) ~
-                                     (setf (row-id-name target) \"~A\") ~
+                                       ~A ~
-                                     (setf (table-columns target) '(~A))"
+                                       (setf (table-name target) \"~A\") ~
-				(attribute (parent-element control) "data-clog-name")
+                                       (setf (where-clause target) \"~A\") ~
-				(attribute control "data-clog-one-row-table")
+                                       (setf (order-by target) \"~A\") ~
-				(attribute control "data-clog-one-row-where")
+                                       (setf (limit target) \"~A\") ~
-				(attribute control "data-clog-one-row-order")
+                                       (setf (row-id-name target) \"~A\") ~
-				(attribute control "data-clog-one-row-limit")
+                                       (setf (table-columns target) '(~A))"
-				(attribute control "data-clog-one-row-id-name")
+				  (if master
-				(attribute control "data-clog-one-row-columns")))
+				      (format nil "(clog-database (~A panel))" parent)
+				      (format nil "(~A panel)" parent))
+				  (if master
+				      (format nil "(set-master-one-row target (~A panel) \"~A\")"
+					      parent master)
+				      "")
+				  (attribute control "data-clog-one-row-table")
+				  (attribute control "data-clog-one-row-where")
+				  (attribute control "data-clog-one-row-order")
+				  (attribute control "data-clog-one-row-limit")
+				  (attribute control "data-clog-one-row-id-name")
+				  (attribute control "data-clog-one-row-columns"))))
      :events         ((:name        "on-fetch"
 		       :parameters  "target")
 		       ,@*events-element*)
      :properties     ((:name "table name"
 		       :attr "data-clog-one-row-table")
+		      (:name "table row id name"
+		       :attr "data-clog-one-row-id-name")
+		      (:name "table columns"
+		       :attr "data-clog-one-row-columns")
 		      (:name "where clause (optional)"
 		       :attr "data-clog-one-row-where")
 		      (:name "order by (optional)"
 		       :attr "data-clog-one-row-order")
 		      (:name "limit (optional)"
 		       :attr "data-clog-one-row-limit")
-		      (:name "table row id name"
+		      (:name "join to slot-name (optional)"
-		       :attr "data-clog-one-row-id-name")
+		       :attr "data-clog-one-row-master")
-		      (:name "table columns"
-		       :attr "data-clog-one-row-columns")
 		      ,@*props-element*))))
 
 (defparameter *supported-templates*