I spend nearly the whole weekend on gettign a bit further. My code is not this:
(in-package :qss.web)
;; (use-package :cells) (eval-when (:compile-toplevel :execute) (defparameter *example-app* (make-instance 'cookie-session-application :url-prefix "/ucw/examples/" :tal-generator (make-instance 'yaclml:file-system-generator :cachep t :root-directories (list *ucw-tal-root*)) :www-roots (list *ucw-tal-root*))))
;; (register-application *default-server* *example-app*)
(cells:defmodel controller (cells:model) ((view-obj :accessor view-obj :cell t :initarg :view-obj :initform (cells:c-in nil)) (db-obj :accessor db-obj :initarg :db-obj :cell t :initform (cells:c? (update-from-view cells:self)))))
(clsql:def-view-class example-app () ((id :type integer :db-kind :key :accessor id :initarg :id) (tag :type string :accessor tag :initarg :tag) (description :type string :accessor description :initarg :description) (some-fk :type integer :accessor some-fk :initarg :some-fk) (some-objects :accessor some-objects :db-kind :join :db-info (:join-class other-class :retrieval :deferred :set nil :foreign-key example-id :home-key id))))
(clsql:def-view-class other-class () ((example-id :type integer :accessor example-id :initarg :example-id) (val :type string :accessor val :initarg :val)))
;; (clsql:create-view-from-class 'simple-db)
(defmethod update-from-view ((controller controller)) (with-accessors ((db-obj db-obj) (view-obj view-obj)) controller (inspect controller) ;; view should steer the database object usually (let ((other (some-objects db-obj))) (setf (tag db-obj) (read-client-value (tag view-obj)) (description db-obj) (read-client-value (description view-obj)) (val other) (read-client-value (other view-obj))) (clsql:update-records-from-instance db-obj)) (values)))
(defun populate-db () (let ((other (make-instance 'other-class :example-id 1 :val "some text"))) (clsql:update-records-from-instance other) (let ((mobj (make-instance 'example-app :id 1 :tag "some tag" :description "this is the description" :some-fk 1))) (setf (some-objects mobj) other) (clsql:update-records-from-instance mobj))))
;; (clsql:drop-view-from-class 'other-class) ;; (clsql:drop-view-from-class 'example-app)
;; ;; (clsql:create-view-from-class 'example-app) ;; (clsql:create-view-from-class 'other-class) ;; (populate-db)
(defcomponent example-view (simple-window-component) ((db-obj :initarg :db-obj :reader db-obj) (tag :accessor tag :initarg :tag :component (text-field :size 20 :maxlength 20)) (description :type string :accessor description :initarg :description :component (text-area-field :width 20 :height 10)) (other :accessor other :component (text-field :size 20 :maxlength 20))))
(defun setup-db () ;; open a connectoin to DB (clsql:enable-sql-reader-syntax))
;; (setup-db)
(defcomponent text (simple-window-component) ((view-text :initarg :view-text :reader view-text) (db-text :initarg :db-text :reader db-text)))
(defmethod render-on ((res response) (text text)) (inspect text) (<:p "view data: " (<:as-is (view-text text))) (<:p "database data: " (<:as-is (db-text text))))
(defmethod initialize-vfd ((view example-view) (controller controller)) (let ((db-obj (db-obj controller)))
(setf (some-objects db-obj) (car (clsql:select 'other-class :where [= [example-id] 1] :flatp t))) ;; (inspect db-obj) (clsql:update-records-from-instance db-obj) (setf (ucw::client-value (tag view)) (tag db-obj) (ucw::client-value (description view)) (description db-obj ) (ucw::client-value (other view )) (val (some-objects db-obj )) (view-obj controller) view) (inspect controller) (values)))
(defmethod render-on ((res response) (view example-view)) ;; this is not perfect but for the example it should be enough ;; (inspect view) (let ((controller (make-instance 'controller))) (setf (db-obj controller) (slot-value view 'db-obj)) (initialize-vfd view controller) (inspect controller) (<ucw:form :action (save-and-show-data view controller) (<:table (<:tr (<:td "tag") (<:td "Description") (<:td "Other text")) (<:tr (<:td (render-on res (tag view))) (<:td (render-on res (description view))) (<:td (render-on res (other view))))) (<:p (<:input :type "submit" :value "Accept")))))
(defaction save-and-show-data ((view example-view) (controller controller)) (call 'text :view-text (format nil "tag = ~a, descripton = ~a, other-text = ~a~%" (read-client-value (tag (view-obj controller))) (read-client-value (description (view-obj controller))) (read-client-value (other (view-obj controller)))) :db-text (format nil "tag = ~a, descripton = ~a, other-text = ~a~%" (tag (db-obj controller)) (description (db-obj controller)) (val (some-objects (db-obj controller))))))
(defun init-cells () (clsql:enable-sql-reader-syntax) (cells:cell-reset))
(defentry-point "index.ucw" (:application *example-app*) () (init-cells) (call 'example-view :db-obj (car (clsql:select 'example-app :where [= [id] 1] :flatp t :refresh t)))
my problem update-from-view is not called I was thinking that (db-obj :accessor db-obj :initarg :db-obj :cell t :initform (cells:c? (update-from-view cells:self)))))
is reponsible for it. But of course I'm set'fing the db-obj slot also, out come is that 1) the view is initialized from the db-view 2) that the db-view won't get changed.
I'm sure it could be done but I don't know how, could someone give me a hand please?
Regards Friedrich