Author: achiumenti Date: Wed Oct 1 07:59:39 2008 New Revision: 103
Added: trunk/main/claw-demo/src/frontend/users.lisp Log: several bugfixes and enhancements
Added: trunk/main/claw-demo/src/frontend/users.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-demo/src/frontend/users.lisp Wed Oct 1 07:59:39 2008 @@ -0,0 +1,369 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: src/frontend/users.lisp $ + +;;; Copyright (c) 2008, Andrea Chiumenti. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :claw-demo-frontend) + +(defgeneric users-page-find-users (users-page)) + +(defgeneric users-page-offset-reset (users-page)) + +(defgeneric users-page-edit-user (uses-page)) + +(defgeneric users-page-sorting (users-page)) + +(defgeneric users-page-delete-users (users-page)) + +(defclass users-page (db-page) + ((users :initform nil + :accessor users-page-users) + (current-user :initform (make-instance 'user) + :accessor users-page-current-user) + (user-edit-dialog-title :initform "Add new cutomer" + :accessor users-page-user-edit-dialog-title) + (users-total-count :initform 0 + :accessor users-page-users-total-count) + (list-size :initarg :list-size + :accessor users-page-list-size) + (offset :initform 0 + :accessor users-page-offset) + (surname :initform "*" + :accessor users-page-surname) + (firstname :initform "" + :accessor users-page-firstname) + (username :initform "" + :accessor users-page-username) + (email :initform "" + :accessor users-page-email) + (active :initform :any + :accessor users-page-active) + (roles :initform '("user" "guest") + :accessor users-page-roles) + (sorting-column :initform "surname" + :accessor users-page-sorting-column) + (sorting-order :initform "asc" + :accessor users-page-sorting-order) + (delete-all :initform nil + :accessor users-page-delete-all) + (delete-items :initform nil + :accessor users-page-delete-items)) + (:default-initargs :list-size 20)) + +(defmethod users-page-offset-reset ((page users-page)) 0) + +(defmethod users-page-edit-user ((page users-page)) + (let ((user-id (parse-integer (claw-parameter "userid"))) + (current-user)) + (setf current-user (find-by-id 'user user-id) + (users-page-user-edit-dialog-title page) "Edit user" + (users-page-users page) (list current-user)) + (when current-user + (setf (users-page-current-user page) current-user)))) + +(defmethod users-page-sorting ((page users-page)) + (let ((direction (if (string-equal "asc" (users-page-sorting-order page)) + :asc + :desc)) + (fields (cond + ((string-equal "surname" (users-page-sorting-column page)) (list (slot-column-name 'user "surname") + (slot-column-name 'user "firstname"))) + ((string-equal "username" (users-page-sorting-column page)) (list (slot-column-name 'user "username"))) + (t (list (slot-column-name 'user "email") + (slot-column-name 'user "surname") + (slot-column-name 'user "firstname")))))) + (loop for field in fields + collect (list field direction)))) + +(defmethod page-content ((page users-page)) + (let ((spinner-id (generate-id "spinner")) + (form-id (generate-id "usersForm")) + (users (users-page-users page)) + (offset-id (generate-id "offset")) + (result-container-id (generate-id "resultContainer")) + (edit-user-dialog-container-id (generate-id "userDialogContainer")) + (edit-user-dialog-id (generate-id "userDialog")) + (edit-user-form-id (generate-id "userForm")) + (sorting-column-id (generate-id "sorting-column")) + (sorting-order-id (generate-id "sorting-order")) + (active-any-id (generate-id "activeAny")) + (active-yes-id (generate-id "activeYes")) + (active-no-id (generate-id "activeNo")) + (edit-user-action-link-id (generate-id "editUser")) + (sort-field (users-page-sorting-column page)) + (sort-direction (users-page-sorting-order page)) + (all-roles (find-vo 'role :order-by (list (slot-column-name 'role "name"))))) + (site-template> :title "CLAW Demo anagraphics" + (djfloating-content> :static-id spinner-id + (img> :alt "spinner" + :src "docroot/img/spinner.gif")) + (djform> :static-id form-id + :class "users" + :action 'users-page-find-users + :update-id result-container-id + :on-before-submit (ps:ps* `(.show (dijit.by-id ,spinner-id))) + :on-xhr-finish (ps:ps* `(.hide (dijit.by-id ,spinner-id))) + (div> (div> :class "searchParameters hlist" + (div> :class "item" (span> :class "surname" "Name") + (djtext-box> :label "name" :id "surname" :accessor 'users-page-surname) + (djtext-box> :label "name" :id "firstname" :accessor 'users-page-firstname)) + (div> :class "item" (span> :class "username" "Username") + (djtext-box> :label "username" :id "username" :accessor 'users-page-username)) + (div> :class "item" (span> :class "email" "Email") + (djtext-box> :label "email" :id "email" :accessor 'users-page-email)) + (div> :class "item active" (span> :class "active" "Active") + (div> :class "boundBox" + (div> (djradio-button> :static-id active-any-id + :name "active" + :class "active" + :translator *threestate-translator* + :accessor 'users-page-active + :value :any) + (label> :for active-any-id "Any")) + (div> (djradio-button> :static-id active-yes-id + :name "active" + :class "active" + :translator *threestate-translator* + :accessor 'users-page-active + :value t) + (label> :for active-yes-id "Yes")) + (div> (djradio-button> :static-id active-no-id + :name "active" + :class "active" + :translator *threestate-translator* + :accessor 'users-page-active + :value nil) + (label> :for active-no-id "No")))) + (div> :class "item roles" (span> :class "roles" "Roles") + (div> :class "boundBox" + (loop for role in all-roles + collect (let ((chk-id (generate-id "selRole"))) + (div> (djcheck-box> :static-id chk-id + :name "selRole" + :class "selRole" + :accessor 'users-page-roles + :value (role-name role) + :multiple t) + (label> :for chk-id (role-name role)))))))) + (cinput> :type "hidden" + :static-id offset-id + :translator *integer-translator* + :reader 'users-page-offset-reset + :writer (attribute-value '(setf users-page-offset))) + (cinput> :type "hidden" + :static-id sorting-column-id + :accessor 'users-page-sorting-column) + (cinput> :type "hidden" + :static-id sorting-order-id + :accessor 'users-page-sorting-order) + (div> :class "hlistButtons" + (djsubmit-button> :id "search" + :value "Search") + (djconfirmation-submit> :id "delete" + :value "Delete" + :action 'users-page-delete-users + :confirmation-message "Are you sure to delete these items?"))) + + (div> :static-id result-container-id + (table> :class "listTable" + (tr> :class "header" + (th> :class "deleteAll" (djcheck-box> :id "deleteAll" + ;:reader 'users-page-delete-all + :value "all" + :onchange(remove #\newline (ps:ps (.for-each dojo (.map (.query dojo ".deleteItem") dijit.by-node) + (lambda (checkbox) (.attr checkbox "checked" (.attr this "checked"))) this))))) + (th> :class "name" (span> :class (if (string-equal "surname" sort-field) + (if (string-equal "asc" sort-direction) + "sort sortAsc" + "sort sortDesc") + "sort") + :on-click (remove #\newline (ps:ps* `(progn (setf (slot-value (dojo.by-id ,sorting-order-id) 'value) + (if (and (== (slot-value (dojo.by-id ,sorting-column-id) 'value) "surname") + (== (slot-value (dojo.by-id ,sorting-order-id) 'value) "asc")) + "desc" + "asc")) + (setf (slot-value (dojo.by-id ,sorting-column-id) 'value) + "surname") + (.submit (dijit.by-id ,form-id))))) + "Name")) + (th> :class "username" (span> :class (if (string-equal "username" sort-field) + (if (string-equal "asc" sort-direction) + "sort sortAsc" + "sort sortDesc") + "sort") + :on-click (remove #\newline (ps:ps* `(progn (setf (slot-value (dojo.by-id ,sorting-order-id) 'value) + (if (and (== (slot-value (dojo.by-id ,sorting-column-id) 'value) "username") + (== (slot-value (dojo.by-id ,sorting-order-id) 'value) "asc")) + "desc" + "asc")) + (setf (slot-value (dojo.by-id ,sorting-column-id) 'value) + "username") + (.submit (dijit.by-id ,form-id))))) + "Username")) + (th> :class "email" (span> :class (if (string-equal "email" sort-field) + (if (string-equal "asc" sort-direction) + "sort sortAsc" + "sort sortDesc") + "sort") + :on-click (remove #\newline (ps:ps* `(progn (setf (slot-value (dojo.by-id ,sorting-order-id) 'value) + (if (and (== (slot-value (dojo.by-id ,sorting-column-id) 'value) "email") + (== (slot-value (dojo.by-id ,sorting-order-id) 'value) "asc")) + "desc" + "asc")) + (setf (slot-value (dojo.by-id ,sorting-column-id) 'value) + "email") + (.submit (dijit.by-id ,form-id))))) + "Email")) + (th> :class "enabled" "Enabled") + (th> :class "roles" "Roles")) + (loop for user in users + for index = 0 then (incf index) + collect (tr> :class (if (evenp index) "item even" "item odd") + (th> :class "delete" (djcheck-box> :id "deleteItem" :class "deleteItem" :accessor 'users-page-delete-items + :value (table-id user) + :translator *integer-translator* + :multiple t)) + (td> (a> :id "edit" + :href "#" + :on-click (remove #\newline (ps:ps* `(progn (setf (slot-value (dijit.by-id ,edit-user-action-link-id) 'parameters) + (create "userid" ,(table-id user))) + (.click (dijit.by-id ,edit-user-action-link-id))))) + (user-surname user) + " " + (user-firstname user))) + (td> (user-username user)) + (td> (user-email user)) + (td> :class (if (user-active user) + "active" + "inactive") + (if (user-active user) + "yes" + "no")) + (td> (format nil "~{~a~^, ~}" (loop for role in (user-roles user) + collect (role-name (first role)))))))) + (unless users + (djcheck-box> :id "deleteItem" + :accessor 'users-page-delete-items + :value 0 + :multiple t + :translator *integer-translator* + :style "display: none;")) + (djaction-link> :static-id edit-user-action-link-id + :style "display:none" + :action 'users-page-edit-user + :update-id (attribute-value (list edit-user-dialog-container-id result-container-id)) + :on-before-submit (ps:ps* `(.show (dijit.by-id ,spinner-id))) + :on-xhr-finish (remove #\newline (ps:ps* `(progn (.hide (dijit.by-id ,spinner-id)) + (.show (dijit.by-id ,edit-user-dialog-id))))) + "invisible") + (pager> :id "pager" + :update-component-id offset-id + :page-size (users-page-list-size page) + :total-items (users-page-users-total-count page) + :first-item-offset (users-page-offset page)))) + (div> :static-id edit-user-dialog-container-id + (djdialog> :static-id edit-user-dialog-id + :class "userDialog" + :title (users-page-user-edit-dialog-title page) + #| + (edit-user> :static-id edit-user-form-id + :on-close-click (ps:ps* `(.hide (dijit.by-id ,edit-user-dialog-id))) + :update-id (attribute-value (list edit-user-form-id result-container-id)) + :user (users-page-current-user page) + :on-before-submit (remove #\newline (ps:ps* `(progn (.show (dijit.by-id ,spinner-id)) + (dojo.add-class + (slot-value (dijit.by-id ,edit-user-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-user-dialog-id) 'container-node) + "hideForm")))) + |# + (exception-monitor> :id "exceptionMonitor" :json-render-on-validation-errors-p edit-user-form-id)))))) + +(defmethod users-page-delete-users ((page users-page)) + (let ((user-id-list (users-page-delete-items page)) + (surname (users-page-surname page)) + (firstname (users-page-firstname page)) + (username (user-username page)) + (email (users-page-email page)) + (active (users-page-active page)) + (roles (users-page-roles page))) + (log-message :info "...deleting") + (delete-by-id 'user user-id-list) + (setf (users-page-delete-items page) ()) + (multiple-value-bind (users total-size) + (find-users :offset (users-page-offset page) + :limit (users-page-list-size page) + :surname (null-when-empty surname) + :firstname (null-when-empty firstname) + :username username + :email (null-when-empty email) + :active active + :role-names (null-when-empty roles) + :sorting (users-page-sorting page)) + (setf (users-page-users page) users + (users-page-users-total-count page) total-size)))) + +(defmethod users-page-find-users ((page users-page)) + (let ((surname (users-page-surname page)) + (firstname (users-page-firstname page)) + (username (users-page-username page)) + (email (users-page-email page)) + (active (users-page-active page)) + (roles (users-page-roles page))) +(log-message :info "èèèè ~a" roles) + (multiple-value-bind (users total-size) + (find-users :offset (users-page-offset page) + :limit (users-page-list-size page) + :surname (null-when-empty surname) + :firstname (null-when-empty firstname) + :username (null-when-empty username) + :email (null-when-empty email) + :active active + :role-names roles + :sorting (users-page-sorting page)) + (log-message :info "xxxx : ~a" users) + (setf (users-page-users page) users + (users-page-users-total-count page) total-size)))) + +(defmethod page-before-render ((page users-page)) + (unless (page-req-parameter page *rewind-parameter*) + (multiple-value-bind (users total-size) + (find-users :sorting (users-page-sorting page) + :offset 0 + :limit (users-page-list-size page)) + (setf (users-page-users page) users + (users-page-users-total-count page) total-size)))) + + +(lisplet-register-function-location *dojo-demo-lisplet* + (make-page-renderer 'users-page #'claw-post-parameters #'claw-get-parameters) + "users.html") + +(lisplet-protect *dojo-demo-lisplet* "users.html" '("administrator" "user")) +