[claw-cvs] r94 - trunk/main/claw-demo/src/frontend
achiumenti at common-lisp.net
achiumenti at common-lisp.net
Thu Sep 18 13:32:13 UTC 2008
Author: achiumenti
Date: Thu Sep 18 09:32:12 2008
New Revision: 94
Modified:
trunk/main/claw-demo/src/frontend/auth.lisp
trunk/main/claw-demo/src/frontend/commons.lisp
trunk/main/claw-demo/src/frontend/customers.lisp
Log:
several bugfixes and enhancements
Modified: trunk/main/claw-demo/src/frontend/auth.lisp
==============================================================================
--- trunk/main/claw-demo/src/frontend/auth.lisp (original)
+++ trunk/main/claw-demo/src/frontend/auth.lisp Thu Sep 18 09:32:12 2008
@@ -40,22 +40,21 @@
()
(:documentation "Authorization configuration for application
atuhentication and authorization management."))
-
+0
(defmethod configuration-login ((configuration configuration))
- (multiple-value-bind (user password)
- (if (eq (lisplet-authentication-type *claw-current-lisplet*) :basic)
- (claw-authorization)
- (values (claw-parameter "username")
- (claw-parameter "password")))
- (unwind-protect
- (progn
- (db-connect)
- (let ((user-vo (find-user-by-name user)))
- (when (and user-vo (string= password (user-password user-vo)))
- (make-instance 'demo-principal
- :name (user-username user-vo)
- :firstname (user-firstname user-vo)
- :surname (user-surname user-vo)
- :roles (loop for role-vo in (user-roles user-vo)
- collect (role-name (first role-vo)))))))
- (db-disconnect))))
\ No newline at end of file
+ (let ((claw-demo-backend:*claw-demo-db* (db-connect)))
+ (multiple-value-bind (user password)
+ (if (eq (lisplet-authentication-type *claw-current-lisplet*) :basic)
+ (claw-authorization)
+ (values (claw-parameter "username")
+ (claw-parameter "password")))
+ (unwind-protect
+ (let ((user-vo (find-user-by-name user)))
+ (when (and user-vo (string= password (user-password user-vo)))
+ (make-instance 'demo-principal
+ :name (user-username user-vo)
+ :firstname (user-firstname user-vo)
+ :surname (user-surname user-vo)
+ :roles (loop for role-vo in (user-roles user-vo)
+ collect (role-name (first role-vo))))))
+ (db-disconnect)))))
\ No newline at end of file
Modified: trunk/main/claw-demo/src/frontend/commons.lisp
==============================================================================
--- trunk/main/claw-demo/src/frontend/commons.lisp (original)
+++ trunk/main/claw-demo/src/frontend/commons.lisp Thu Sep 18 09:32:12 2008
@@ -97,11 +97,13 @@
())
(defmethod page-render :around ((db-page db-page))
- (let ((result))
- (unwind-protect (progn
- (db-connect)
- (setf result (call-next-method)))
- (db-disconnect))
+ (let ((result)
+ (claw-demo-backend:*claw-demo-db* (db-connect))
+ (clsql-sys:*default-caching* nil))
+ (unwind-protect
+ (setf result (call-next-method))
+ (when *claw-demo-db*
+ (db-disconnect)))
result))
@@ -220,4 +222,40 @@
(defun null-when-empty (string)
(unless (string= string "")
- string))
\ No newline at end of file
+ string))
+
+(defclass djconfirmation-submit (wcomponent)
+ ((value :initarg :value
+ :accessor djconfirmation-submit-value)
+ (action :initarg :action
+ :accessor djconfirmation-submit-action)
+ (confirmation-message :initarg :confirmation-message
+ :accessor djconfirmation-submit-confirmation-message)
+ (yes-label :initarg :yes
+ :accessor djconfirmation-submit-yes)
+ (no-label :initarg :no
+ :accessor djconfirmation-submit-no))
+ (:default-initargs :yes "Yes" :no "No")
+ (:metaclass metacomponent))
+
+(defmethod wcomponent-template ((obj djconfirmation-submit))
+ (let* ((dialog-id (generate-id "confirmationDiaolg"))
+ (yes-id (generate-id "yes"))
+ (value (djconfirmation-submit-value obj)))
+ (div> :class "dijit dijitReset dijitLeft dijitInline"
+ (djbutton> :static-id (htcomponent-client-id obj)
+ :on-click (ps:ps* `(.show (dijit.by-id ,dialog-id)))
+ (wcomponent-informal-parameters obj)
+ (or (htcomponent-body obj) value))
+ (djdialog> :static-id dialog-id
+ :title "Confirm"
+ (div> (djconfirmation-submit-confirmation-message obj)
+ (div> :class "buttonContainer"
+ (djsubmit-button> :static-id yes-id
+ :value (djconfirmation-submit-value obj)
+ :action (djconfirmation-submit-action obj)
+ :on-click (ps:ps* `(.hide (dijit.by-id ,dialog-id)))
+ (djconfirmation-submit-yes obj))
+ (djbutton> :id dialog-id
+ :on-click (ps:ps* `(.hide (dijit.by-id ,dialog-id)))
+ (djconfirmation-submit-no obj))))))))
\ No newline at end of file
Modified: trunk/main/claw-demo/src/frontend/customers.lisp
==============================================================================
--- trunk/main/claw-demo/src/frontend/customers.lisp (original)
+++ trunk/main/claw-demo/src/frontend/customers.lisp Thu Sep 18 09:32:12 2008
@@ -34,14 +34,18 @@
(defclass edit-customer (djform)
((customer :initarg :customer
:accessor edit-customer-customer)
+#|
(on-before-submit :initarg :on-before-submit
:accessor on-before-submit)
(on-xhr-finish :initarg :on-xhr-finish
:accessor on-xhr-finish)
+|#
(customer-id-parameter :initarg :customer-id-parameter
- :accessor edit-customer-customer-id-parameter))
+ :accessor edit-customer-customer-id-parameter)
+ (on-close-click :initarg :on-close-click
+ :accessor edit-customer-on-close-click))
(:metaclass metacomponent)
- (:default-initargs :on-before-submit nil :on-xhr-finish nil
+ (:default-initargs :on-close-click nil
:class "customerForm" :customer-id-parameter "customerid"))
(defmethod initialize-instance :after ((obj edit-customer) &key rest)
@@ -49,8 +53,33 @@
(setf (action-object obj) obj
(action obj) 'edit-customer-save))
+(defun find-or-add-address (customer address-type)
+ (let ((address (loop for item in (customer-addresses customer)
+ when (= (customer-address-type item) address-type)
+ return item)))
+ (unless address
+ (setf address (make-instance 'customer-address :address-type address-type))
+ (push address (customer-addresses customer)))
+ address))
+
+(defun address-nullp (address)
+ (let ((attributes (list (customer-address-address address)
+ (customer-address-zip address)
+ (customer-address-city address)
+ (customer-address-state address)
+ (customer-address-country address))))
+ (not
+ (loop for val in (mapcar #'(lambda (x)
+ (when (and x (string-not-equal x ""))
+ t))
+ attributes)
+ when val
+ return t))))
+
(defmethod htcomponent-body ((obj edit-customer))
- (let ((visit-object (edit-customer-customer obj)))
+ (let* ((visit-object (edit-customer-customer obj))
+ (main-address (find-or-add-address visit-object 0))
+ (billing-address (find-or-add-address visit-object 1)))
(list
(cinput> :id (edit-customer-customer-id-parameter obj)
:type "hidden" :visit-object visit-object
@@ -122,8 +151,75 @@
(djvalidation-text-box> :visit-object visit-object
:label "Code 4"
:accessor 'customer-code4))
+ (djtab-container> :id "addressTabs"
+ :class "addressTabs"
+ (djcontent-pane> :id "mainAddress" :title "Main address"
+ (div> (div> :class "address"
+ (span> :class "label" "Street")
+ (djvalidation-text-box> :visit-object main-address
+ :label "Main Address[address]"
+ :accessor 'customer-address-address))
+ (div> :class "zip"
+ (span> :class "label" "Zip")
+ (djvalidation-text-box> :visit-object main-address
+ :class "text"
+ :label "Main Address[zip]"
+ :accessor 'customer-address-zip))
+ (div> :class "city"
+ (span> :class "label" "City")
+ (djvalidation-text-box> :visit-object main-address
+ :class "text"
+ :label "Main Address[city]"
+ :accessor 'customer-address-city))
+ (div> :class "state"
+ (span> :class "label" "State")
+ (djvalidation-text-box> :visit-object main-address
+ :class "text"
+ :label "Main Address[state]"
+ :accessor 'customer-address-state))
+ (div> :class "country"
+ (span> :class "label" "Country")
+ (djvalidation-text-box> :visit-object main-address
+ :class "text"
+ :label "Main Address[country]"
+ :accessor 'customer-address-country))))
+ (djcontent-pane> :id "billingAddress" :title "Billing address"
+ (div> (div> :class "address"
+ (span> :class "label" "Street")
+ (djvalidation-text-box> :visit-object billing-address
+ :class "text"
+ :label "Billing Address[street]"
+ :accessor 'customer-address-address))
+ (div> :class "zip"
+ (span> :class "label" "Zip")
+ (djvalidation-text-box> :visit-object billing-address
+ :class "text"
+ :label "Billing Address[zip]"
+ :accessor 'customer-address-zip))
+ (div> :class "city"
+ (span> :class "label" "City")
+ (djvalidation-text-box> :visit-object billing-address
+ :class "text"
+ :label "Billing Address[city]"
+ :accessor 'customer-address-city))
+ (div> :class "state"
+ (span> :class "label" "State")
+ (djvalidation-text-box> :visit-object billing-address
+ :class "text"
+ :label "Billing Address[state]"
+ :accessor 'customer-address-state))
+ (div> :class "country"
+ (span> :class "label" "Country")
+ (djvalidation-text-box> :visit-object billing-address
+ :class "text"
+ :label "Billing Address[country]"
+ :accessor 'customer-address-country)))))
(div> :class "buttons"
- (djsubmit-button> :value "Save")))))
+ (djsubmit-button> :value "Save")
+ (djbutton> :render-condition #'(lambda () (edit-customer-on-close-click obj))
+ :id "Close"
+ :on-click (edit-customer-on-close-click obj)
+ "Close")))))
(defmethod wcomponent-before-rewind :before ((obj edit-customer) (page page))
@@ -131,14 +227,24 @@
(let ((customer-id (parse-integer (claw-parameter (edit-customer-customer-id-parameter obj)))))
(setf (edit-customer-customer obj)
(find-by-id 'customer
- customer-id)))))
+ customer-id))
+ (find-or-add-address (edit-customer-customer obj) 0)
+ (find-or-add-address (edit-customer-customer obj) 1))))
(defmethod edit-customer-save ((obj edit-customer))
(let ((id (htcomponent-client-id obj))
- (customer (edit-customer-customer obj)))
+ (customer (edit-customer-customer obj))
+ (main-address (find-or-add-address (edit-customer-customer obj) 0))
+ (billing-address (find-or-add-address (edit-customer-customer obj) 1))
+ (address-list ()))
(handler-case
(progn
(log-message :info "PHONE: ~a" (customer-phone1 customer))
+ (unless (address-nullp main-address)
+ (push main-address address-list))
+ (unless (address-nullp billing-address)
+ (push billing-address address-list))
+ (setf (customer-addresses customer) address-list)
(update-db-item customer))
(clsql-sys:sql-database-error (cond)
(log-message :info "Exception on edit-customer-save: ~a" cond)
@@ -153,6 +259,8 @@
(defgeneric customers-page-sorting (customers-page))
+(defgeneric customers-page-delete-customers (customers-page))
+
(defclass customers-page (db-page)
((customers :initform nil
:accessor customers-page-customers)
@@ -179,7 +287,11 @@
(sorting-column :initform "name1"
:accessor customers-page-sorting-column)
(sorting-order :initform "asc"
- :accessor customers-page-sorting-order))
+ :accessor customers-page-sorting-order)
+ (delete-all :initform nil
+ :accessor customers-page-delete-all)
+ (delete-items :initform nil
+ :accessor customers-page-delete-items))
(:default-initargs :list-size 20))
(defmethod wcomponent-after-rewind :after ((obj edit-customer) (page customers-page))
@@ -255,10 +367,16 @@
:static-id sorting-order-id
:accessor 'customers-page-sorting-order)
(djsubmit-button> :id "search"
- :value "Search"))
+ :value "Search")
+ (djconfirmation-submit> :id "delete"
+ :value "Delete"
+ :action 'customers-page-delete-customers
+ :confirmation-message "Are you sure to delete these items?"))
+
(div> :static-id result-container-id
(table> :class "listTable"
(tr> :class "header"
+ (th> :class "delete" (djcheck-box> :id "deleteAll" :accessor 'customers-page-delete-all :value "all"))
(th> :class "name" (span> :class (if (string-equal "name1" sort-field)
(if (string-equal "asc" sort-direction)
"sort sortAsc"
@@ -292,6 +410,10 @@
(loop for customer in customers
for index = 0 then (incf index)
collect (tr> :class (if (evenp index) "item even" "item odd")
+ (th> :class "delete" (djcheck-box> :id "deleteItem" :accessor 'customers-page-delete-items
+ :value (table-id customer)
+ :translator *integer-translator*
+ :multiple t))
(td> (a> :id "edit"
:href "#"
:on-click (remove #\newline (ps:ps* `(progn (setf (slot-value (dijit.by-id ,edit-customer-action-link-id) 'parameters)
@@ -303,6 +425,13 @@
(td> (customer-email customer))
(td> (customer-vat customer))
(td> (customer-phone1 customer)))))
+ (unless customers
+ (djcheck-box> :id "deleteItem"
+ :accessor 'customers-page-delete-items
+ :value 0
+ :multiple t
+ :translator *integer-translator*
+ :style "display: none;"))
(djaction-link> :static-id edit-customer-action-link-id
:style "display:none"
:action 'customers-page-edit-customer
@@ -318,14 +447,44 @@
:first-item-offset (customers-page-offset page))))
(div> :static-id edit-customer-dialog-container-id
(djdialog> :static-id edit-customer-dialog-id
- :title (customers-page-customer-edit-dialog-title page)
+ :class "customerDialog"
+ :title (customers-page-customer-edit-dialog-title page)
(edit-customer> :static-id edit-customer-form-id
+ :on-close-click (ps:ps* `(.hide (dijit.by-id ,edit-customer-dialog-id)))
:update-id (attribute-value (list edit-customer-form-id result-container-id))
:customer (customers-page-current-customer page)
- :on-before-submit (ps:ps* `(.show (dijit.by-id ,spinner-id)))
- :on-xhr-finish (ps:ps* `(.hide (dijit.by-id ,spinner-id))))
+ :on-before-submit (remove #\newline (ps:ps* `(progn (.show (dijit.by-id ,spinner-id))
+ (dojo.add-class
+ (slot-value (dijit.by-id ,edit-customer-dialog-id) 'container-node)
+ "hideForm"))))
+ :on-xhr-finish (ps:ps* `(progn (.hide (dijit.by-id ,spinner-id))
+ (dojo.remove-class
+ (slot-value (dijit.by-id ,edit-customer-dialog-id) 'container-node)
+ "hideForm"))))
(exception-monitor> :id "exceptionMonitor" :json-render-on-validation-errors-p edit-customer-form-id))))))
+(defmethod customers-page-delete-customers ((page customers-page))
+ (let ((customer-id-list (customers-page-delete-items page))
+ (name1 (customers-page-name1 page))
+ (name2 (customers-page-name2 page))
+ (email (customers-page-email page))
+ (vat (customers-page-vat page))
+ (phone (customers-page-phone page)))
+ (log-message :info "...deleting")
+ (delete-by-id 'customer customer-id-list)
+ (setf (customers-page-delete-items page) ())
+ (multiple-value-bind (customers total-size)
+ (find-customers :offset (customers-page-offset page)
+ :limit (customers-page-list-size page)
+ :name1 (null-when-empty name1)
+ :name2 (null-when-empty name2)
+ :email (null-when-empty email)
+ :vat (null-when-empty vat)
+ :phone (null-when-empty phone)
+ :sorting (customers-page-sorting page))
+ (setf (customers-page-customers page) customers
+ (customers-page-customers-total-count page) total-size))))
+
(defmethod customers-page-find-customers ((page customers-page))
(let ((name1 (customers-page-name1 page))
(name2 (customers-page-name2 page))
More information about the Claw-cvs
mailing list