Author: achiumenti Date: Sun Mar 30 23:48:36 2008 New Revision: 24
Modified: trunk/main/claw-core/src/validators.lisp Log: beginning of local-time integration
Modified: trunk/main/claw-core/src/validators.lisp ============================================================================== --- trunk/main/claw-core/src/validators.lisp (original) +++ trunk/main/claw-core/src/validators.lisp Sun Mar 30 23:48:36 2008 @@ -30,10 +30,10 @@ (in-package :claw)
(defgeneric translator-encode (translator wcomponent) - (:documentation "Encodes the input component value, used when rendering the component")) + (:documentation "Encodes the input component value, used when rendering the component (Encodes from type to string)."))
(defgeneric translator-decode (translator wcomponent) - (:documentation "Decodes the input component value after a form submit.")) + (:documentation "Decodes the input component value after a form submit (Decodes from string to type)."))
(defclass translator () () @@ -63,6 +63,11 @@ "*SIMPLE-TRANSLATOR* is the default translator for any CINPUT component. Its encoder and decoder methods pass values unchanged")
+ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;; Integer translator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defclass translator-integer (translator) ((thousand-separator :initarg :thousand-separator :reader translator-thousand-separator @@ -115,7 +120,9 @@ (parse-integer (regex-replace-all (format nil "~a" thousand-separator) new-value "")) (parse-integer new-value)))))
-;;========================================= +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;Folating point number translator ;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass translator-number (translator-integer) ((decimals-separator :initarg :decimals-separator @@ -197,7 +204,83 @@ (coerce result type))))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;; Dates translator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(defclass translator-date (translator) + ((date-format :initarg :date-format + :reader translator-date-fromat + :documentation "Sets the format of a date using a list where element are joined together and :DATE :MONTH and :YEAR are +expanded into day of the month for :DATE, month number for :MONTH and the year for :YEAR. The Default is the list '(:month "/" :date "/" :year)")) + (:default-initargs :date-format '(:month "/" :date "/" :year)) + (:documentation "A translator object encodes and decodes local-date object value passed to a html input component")) + + +#| +(defmethod translator-encode ((translator translator-number) (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)) + (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 "~~~d,' ,v:~aD" grouping-size signum-directive) + (format nil "~~~ad" signum-directive))) + + (value (page-req-parameter page (htcomponent-client-id wcomponent) nil))) + (if (component-validation-errors wcomponent) + value + (progn + (when (null visit-object) + (setf visit-object (htcomponent-page wcomponent))) + (multiple-value-bind (int-value dec-value) + (floor (cond + ((and (null reader) accessor) (funcall (fdefinition accessor) visit-object)) + (t (funcall (fdefinition reader) visit-object)))) + (progn + (setf dec-value (coerce dec-value 'float)) + (format nil "~a~a" (if thousand-separator + (string-trim " " (format nil integer-control-string thousand-separator int-value)) + (format nil integer-control-string int-value)) + (cond + ((and (= 0.0 (coerce dec-value 'double-float)) decimal-digits) + (format nil "~a~a" decimals-separator (make-string decimal-digits :initial-element #\0))) + (decimal-digits + (let ((frac-part (subseq (format nil "~f" dec-value) 2))) + (if (> (length frac-part) decimal-digits) + (setf frac-part (subseq frac-part 0 decimal-digits)) + (setf frac-part (concatenate 'string frac-part (make-string (- decimal-digits (length frac-part)) :initial-element #\0)))) + (format nil "~a~a" decimals-separator frac-part))) + (t (format nil "~a~a" decimals-separator (subseq (format nil "~f" dec-value) 2))))))))))) +
+(defmethod translator-decode ((translator translator-number) (wcomponent wcomponent)) + (let* ((thousand-separator (translator-thousand-separator translator)) + (type (translator-coerce translator)) + (int-value) + (dec-value)) + (multiple-value-bind (client-id new-value) + (component-id-and-value wcomponent) + (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)) + (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"