Author: achiumenti Date: Sun Apr 27 12:15:22 2008 New Revision: 43 Modified: trunk/main/claw-core/src/lisplet.lisp 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/translators.lisp trunk/main/claw-core/src/validators.lisp trunk/main/claw-core/tests/test1.lisp Log: API cleanup Modified: trunk/main/claw-core/src/lisplet.lisp ============================================================================== --- trunk/main/claw-core/src/lisplet.lisp (original) +++ trunk/main/claw-core/src/lisplet.lisp Sun Apr 27 12:15:22 2008 @@ -86,7 +86,7 @@ (setf *http-error-handler* ;;overrides the default hunchentoot error handling #'(lambda (error-code) - (let* ((error-handlers (lisplet-error-hadlers (current-lisplet))) + (let* ((error-handlers (lisplet-error-handlers (current-lisplet))) (handler (gethash error-code error-handlers))) (if handler (funcall handler) @@ -112,7 +112,7 @@ :accessor lisplet-pages :documentation "A collection of cons where the car is an url location and the cdr is a dispatcher") (error-handlers :initform (make-hash-table) - :accessor lisplet-error-hadlers + :accessor lisplet-error-handlers :documentation "An hash table where keys are http error codes and values are functions with no parameters") (protected-resources :initform nil :accessor lisplet-protected-resources @@ -192,9 +192,7 @@ (uri (request-uri)) (welcome-page (lisplet-welcome-page lisplet))) (progn - ;;(setf (aux-request-value 'lisplet) lisplet) (setf (current-lisplet) lisplet) - ;;(setf (aux-request-value 'realm) (lisplet-realm lisplet)) (setf (current-realm) (lisplet-realm lisplet)) (lisplet-check-authorization lisplet) (when (= (return-code) +http-ok+) Modified: trunk/main/claw-core/src/misc.lisp ============================================================================== --- trunk/main/claw-core/src/misc.lisp (original) +++ trunk/main/claw-core/src/misc.lisp Sun Apr 27 12:15:22 2008 @@ -74,7 +74,7 @@ (let ((result (remove-by-location (car location-cons) cons-list))) (setf result (push location-cons result)))) -(defun lisplet-start-session () +(defun start-session () "Starts a session bound to the current lisplet base path" (start-session (format nil "~@[~a~]~a/" *clawserver-base-path* (lisplet-base-path (current-lisplet))))) @@ -119,7 +119,7 @@ (defun (setf current-principal) (principal &optional (session *session*)) "Setf the principal(user) that logged into the application" (unless session - (setf session (lisplet-start-session))) + (setf session (start-session))) (setf (session-value 'principal session) principal)) (defun user-in-role-p (roles &optional (session *session*)) @@ -191,7 +191,7 @@ ,default-val))))) (defun do-message (key &optional (default "") locale) - "This function call the lambda function returned by the WITH-MESSAGE macro." + "This function calls the lambda function returned by the WITH-MESSAGE macro." (funcall (with-message key default locale))) (defun user-locale (&optional (request *request*) (session *session*)) @@ -211,7 +211,7 @@ "This function forces the locale for the current user, binding it to the user session, that is created if no session exists." (unless session - (setf session (lisplet-start-session))) + (setf session (start-session))) (setf (session-value 'locale session) locale)) (defun validation-errors (&optional (request *request*)) Modified: trunk/main/claw-core/src/packages.lisp ============================================================================== --- trunk/main/claw-core/src/packages.lisp (original) +++ trunk/main/claw-core/src/packages.lisp Sun Apr 27 12:15:22 2008 @@ -34,7 +34,7 @@ (defpackage :claw (:use :cl :closer-mop :hunchentoot :alexandria :cl-ppcre :cl-fad :local-time) - (:shadow :flatten) + (:shadow :flatten :start-session) (:documentation "A comprehensive web application framework and server for the Common Lisp programming language") (:export :*html-4.01-strict* :*html-4.01-transitional* @@ -52,46 +52,29 @@ :strings-to-jsarray :empty-string-p :build-tagf - :parse-htcomponent-function - :page ;page classes hadle the whole rendering cycle - :message-dispatch - :page-writer - :page-can-print - :page-url + :page + :message-dispatch :page-lisplet :page-current-form - :page-req-parameter - :page-json-id-list - :page-format - :page-format-raw + :page-req-parameter :page-script-files :page-stylesheet-files :page-class-initscripts :page-instance-initscripts - :page-indent - :page-xmloutput - :page-doc-type - :page-current-component - :page-content-type - :htclass-body + :page-current-component :htcomponent :htcomponent-page :htcomponent-body -; :setf-htcomponent-page - :htcomponent-attributes - :htcomponent-can-print :htcomponent-empty :htcomponent-client-id :htcomponent-script-files :htcomponent-stylesheet-files :htcomponent-class-initscripts :htcomponent-instance-initscript - :tag ;class for tags that accept body + :tag :tag-name - :tag-render-starttag - :tag-render-endtag + :tag-attributes :htbody - :page-body-init-scripts :htscript :htlink :hthead @@ -193,32 +176,23 @@ :var> ;; class modifiers :page-content - :page-render :generate-id :metacomponent :wcomponent - :wcomponent-parameters :wcomponent-informal-parameters :wcomponent-allow-informal-parametersp :wcomponent-template - :wcomponent-parameter-value :wcomponent-before-rewind :wcomponent-after-rewind :wcomponent-before-prerender :wcomponent-after-prerender :wcomponent-before-render :wcomponent-after-render - :make-component :cform :cform> :action-link :action-link> - :base-cinput :cinput - :cinput-reader - :cinput-writer - :cinput-accessor - :cinput-visit-object :cinput> :cselect :cselect> @@ -227,18 +201,12 @@ :submit-link :submit-link> :lisplet - :lisplet-realm :lisplet-pages - :lisplet-base-path - :lisplet-dispatch-method :lisplet-register-page-location :lisplet-register-function-location :lisplet-register-resource-location - :lisplet-protect - :lisplet-authentication-type - :lisplet-start-session - :lisplet-error-handlers - :lisplet-redirect-protected-resources-p + :lisplet-protect + :start-session ;; clawserver :clawserver :clawserver-register-lisplet @@ -255,8 +223,7 @@ :clawserver-input-chunking-p :clawserver-read-timeout :clawserver-write-timeout - :clawserver-login-config - :login + :clawserver-login-config #+(and :unix (not :win32)) :clawserver-setuid #+(and :unix (not :win32)) :clawserver-setgid #-:hunchentoot-no-ssl :clawserver-ssl-certificate-file @@ -266,8 +233,7 @@ :*id-and-static-id-description* :describe-component-behaviour :describe-html-attributes-from-class-slot-initargs - :clawserver-register-configuration - :claw-require-authorization + :clawserver-register-configuration :configuration :configuration-login :principal Modified: trunk/main/claw-core/src/tags.lisp ============================================================================== --- trunk/main/claw-core/src/tags.lisp (original) +++ trunk/main/claw-core/src/tags.lisp Sun Apr 27 12:15:22 2008 @@ -161,6 +161,9 @@ - TAG is the tag instance - PAGE the page instance")) +(defgeneric tag-attributes (tag) + (:documentation "Returns an alist of tag attributes")) + (defgeneric (setf htcomponent-page) (page htcomponent) (:documentation "Internal method to set the component owner page and to assign an unique id attribute when provided. @@ -170,20 +173,6 @@ (defgeneric (setf slot-initialization) (value wcomponent slot-initarg) (:documentation "Sets a slot by its :INITARG. It's used just after instance creation")) -(defgeneric wcomponent-parameter-value (wcomponent key) - (:documentation "Returns the value of a parameter passed to the wcomponent initialization -function (the one generated with DEFCOMPONENT) or :UNDEFINED if not passed. - - WCOMPONENT is the wcomponent instance - - KEY the parameter key to query")) - -(defgeneric wcomponent-check-parameters(wcomponent) - (:documentation "This internal method check if all :REQUIRED parameters are provided - - WCOMPONENT is the wcomponent instance")) - -(defgeneric wcomponent-parameters(wcomponent) - (:documentation "This method returns class formal parameters as an alist (formal parameters are the ones expected by the component) - - WCOMPONENT is the wcomponent instance")) - (defgeneric wcomponent-informal-parameters(wcomponent) (:documentation "This method returns class informal parameters as an alist (informal parameters are the ones not expected by the component, usually rendered as tag attributes withot any kind of evaluation) @@ -528,7 +517,6 @@ (member tag-name *empty-tags* :test #'string-equal)) ;;;--------------------METHODS implementation---------------------------------------------- - (defmethod (setf htcomponent-page) ((page page) (htcomponent htcomponent)) (let ((id (getf (htcomponent-attributes htcomponent) :id)) (static-id (getf (htcomponent-attributes htcomponent) :static-id)) @@ -779,6 +767,9 @@ (htcomponent-json-print-end-component htcomponent)))) ;;;========= TAG ===================================== +(defmethod tag-attributes ((tag tag)) + (htcomponent-attributes tag)) + (defmethod tag-render-attributes ((tag tag) (page page)) (when (htcomponent-attributes tag) (loop for (k v) on (htcomponent-attributes tag) by #'cddr @@ -992,11 +983,7 @@ ;;;========= WCOMPONENT =================================== (defclass wcomponent (htcomponent) - ((parameters :initarg :parameters - :accessor wcomponent-parameters - :type cons - :documentation "must be a plist or nil") - (reserved-parameters :initarg :reserved-parameters + ((reserved-parameters :initarg :reserved-parameters :accessor wcomponent-reserved-parameters :type cons :documentation "Parameters that may not be used in the constructor function") @@ -1036,8 +1023,6 @@ finally (return result)))) (setf (slot-value instance 'informal-parameters) informal-parameters))) -(defmethod wcomponent-check-parameters((comp wcomponent))) - (defmethod (setf slot-initialization) (value (wcomponent wcomponent) slot-initarg) (let* ((initarg (if (or (eq slot-initarg :static-id) (eq slot-initarg :id)) :client-id slot-initarg)) (new-value (if (eq slot-initarg :id) (generate-id value) value)) @@ -1065,7 +1050,6 @@ (remf parameters :id)) (loop for (initarg value) on parameters by #'cddr do (setf (slot-initialization instance initarg) value)) - (wcomponent-check-parameters instance) (setf (htcomponent-body instance) content) instance)) @@ -1076,13 +1060,6 @@ (let ((fbody (parse-htcomponent-function (flatten rest)))) (make-component component-name (first fbody) (second fbody)))) - -(defmethod wcomponent-parameter-value ((c wcomponent) key) - (let ((result (getf (htcomponent-attributes c) key :undefined))) - (if (eq result :undefined) - (getf (wcomponent-parameters c) key) - result))) - (defmethod htcomponent-rewind ((wcomponent wcomponent) (page page)) (let ((template (wcomponent-template wcomponent))) (wcomponent-before-rewind wcomponent page) Modified: trunk/main/claw-core/src/translators.lisp ============================================================================== --- trunk/main/claw-core/src/translators.lisp (original) +++ trunk/main/claw-core/src/translators.lisp Sun Apr 27 12:15:22 2008 @@ -280,7 +280,7 @@ (and (> day 0) (<= day (days-in-month month year)))) :component wcomponent :message (format nil (do-message "VALIDATOR-DATE" "Field ~a is not a valid date or wrong format: ~a") - (wcomponent-parameter-value wcomponent :label) + (label wcomponent) old-value)) (if (component-validation-errors wcomponent) old-value Modified: trunk/main/claw-core/src/validators.lisp ============================================================================== --- trunk/main/claw-core/src/validators.lisp (original) +++ trunk/main/claw-core/src/validators.lisp Sun Apr 27 12:15:22 2008 @@ -73,7 +73,7 @@ (when (stringp value) (validate (and value (string-not-equal value "")) :component component - :message (format nil (do-message "VALIDATOR-REQUIRED" "Field ~a may not be null.") (wcomponent-parameter-value component :label))))) + :message (format nil (do-message "VALIDATOR-REQUIRED" "Field ~a may not be null.") (label component))))) (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. @@ -90,13 +90,13 @@ (validate (>= value-len min-size) :component component :message (format nil (do-message "VALIDATOR-SIZE-MIN" "Size of ~a may not be less then ~a chars." ) - (wcomponent-parameter-value component :label) + (label component) min-size))) (when max-size (validate (<= value-len max-size) :component component :message (format nil (do-message "VALIDATOR-SIZE-MAX" "Size of ~a may not be more then ~a chars." ) - (wcomponent-parameter-value component :label) + (label component) max-size))))))) (defun validator-range (component value &key min max) @@ -110,7 +110,7 @@ (validate (>= value min) :component component :message (format nil (do-message "VALIDATOR-RANGE-MIN" "Field ~a is not greater then or equal to ~d") - (wcomponent-parameter-value component :label) + (label component) (if (typep min 'ratio) (coerce min 'float) min)))) @@ -118,7 +118,7 @@ (validate (<= value max) :component component :message (format nil (do-message "VALIDATOR-RANGE-MAX" "Field ~a is not less then or equal to ~d") - (wcomponent-parameter-value component :label) + (label component) (if (typep max 'ratio) (coerce max 'float) max))))))) @@ -131,7 +131,7 @@ (let ((test (numberp value))) (and (validate test :component component - :message (format nil (do-message "VALIDATOR-NUMBER" "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.") (label component))) (validator-range component value :min min :max max))))) (defun validator-integer (component value &key min max) @@ -142,7 +142,7 @@ (let ((test (integerp value))) (and (validate test :component component - :message (format nil (do-message "VALIDATOR-INTEGER" "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.") (label component))) (validator-range component value :min min :max max))))) @@ -156,7 +156,7 @@ If value is greater then the date passed to :MAX, a localizable message \"Field ~a is greater then ~a.\" is sent with key \"VALIDATOR-DATE-RANGE-MAX\". The argument for the message will be the :label attribute of the COMPONENT and the value passed to :MAX parsed with the :LOCAL-TIME-FORMAT keyword." (unless (component-validation-errors component) - (let ((local-time-format '(:date "-" :month "-" :year));(translator-local-time-format (wcomponent-parameter-value component :translator))) + (let ((local-time-format '(:date "-" :month "-" :year)) (new-value (make-instance 'local-time :nsec (nsec-of value) :sec (sec-of value) @@ -181,13 +181,13 @@ (validate (local-time> new-value min) :component component :message (format nil (do-message "VALIDATOR-DATE-RANGE-MIN" "Field ~a is less then ~a.") - (wcomponent-parameter-value component :label) + (label component) (local-time-to-string min local-time-format)))) (when max (validate (local-time< new-value max) :component component :message (format nil (do-message "VALIDATOR-DATE-RANGE-MAX" "Field ~a is greater then ~a.") - (wcomponent-parameter-value component :label) + (label component) (local-time-to-string max local-time-format)))))))) @@ -207,10 +207,6 @@ (describe-html-attributes-from-class-slot-initargs class) (describe-component-behaviour class)))) -(defmethod wcomponent-parameters ((exception-monitor exception-monitor)) - (declare (ignore exception-monitor)) - (list :class nil)) - (defmethod wcomponent-template ((exception-monitor exception-monitor)) (let ((client-id (htcomponent-client-id exception-monitor)) (validation-errors (aux-request-value :validation-errors))) Modified: trunk/main/claw-core/tests/test1.lisp ============================================================================== --- trunk/main/claw-core/tests/test1.lisp (original) +++ trunk/main/claw-core/tests/test1.lisp Sun Apr 27 12:15:22 2008 @@ -73,12 +73,8 @@ (defun test-configuration-do-login (request user password) (let ((session *session*)) (when (and (string-equal user "kiuma") - (string-equal password "password")) - (progn - ;;(unless session - ;; (setf session (lisplet-start-session))) - ;;(setf (session-value 'principal session) (make-instance 'principal :name user :roles '("user"))))))) - (setf (current-principal session) (make-instance 'principal :name user :roles '("user"))))))) + (string-equal password "password")) + (setf (current-principal session) (make-instance 'principal :name user :roles '("user")))))) @@ -216,7 +212,7 @@ (defmethod page-content ((o realm-page)) (when (null *session*) - (lisplet-start-session)) + (start-session)) (unless (session-value 'RND-NUMBER) (setf (session-value 'RND-NUMBER) (random 1000))) (site-template> :title "Realm test page"