Mercurial > hg > dml-open-cliopatria
diff 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 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/cpack/dml/lib/webby.pl Tue Feb 09 21:05:06 2016 +0100 @@ -0,0 +1,99 @@ +/* Part of DML (Digital Music Laboratory) + Copyright 2014-2015 Samer Abdallah, University of London + + 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 2 + 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 library; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +*/ + +:- module(webby, + [ webcall/3 + , restcall/4 + , parts_path/2 + , http_status/2 + ]). +/** <module> Web API tools + +---+++ Types +== +web_reader ---> json(-D:dict) + ; nil. + +web_method ---> get(+Params:list(param)) + ; post(+D:post_data) + ; put(+D:post_data) + ; delete(+D:post_data) + . + +post_data ---> form(list(param)) + ; json(dict) + . + +param ---> atom=_. +== +*/ + +:- multifile read_reply/2. + +:- use_module(library(http/http_open)). +:- use_module(library(http/http_header)). +:- use_module(library(http/json)). + +parts_path(Parts,Path) :- + atomics_to_string([''|Parts],"/",Path). + +%% webcall(+URL:url_spec, +Opt:options, +R:web_reader) is det. +webcall(URL,Opts,Reader) :- + debug(webby,"HTTP connecting to ~w, ~w",[URL,Opts]), + setup_call_cleanup( + http_open(URL,In,[status_code(SC)|Opts]), + ( set_stream(In,encoding(utf8)), % ! + ( between(200,299,SC) -> read_reply(Reader,In) + ; read_stream_to_codes(In,ErrorDoc), + throw(http_bad_status(SC,codes(ErrorDoc))))), + close(In)). + +read_reply(json(Dict),In) :- json_read_dict(In,Dict). +read_reply(nil,_). + +%% post_data(+D:post_data,-D2:post_data) is det. +post_data(json(Dict),codes('application/json',Codes)) :- !, atom_json_dict(Codes,Dict,[as(codes)]). +post_data(Data,Data). + +%% restcall(+M:web_method, +R:web_reader, +URL:url_spec, +Opts:options) is det. +restcall(get(Params), Rdr, URL, Opts) :- webcall([search(Params)|URL], Opts, Rdr). +restcall(post(D), Rdr, URL, Opts) :- post_data(D,Data), webcall(URL, [method(post),post(Data)|Opts], Rdr). +restcall(delete(D), Rdr, URL, Opts) :- post_data(D,Data), webcall(URL, [method(delete),post(Data)|Opts], Rdr). +restcall(put(D), Rdr, URL, Opts) :- post_data(D,Data), webcall(URL, [method(put),post(Data)|Opts], Rdr). + +status_meaning(200,"OK"). +status_meaning(201,"Created"). +status_meaning(204,"No content"). +status_meaning(304,"Not modified"). +status_meaning(400,"Bad request"). +status_meaning(401,"Unauthorised"). +status_meaning(403,"Forbidden"). +status_meaning(404,"Not found"). +status_meaning(405,"Method not allowed"). +status_meaning(429,"Too many requests"). +status_meaning(500,"Internal server error"). +status_meaning(502,"Bad gateway"). +status_meaning(503,"Service unavailable"). + +http_status(Code,Meaning) :- status_meaning(Code,Meaning), !. +http_status(_,"<Unrecognised status>"). + +prolog:message(http_bad_status(SC,codes(Doc))) --> + {http_status(SC,Meaning)}, + ["HTTP call returned status ~w (~w)."-[SC,Meaning]], + ["Reply document was |~s|"-[Doc]].