1/* 2 3 @copyright Copyright (c) 2012, University of Houston 4 all rights reserved 5 6 Released under the terms of the LGPL 7 8*/ 9:- module(html_form , [ 10 validated_form/2, 11 error_message//2, 12 form_field//3, 13 form_invalidate/0, 14 length_input_minmax/2, 15 numeric_minmax/2, 16 value/1, 17 length_input_minmax/5, 18 numeric_minmax/5, 19 value/4 20 21 ]). 22 23:- use_module(library(http/http_parameters)). 24:- use_module(library(http/html_write)). 25:- use_module(library(http/http_wrapper)).

HTML Form Validator

This module handles the common web task of creating a form, validating the input, and, if not valid, redirecting the user back to the form with error messages over the offending elements

So, say the form is

   name: [       ]
   age:  [     ]
   (Submit)

The user enters their name but leaves their age blank.

they next see

   name:  [Sally Smith]
   You need to enter an age:
   age:   [    ]
   (Submit)

They enter their age and click submit. They land on a landing page:

   Thank you for your personal info. We'll be sure
   to enter it in our database and as a bonus we'll
   make sure it gets entered in many others throughout
   the globe.
        (Home)

To implement this example we would define a handler

:- http_handler(root(spamform) , spam_page_handler, [id(spamform)]).

spam_page_handler(Request) :-
        validated_form(
            reply_html_page(
                web_style,
                [title('A little problem....')],
                login_form(Request)),
            reply_html_page(
                web_style,
                [title('Thanks'),
                spam_landing_page_content(Request))).

and then in login_form you do something like

login_form(Request) -->
 ....
      form([action='/spamform', method=POST], [
             \(html_form:error_message([for=name], p([class=oops], 'you have to type a name'))),
             \(html_form:form_field(Request, length_input_minmax(3, '>'), input([name=name, type=textarea], []))),
             \(html_form:error_message([for=age], p([class=oops], 'Problem with age'))),
             \(html_form:form_field(Request, numeric_minmax(14, '>'), input([name=age, type=textarea], [])))
                                               ....]

author: - Anne Ogborn
license: - LGPL
*/

97:- thread_local html_form:'$$form_validate'/1. 98 99:- meta_predicate validated_form(0, 0). 100 101% these just suppress some annoying warnings 102:- dynamic length_input_minmax/2, numeric_minmax/2, value/1. 103:- dynamic length_input_minmax/5, numeric_minmax/5, value/4. 104 105% 106% Handler for a form to be validated. 107%% validated_form(+FormReplyGoal:goal, +LandingReplyGoal:goal) is det 108% 109% @param FormReplyGoal is a handler that creates the form page 110% @param LandingReplyGoal is the handler for the landing page. 111% 112validated_form(FormReplyGoal, LandingReplyGoal) :- 113 debug(html_form, '=========~nFormReplyGoal: ~w~n~nLandingReplyGoal: ~w~n', 114 [FormReplyGoal, LandingReplyGoal]), 115 setup_call_cleanup( 116 setup_for_form, 117 % call twice, because the first one asserts the err message names 118 % and the second actually generates the output (like 2 pass compiler) 119 ( with_output_to(string(_), call(FormReplyGoal)), 120 with_output_to(string(S), call(FormReplyGoal)), 121 ( has_invalid_entries -> 122 write(S) ; 123 call(LandingReplyGoal) 124 )), 125 retractall(html_form:'$$form_validate'(_)) 126 ). 127 128setup_for_form :- 129 retractall(html_form:'$$form_validate'(_)), 130 http_current_request(Request), 131 % doing this because the POST handling in swipl is awkward, 132 % only allows you to call it once 133 http_parameters(Request, [], [form_data(FormData)]), 134 assert(html_form:'$$form_validate'(formdata(FormData))). 135 136% 137%% has_invalid_entries is semidet 138% 139% unifies if there are current invalid entries 140% 141has_invalid_entries :- 142 html_form:'$$form_validate'(validity(_, false)), 143 debug(html_form, 'form has invalid entries~n' , []), 144 !. 145 146% error_message(+Options:list, +termHtml:termerized_html)// semidet 147% DCG to include an error message that will only expand beyond 148% nothing if the entry is invalid. 149% 150% @param Options option list, the only option is required, for=Name, 151% case where we can find the for option 152% 153error_message(Options, _TermHtml) --> 154 { 155 memberchk(for=ForTerm, Options), 156 html_form:'$$form_validate'(validity(ForTerm, true)), 157 debug(html_form, 'for=~w is valid~n', [ForTerm]) 158 }, 159 []. 160 161error_message(Options, TermHtml) --> 162 { 163 memberchk(for=ForTerm, Options), 164 html_form:'$$form_validate'(validity(ForTerm, false)), 165 debug(html_form, 'for=~w is invalid~n', [ForTerm]) 166 }, 167 html(TermHtml). 168 169error_message(Options, _TermHtml) --> 170 { 171 memberchk(for=ForTerm, Options), 172 \+ html_form:'$$form_validate'(validity(ForTerm, _)), 173 debug(html_form, 'for=~w is unknown validity~n', [ForTerm]) 174 }, 175 html(p('No validity check for ' - ForTerm)). 176 177% when for=Name is missing (user was ebil) 178error_message(Options, TermHtml) --> 179 { 180 \+ memberchk(for=_, Options), 181 debug(html_form, 182 'Missing for= option in error_message(~w, ~w)~n', 183 [Options, TermHtml]) 184 }, 185 html(p('missing for option')). 186 187:- meta_predicate form_field(+, 3, +).

199form_field(Request, Validator, input(Attribs, Content)) --> 200 { 201 memberchk(name=Name, Attribs), 202 html_form:'$$form_validate'(formdata(FormData)), 203 memberchk(Name=Value, FormData), 204 %and validate it 205 call(Validator, Name, Value, Request), 206 assert(html_form:'$$form_validate'(validity(Name, true))), 207 filled_in_field(input(Attribs, Content), Value, FilledInField), 208 debug(html_form, 'the form field ~w=~w validates~n', [Name, Value]) 209 }, 210 html(FilledInField). 211 212% 213% parm exists but doesn't validate 214% 215form_field(Request, Validator, input(Attribs, Content)) --> 216 { 217 memberchk(name=Name, Attribs), 218 html_form:'$$form_validate'(formdata(FormData)), 219 memberchk(Name=Value, FormData), 220 %and validate it 221 \+ call(Validator, Name, Value, Request), 222 assert(html_form:'$$form_validate'(validity(Name, false))), 223 filled_in_field(input(Attribs, Content), Value, FilledInField), 224 debug(html_form, 'the form field ~w=~w does not validate~n', [Name, Value]) 225 }, 226 html(FilledInField). 227 228 229% 230% Case where parm doesn't exist in request 231% eg if user is visiting form for first time 232% 233% 234form_field(_Request, _Validator, input(Attribs, Content)) --> 235 { 236 memberchk(name=Name, Attribs), 237 html_form:'$$form_validate'(formdata(FormData)), 238 \+ memberchk(Name=_Value, FormData), 239 % 'valid' in that we don't want the err message 240 assert(html_form:'$$form_validate'(validity(Name, true))), 241 % but we need to make sure whole form is invalid 242 assert(html_form:'$$form_validate'( 243 validity('$$notreallyaname', false))), 244 debug(html_form, 'the form field ~w=... does not validate~n', [Name]) 245 }, 246 html(input(Attribs, Content)). 247 248form_field(_Request, _Validator, input(Attribs, Content)) --> 249 { 250 \+ memberchk(name=_, Attribs), 251 debug(html_form, 252 'The form field input(~w, ~w) is missing name field~n', 253 [Attribs, Content]) 254 }, 255 html([input(Attribs, Content)]). 256 257% TODO button, select, textarea, isindex, and a catchall 258 259% Fill in termerized content as if user had typed it in 260% 261filled_in_field(input(Attribs, InsideHTML), Contents, 262 input(NewAttribs, InsideHTML)) :- 263 set_value(Attribs, value=Contents, NewAttribs). 264 265set_value(Name=_, Name=Value, Name=Value) :- !. 266 267set_value(KV, Name=Value, [Name=Value|FreshNCleanKV]) :- 268 memberchk(Name=_, KV), 269 selectchk(Name=_, KV, FreshNCleanKV). 270 271set_value(KV, Name=Value, [Name=Value|KV]) :- 272 is_list(KV), 273 \+ memberchk(Name=_, KV). 274 275% 276% validates if the length of Value is (Operator) of Length, 277% so length_input_minmax(3, '>', _, howdy, _) validates 278% (because howdy is of length 5, which is > 3 279% 280length_input_minmax(Length, Operator, _, Value, _) :- 281 write_length(Value, Len, [max_length(65536)]), 282 Compare =.. [Operator, Len, Length], 283 call(Compare). 284% 285% validates if Value is convertable to a number 286% and (Size, Operator, Value) holds considering 287% Operator as an infix value 288% 289% numeric_minmax(Size, Operator, Name, Value, Request) 290 291numeric_minmax(Size, Operator, _, Value, _) :- 292 atom_number(Value, Number), 293 Compare =.. [Operator, Number, Size], 294 call(Compare). 295 296% 297% validates if Value is whatever we expect it to be 298% 299value(Value, _Name, Value, _Request). 300 301 302http_parameters_quietly(Request, DSL) :- 303 catch( 304 http_parameters(Request, DSL), 305 _E, 306 fail)