newlispfanclub.alh.net

Code: Select all

#!/usr/bin/env newlisp

;; Validation routines library
;;
;; The validation library handles the task of validating fields in a cgi form.
;; After assigning fields (see the examples below), run validation:run with
;; your post-data (from cgi.lsp or elsewhere). The library will validate all
;; fields and assign errors and post values to assoc lists in this context.
;;
;; If validation:run evaluates to nil, you can then use the errors and values
;; to repopulate the form and let the user know they need to fix certain values.
;; If validation:run evaluates as true, you can process the data and continue
;; on however you wish.

;; Examples
;
;(validation:add-field "username" '((validation:required 
;                                   "Username is required")
;                                   (validation:min-length 6 
;                                   "Username must be at least 5 chars")
;                                   (validation:alpha-numeric 
;                                   "Username can only contain letters, numbers, and -/_.")))
;(validation:add-field "password" '((validation:required 
;                                   "Password is required")
;                                   (validation:min-length 6 
;                                   "Password must be at least 5 chars")
;                                   (validation:alpha-numeric 
;                                   "Password can only contain letters, numbers, and -/_.")))
;
;(if (nil? (validation:get-validation-errors post-data))
;    ;;Load form again. Errors are available as an assoc list
;    ;;(validation:errors) or individually (validation:error "fieldname").
;    ;;You can repopulate the form values using (validation:value "fieldname").
;    (if validation:errors (println validation:errors) (println "No errors"))
;    (println (validation:error "username") (validation:value "username"))

(context 'validation)

;; Handlers

(set 'rules '())
(set 'values '())
(set 'errors '())

(define (add-field fld-name fld-rules)
  "Adds field fld-name with fld-rules as a list of 
  '((validation-function error-string) ...)."
  (push (list fld-name fld-rules) rules -1))

(define (vldt value conditions)
  "Takes value and tests against parameter list conditions 
  ((function [function-argument] error-string)...). It evaluates the function
  with the function-argument as the first parameter and the value as the second.
  If there is an error, it throws the error-string. Otherwise, it returns nil."
  (dolist (condition conditions)
          (if (> 3 (length condition))
              (if (nil? (eval (cons (condition 0) value))) 
                        (throw (condition 1)) nil)
              (if (nil? (eval (list (condition 0) (condition 1) value))) 
                        (throw (condition 2)) nil))))

(define (run post-data)
  (dolist (pair rules)
          (let ((err (catch (vldt ((assoc (pair 0) post-data) 1) (pair 1)))))
               (if err (begin
                          (push (list (pair 0) err) errors)
                          (push (list (pair 0) ((assoc (pair 0) post-data) 1)) 
                                                values)))))
  (if (< 0 (length errors)) nil true))

(define (error fld-name)
  (if (assoc fld-name errors) ((assoc fld-name errors) 1) ""))

(define (value fld-name)
  (if (assoc fld-name values) ((assoc fld-name values) 1) ""))

;; Validator functions

(define (required value)
  "Value exists (not zero length)"
  (< 0 (length value)))

(define (max-length len value)
  "Value has a maximum length of len"
  (<length>= (length value) len))

(define (exact-length len value)
  "Value is exactly length len"
  (= (length value) len))

(define (alpha? value)
  "Value only contains letters, underscores, and whitespace."
  (not (regex {[^a-zA-Z_ ]} value 4)))

(define (alpha-dash? value)
  "Value only contains letters, underscores, dashes, and whitespace."
  (not (regex {[^a-zA-Z_\- ]} value 4)))

(define (alpha-numeric? value)
  "Value only contains letters, underscores, dashes, numbers and whitespace."
  (not (regex {[^a-zA-Z_\- 0-9]} value 4)))

(define (valid-phone? value)
  "Value is a valid (U.S.) phone number (format: 555-555-5555)."
  (regex {^\d{3}-\d{3}-\d{4}$} value))

(define (valid-ip? value)
  "Value is a valid IPV4 ip address (0-255 for x.x.x.x)."
  (= 4 (length (filter (lambda (val) (and (number? val) (>= val 0) (< val 256))) 
                       (map int (parse value "."))))))

(define (valid-email? value)
  "Reasonably usable predicate for email validation.
  The regular expression was yanked from Code Igniter."
  (regex {^([a-z0-9\+_\-]+)(\.[a-z0-9\+_\-]+)*@([a-z0-9\-]+\.)+[a-z]{2,6}$} 
  value))

(context MAIN)