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]].