diff --git a/source/clog-dbi.lisp b/source/clog-dbi.lisp
index 8a6db5a..a4f6fc6 100644
--- a/source/clog-dbi.lisp
+++ b/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
-must be a parent to CLOG-One-Row."))
+ (:documentation "Create a new CLOG-One-Row element. If CLOG-OBJ is
+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
- (dbi:prepare
- (database-connection (clog-database obj))
- (sql-select (table-name obj)
- (table-columns obj)
- :where (where-clause obj)
- :order-by (order-by obj)
- :limit (limit obj)))))
- (next-row obj panel))
+ (let ((where (where-clause obj)))
+ (when (slave-to-slot obj)
+ (let ((field (slave-to-slot obj))
+ (data (car (data-write-list panel (list (slave-to-slot obj))))))
+ (when (consp (slave-to-slot obj))
+ (setf flield (car field)))
+ (setf where (format nil "~A='~A'~A"
+ field
+ 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
diff --git a/source/clog.lisp b/source/clog.lisp
index 9a94483..d1c53c4 100644
--- a/source/clog.lisp
+++ b/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)
- (set-on-fetch generic-function)
- (create-one-row generic-function)
- (clog-database generic-function)
- (table-name generic-function)
- (where-clause generic-function)
- (order-by generic-function)
- (limit generic-function)
- (row-id-name generic-function)
- (rowid generic-function)
- (table-columns generic-function)
- (last-fetch generic-function)
- (query-row generic-function)
- (get-row generic-function)
- (next-row generic-function)
- (insert-row generic-function)
- (update-row generic-function)
- (clear-row generic-function)
- (delete-row generic-function))
+ (clog-one-row class)
+ (set-on-fetch generic-function)
+ (set-master-one-row generic-function)
+ (create-one-row generic-function)
+ (clog-database generic-function)
+ (table-name generic-function)
+ (where-clause generic-function)
+ (order-by generic-function)
+ (limit generic-function)
+ (row-id-name generic-function)
+ (rowid generic-function)
+ (table-columns generic-function)
+ (last-fetch generic-function)
+ (query-row generic-function)
+ (get-row generic-function)
+ (next-row generic-function)
+ (insert-row generic-function)
+ (update-row generic-function)
+ (clear-row generic-function)
+ (delete-row generic-function))
(defsection @clog-panels (:title "CLOG Panels")
"CLOG-Panel - CLOG Panels"
diff --git a/test/rolodex.clog b/test/rolodex.clog
index 8fe7e96..68089d5 100644
--- a/test/rolodex.clog
+++ b/test/rolodex.clog
@@ -1 +1 @@
-
\ No newline at end of file
+
\ No newline at end of file
diff --git a/tools/clog-builder-settings.lisp b/tools/clog-builder-settings.lisp
index 883b179..7e6a53f 100644
--- a/tools/clog-builder-settings.lisp
+++ b/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)) ~
- (setf (table-name target) \"~A\") ~
- (setf (where-clause target) \"~A\") ~
- (setf (order-by target) \"~A\") ~
- (setf (limit target) \"~A\") ~
- (setf (row-id-name target) \"~A\") ~
- (setf (table-columns target) '(~A))"
- (attribute (parent-element control) "data-clog-name")
- (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")))
+ (let ((parent (attribute (parent-element control) "data-clog-name"))
+ (master (attribute control "data-clog-one-row-master")))
+ (when (equal master "")
+ (setf master nil))
+ (format nil "(setf (clog-database target) ~A) ~
+ ~A ~
+ (setf (table-name target) \"~A\") ~
+ (setf (where-clause target) \"~A\") ~
+ (setf (order-by target) \"~A\") ~
+ (setf (limit target) \"~A\") ~
+ (setf (row-id-name target) \"~A\") ~
+ (setf (table-columns target) '(~A))"
+ (if master
+ (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"
- :attr "data-clog-one-row-id-name")
- (:name "table columns"
- :attr "data-clog-one-row-columns")
+ (:name "join to slot-name (optional)"
+ :attr "data-clog-one-row-master")
,@*props-element*))))
(defparameter *supported-templates*