1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
|
;;; esxml-form.el --- HTML Forms with EmacsLisp -*- lexical-binding: t -*-
;; Copyright (C) 2012 Nic Ferrier
;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
;; Maintainer: Nic Ferrier <nferrier@ferrier.me.uk>
;; Keywords: data, lisp
;; Created: 23rd September 2012
;; Package-Requires: ((esxml "0.0.7") (db "0.0.1"))
;; Version: 0.0.1
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This is an HTML Form processing library for ESXML. It ties together
;; the things in Lisp you need to make Forms work; like validation,
;; database validation and rendering.
;;; Code:
(require 'cl-lib)
(require 'esxml)
(require 'esxml-html)
(defconst esxml-form-field-defn
'(name
&key
(type :regex) ; or :password, :email
(regex ".+")
;; :html is one of :text :textarea :password
;; :checkbox :radio :select
;;
;; Further options should deal with the extra
;; data required by some of those types, for
;; example, :checkbox_selected could be used
;; for the checkbox
(html :text)
(check-failure "the content of the field was wrong")
(type-check-failure "the content of the field was wrong")
db-key
db-check)
"The Lisp definition used for a field.")
(cl-defmacro esxml-form ((&key db db-key) &rest field-args)
"Make a field set.
A field set binds some field parameters together with some other
data, for example, a database."
(declare (indent 0))
(let ((fields (make-symbol "fieldsv")))
`(let ((,fields
(mapcar
(lambda (field-arg)
(cl-destructuring-bind ,esxml-form-field-defn field-arg
(list name
:type type
:regex regex
:check-failure check-failure
:type-check-failure type-check-failure
:html html
:db-check db-check
:db-key db-key)))
(quote ,field-args))))
(list :db (quote ,db)
:db-key (quote ,db-key)
:fields ,fields))))
(defun esxml-form-fields (fs)
(plist-get fs :fields))
(defun esxml-form-db (fs)
(symbol-value (plist-get fs :db)))
(defun esxml-form-db-key (fs)
(plist-get fs :db-key))
(defmacro esxml-form-bind (body form)
"Bind BODY successively to FORMS fields."
`(mapcar
(lambda (form-field)
(cl-destructuring-bind ,esxml-form-field-defn form-field
,body))
(esxml-form-fields ,form)))
;; Verification stuff
(defconst esxml-form-field-set-email-verify-re
(concat
"[a-zA-Z0-9-]+@[a-zA-Z0-9.-]+"
"\\.\\(com\\|net\\|org\\|gov\\|[A-Za-z]+\\.[A-Za-z]+\\)$"))
(defun esxml--field-check (field value &optional db query)
"Do a validity check on the FIELD.
Return the type of validation failure or `nil' for no failure.
The type of validation failure can be used as a key into the
field's `:check-failure' alist (if it is a list). This means the
form can respond differently about database validation or other
types of validation."
(let* ((field-type (plist-get field :type))
(valid
(cl-case field-type
(:regex
(equal
0
(string-match
(plist-get field :regex)
(or value ""))))
(:email
(string-match esxml-form-field-set-email-verify-re value))
(:password
;; really? is this a verification?
t))))
(if (and valid db query)
(when (db-query db query) :db-check)
(unless valid field-type))))
(cl-defun esxml-field-set-check (fs params &key onerror onsuccess)
"Check field set FS against the PARAMS values.
Checks that ALL the required fields are there and that any field
that is there is correctly specified.
Returns the empty list when it passes and an alist of field-name,
field-value and validation error message if it fails."
(cl-labels ((subs-all (new old lst)
(let ((l (lambda (e) (if (listp e) (subs-all new old e) e))))
(cl-substitute new old (mapcar l lst)))))
(let* (last-check
(db (esxml-form-db fs))
(fields-set (esxml-form-fields fs))
(errors
(cl-loop with field-value
for (field-name . field-plist) in fields-set
do
(setq field-value (cdr (assoc field-name params
#'string-equal)))
when
(setq
last-check
(esxml--field-check
field-plist field-value
db (when db
(subs-all field-value '$
(plist-get field-plist :db-check)))))
collect (list ; return the error structure
field-name
field-value
(let ((check-msg
(plist-get field-plist :check-failure)))
(if (listp check-msg)
(car (cdr (assoc last-check check-msg)))
check-msg))))))
(cond
((and errors (functionp onerror))
(funcall onerror params errors))
((and (not errors) (functionp onsuccess))
(funcall onsuccess params))
(t errors)))))
(cl-defun esxml-field-set/label-style (&key html name value err)
(esxml-label
name
nil
(cons
'div
(cons
'()
(cons
(cl-case html
(:text (esxml-input name "text" value))
(:password (esxml-input name "password" value))
(:checkbox (esxml-input name "checkbox" value))
(:radio (esxml-input name "radio" value))
;;(:select (esxml-select (symbol-name name)))
(:textarea (esxml-textarea name value)))
(when err
(list
`(div
((class . "error"))
,(elt err 1)))))))))
(cl-defun esxml-field-set/bootstrap-style (&key html name value err)
"Produce a field in twitter bootstrap style."
`(div
((class . ,(concat
"control-group"
(when err " error"))))
,(esxml-label name '((class . "control-label")))
(div
((class . "controls"))
,@(let ((ctrl
(cl-case html
(:text (esxml-input name "text" value))
(:password (esxml-input name "password" value))
(:checkbox (esxml-input name "checkbox" value))
(:radio (esxml-input name "radio" value))
;;(:select (esxml-select (symbol-name name)))
(:textarea (esxml-textarea name (or value ""))))))
(if err
(list ctrl
`(span ((class . "help-inline"))
,(elt err 1)))
(list ctrl))))))
(defvar esxml-field-style :label
"Style used for making form fields.")
(defun esxml-field-set->esxml (form &optional params errors style)
"Fieldset of FORM to ESXML description of fields.
PARAMS, if supplied, is an ALIST of field-names -> value bindings
which are used to validate the fields and assigned to the
respective fields in the output.
The output is an ESXML representation of a form in label
style (an HTML LABEL element contains the controls).
If validation errors occur they are output as a DIV with class
\"error\", again, inside the LABEL.
STYLE, if specified is a either `:label' or `:bootstrap' to
indicate the style of form output used."
(let ((form-style (or style esxml-field-style :label)))
`(fieldset
()
,@(esxml-form-bind
(let* ((symname (symbol-name name))
(value (cdr (assoc symname params)))
(err (cdr (assoc name errors))))
(funcall
(cl-case form-style
(:label 'esxml-field-set/label-style)
(:bootstrap 'esxml-field-set/bootstrap-style))
:html html
:name symname
:value value
:err err))
form))))
(cl-defun esxml-form-save (form params &key db-data)
"Save the specified PARAMS in the FORM in the attached DB.
If DB-DATA is a function it is called to filter the data going
into the DB."
(let ((db (esxml-form-db form))
(db-key (esxml-form-db-key form)))
(when (and db db-key)
(let ((key-value (cdr (assoc db-key params)))
(form-data
(esxml-form-bind (assoc (symbol-name name) params) form)))
(db-put key-value
(if (functionp db-data)
(funcall db-data form-data)
form-data)
db)))))
;;; This isn't right yet. needs to be more generic.
(defun esxml-form-handle (form httpcon page handler &optional extra-data)
"Handle the FORM on the HTTPCON.
PAGE is the file you will send.
HANDLER is a function that takes the DATA from the POST that has
been validated by the FORM for saving it.
EXTRA-DATA is passed to the PAGE as extra `replacements'."
(cl-flet ((send (&optional data errors)
(let ((esxml (esxml-field-set->esxml form data errors)))
(elnode-send-file
httpcon page
:replacements `(("form" . ,(esxml-to-xml esxml))
,@extra-data)))))
(elnode-method httpcon
(GET (send))
(POST
(esxml-field-set-check
form (elnode-http-params httpcon)
:onerror 'send
:onsuccess handler)))))
(provide 'esxml-form)
;;; esxml-form.el ends here
|
