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))