;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; $Header: components/edit-customer.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 edit-customer-save (edit-customer)) (defclass edit-customer (djform) ((customer :initarg :customer :accessor edit-customer-customer) (customer-id-parameter :initarg :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-close-click nil :class "customerForm" :customer-id-parameter "customerid")) (defmethod initialize-instance :after ((obj edit-customer) &key rest) (declare (ignore rest)) (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-global-initscripts :around ((obj edit-customer)) (let ((req-function (ps:ps (defun is-address-field-required (container-id) (defvar input-list (dojo.query "[widgetId]" (dojo.by-id container-id))) (defvar result false) (dojo.for-each (.map input-list (slot-value dijit 'by-node)) (lambda (input) (when (.get-value input) (setf result t)))) (return result)))) (address-field-validation (ps:ps (progn (defun address-field-validation-init (component-id address-container-class) (dojo.for-each (dojo.query (+ "." address-container-class) (dojo.by-id component-id)) (lambda (main-address-node) (dojo.for-each (.map (dojo.query "[widgetId]" main-address-node) dijit.by-node) (lambda (widget) (setf (slot-value widget 'is-valid) (lambda (is-focused) (address-field-validation widget (slot-value main-address-node 'id)) (return (.validator widget (slot-value (slot-value widget 'textbox) 'value) (slot-value widget 'constraints)))))))))) (defun address-field-validation (sender container-id) (if (is-address-field-required container-id) (unless (= (slot-value sender 'required) t) (defvar input-list (dojo.query "[widgetId]" (dojo.by-id container-id))) (dojo.for-each (.map input-list dijit.by-node) (lambda (input-widget) (setf (slot-value input-widget 'required) t)))) (unless (!= (slot-value sender 'required) t) (defvar input-list (dojo.query "[widgetId]" (dojo.by-id container-id))) (dojo.for-each (.map input-list dijit.by-node) (lambda (input-widget) (setf (slot-value input-widget 'required) false)))))))))) (append (list req-function address-field-validation) (call-next-method)))) (defmethod htcomponent-initscripts :around ((obj edit-customer)) (let* ((component-id (htcomponent-client-id obj)) (parent-script (call-next-method)) (script (ps:ps* `(progn (address-field-validation-init ,component-id "mainAddress") (address-field-validation-init ,component-id "billingAddress"))))) (if parent-script (format nil "~a~%~a" parent-script script) script))) (defmethod htcomponent-body ((obj edit-customer)) (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)) (main-address-id (generate-id "mainAddress")) (billing-address-id (generate-id "billingAddress")) (address-1-id (generate-id "address")) (zip-1-id (generate-id "zip")) (city-1-id (generate-id "city")) (state-1-id (generate-id "state")) (country-1-id (generate-id "country")) (address-2-id (generate-id "address")) (zip-2-id (generate-id "zip")) (city-2-id (generate-id "city")) (state-2-id (generate-id "state")) (country-2-id (generate-id "country"))) (list (cinput> :id (edit-customer-customer-id-parameter obj) :type "hidden" :visit-object visit-object :translator *integer-translator* :accessor 'table-id) (cinput> :id "tabbleVersion" :type "hidden" :visit-object visit-object :translator *integer-translator* :accessor 'table-version) (div> :class "label name1" (span> "Name 1") (djvalidation-text-box> :visit-object visit-object :required "true" :label "Name 1" :size 150 :accessor 'customer-name1)) (div> :class "label name2" (span> "Name 2") (djvalidation-text-box> :visit-object visit-object :label "Name 2" :size 80 :accessor 'customer-name2)) (div> :class "label email" (span> "Email") (djvalidation-text-box> :visit-object visit-object :label "Email" :size 200 :accessor 'customer-email)) (div> :class "label pone1" (span> "Phone 1") (djvalidation-text-box> :visit-object visit-object :label "Phone 1" :size 25 :accessor 'customer-phone1)) (div> :class "label pone2" (span> "Phone 2") (djvalidation-text-box> :visit-object visit-object :label "Phone 2" :size 25 :accessor 'customer-phone2)) (div> :class "label pone3" (span> "Phone 3") (djvalidation-text-box> :visit-object visit-object :label "Phone 3" :size 25 :accessor 'customer-phone3)) (div> :class "label fax" (span> "Fax") (djvalidation-text-box> :visit-object visit-object :label "Fax" :size 25 :accessor 'customer-fax)) (div> :class "label vat" (span> "VAT") (djvalidation-text-box> :visit-object visit-object :label "VAT" :size 50 :accessor 'customer-vat)) (div> :class "label code1" (span> "Code 1") (djvalidation-text-box> :visit-object visit-object :label "Code 1" :size 50 :accessor 'customer-code1)) (div> :class "label code2" (span> "Code 2") (djvalidation-text-box> :visit-object visit-object :label "Code 2" :size 50 :accessor 'customer-code2)) (div> :class "label code3" (span> "Code 3") (djvalidation-text-box> :visit-object visit-object :label "Code 3" :size 50 :accessor 'customer-code3)) (div> :class "label code4" (span> "Code 4") (djvalidation-text-box> :visit-object visit-object :label "Code 4" :size 50 :accessor 'customer-code4)) (djtab-container> :id "addressTabs" :class "addressTabs" (djcontent-pane> :static-id main-address-id :class "mainAddress" :title "Main address" (div> (div> :class "address" (span> :class "label" "Street") (djvalidation-text-box> :static-id address-1-id :trim "true" :visit-object main-address :class "text" :label "Main Address[address]" :size 200 :accessor 'customer-address-address)) (div> :class "zip" (span> :class "label" "Zip") (djvalidation-text-box> :static-id zip-1-id :trim "true" :visit-object main-address :class "text" :label "Main Address[zip]" :size 5 :accessor 'customer-address-zip)) (div> :class "city" (span> :class "label" "City") (djvalidation-text-box> :static-id city-1-id :trim "true" :visit-object main-address :class "text" :label "Main Address[city]" :size 120 :accessor 'customer-address-city)) (div> :class "state" (span> :class "label" "State") (djvalidation-text-box> :static-id state-1-id :trim "true" :visit-object main-address :class "text" :label "Main Address[state]" :size 120 :accessor 'customer-address-state)) (div> :class "country" (span> :class "label" "Country") (djvalidation-text-box> :static-id country-1-id :trim "true" :visit-object main-address :class "text" :label "Main Address[country]" :size 80 :accessor 'customer-address-country)))) (djcontent-pane> :static-id billing-address-id :class "billingAddress" :title "Billing address" (div> (div> :class "address" (span> :class "label" "Street") (djvalidation-text-box> :static-id address-2-id :trim "true" :visit-object billing-address :class "text" :label "Billing Address[street]" :size 200 :accessor 'customer-address-address)) (div> :class "zip" (span> :class "label" "Zip") (djvalidation-text-box> :static-id zip-2-id :trim "true" :visit-object billing-address :class "text" :label "Billing Address[zip]" :size 5 :accessor 'customer-address-zip)) (div> :class "city" (span> :class "label" "City") (djvalidation-text-box> :static-id city-2-id :trim "true" :visit-object billing-address :class "text" :label "Billing Address[city]" :size 120 :accessor 'customer-address-city)) (div> :class "state" (span> :class "label" "State") (djvalidation-text-box> :static-id state-2-id :trim "true" :visit-object billing-address :class "text" :label "Billing Address[state]" :size 120 :accessor 'customer-address-state)) (div> :class "country" (span> :class "label" "Country") (djvalidation-text-box> :static-id country-2-id :trim "true" :visit-object billing-address :class "text" :label "Billing Address[country]" :size 80 :accessor 'customer-address-country))))) (div> :class "buttons" (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)) (when (string-equal (htcomponent-client-id obj) (claw-parameter *rewind-parameter*)) (let ((customer-id (parse-integer (claw-parameter (edit-customer-customer-id-parameter obj))))) (if (> customer-id 0) (setf (edit-customer-customer obj) (find-by-id 'customer customer-id)) (setf (edit-customer-customer obj) (make-instance 'customer))) (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)) (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) (add-validation-error id (clsql-sys:sql-error-database-message cond)) nil))))