Author: achiumenti Date: Sat Mar 29 01:54:18 2008 New Revision: 23 Modified: trunk/main/claw-core/src/misc.lisp trunk/main/claw-core/src/packages.lisp trunk/main/claw-core/src/tags.lisp trunk/main/claw-core/src/validators.lisp trunk/main/claw-core/tests/test1.lisp Log: finishing commenting validators forms corrected some validators quirks added content type property to page compoenent Modified: trunk/main/claw-core/src/misc.lisp ============================================================================== --- trunk/main/claw-core/src/misc.lisp (original) +++ trunk/main/claw-core/src/misc.lisp Sat Mar 29 01:54:18 2008 @@ -177,7 +177,9 @@ (if ,result ,result ,default-val))))) - + +(defun do-message (key &optional (default "") locale) + (funcall (with-message key default locale))) (defun user-locale (&optional (request *request*) (session *session*)) (let ((locale (when session Modified: trunk/main/claw-core/src/packages.lisp ============================================================================== --- trunk/main/claw-core/src/packages.lisp (original) +++ trunk/main/claw-core/src/packages.lisp Sat Mar 29 01:54:18 2008 @@ -75,6 +75,7 @@ :page-xmloutput :page-doc-type :page-current-component + :page-content-type :htclass-body :htcomponent :htcomponent-page @@ -282,6 +283,7 @@ :simple-message-dispatcher :simple-message-dispatcher-add-message :with-message + :do-message ;;validation :translator :translator-integer Modified: trunk/main/claw-core/src/tags.lisp ============================================================================== --- trunk/main/claw-core/src/tags.lisp (original) +++ trunk/main/claw-core/src/tags.lisp Sat Mar 29 01:54:18 2008 @@ -363,7 +363,7 @@ :accessor page-xmloutput :documentation "Determine if the page must be rendered as an XML") (current-form :initform :nil :accessor page-current-form :documentation "During the rewinding phase the form or the action-link whose action has been fired") - (content-type :initarg :doc-type + (doc-type :initarg :doc-type :accessor page-doc-type :documentation "The DOCUMENT TYPE of the page (default to HTML 4.01 STRICT)") (lasttag :initform nil :accessor page-lasttag :documentation "Last rendered tag. Needed for page output rendering") @@ -372,7 +372,10 @@ (request-parameters :initarg :request-parameters) (components-stack :initform nil :accessor page-components-stack - :documentation "A stack of components enetered into rendering process.") + :documentation "A stack of components enetered into rendering process.") + (content-type :initarg :content-type + :accessor page-content-type + :documentation "Define the content type of the page when rendered") (url :initarg :url :accessor page-url :documentation "The URL provided with this page instance")) (:default-initargs :writer t @@ -386,6 +389,7 @@ :xmloutput nil :doc-type *html-4.01-strict* :request-parameters nil + :content-type hunchentoot:*default-content-type* :url nil) (:documentation "A page object holds claw components to be rendered") ) @@ -585,6 +589,7 @@ (defmethod page-render ((page page)) (let ((body (page-content page)) (jsonp (page-json-id-list page))) + (setf (hunchentoot:content-type) (page-content-type page)) (if (null body) (format nil "null body for page ~a~%" (type-of page)) (progn @@ -802,8 +807,6 @@ (htcomponent-json-print-start-component tag)) (when (or (page-can-print page) previous-print-status) (tag-render-starttag tag page)) - (when (string-equal "messaged" (htcomponent-client-id tag)) - (log-message :info "RENDEING ~a: body ~a" (htcomponent-client-id tag) body-list)) (dolist (child-tag body-list) (when child-tag (cond @@ -822,6 +825,7 @@ (let ((body-list (htcomponent-body hthead)) (injections (page-init-injections page))) (tag-render-starttag hthead page) + (htcomponent-render (meta> :http-equiv "Content-Type" :content (page-content-type page)) page) (dolist (child-tag body-list) (when child-tag (cond Modified: trunk/main/claw-core/src/validators.lisp ============================================================================== --- trunk/main/claw-core/src/validators.lisp (original) +++ trunk/main/claw-core/src/validators.lisp Sat Mar 29 01:54:18 2008 @@ -33,7 +33,7 @@ (:documentation "Encodes the input component value, used when rendering the component")) (defgeneric translator-decode (translator wcomponent) - (:documentation "Decodes the input component value")) + (:documentation "Decodes the input component value after a form submit.")) (defclass translator () () @@ -59,30 +59,38 @@ (declare (ignore client-id)) new-value)) -(defvar *simple-translator* (make-instance 'translator)) +(defvar *simple-translator* (make-instance 'translator) + "*SIMPLE-TRANSLATOR* is the default translator for any CINPUT component. +Its encoder and decoder methods pass values unchanged") (defclass translator-integer (translator) ((thousand-separator :initarg :thousand-separator - :reader translator-thousand-separator) + :reader translator-thousand-separator + :documentation "If specified (as character), it is the thousands separator. Despite of +its name, grouping is done following the TRANSLATOR-GROUPING-SIZE, so it's not a real 'tousands' separator") (always-show-signum :initarg :always-show-signum - :reader translator-always-show-signum) + :reader translator-always-show-signum + :documentation "When true the signum is used also for displaying positive numbers.") (grouping-size :initarg :grouping-size - :reader translator-grouping-size)) + :reader translator-grouping-size + :documentation "Used only if TRANSLATOR-THOUSAND-SEPARATOR is defined. Default to 3")) (:default-initargs :thousand-separator nil + :grouping-size 3 :always-show-signum nil) - (:documentation "a translator object encodes and decodes integer values passed to a html input component")) + (:documentation "A translator object encodes and decodes integer values passed to a html input component")) (defmethod translator-encode ((translator translator-integer) (wcomponent wcomponent)) (let* ((page (htcomponent-page wcomponent)) (visit-object (wcomponent-parameter-value wcomponent :visit-object)) (accessor (wcomponent-parameter-value wcomponent :accessor)) (reader (wcomponent-parameter-value wcomponent :reader)) + (grouping-size (translator-grouping-size translator)) (thousand-separator (translator-thousand-separator translator)) (signum-directive (if (translator-always-show-signum translator) "@" "")) (control-string (if thousand-separator - (format nil "~~3,' ,v:~aD" signum-directive) + (format nil "~~~d,' ,v:~aD" grouping-size signum-directive) (format nil "~~~ad" signum-directive))) (value (page-req-parameter page (htcomponent-client-id wcomponent) nil))) @@ -109,21 +117,19 @@ ;;========================================= -(defclass translator-number (translator) - ((thousand-separator :initarg :thousand-separator - :reader translator-thousand-separator) - (decimals-separator :initarg :decimals-separator - :reader translator-decimals-separator) +(defclass translator-number (translator-integer) + ((decimals-separator :initarg :decimals-separator + :reader translator-decimals-separator + :documentation "The decimal separator of the rendered number. Default to #\.") (decimal-digits :initarg :decimal-digits - :reader translator-decimal-digits) - (always-show-signum :initarg :always-show-signum - :reader translator-always-show-signum) + :reader translator-decimal-digits + :documentation "force the rendering of the value to a fixed number of decimal digits") (coerce :initarg :coerce - :accessor translator-coerce)) - (:default-initargs :thousand-separator nil :decimals-separator #\. + :accessor translator-coerce + :documentation "Coerces the decoded input value to the given value type")) + (:default-initargs :decimals-separator #\. ;:integer-digits nil - :decimal-digits nil - :always-show-signum nil + :decimal-digits nil :coerce 'ratio) (:documentation "a translator object encodes and decodes integer values passed to a html input component")) @@ -134,13 +140,14 @@ (accessor (wcomponent-parameter-value wcomponent :accessor)) (reader (wcomponent-parameter-value wcomponent :reader)) (thousand-separator (translator-thousand-separator translator)) + (grouping-size (translator-grouping-size translator)) (decimal-digits (translator-decimal-digits translator)) (decimals-separator (translator-decimals-separator translator)) (signum-directive (if (translator-always-show-signum translator) "@" "")) (integer-control-string (if thousand-separator - (format nil "~~3,' ,v:~aD" signum-directive) + (format nil "~~~d,' ,v:~aD" grouping-size signum-directive) (format nil "~~~ad" signum-directive))) (value (page-req-parameter page (htcomponent-client-id wcomponent) nil))) @@ -180,15 +187,20 @@ (declare (ignore client-id)) (when thousand-separator (setf new-value (regex-replace-all (format nil "~a" thousand-separator) new-value ""))) - (let ((decomposed-string (all-matches-as-strings "[0-9]+" new-value))) - (setf int-value (parse-integer (concatenate 'string (first decomposed-string) (second decomposed-string)))) - (setf dec-value (expt 10 (length (second decomposed-string)))) - (coerce (/ int-value dec-value) type))))) + (let ((decomposed-string (all-matches-as-strings "[0-9]+" new-value)) + (result)) + (setf int-value (parse-integer (concatenate 'string (first decomposed-string) (second decomposed-string))) + dec-value (expt 10 (length (second decomposed-string))) + result (/ int-value dec-value)) + (if (integerp result) + result + (coerce result type)))))) ;;---------------------------------------------------------------------------------------- (defun add-exception (id reason) +"Adds an exception for the given input component identified by its ID with the message expressed by REASON" (let* ((validation-errors (aux-request-value :validation-errors)) (component-exceptions (assoc id validation-errors :test #'equal))) (if component-exceptions @@ -199,6 +211,7 @@ (defun validate (test &key component message) +"When test is nil, an exception message given by MESSAGE is added for the COMPONENT. See: ADD-EXCEPTION..." (let ((client-id (htcomponent-client-id component))) (unless test (add-exception client-id message)))) @@ -213,12 +226,19 @@ (assoc client-id (validation-errors request) :test #'equal))) (defun validator-required (component value) + "Checks if the required input field VALUE is present. If not, a localizable message \"Field ~a may not be null.\" is sent with key \"VALIDATOR-REQUIRED\". +The argument for the message will be the :label attribute of the COMPONENT." (when (stringp value) (validate (and value (string-not-equal value "")) :component component - :message (format nil "Field ~a may not be null." (wcomponent-parameter-value component :label))))) + :message (format nil (do-message "VALIDATOR-REQUIRED" "Field ~a may not be null.") (wcomponent-parameter-value component :label))))) (defun validator-size (component value &key min-size max-size) +"Checks if the input field VALUE legth is less then or greater then rispectively of the form keywords :MIN-SIZE and :MAX-SIZE. +If less then :MIN-SIZE, a localizable message \"Size of ~a may not be less then ~a chars.\" is sent with key \"VALIDATOR-SIZE-MIN\". +The argument for the message will be the :label attribute of the COMPONENT and the :MIN-ZIZE value. +If greater then :MAX-SIZE, a localizable message \"Size of ~a may not be more then ~a chars\" is sent with key \"VALIDATOR-SIZE-MAX\". +The argument for the message will be the :label attribute of the COMPONENT and the :MAX-ZIZE value." (let ((value-len 0)) (when value (setf value (format nil "~a" value)) @@ -227,22 +247,27 @@ (when min-size (validate (>= value-len min-size) :component component - :message (format nil "Size of ~a may not be less then ~a" + :message (format nil (do-message "VALIDATOR-SIZE-MIN" "Size of ~a may not be less then ~a chars." ) (wcomponent-parameter-value component :label) min-size))) (when max-size (validate (<= value-len max-size) :component component - :message (format nil "Size of ~a may not be more then ~a" + :message (format nil (do-message "VALIDATOR-SIZE-MAX" "Size of ~a may not be more then ~a chars." ) (wcomponent-parameter-value component :label) max-size))))))) (defun validator-range (component value &key min max) +"Checks if the numeric input field VALUE is less then or greater then rispectively of the form keywords :MIN and :MAX. +If less then :MIN, a localizable message \"Field ~a is not less then or equal to ~d.\" is sent with key \"VALIDATOR-RANGE-MIN\". +The argument for the message will be the :label attribute of the COMPONENT and the :MIN value. +If greater then :MIN, a localizable message \"Field ~a is not greater then or equal to ~d.\" is sent with key \"VALIDATOR-RANGE-MAX\". +The argument for the message will be the :label attribute of the COMPONENT and the :MAX value." (when value (or (when min (validate (>= value min) :component component - :message (format nil "Field ~a is not greater then or equal to ~d" + :message (format nil (do-message "VALIDATOR-RANGE-MIN" "Field ~a is not greater then or equal to ~d") (wcomponent-parameter-value component :label) (if (typep min 'ratio) (coerce min 'float) @@ -250,26 +275,32 @@ (when max (validate (<= value max) :component component - :message (format nil "Field ~a is not less then or equal to ~d" + :message (format nil (do-message "VALIDATOR-RANGE-MAX" "Field ~a is not less then or equal to ~d") (wcomponent-parameter-value component :label) (if (typep max 'ratio) (coerce max 'float) max))))))) (defun validator-number (component value &key min max) +"Checks if the input field VALUE is a valid number and then passes the validation to VALIDATION-RANGE. +If not a number, a localizable message \"Field ~a is not a valid number.\" is sent with key \"VALIDATOR-NUMBER\". +The argument for the message will be the :label attribute of the COMPONENT." (when value (let ((test (numberp value))) (or (validate test :component component - :message (format nil "Field ~a is not a valid number" (wcomponent-parameter-value component :label))) + :message (format nil (do-message "VALIDATOR-NUMBER" "Field ~a is not a valid number.") (wcomponent-parameter-value component :label))) (validator-range component value :min min :max max))))) (defun validator-integer (component value &key min max) +"Checks if the input field VALUE is a valid number and then passes the validation to VALIDATION-RANGE. +If not a number, a localizable message \"Field ~a is not a valid integer.\" is sent with key \"VALIDATOR-INTEGER\". +The argument for the message will be the :label attribute of the COMPONENT." (when value (let ((test (integerp value))) (or (validate test :component component - :message (format nil "Field ~a is not a valid integer" (wcomponent-parameter-value component :label))) + :message (format nil (do-message "VALIDATOR-INTEGER" "Field ~a is not a valid integer.") (wcomponent-parameter-value component :label))) (validator-range component value :min min :max max))))) Modified: trunk/main/claw-core/tests/test1.lisp ============================================================================== --- trunk/main/claw-core/tests/test1.lisp (original) +++ trunk/main/claw-core/tests/test1.lisp Sat Mar 29 01:54:18 2008 @@ -29,6 +29,8 @@ (in-package :claw-tests) +(setf *default-content-type* "text/html; charset=UTF-8") + (setf *rewrite-for-session-urls* nil) (defvar *this-file* (load-time-value (or #.*compile-file-pathname* *load-pathname*))) @@ -40,9 +42,13 @@ (simple-message-dispatcher-add-message *lisplet-messages* "en" "NAME" "Name") (simple-message-dispatcher-add-message *lisplet-messages* "en" "SURNAME" "Surname") +(simple-message-dispatcher-add-message *lisplet-messages* "en" "WELCOME" "Welcome") (simple-message-dispatcher-add-message *lisplet-messages* "it" "NAME" "Nome") (simple-message-dispatcher-add-message *lisplet-messages* "it" "SURNAME" "Cognome") +(simple-message-dispatcher-add-message *lisplet-messages* "it" "WELCOME" "Benvenuto") + +(simple-message-dispatcher-add-message *lisplet-messages* "it" "VALIDATOR-REQUIRED" "Il campo ~a non può essere vuoto!") (defvar *test-lisplet*) (setf *test-lisplet* (make-instance 'lisplet :realm "test1" :base-path "/test" @@ -56,8 +62,8 @@ (defparameter *clawserver* (make-instance 'clawserver :port 4242 :sslport 4445 :mod-lisp-p nil - :ssl-certificate-file #P"/home/kiuma/pem/cacert.pem" - :ssl-privatekey-file #P"/home/kiuma/pem/privkey.pem")) + :ssl-certificate-file #P"/home/kiuma/pem/cacert.pem" + :ssl-privatekey-file #P"/home/kiuma/pem/privkey.pem")) (setf (lisplet-redirect-protected-resources-p *test-lisplet*) t) @@ -256,7 +262,8 @@ ((username :initform "" :accessor login-page-username) (passowrd :initform "" - :accessor login-page-password))) + :accessor login-page-password)) + (:default-initargs :message-dispatcher *lisplet-messages*)) (defmethod page-content ((login-page login-page)) (let ((princp (current-principal))) @@ -280,7 +287,7 @@ (td> :colspan "2" (csubmit> :id "submit" :value "Login"))))) (p> - "Welcome " + (with-message "WELCOME" "WELCOME") " " (principal-name princp) (a> :href "index.html" "home"))))))