mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
Support slave clog-one-rows to handle one to many relationships
This commit is contained in:
David Botton
parent
1f56039d99
commit
d903791c86
4 changed files with 104 additions and 51 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
|
|
@ -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*
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue