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:- predicate_options(http_parameters/3, 3,
53 [ form_data(-list),
54 attribute_declarations(callable)
55 ]). 56
78
79:- meta_predicate
80 http_parameters(+, ?, :),
81 http_convert_parameters(+, ?, 2). 82
116
117http_parameters(Request, Params) :-
118 http_parameters(Request, Params, []).
119
120http_parameters(Request, Params, Options) :-
121 must_be(list, Params),
122 meta_options(is_meta, Options, QOptions),
123 option(attribute_declarations(DeclGoal), QOptions, -),
124 http_parms(Request, Params, DeclGoal, Form),
125 ( memberchk(form_data(RForm), QOptions)
126 -> RForm = Form
127 ; true
128 ).
129
130is_meta(attribute_declarations).
131
132
133http_parms(Request, Params, DeclGoal, Data) :-
134 memberchk(method(post), Request),
135 memberchk(content_type(Content), Request),
136 form_data_content_type(Content),
137 !,
138 debug(post_request, 'POST Request: ~p', [Request]),
139 posted_form(Request, Data),
140 fill_parameters(Params, Data, DeclGoal).
141http_parms(Request, Params, DeclGoal, Search) :-
142 ( memberchk(search(Search), Request)
143 -> true
144 ; Search = []
145 ),
146 fill_parameters(Params, Search, DeclGoal).
147
148:- multifile
149 form_data_content_type/1. 150
151form_data_content_type('application/x-www-form-urlencoded') :- !.
152form_data_content_type(ContentType) :-
153 sub_atom(ContentType, 0, _, _, 'application/x-www-form-urlencoded;').
154
159
160posted_form(Request, _Data) :-
161 nb_current(http_post_data, read),
162 !,
163 option(request_uri(URI), Request),
164 throw(error(permission_error('re-read', 'POST data', URI),
165 context(_, 'Attempt to re-read POST data'))).
166posted_form(Request, Data) :-
167 http_read_data(Request, Data, []),
168 nb_setval(http_post_data, read),
169 debug(post, 'POST Data: ~p', [Data]).
170
171wipe_posted_data :-
172 debug(post, 'Wiping posted data', []),
173 nb_delete(http_post_data).
174
175:- listen(http(request_finished(_Id, _Code, _Status, _CPU, _Bytes)),
176 wipe_posted_data). 177
178
182
183fill_parameters([], _, _).
184fill_parameters([H|T], FormData, DeclGoal) :-
185 fill_parameter(H, FormData, DeclGoal),
186 fill_parameters(T, FormData, DeclGoal).
187
188fill_parameter(H, _, _) :-
189 var(H),
190 !,
191 instantiation_error(H).
192fill_parameter(group(Members, _Options), FormData, DeclGoal) :-
193 is_list(Members),
194 !,
195 fill_parameters(Members, FormData, DeclGoal).
196fill_parameter(H, FormData, _) :-
197 H =.. [Name,Value,Options],
198 !,
199 fill_param(Name, Value, Options, FormData).
200fill_parameter(H, FormData, DeclGoal) :-
201 H =.. [Name,Value],
202 ( DeclGoal \== (-),
203 call(DeclGoal, Name, Options)
204 -> true
205 ; throw(error(existence_error(attribute_declaration, Name), _))
206 ),
207 fill_param(Name, Value, Options, FormData).
208
209fill_param(Name, Values, Options, FormData) :-
210 memberchk(zero_or_more, Options),
211 !,
212 fill_param_list(FormData, Name, Values, Options).
213fill_param(Name, Values, Options, FormData) :-
214 memberchk(list(Type), Options),
215 !,
216 fill_param_list(FormData, Name, Values, [Type|Options]).
217fill_param(Name, Value, Options, FormData) :-
218 ( memberchk(Name=Value0, FormData),
219 Value0 \== '' 220 -> http_convert_parameter(Options, Name, Value0, Value)
221 ; memberchk(default(Value), Options)
222 -> true
223 ; memberchk(optional(true), Options)
224 -> true
225 ; throw(error(existence_error(http_parameter, Name), _))
226 ).
227
228
229fill_param_list([], _, [], _).
230fill_param_list([Name=Value0|Form], Name, [Value|VT], Options) :-
231 !,
232 http_convert_parameter(Options, Name, Value0, Value),
233 fill_param_list(Form, Name, VT, Options).
234fill_param_list([_|Form], Name, VT, Options) :-
235 fill_param_list(Form, Name, VT, Options).
236
237
250
251http_convert_parameters(Data, ParamDecls) :-
252 fill_parameters(ParamDecls, Data, -).
253http_convert_parameters(Data, ParamDecls, DeclGoal) :-
254 fill_parameters(ParamDecls, Data, DeclGoal).
255
266
267http_convert_parameter([], _, Value, Value).
268http_convert_parameter([H|T], Field, Value0, Value) :-
269 ( check_type_no_error(H, Value0, Value1)
270 -> http_convert_parameter(T, Field, Value1, Value)
271 ; throw(error(type_error(H, Value0),
272 context(_, http_parameter(Field))))
273 ).
274
275check_type_no_error(Type, In, Out) :-
276 http:convert_parameter(Type, In, Out),
277 !.
278check_type_no_error(Type, In, Out) :-
279 check_type3(Type, In, Out).
280
284
285check_type3((T1;T2), In, Out) :-
286 !,
287 ( check_type_no_error(T1, In, Out)
288 -> true
289 ; check_type_no_error(T2, In, Out)
290 ).
291check_type3(string, Atom, String) :-
292 !,
293 to_string(Atom, String).
294check_type3(number, Atom, Number) :-
295 !,
296 to_number(Atom, Number).
297check_type3(integer, Atom, Integer) :-
298 !,
299 to_number(Atom, Integer),
300 integer(Integer).
301check_type3(nonneg, Atom, Integer) :-
302 !,
303 to_number(Atom, Integer),
304 integer(Integer),
305 Integer >= 0.
306check_type3(float, Atom, Float) :-
307 !,
308 to_number(Atom, Number),
309 Float is float(Number).
310check_type3(between(Low, High), Atom, Value) :-
311 !,
312 to_number(Atom, Number),
313 ( (float(Low) ; float(High))
314 -> Value is float(Number)
315 ; Value = Number
316 ),
317 is_of_type(between(Low, High), Value).
318check_type3(boolean, Atom, Bool) :-
319 !,
320 truth(Atom, Bool).
321check_type3(Type, Atom, Atom) :-
322 check_type2(Type, Atom).
323
324to_number(In, Number) :-
325 number(In), !, Number = In.
326to_number(In, Number) :-
327 atom(In),
328 atom_number(In, Number).
329
330to_string(In, String) :- string(In), !, String = In.
331to_string(In, String) :- atom(In), !, atom_string(In, String).
332to_string(In, String) :- number(In), !, number_string(In, String).
333
337
338check_type2(oneof(Set), Value) :-
339 !,
340 memberchk(Value, Set).
341check_type2(length > N, Value) :-
342 !,
343 atom_length(Value, Len),
344 Len > N.
345check_type2(length >= N, Value) :-
346 !,
347 atom_length(Value, Len),
348 Len >= N.
349check_type2(length < N, Value) :-
350 !,
351 atom_length(Value, Len),
352 Len < N.
353check_type2(length =< N, Value) :-
354 !,
355 atom_length(Value, Len),
356 Len =< N.
357check_type2(_, _).
358
363
364truth(true, true).
365truth('TRUE', true).
366truth(yes, true).
367truth('YES', true).
368truth(on, true).
369truth('ON', true). 370truth('1', true).
371
372truth(false, false).
373truth('FALSE', false).
374truth(no, false).
375truth('NO', false).
376truth(off, false).
377truth('OFF', false).
378truth('0', false).
379
380
381 384
385:- multifile
386 prolog:called_by/2,
387 emacs_prolog_colours:goal_colours/2. 388
389prolog:called_by(http_parameters(_,_,Options), [G+2]) :-
390 option(attribute_declarations(G), Options, _),
391 callable(G),
392 !.
393
394emacs_prolog_colours:goal_colours(http_parameters(_,_,Options),
395 built_in-[classify, classify, Colours]) :-
396 option_list_colours(Options, Colours).
397
398option_list_colours(Var, error) :-
399 var(Var),
400 !.
401option_list_colours([], classify) :- !.
402option_list_colours(Term, list-Elements) :-
403 Term = [_|_],
404 !,
405 option_list_colours_2(Term, Elements).
406option_list_colours(_, error).
407
408option_list_colours_2(Var, classify) :-
409 var(Var).
410option_list_colours_2([], []).
411option_list_colours_2([H0|T0], [H|T]) :-
412 option_colours(H0, H),
413 option_list_colours_2(T0, T).
414
415option_colours(Var, classify) :-
416 var(Var),
417 !.
418option_colours(_=_, built_in-[classify,classify]) :- !.
419option_colours(attribute_declarations(_), 420 option(attribute_declarations)-[dcg]) :- !.
421option_colours(Term, option(Name)-[classify]) :-
422 compound(Term),
423 Term =.. [Name,_Value],
424 !.
425option_colours(_, error).
426
427 430
431:- multifile prolog:error_message//1. 432:- multifile prolog:message//1. 433
434prolog:error_message(existence_error(http_parameter, Name)) -->
435 [ 'Missing value for parameter "~w".'-[Name] ].
436prolog:message(error(type_error(Type, Term), context(_, http_parameter(Param)))) -->
437 { atom(Param) },
438 [ 'Parameter "~w" must be '-[Param] ],
439 param_type(Type),
440 ['. Found "~w".'-[Term] ].
441
442param_type(length>N) -->
443 !,
444 ['longer than ~D characters'-[N]].
445param_type(length>=N) -->
446 !,
447 ['at least ~D characters'-[N]].
448param_type(length<N) -->
449 !,
450 ['shorter than ~D characters'-[N]].
451param_type(length=<N) -->
452 !,
453 ['at most ~D characters'-[N]].
454param_type(between(Low,High)) -->
455 !,
456 ( {float(Low);float(High)}
457 -> ['a number between ~w and ~w'-[Low,High]]
458 ; ['an integer between ~w and ~w'-[Low,High]]
459 ).
460param_type(oneof([Only])) -->
461 !,
462 ['"~w"'-[Only]].
463param_type(oneof(List)) -->
464 !,
465 ['one of '-[]], oneof(List).
466param_type(T) -->
467 ['of type ~p'-[T]].
468
469
470oneof([]) --> [].
471oneof([H|T]) -->
472 ['"~w"'-[H]],
473 ( {T == []}
474 -> []
475 ; {T = [Last]}
476 -> [' or "~w"'-[Last] ]
477 ; [', '-[]],
478 oneof(T)
479 )