35
36:- module(http_parameters,
37 [ http_parameters/2, 38 http_parameters/3, 39
40 http_convert_parameter/4, 41 http_convert_parameters/2, 42 http_convert_parameters/3 43 ]). 44:- use_module(http_client). 45:- use_module(http_multipart_plugin). 46:- use_module(http_hook). 47:- use_module(library(debug)). 48:- use_module(library(option)). 49:- use_module(library(error)). 50:- use_module(library(broadcast)). 51
52:- multifile
53 http:convert_parameter/3. 54
55:- predicate_options(http_parameters/3, 3,
56 [ form_data(-list),
57 attribute_declarations(callable)
58 ]). 59
85
86:- meta_predicate
87 http_parameters(+, ?, :),
88 http_convert_parameters(+, ?, 2). 89
134
135http_parameters(Request, Params) :-
136 http_parameters(Request, Params, []).
137
138http_parameters(Request, Params, Options) :-
139 must_be(list, Params),
140 meta_options(is_meta, Options, QOptions),
141 option(attribute_declarations(DeclGoal), QOptions, no_decl_goal),
142 http_parms(Request, Params, DeclGoal, Form),
143 ( memberchk(form_data(RForm), QOptions)
144 -> RForm = Form
145 ; true
146 ).
147
148is_meta(attribute_declarations).
149
150
151http_parms(Request, Params, DeclGoal, Search) :-
152 memberchk(search(Search), Request),
153 !,
154 fill_parameters(Params, Search, DeclGoal).
155http_parms(Request, Params, DeclGoal, Data) :-
156 memberchk(method(Method), Request),
157 Method == post,
158 memberchk(content_type(Content), Request),
159 form_data_content_type(Content),
160 !,
161 debug(post_request, 'POST Request: ~p', [Request]),
162 posted_form(Request, Data),
163 fill_parameters(Params, Data, DeclGoal).
164http_parms(_Request, Params, DeclGoal, []) :-
165 fill_parameters(Params, [], DeclGoal).
166
167:- multifile
168 form_data_content_type/1. 169
170form_data_content_type('application/x-www-form-urlencoded') :- !.
171form_data_content_type(ContentType) :-
172 sub_atom(ContentType, 0, _, _, 'application/x-www-form-urlencoded;').
173
178
179posted_form(Request, _Data) :-
180 nb_current(http_post_data, read),
181 !,
182 option(request_uri(URI), Request),
183 throw(error(permission_error('re-read', 'POST data', URI),
184 context(_, 'Attempt to re-read POST data'))).
185posted_form(Request, Data) :-
186 http_read_data(Request, Data, []),
187 nb_setval(http_post_data, read),
188 debug(post, 'POST Data: ~p', [Data]).
189
190wipe_posted_data :-
191 debug(post, 'Wiping posted data', []),
192 nb_delete(http_post_data).
193
194:- listen(http(request_finished(_Id, _Code, _Status, _CPU, _Bytes)),
195 wipe_posted_data). 196
197
201
202:- meta_predicate fill_parameters(+, +, 2). 203
204fill_parameters([], _, _).
205fill_parameters([H|T], FormData, DeclGoal) :-
206 fill_parameter(H, FormData, DeclGoal),
207 fill_parameters(T, FormData, DeclGoal).
208
209fill_parameter(H, _, _) :-
210 var(H),
211 !,
212 instantiation_error(H).
213fill_parameter(group(Members, _Options), FormData, DeclGoal) :-
214 is_list(Members),
215 !,
216 fill_parameters(Members, FormData, DeclGoal).
217fill_parameter(H, FormData, _) :-
218 H =.. [Name,Value,Options],
219 !,
220 fill_param(Name, Value, Options, FormData).
221fill_parameter(H, FormData, DeclGoal) :-
222 H =.. [Name,Value],
223 ( DeclGoal \== (-),
224 call(DeclGoal, Name, Options)
225 -> true
226 ; throw(error(existence_error(attribute_declaration, Name), _))
227 ),
228 fill_param(Name, Value, Options, FormData).
229
230fill_param(Name, Values, Options, FormData) :-
231 memberchk(zero_or_more, Options),
232 !,
233 fill_param_list(FormData, Name, Values, Options).
234fill_param(Name, Values, Options, FormData) :-
235 memberchk(list(Type), Options),
236 !,
237 fill_param_list(FormData, Name, Values, [Type|Options]).
238fill_param(Name, Value, Options, FormData) :-
239 ( memberchk(Name=Value0, FormData),
240 Value0 \== '' 241 -> http_convert_parameter(Options, Name, Value0, Value)
242 ; memberchk(default(Value), Options)
243 -> true
244 ; memberchk(optional(true), Options)
245 -> true
246 ; throw(error(existence_error(http_parameter, Name), _))
247 ).
248
249
250fill_param_list([], _, [], _).
251fill_param_list([Name=Value0|Form], Name, [Value|VT], Options) :-
252 !,
253 http_convert_parameter(Options, Name, Value0, Value),
254 fill_param_list(Form, Name, VT, Options).
255fill_param_list([_|Form], Name, VT, Options) :-
256 fill_param_list(Form, Name, VT, Options).
257
258
271
272http_convert_parameters(Data, ParamDecls) :-
273 fill_parameters(ParamDecls, Data, no_decl_goal).
274http_convert_parameters(Data, ParamDecls, DeclGoal) :-
275 fill_parameters(ParamDecls, Data, DeclGoal).
276
277no_decl_goal(_,_) :- fail.
278
289
290http_convert_parameter([], _, Value, Value).
291http_convert_parameter([H|T], Field, Value0, Value) :-
292 ( check_type_no_error(H, Value0, Value1)
293 -> catch(http_convert_parameter(T, Field, Value1, Value),
294 error(Formal, _),
295 throw(error(Formal, context(_, http_parameter(Field)))))
296 ; throw(error(type_error(H, Value0),
297 context(_, http_parameter(Field))))
298 ).
299
300check_type_no_error(Type, In, Out) :-
301 http:convert_parameter(Type, In, Out),
302 !.
303check_type_no_error(Type, In, Out) :-
304 check_type3(Type, In, Out).
305
309
310check_type3((T1;T2), In, Out) :-
311 !,
312 ( check_type_no_error(T1, In, Out)
313 -> true
314 ; check_type_no_error(T2, In, Out)
315 ).
316check_type3(string, Atom, String) :-
317 !,
318 to_string(Atom, String).
319check_type3(number, Atom, Number) :-
320 !,
321 to_number(Atom, Number).
322check_type3(integer, Atom, Integer) :-
323 !,
324 to_number(Atom, Integer),
325 integer(Integer).
326check_type3(nonneg, Atom, Integer) :-
327 !,
328 to_number(Atom, Integer),
329 integer(Integer),
330 Integer >= 0.
331check_type3(float, Atom, Float) :-
332 !,
333 to_number(Atom, Number),
334 Float is float(Number).
335check_type3(between(Low, High), Atom, Value) :-
336 !,
337 to_number(Atom, Number),
338 ( (float(Low) ; float(High))
339 -> Value is float(Number)
340 ; Value = Number
341 ),
342 is_of_type(between(Low, High), Value).
343check_type3(boolean, Atom, Bool) :-
344 !,
345 truth(Atom, Bool).
346check_type3(Type, Atom, Atom) :-
347 check_type2(Type, Atom).
348
349to_number(In, Number) :-
350 number(In), !, Number = In.
351to_number(In, Number) :-
352 atom(In),
353 atom_number(In, Number).
354
355to_string(In, String) :- string(In), !, String = In.
356to_string(In, String) :- atom(In), !, atom_string(In, String).
357to_string(In, String) :- number(In), !, number_string(In, String).
358
362
363check_type2(oneof(Set), Value) :-
364 !,
365 memberchk(Value, Set).
366check_type2(length > N, Value) :-
367 !,
368 atom_length(Value, Len),
369 Len > N.
370check_type2(length >= N, Value) :-
371 !,
372 atom_length(Value, Len),
373 Len >= N.
374check_type2(length < N, Value) :-
375 !,
376 atom_length(Value, Len),
377 Len < N.
378check_type2(length =< N, Value) :-
379 !,
380 atom_length(Value, Len),
381 Len =< N.
382check_type2(_, _).
383
388
389truth(true, true).
390truth('TRUE', true).
391truth(yes, true).
392truth('YES', true).
393truth(on, true).
394truth('ON', true). 395truth('1', true).
396
397truth(false, false).
398truth('FALSE', false).
399truth(no, false).
400truth('NO', false).
401truth(off, false).
402truth('OFF', false).
403truth('0', false).
404
405
406 409
410:- multifile
411 prolog:called_by/2,
412 emacs_prolog_colours:goal_colours/2. 413
414prolog:called_by(http_parameters(_,_,Options), [G+2]) :-
415 option(attribute_declarations(G), Options, _),
416 callable(G),
417 !.
418
419emacs_prolog_colours:goal_colours(http_parameters(_,_,Options),
420 built_in-[classify, classify, Colours]) :-
421 option_list_colours(Options, Colours).
422
423option_list_colours(Var, error) :-
424 var(Var),
425 !.
426option_list_colours([], classify) :- !.
427option_list_colours(Term, list-Elements) :-
428 Term = [_|_],
429 !,
430 option_list_colours_2(Term, Elements).
431option_list_colours(_, error).
432
433option_list_colours_2(Var, classify) :-
434 var(Var).
435option_list_colours_2([], []).
436option_list_colours_2([H0|T0], [H|T]) :-
437 option_colours(H0, H),
438 option_list_colours_2(T0, T).
439
440option_colours(Var, classify) :-
441 var(Var),
442 !.
443option_colours(_=_, built_in-[classify,classify]) :- !.
444option_colours(attribute_declarations(_), 445 option(attribute_declarations)-[dcg]) :- !.
446option_colours(Term, option(Name)-[classify]) :-
447 compound(Term),
448 Term =.. [Name,_Value],
449 !.
450option_colours(_, error).
451
452 455
456:- multifile prolog:error_message//1. 457:- multifile prolog:message//1. 458
459prolog:error_message(existence_error(http_parameter, Name)) -->
460 [ 'Missing value for parameter "~w".'-[Name] ].
461prolog:message(error(type_error(Type, Term), context(_, http_parameter(Param)))) -->
462 { atom(Param) },
463 [ 'Parameter "~w" must be '-[Param] ],
464 param_type(Type),
465 ['. Found "~w".'-[Term] ].
466
467param_type(length>N) -->
468 !,
469 ['longer than ~D characters'-[N]].
470param_type(length>=N) -->
471 !,
472 ['at least ~D characters'-[N]].
473param_type(length<N) -->
474 !,
475 ['shorter than ~D characters'-[N]].
476param_type(length=<N) -->
477 !,
478 ['at most ~D characters'-[N]].
479param_type(between(Low,High)) -->
480 !,
481 ( {float(Low);float(High)}
482 -> ['a number between ~w and ~w'-[Low,High]]
483 ; ['an integer between ~w and ~w'-[Low,High]]
484 ).
485param_type(oneof([Only])) -->
486 !,
487 ['"~w"'-[Only]].
488param_type(oneof(List)) -->
489 !,
490 ['one of '-[]], oneof(List).
491param_type(T) -->
492 ['of type ~p'-[T]].
493
494
495oneof([]) --> [].
496oneof([H|T]) -->
497 ['"~w"'-[H]],
498 ( {T == []}
499 -> []
500 ; {T = [Last]}
501 -> [' or "~w"'-[Last] ]
502 ; [', '-[]],
503 oneof(T)
504 )