Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

-Massive friggin changes (all old features are still supported, it ha…

…s been thoroughly tested and the test facility is included, minus reCaptcha keys) check README.md for details on what's new
  • Loading branch information...
commit 844ea0042b15dc6be0e506b65a7f3cc28056eb42 1 parent 7e3f64e
ingram authored
View
123 README.md
@@ -6,9 +6,14 @@ An implementation of self-validating formlets for Hunchentoot.
News
----
-- support for inputs of type `file` has been added. This includes changing `enctype` to `multipart/form-data` when necessary
-- there are now a few packaged predicates such as `longer-than?`, `matches?` and `file-smaller-than?`. See below for usage
-- validation functions have been re-written for clarity (they now make heavy use of the `loop` macro instead of explicit recursion)
+- big codebase re-organization (it now makes liberal use of classes and methods to reduce complexity)
+ - the declaration format has changed (for the better, hopefully, but you still need to change it slightly)
+ - `show-formlet` is now a function that takes a formlet name and no magic variables
+ - validator functions now automatically redirect to the referer, so you don't need to specify a `source-function`
+ - validator functions now communicate via the `session` instead of calling back to the previous function
+- support added for inputs of type `checkbox`, `checkbox-set`, `radio-set`, `select` and `multi-select`
+- added new predicates `not-blank?`, `same-as?`, `picked-more-than?`, `picked-fewer-than?` and `picked-exactly?`
+- multiple formlets can now co-exist on one page
Goals
-----
@@ -17,111 +22,113 @@ Goals
At the high level, form interaction in HTML requires
1. Showing the user a form
-2. Get the response back
-3. Run a validation function per form field (or run a single validation function on all of the fields)
-4. If the validation passed, send them on, otherwise, show them the form again (but annotated to highight errors they need to correct)
+2. Getting the response back
+3. Running a validation function per form field (or run a single validation function on all of the fields)
+4. If the validation passed, sending them on, otherwise, showing them the form again (annotating to highight errors)
-and I don't want to have to type it all the time.
+and I don't want to have to type it out all the time.
### Simplicity
-A declaration and `show-formlet` call is all that should be required to display, validate and potentially re-display a form.
+A `define-formlet` and `show-formlet` call is all that should be required to display, validate and potentially re-display a form as many times as necessary.
### Style
-Automatically wraps the generated form in a UL and provides CSS classes and ids as hooks for the designers, making the look and feel easily customizable.
+Automatically wraps the generated form in a UL and provides CSS classes and ids as hooks for the designers, making the look and feel easily customizable with an external stylesheet.
### Completeness
-The system will eventually support the full complement of HTML form elements, including `select`, `checkbox` and `radio`, as well as higher-level inputs like `date` or `slider`. Currently, it only supports `password`, `text`, `textarea`, `file` and `recaptcha`.
+The system will eventually support the full complement of HTML form elements, like `hidden`, as well as higher-level inputs, like `date` or `slider`. Currently, it only supports `password`, `text`, `textarea`, `file`, `checkbox` (and `checkbox-set`), `radio-set` (a stand-alone radio button is kind of pointless), `select` (and `multi-select`) and `recaptcha`.
-Non-Goals
+Semi-Goals
---------
### Portability
-The system assumes Hunchentoot + cl-who. This allows the internal code to take advantage of HTML generation, as opposed to tag `format`ting.
+The system assumes Hunchentoot + cl-who. This allows the internal code to take advantage of HTML generation, as opposed to tag `format`ting, and make use of `post-parameters*` and the Hunchentoot `session`. That said, porting away from cl-who would only involve re-defining the `show` methods, and porting away from Hunchentoot would involve re-writing the `define-formlet` and `show-formlet` macros to accomodate another `session` and `POST` model. I have no experience with this, but patches welcome.
### Run-time efficiency
The module is aimed at simplifying HTML form use for the developer. This is a place that's by definition bound by the slower of user speed or network speed. Furthermore, a single form is very rarely more than 20 inputs long in practice. Pieces will be made efficient where possible, but emphasis will not be placed on it.
### Markup customization
-While there are no assumptions about the CSS, formlet HTML markup is fixed by the implementation. A user can modify the `show-form` and `show-form-field` functions to change output, but this will not be made customizable by external variables.
+While there are no assumptions about the CSS, formlet HTML markup is fixed in the `show` methods. You can go in and re-define all the `show`s, but that's about as easy as markup customization is going to get.
+
+
+All that said, I have no experience working with CL servers other than hunchentoot, and `formlets` is as fast as I need it to be at the moment, so if you'd like to change any of the above things, patches welcome.
Usage
-----
-### Predicates (new)
+### Predicates
-Formlets now includes a number of predicate generators for external use. These cover the common situations so that you won't typically have to pass around raw `lambdas`. They all return predicate functions as output, so they aren't yet easily composable (I'm working on it).
+Formlets now includes a number of predicate generators for external use. These cover the common situations so that you won't typically have to pass around raw `lambdas`. They all return predicate functions as output.
-The following four are pretty self explanatory. Longer/shorter checks the length of a string. `matches?` passes if the given regex returns a result for the given input, and `mismatches?` is the opposite.
+The following four are pretty self explanatory. Longer/shorter checks the length of a string. `matches?` passes if the given regex returns a result for the given input, and `mismatches?` is the opposite. `not-blank?` makes sure that a non-"" value was passed, and `same-as?` checks that the field value is `string=` to the specified value.
-+ `longer-than?` :: Num -> fn
-+ `shorter-than?` :: Num -> fn
-+ `matches?` :: regex -> fn
-+ `mismatches?` :: regex -> fn
++ `longer-than?` :: Num -> (String -> Bool)
++ `shorter-than?` :: Num -> (String -> Bool)
++ `matches?` :: regex -> (String -> Bool)
++ `mismatches?` :: regex -> (String -> Bool)
++ `not-blank?` :: (String -> Bool)
++ `same-as?` :: field-name-string -> (String -> Bool)
The file predicates expect a [hunchentoot file tuple](http://weitz.de/hunchentoot/#upload) instead of a string, but act the same from the users' perspective. `file-type?` takes any number of type-strings and makes sure that the given files' content type matches one of them. You can find a list of common mimetypes [here](http://www.utoronto.ca/web/htmldocs/book/book-3ed/appb/mimetype.html). It doesn't rely on file extensions. `file-smaller-than?` takes a number of bytes and checks if the given file is smaller.
-+ `file-type?` :: [File-type-string] -> fn
-+ `file-smaller-than?` :: Size-in-bytes -> fn
++ `file-type?` :: [File-type-string] -> (FileTuple -> Bool)
++ `file-smaller-than?` :: Size-in-bytes -> (FileTuple -> Bool)
+
+Finally, the newly added set-predicates expect a list of values as input from the given field (these can only be used on `multi-select` boxes and `checkbox-set`s). They ensure that the number of returned values is (greater than|less than|equal to) a specified number.
+
++ `picked-more-than?` Num -> ([String] -> Bool)
++ `picked-fewer-than?` Num -> ([String] -> Bool)
++ `picked-exactly?` Num -> ([String] -> Bool)
### Tutorial
-An example form declaration using a general validation message:
+To see some example code, check out the `test.lisp` file (to see it in action, load the `formlets-test` system). An example form declaration using a general validation message:
- (def-formlet login
- (login-page ((user-name :text (lambda (f) (check-password user-name password)))
- (password :password))
- :submit "Login"
- :general "You did not enter the correct user name or password")
+ (define-formlet (login :submit "Login" :general-validation (#'check-password "I see what you did there. ಠ_ಠ"))
+ ((user-name text) (password password))
(start-session)
(setf (session-value :user-name) user-name)
(setf (session-value :user-id) (check-password user-name password))
(redirect "/profile"))
-If the validation function returns `t`, a session is started and the user is redirected to `/profile`. If it returns `nil`, the user will be sent to `login-page`, and a general error will be displayed just above the form. The fields in this formlet are `user-name` (a standard text input), and `password` (a password input). The submit button will read "Login" (by default, it reads "Submit").
+If the validation function returns `t`, a session is started and the user is redirected to `/profile`. Otherwise, the user will be sent back to the previous page, and a general error will be displayed just above the form. The fields in this formlet are `user-name` (a standard text input), and `password` (a password input). The submit button will read "Login" (by default, it reads "Submit").
You would display the above formlet as follows:
- (define-easy-handler (login-page :uri "/") (form-values form-errors)
- (form-template (show-login-form form-values form-errors)))
+ (define-easy-handler (login-page :uri "/") ()
+ (form-template (show-formlet login)))
-The function `show-login-formlet` is declared as part of the `def-formlet` call above. Calling it with `form-values` and `form-errors` causes the full HTML of the formlet to be generated. If `form-values` contains any appropriate values, they will be displayed as default form values (this doesn't happen for passwords or recaptcha fields). If `form-errors` contains any appropriate values, they will be displayed alongside the associated input.
+An instance of the `formlet` named `login` is created as part of the `define-formlet` call above. Calling `show-formlet` with the appropriate formlet name causes the full HTML of the formlet to be generated. If any values appropiate for this formlet are found in session, they will be displayed as default form values (passwords and recaptcha fields are never stored in session, so even if you redefine the `password` `show` method to display its value, it will not). If any errors appropriate for this formlet are present, they are `show`n alongside the associated input.
An example form using individual input validation:
- (def-formlet register
- (register-page
- ((user-name :text (lambda (f) (and (not (equalp "" f)) (not (user-exists? f)))) "That name has already been taken")
- (password :password (longer-than? 4) "Your password must be longer than 4 characters")
- (confirm-password :password (lambda (f) (string= f password)) "You must enter the same password in 'confirm password'")
- (captcha :recaptcha))
- :submit "Register")
+ (def-formlet (register :submit "Register")
+ ((user-name text :validation ((not-blank?) "You can't leave this field blank"
+ #`unique-username? "That name has already been taken"))
+ (password password :validation (longer-than? 4) "Your password must be longer than 4 characters")
+ (confirm-password password :validation ((same-as? "password") "You must enter the same password in 'confirm password'"))
+ (captcha recaptcha))
(let ((id (register user-name password)))
(start-session)
(setf (session-value :user-name) user-name)
(setf (session-value :user-id) id)
(redirect "/profile")))
-You'd display this the same way as above, and the same principles apply. The only difference is that, instead of a single error being displayed on a validation failure, one is displayed next to each input. In this case, it's a series of 4 (recaptchas are always validated the same way, so that was coded in the formlet module itself). If all of them pass, the user is redirected to `/profile`, otherwise a list of errors and user inputs is returned to `register-page`.
+You'd display this the same way as above, and the same principles apply. The only difference is that, instead of a single error being displayed on a validation failure, one is displayed next to each input. In this case, it's a series of 4 (recaptchas are the odd duck; they have their very own `validate` method, which you can see in `recaptcha.lisp`, so no additional declaration is needed). If all of them pass, the user is redirected to `/profile`, otherwise a list of errors and user inputs is returned to `register-page`.
-A single field looks like this
- (field-name :field-type validation-function "Error message")
-+ The field name is used to generate a label, CSS id and name for the form field.
-+ The type signifies what kind of input will be displayed (currently, the system supports only `:text`, `:password`, `:textarea` or `:recaptcha`. A special note, in order to use the `:recaptcha` input type, you need to `setf` the `formlets:*private-key*` and `formlets:*public-key*` as appropriate for your recaptcha account.
-+ A validation function and error message can be provided optionally. If they aren't, the field won't be validated. If they are, then the function will be applied to the users' response. If the application fails, the error message will be pushed onto `form-errors`.
+A single field declaration looks like this (the `validation` parameter is a list of `((predicate-function error-message) ...)`
+
+ (field-name field-type &key size value-set default-value validation)
+
++ The field name is used to generate a label and name for the form field.
++ The type signifies what kind of input will be displayed (currently, the system supports `text`, `textarea`, `password`, `file`, `checkbox`, `select`, `radio-set`, `multi-select`, `checkbox-set` or `recaptcha`. A special note, in order to use the `recaptcha` input type, you need to `setf` the `formlets:*private-key*` and `formlets:*public-key*` as appropriate for your recaptcha account.
A formlet declaration breaks down as
- (def-formlet [formlet name]
- ([source function]
- ([list of fields])
- :submit [submit button caption]
- :general [general error message]
- [on success])
-
-+ Formlet name is used to generate the CSS id and name of the form, as well as determine the final name of this formlets' `show-[name]-formlet` function.
-+ If the formlet fails validation, it will redirect the user to `[source function]` (the provided function must be expecting the `form-values` and `form-errors` arguments)
-+ The list of fields should be one or more form fields as defined above
-+ Submit button caption is just the text that will appear on this formlets' submit button. By default, it is "Submit"
-+ If the [general error message] is present, it will be displayed above the form in the event of an error (and none of the individual warnings will be shown). This is useful for places like login forms, where you don't want to tell potential attackers which fields they got wrong.
-+ Finally, `[on success]` is a body parameter that determines what to do if the form validates properly
+ ((name &key general-validation (submit "Submit")) (&rest fields) &rest on-success)
+
++ `name` is used to generate the CSS id and name of the form, as well as determine the final name of this formlets' instance and validation handler.
++ `fields` should be one or more form fields as defined above
++ `submit` is just the text that will appear on this formlets' submit button
++ If the `general-validation` is present, it will be displayed above the form in the event of an error (and none of the individual warnings will be shown). This is useful for places like login forms, where you don't want to tell potential attackers which fields they got wrong.
++ Finally, `on-success` is a body parameter that determines what to do if the form validates properly
View
11 formlets-test.asd
@@ -0,0 +1,11 @@
+(defpackage :formlets-test-system (:use :cl :asdf))
+(in-package :formlets-test-system)
+(defsystem formlets-test
+ :version "0.1"
+ :author "leo.zovic@gmail.com"
+ :maintainer "leo.zovic@gmail.com"
+ :licence "MIT-style"
+ :description "Testing system to simplify development of the validating formlets system for Hunchentoot"
+ :components ((:file "test-package")
+ (:file "test" :depends-on ("test-package")))
+ :depends-on (:cl-who :drakma :hunchentoot :cl-ppcre :formlets))
View
7 formlets.asd
@@ -20,7 +20,7 @@
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
;; THE SOFTWARE.
-(defpackage "FORMLETS-SYSTEM" (:use :cl :asdf))
+(defpackage :formlets-system (:use :cl :asdf))
(in-package :formlets-system)
(defsystem formlets
:version "0.1"
@@ -30,6 +30,7 @@
:description "Validating formlets for Hunchentoot"
:components ((:file "package")
(:file "utility" :depends-on ("package"))
- (:file "recaptcha" :depends-on ("package" "utility"))
- (:file "formlets" :depends-on ("package" "utility" "recaptcha")))
+ (:file "formlets" :depends-on ("package" "utility"))
+ (:file "recaptcha" :depends-on ("package" "utility" "formlets"))
+ (:file "macros" :depends-on ("package" "utility" "formlets")))
:depends-on (:cl-who :drakma :hunchentoot :cl-ppcre))
View
249 formlets.lisp
@@ -1,84 +1,171 @@
(in-package :formlets)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Predicates
-;;;;;;;;;;;;;;;basic field predicates
-(defun longer-than? (num) (lambda (f) (> (length f) num)))
-(defun shorter-than? (num) (lambda (f) (< (length f) num)))
-(defun matches? (regex) (lambda (f) (scan regex f)))
-(defun mismatches? (regex) (lambda (f) (not (scan regex f))))
-
-;;;;;;;;;;;;;;;file-related
-;; a hunchentoot file tuple is '(temp-filename origin-filename file-mimetype)
-(defun file-type? (&rest accepted-types)
- (lambda (hunchentoot-file-tuple)
- (member (third hunchentoot-file-tuple) accepted-types :test #'equal)))
-
-(defun file-smaller-than? (byte-size)
- (lambda (hunchentoot-file-tuple)
- (> byte-size (file-size (car hunchentoot-file-tuple)))))
-
-;;;;;;;;;;;;;;;recaptcha
-(defun validate-recaptcha ()
- (recaptcha-passed? (post-parameter "recaptcha_challenge_field") (post-parameter "recaptcha_response_field") (real-remote-addr)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;View related functions
-(defun show-form-field (name type form-values form-errors)
- (let* ((s-name (string name)) (l-name (string-downcase s-name)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; CLASS DECLARATIONS
+(defclass formlet ()
+ ((name :reader name :initarg :name)
+ (fields :reader fields :initarg :fields)
+ (validation-functions :accessor validation-functions :initarg :validation-functions :initform nil)
+ (error-messages :reader error-messages :initarg :error-messages :initform nil)
+ (submit-caption :reader submit :initarg :submit :initform "Submit")
+ (enctype :accessor enctype :initarg :enctype :initform "application/x-www-form-urlencoded")
+ (on-success :reader on-success :initarg :on-success)))
+
+(defclass formlet-field ()
+ ((name :reader name :initarg :name)
+ (validation-functions :accessor validation-functions :initarg :validation-functions :initform nil)
+ (default-value :reader default-value :initarg :default-value :initform nil)
+ (error-messages :accessor error-messages :initarg :error-messages :initform nil)))
+
+(defclass text (formlet-field) ())
+(defclass textarea (formlet-field) ())
+(defclass password (formlet-field) ())
+(defclass file (formlet-field) ())
+(defclass checkbox (formlet-field) ())
+
+(defclass formlet-field-set (formlet-field)
+ ((value-set :reader value-set :initarg :value-set :initform nil))
+ (:documentation "This class is for fields that show the user a list of options"))
+
+(defclass select (formlet-field-set) ())
+(defclass radio-set (formlet-field-set) ())
+
+(defclass formlet-field-return-set (formlet-field-set) ()
+ (:documentation "This class is specifically for fields that return multiple values from the user"))
+
+(defclass multi-select (formlet-field-return-set) ())
+(defclass checkbox-set (formlet-field-return-set) ())
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; METHODS
+;;;;;;;;;;post-value
+;;;;NOTE: This section exists because Hunchentoots' (post-parameter [field-name])
+;; returns a single value. This is problematic for multi-select boxes and checkbox sets
+;; (both of which potentially return multiple values from the user).
+;; post-value is not necessarily Hunchentoot specific, but it does expect values in the form of an alist
+
+(defmethod post-value ((formlet formlet) post-alist)
+ (mapcar (lambda (f) (post-value f post-alist)) (fields formlet)))
+
+(defmethod post-value ((field formlet-field) post-alist)
+ (cdr (assoc (name field) post-alist :test #'string=)))
+
+(defmethod post-value ((field formlet-field-return-set) post-alist)
+ (loop for (k . v) in post-alist
+ if (string= k (name field)) collect v))
+
+;;;;;;;;;;validate
+;;;;;NOTE: The validate methods each return (values [validation result] [errors]).
+;; [validation result] is a boolean
+;; [errors] can be either a list or tree of strings
+
+(defmethod validate ((formlet formlet) form-values)
+ (let ((errors (if (validation-functions formlet)
+ (loop for f in (validation-functions formlet)
+ for msg in (error-messages formlet)
+ unless (apply f form-values) collect msg)
+ (loop for f in (fields formlet)
+ for v in form-values
+ collect (multiple-value-bind (result error) (validate f v) (unless result error))))))
+ (values (every #'null errors) errors)))
+
+(defmethod validate ((field formlet-field) value)
+ "Returns (values T NIL) if there are no errors, and (values NIL list-of-errors).
+ By default, a formlet-field passes only its own value to its validation functions."
+ (let ((errors (loop for fn in (validation-functions field)
+ for msg in (error-messages field)
+ unless (funcall fn value) collect msg)))
+ (values (every #'null errors) errors)))
+
+;;;;;;;;;;show
+;;;; The show functions just take a formlet/(-field)?/ (along with its value/s?/ and error/s?/)
+;; and output the corresponding HTML. This part is cl-who specific, but it could be easily made portable
+;; by replacing html-to-stout and html-to-str with raw format calls
+
+(defmethod show ((formlet formlet) &optional values errors)
+ (with-slots (error-messages name enctype) formlet
(html-to-stout
- (:li (:span :class "label" (str (name->label name)))
- (case type
- (:textarea (htm (:textarea :name l-name (str (getf form-values (sym->keyword name))))))
- (:password (htm (:input :name l-name :class "text-box" :type (string type))))
- (:file (htm (:input :name l-name :class "file" :type (string type))))
- (:recaptcha (htm (recaptcha)))
- (otherwise (htm (:input :name l-name
- :value (getf form-values (sym->keyword name))
- :class "text-box" :type (string type)))))
- (show-error form-errors (sym->keyword name))))))
-
-(defmacro show-form ((form-name values errors &key (submit "Submit") (enctype "application/x-www-form-urlencoded")) &body fields)
- (let ((n (string-downcase (string form-name))))
- `(html-to-stout
- (show-general-error ,errors)
- (:form :name ,n :id ,n :action ,(string-downcase (format nil "/validate-~a" n)) :enctype ,enctype :method "post"
- (:ul :class "form-fields"
- ,@(mapcar (lambda (field)
- `(show-form-field ',(car field) ',(cadr field) ,values ,errors))
- fields)
- (:li (:span :class "label") (:input :type "submit" :class "submit" :value ,submit)))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Validation related functions
-(defmacro validate-form ((origin-fn &key fields general) &body on-success)
- `(let ((results (list ,@(loop for (field-name field-type . fn/message-list) in fields
- collect (sym->keyword field-name)
- collect (validate-field field-name field-type fn/message-list general)))))
- (if (all-valid? results)
- (progn ,@on-success)
- (,origin-fn :form-values (list ,@(loop for field in fields
- unless (member (cadr field) '(:password :file :recaptcha))
- collect (sym->keyword (car field)) and collect (car field)))
- :form-errors ,(if general `(list :general-error ,general) 'results)))))
-
-(defun validate-field (field-value field-type fn/message-list general-error-message)
- (cond ((equalp :recaptcha field-type) `(unless (validate-recaptcha) "You seem to have mistyped the recaptcha"))
- ((null fn/message-list) nil)
- (general-error-message `(unless (funcall ,(car fn/message-list) ,field-value) ,general-error-message))
- ((= 2 (length fn/message-list)) `(unless (funcall ,(car fn/message-list) ,field-value) ,(cadr fn/message-list)))
- (t `(combine-errors (loop for (val-fn error-message) on (list ,@fn/message-list) by #'cddr
- collect (unless (funcall val-fn ,field-value) error-message))))))
-
-(defun combine-errors (list-of-errors)
- (when (remove-if #'null list-of-errors)
- (html-to-str
- (dolist (e list-of-errors)
- (when e (htm (:p (str e))))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Formlet definition
-(defmacro def-formlet (formlet-name (source-fn fields &key general submit) &body on-success)
- (let* ((enctype "application/x-www-form-urlencoded")
- (name+type (loop for f in fields collecting (list (car f) (cadr f)) when (equalp (cadr f) :file) do (setf enctype "multipart/form-data")))
- (f-names (mapcar #'car fields)))
- `(progn (defun ,(intern (format nil "SHOW-~a-FORM" formlet-name)) (values errors)
- (show-form (,formlet-name values errors :submit ,submit :enctype ,enctype) ,@name+type))
- (define-easy-handler (,(intern (format nil "VALIDATE-~a" formlet-name)) :uri ,(format nil "/validate-~(~a~)" formlet-name)) ,f-names
- (validate-form (,source-fn :fields ,fields :general ,general) ,@on-success)))))
+ (when (and (not (every #'null errors)) error-messages)
+ (htm (:span :class "general-error" (str (show error-messages)))))
+ (:form :name (name formlet) :id name :action (format nil "/validate-~(~a~)" name) :enctype enctype :method "post"
+ (:ul :class "form-fields"
+ (loop for a-field in (fields formlet)
+ for e in errors
+ for v in values
+ do (htm (:li (:span :class "label" (str (string-capitalize (regex-replace-all "-" (name a-field) " "))))
+ (str (show a-field v (when (and e (not error-messages)) e))))))
+ (:li (:span :class "label") (:input :type "submit" :class "submit" :value (submit formlet))))))))
+
+(defmethod show ((list-of-string list) &optional v e)
+ "A method for showing error output in the Formlets module"
+ (declare (ignore v e))
+ (when list-of-string
+ (html-to-str (:span :class "formlet-error" (dolist (s list-of-string) (htm (:p (str s))))))))
+
+(defmethod show ((field formlet-field) &optional value error)
+ (html-to-str (:input :name (name field) :value value :class "text-box") (str (show error))))
+
+(defmethod show ((field textarea) &optional value error)
+ (html-to-str (:textarea :name (name field) (str value)) (str (show error))))
+
+(defmethod show ((field password) &optional value error)
+ (html-to-str (:input :name (name field) :type "password" :class "text-box") (str (show error))))
+
+(defmethod show ((field file) &optional value error)
+ (html-to-str (:input :name (name field) :type "file" :class "file") (str (show error))))
+
+(defmethod show ((field select) &optional value error)
+ (html-to-str (:select :name (name field)
+ (loop for v in (value-set field)
+ do (htm (:option :value v :selected (when (string= v value) "selected") (str v)))))
+ (str (show error))))
+
+(defmethod show ((field checkbox) &optional value error)
+ (html-to-str (:input :type "checkbox" :name (name field) :value (name field)
+ :checked (when (string= (name field) value) "checked"))
+ (str (show error))))
+
+(defmethod show ((field radio-set) &optional value error)
+ (html-to-str (loop for v in (value-set field)
+ do (htm (:span :class "input+label"
+ (:input :type "radio" :name (name field) :value v
+ :checked (when (string= v value) "checked"))
+ (str v))))
+ (str (show error))))
+
+
+(defmethod show ((field multi-select) &optional value error)
+ (html-to-str (:select :name (name field) :multiple "multiple" :size 5
+ (loop for v in (value-set field)
+ do (htm (:option :value v
+ :selected (when (member v value :test #'string=) "selected")
+ (str v)))))
+ (str (show error))))
+
+(defmethod show ((field checkbox-set) &optional value error)
+ (html-to-str (loop for v in (value-set field)
+ do (htm (:span :class "input+label"
+ (:input :type "checkbox" :name (name field) :value v
+ :checked (when (member v value :test #'string=) "checked"))
+ (str v))))
+ (str (show error))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PREDICATES
+(defmacro define-predicate (name (&rest args) &body body)
+ `(defun ,name ,args (lambda (val) ,@body)))
+
+;;;;;;;;;; basic field predicates
+(define-predicate longer-than? (num) (> (length val) num))
+(define-predicate shorter-than? (num) (< (length val) num))
+(define-predicate matches? (regex) (scan regex val))
+(define-predicate mismatches? (regex) (not (scan regex val)))
+(define-predicate not-blank? () (or (null val) (and (stringp val) (not (string= "" val)))))
+(define-predicate same-as? (field-name-string) (string= val (post-parameter field-name-string)))
+
+;;;;;;;;;; file-related
+;; a hunchentoot file tuple is '([temp filename] [origin filename] [file mimetype])
+(define-predicate file-type? (&rest accepted-types) (member (third val) accepted-types :test #'equal))
+(define-predicate file-smaller-than? (byte-size) (> byte-size (file-size (car val))))
+
+;;;;;;;;;; set-related
+(define-predicate picked-more-than? (num) (> (length val) num))
+(define-predicate picked-fewer-than? (num) (< (length val) num))
+(define-predicate picked-exactly? (num) (= (length val) num))
View
65 macros.lisp
@@ -0,0 +1,65 @@
+(in-package :formlets)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; HELPER MACROS
+;; NOTE: If you REALLY want, you can define your own raw formlet instance and validator as in define-formlet.
+;; The same can be said about show-formlet. If you go this route, pay attention to how they communicate;
+;; currently they use Hunchentoots' session (which is the main reason :formlets isn't portable)
+(defun define-field (field-name field-type &key size value-set default-value validation)
+ "Takes a terse declaration and expands it into a make-instance for macro purposes"
+ (let ((final-value-set (when value-set `(:value-set (list ,@value-set))))
+ (final-size (when size `(:size ,size))))
+ (multiple-value-bind (functions messages) (split-validation-list validation)
+ `(make-instance ',field-type :name ,(format nil "~(~a~)" field-name)
+ :default-value ,default-value ,@final-value-set ,@final-size
+ :validation-functions (list ,@functions) :error-messages (list ,@messages)))))
+
+(defmacro define-formlet ((name &key general-validation (submit "Submit")) (&rest fields) &rest on-success)
+ "Converts a terse declaration form into the corresponding object and validation handler."
+ ;;; the flet function converts a terse declaration into the corresponding make-instance declaration
+ (let* ((field-names (mapcar #'car fields))
+ (field-objects (mapcar (lambda (f) (apply #'define-field f)) fields))
+ (enctype (if (every (lambda (f) (not (eq (cadr f) 'file))) fields)
+ "application/x-www-form-urlencoded"
+ "multipart/form-data")))
+ (multiple-value-bind (gen-val-fn gen-err-msg) (split-validation-list general-validation)
+ `(progn
+ ;;; declare formlet instance
+ (defparameter ,name
+ (make-instance 'formlet
+ :name ',name :submit ,submit :enctype ,enctype
+ :validation-functions ,(when general-validation `(list ,@gen-val-fn))
+ :error-messages ,(when general-validation `(list ,@gen-err-msg))
+ :fields (list ,@field-objects)
+ :on-success (lambda ,field-names (progn ,@on-success))))
+
+ ;;; declare validation handler
+ (define-easy-handler (,(intern (format nil "VALIDATE-~a" name)) :uri ,(format nil "/validate-~(~a~)" name)) ()
+ (let* ((formlet-values (post-value ,name (post-parameters*)))
+ (formlet-return-values (loop for f in (formlets::fields ,name) ;;the values list, less password values
+ for v in formlet-values
+ unless (eq (type-of f) 'password) collect v
+ else collect nil)))
+ (multiple-value-bind (result errors) (validate ,name formlet-values)
+ (if result
+ (apply (formlets::on-success ,name) formlet-values) ;; if everything's ok, send the user on
+ (progn
+ (setf (session-value :formlet-values) formlet-return-values
+ (session-value :formlet-errors) errors
+ (session-value :formlet-name) ',name)
+ (redirect (referer)))))))))))
+
+(defmacro show-formlet (formlet-name)
+ "Shortcut for displaying a formlet.
+ It outputs the formlet HTML to standard-out (with indenting).
+ If this is the last submitted formlet in session, display field values and errors, then clear out the formlet-related session information."
+ `(let ((val (if (eq (session-value :formlet-name) ',formlet-name)
+ (session-value :formlet-values)
+ (make-list (length (formlets::fields ,formlet-name)))))
+ (err (if (eq (session-value :formlet-name) ',formlet-name)
+ (session-value :formlet-errors)
+ (make-list (length (formlets::fields ,formlet-name))))))
+ (show ,formlet-name val err)
+ (when (eq (session-value :formlet-name) ',formlet-name)
+ (delete-session-value :formlet-name)
+ (delete-session-value :formlet-values)
+ (delete-session-value :formlet-errors))))
View
9 package.lisp
@@ -2,8 +2,9 @@
(:use :cl :cl-who :hunchentoot)
(:import-from :cl-ppcre :regex-replace-all :split :scan)
(:import-from :drakma :http-request)
- (:export :def-formlet
- :recaptcha :recaptcha-passed? :combine-errors :*private-key* :*public-key*
- :file-type? :file-smaller-than?
- :longer-than? :shorter-than? :matches? :mismatches?)
+ (:export :formlet :formlet-field
+ :text :textarea :password :file :checkbox :select :radio-set :checkbox-set :multi-select
+ :*public-key* :*private-key* :recaptcha
+ :validate :show :post-value :show-formlet :define-formlet
+ :longer-than? :shorter-than? :matches? :mismatches? :file-type? :file-smaller-than? :not-blank? :same-as? :picked-more-than? :picked-fewer-than? :picked-exactly?)
(:documentation "A package implementing auto-validating formlets for Hunchentoot"))
View
32 recaptcha.lisp
@@ -3,16 +3,9 @@
(defvar *public-key* nil)
(defvar *private-key* nil)
-(defun recaptcha (&optional (pub-key *public-key*))
- (html-to-stout
- (:script :type "text/javascript" :src (format nil "http://api.recaptcha.net/challenge?k=~a" pub-key))
- (:noscript (:iframe :src (format nil "http://api.recaptcha.net/noscript?k=~a" pub-key)
- :height "300" :width "500" :frameborder "0")
- (:br)
- (:textarea :name "recaptcha_challenge_field" :rows "3" :cols "40")
- (:input :type "hidden" :name "recaptcha_response_field" :value "manual_challenge"))))
+(defclass recaptcha (formlet-field) ())
-(defun recaptcha-passed? (challenge response ip &key (private-key *private-key*))
+(defun recaptcha-passed? (challenge response ip &optional (private-key *private-key*))
(string= "true"
(car (split #\Newline
(http-request "http://api-verify.recaptcha.net/verify"
@@ -20,4 +13,23 @@
:parameters `(("privatekey" . ,private-key)
("remoteip" . ,ip)
("challenge" . ,challenge)
- ("response" . ,response)))))))
+ ("response" . ,response)))))))
+
+(defmethod validate ((field recaptcha) values)
+ "A reCaptcha, being a foreign API call, is validated in a completely different way"
+ (declare (ignore values))
+ (let* ((result (recaptcha-passed? (post-parameter "recaptcha_challenge_field")
+ (post-parameter "recaptcha_response_field")
+ *private-key* ))
+ (errors (unless result (list "You seem to have mistyped the reCaptcha"))))
+ (values result errors)))
+
+(defmethod show ((field recaptcha) &optional v error)
+ (declare (ignore v))
+ (html-to-str (:script :type "text/javascript" :src (format nil "http://api.recaptcha.net/challenge?k=~a" *public-key*))
+ (:noscript (:iframe :src (format nil "http://api.recaptcha.net/noscript?k=~a" *public-key*)
+ :height "300" :width "500" :frameborder "0")
+ (:br)
+ (:textarea :name "recaptcha_challenge_field" :rows "3" :cols "40")
+ (:input :type "hidden" :name "recaptcha_response_field" :value "manual_challenge"))
+ (str (show error))))
View
2  test-package.lisp
@@ -0,0 +1,2 @@
+(defpackage :formlets-test (:use :cl :cl-who :hunchentoot :formlets)
+ (:documentation "A package implementing the testing tools auto-validating formlets for Hunchentoot"))
View
82 test.lisp
@@ -0,0 +1,82 @@
+(in-package :formlets-test)
+
+(setf formlets:*public-key* "your public key"
+ formlets:*private-key* "your private key"
+ *show-lisp-errors-p* t)
+
+(defmacro page-template ((&key title) &body body)
+ `(with-html-output-to-string (*standard-output* nil :prologue t :indent t)
+ (:html :xmlns "http://www.w3.org/1999/xhtml" :xml\:lang "en" :lang "en"
+ (:head (:meta :http-equiv "Content-Type" :content "text/html;charset=utf-8")
+ (:title ,@title))
+ (:body ,@body))))
+
+(define-formlet (test-form)
+ ((one text
+ :validation
+ ((not-blank?) "This field cannot be left empty"
+ (mismatches? "blah") "You can't write \"blah\" here"
+ (longer-than? 5) "You need to enter more than 5 characters"))
+ (two textarea)
+ (three password)
+ (recaptcha recaptcha))
+ (page-template (:title "Results")
+ (:h4 "Fuck yeah!")
+ (:p (str (write-to-string (post-parameters*))))
+ (:p (str one))
+ (:p (str two))
+ (:p (str recaptcha))))
+
+(define-formlet (test-form-two)
+ ((one text :validation ((lambda (v) (> 6 (length v))) "You can't enter more than 5 characters here"))
+ (two file)
+ (pull-down select :value-set ("one" "two" "three" "four"))
+ (radio-set radio-set :value-set ("one" "two" "three" "four"))
+ (password password)
+ (confirm-password password :validation ((same-as? "password") "You have to enter the same thing here and in the 'Password' field")))
+ (page-template (:title "Results TWO")
+ (:h4 "Wooo!")
+ (:p (str (write-to-string (post-parameters*))))
+ (:p (str one))
+ (:p (str pull-down))
+ (:p (str radio-set))
+ (:p (str two))
+ (:p (str password))))
+
+(define-formlet (test-form-three)
+ ((pull-down multi-select
+ :value-set ("a" "b" "c" "d")
+ :validation ((lambda (val) (= 2 (length val))) "Please pick exactly two options"))
+ (radio-set radio-set :value-set ("one" "two" "three" "four"))
+ (single-check checkbox)
+ (checking checkbox-set :value-set ("aye" "bee" "sea" "dee")))
+ (page-template (:title "Results TWO")
+ (:h4 "Yay!")
+ (:p (str (write-to-string (post-parameters*))))
+ (:p (str pull-down))
+ (:p (str radio-set))
+ (:p (str single-check))
+ (:p (str checking))))
+
+(define-formlet
+ (faux-login-form
+ :submit "Login"
+ :general-validation ((lambda (user-name password) (and (string= "blah" user-name) (string= "pass" password)))
+ "I see what you did there. &#3232;_&#3232;"))
+ ((user-name text) (password password))
+ (page-template (:title "You got it")
+ (:p (str (write-to-string (post-parameters*))))
+ (:p (str user-name))
+ (:p (str password))))
+
+(define-easy-handler (test-page :uri "/") ()
+ (page-template (:title "Formlets Test Page")
+ (:p (str (session-value :formlet-name)))
+ (:p (str (session-value :formlet-values)))
+ (:p (str (session-value :formlet-errors)))
+ (:hr) (show-formlet test-form)
+ (:hr) (show-formlet test-form-two)
+ (:hr) (show-formlet test-form-three)
+ (:hr) (show-formlet faux-login-form)))
+
+(defvar *web-server* (start (make-instance 'acceptor :port 4141)))
View
22 utility.lisp
@@ -8,21 +8,11 @@
"Returns HTML as a string, as well as printing to standard-out"
`(with-html-output-to-string (*standard-output*) ,@body))
-(defun sym->keyword (s) (intern (symbol-name s) :keyword))
+(defun split-validation-list (validation-list)
+ (loop for (fn msg) on validation-list by #'cddr
+ collect fn into list-of-fn
+ collect msg into list-of-msg
+ finally (return (values list-of-fn list-of-msg))))
(defun file-size (f-name)
- (with-open-file (stream f-name :direction :input :if-does-not-exist nil) (file-length stream)))
-
-;;;;;;;;;;;;;;;view-related shortcuts
-(defmacro error-html (key tag class)
- `(html-to-stout
- (if (getf e-list ,key) (htm (,tag :class ,class (str (getf e-list ,key)) (str ""))))))
-
-(defun show-general-error (e-list) (error-html :general-error :div "general-error"))
-(defun show-error (e-list key) (error-html key :span "inline-error"))
-
-(defun name->label (field-name) (string-capitalize (regex-replace-all "-" (string field-name) " ")))
-
-;;;;;;;;;;;;;;;validation-related shortcuts
-(defun all-valid? (results)
- (loop for (k v) on results by #'cddr if v return nil else collect v))
+ (with-open-file (stream f-name :direction :input :if-does-not-exist nil) (file-length stream)))
Please sign in to comment.
Something went wrong with that request. Please try again.