comparison cpack/dml/lib/webby.pl @ 0:718306e29690 tip

commiting public release
author Daniel Wolff
date Tue, 09 Feb 2016 21:05:06 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:718306e29690
1 /* Part of DML (Digital Music Laboratory)
2 Copyright 2014-2015 Samer Abdallah, University of London
3
4 This program is free software; you can redistribute it and/or
5 modify it under the terms of the GNU General Public License
6 as published by the Free Software Foundation; either version 2
7 of the License, or (at your option) any later version.
8
9 This program is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 GNU General Public License for more details.
13
14 You should have received a copy of the GNU General Public
15 License along with this library; if not, write to the Free Software
16 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
17 */
18
19 :- module(webby,
20 [ webcall/3
21 , restcall/4
22 , parts_path/2
23 , http_status/2
24 ]).
25 /** <module> Web API tools
26
27 ---+++ Types
28 ==
29 web_reader ---> json(-D:dict)
30 ; nil.
31
32 web_method ---> get(+Params:list(param))
33 ; post(+D:post_data)
34 ; put(+D:post_data)
35 ; delete(+D:post_data)
36 .
37
38 post_data ---> form(list(param))
39 ; json(dict)
40 .
41
42 param ---> atom=_.
43 ==
44 */
45
46 :- multifile read_reply/2.
47
48 :- use_module(library(http/http_open)).
49 :- use_module(library(http/http_header)).
50 :- use_module(library(http/json)).
51
52 parts_path(Parts,Path) :-
53 atomics_to_string([''|Parts],"/",Path).
54
55 %% webcall(+URL:url_spec, +Opt:options, +R:web_reader) is det.
56 webcall(URL,Opts,Reader) :-
57 debug(webby,"HTTP connecting to ~w, ~w",[URL,Opts]),
58 setup_call_cleanup(
59 http_open(URL,In,[status_code(SC)|Opts]),
60 ( set_stream(In,encoding(utf8)), % !
61 ( between(200,299,SC) -> read_reply(Reader,In)
62 ; read_stream_to_codes(In,ErrorDoc),
63 throw(http_bad_status(SC,codes(ErrorDoc))))),
64 close(In)).
65
66 read_reply(json(Dict),In) :- json_read_dict(In,Dict).
67 read_reply(nil,_).
68
69 %% post_data(+D:post_data,-D2:post_data) is det.
70 post_data(json(Dict),codes('application/json',Codes)) :- !, atom_json_dict(Codes,Dict,[as(codes)]).
71 post_data(Data,Data).
72
73 %% restcall(+M:web_method, +R:web_reader, +URL:url_spec, +Opts:options) is det.
74 restcall(get(Params), Rdr, URL, Opts) :- webcall([search(Params)|URL], Opts, Rdr).
75 restcall(post(D), Rdr, URL, Opts) :- post_data(D,Data), webcall(URL, [method(post),post(Data)|Opts], Rdr).
76 restcall(delete(D), Rdr, URL, Opts) :- post_data(D,Data), webcall(URL, [method(delete),post(Data)|Opts], Rdr).
77 restcall(put(D), Rdr, URL, Opts) :- post_data(D,Data), webcall(URL, [method(put),post(Data)|Opts], Rdr).
78
79 status_meaning(200,"OK").
80 status_meaning(201,"Created").
81 status_meaning(204,"No content").
82 status_meaning(304,"Not modified").
83 status_meaning(400,"Bad request").
84 status_meaning(401,"Unauthorised").
85 status_meaning(403,"Forbidden").
86 status_meaning(404,"Not found").
87 status_meaning(405,"Method not allowed").
88 status_meaning(429,"Too many requests").
89 status_meaning(500,"Internal server error").
90 status_meaning(502,"Bad gateway").
91 status_meaning(503,"Service unavailable").
92
93 http_status(Code,Meaning) :- status_meaning(Code,Meaning), !.
94 http_status(_,"<Unrecognised status>").
95
96 prolog:message(http_bad_status(SC,codes(Doc))) -->
97 {http_status(SC,Meaning)},
98 ["HTTP call returned status ~w (~w)."-[SC,Meaning]],
99 ["Reply document was |~s|"-[Doc]].