1:- module(pl_omdb, [
    2	 omdb_fetch/3,
    3	 omdb_fetch/2,
    4	 omdb_search/3,
    5	 omdb_search/2,
    6	 omdb_search_results/4,
    7	 omdb_search_results/3,
    8	 omdb_fetch_dict/3,
    9	 omdb_fetch_dict/2,
   10	 omdb_search_dict/3,
   11	 omdb_search_dict/2
   12]).   13
   14:- use_module(library(lists), [member/2]).   15:- use_module(library(http/http_open)).   16:- use_module(library(http/json)).   17:- use_module(omdb_query).   18
   19:- create_prolog_flag(omdb_api_key, '', [type(atom)]).

pl_omdb API

This module implements a convenience layer over the OMDB API located at: http://www.omdbapi.com

The author of this convenience layer module is not the author of the main API nor affiliated with the official API/website itself.

author
- Ebrahim Azarisooreh
license
- MIT */
   33omdb_api('http://www.omdbapi.com/?~a&r=json').
   34omdb_poster_api('http://img.omdbapi.com/?~a&apikey=~a&').
 omdb_fetch(+ApiKey, ?KVPair, +Options) is nondet
True if Options is a supplied list of API parameters that fetches a valid result from the OMDB API that corresponds to a set of Key=Value pairs represented by KVPair.
   42omdb_fetch(ApiKey, Key=Value, Options) :-
   43	omdb_call(retrieval, ApiKey, Dict, Options),
   44	Value = Dict.Key.
 omdb_search(+ApiKey, ?KVPair, +Options) is nondet
True if Options is a supplied list of API paremters that fetches a valid OMDB object which contains the number of search results and a list of OMDB dictionaries which each represents a search result. Both the list of search results and the number of results are part of KVPair (Key=Value).
   52omdb_search(ApiKey, Key=Value, Options) :-
   53	omdb_call(search, ApiKey, Dict, Options),
   54	Value = Dict.Key.
 omdb_search_results(+ApiKey, ?KVPair, +Options, ?NumResults) is nondet
Like omdb_search/3, except all the Key=Value pairs are iterated through automatically without needed to do any further unwrapping. NumResults is the number of search results found by the search query.
   61omdb_search_results(ApiKey, Key=Value, Options, NumResults) :-
   62	omdb_search_dict(ApiKey, Dict, Options),
   63	NumResults = Dict.'totalResults',
   64	SearchResults = Dict.'Search',
   65	member(OneResult, SearchResults),
   66	Value = OneResult.Key.
 omdb_fetch_dict(+ApiKey, -Dict, +Options) is det
Like omdb_fetch/3, except the Dict unifies directly with the dictionary object rather than backtracking over individual Key=Value pairs.
   72omdb_fetch_dict(ApiKey, Dict, Options) :-
   73	omdb_call(retrieval, ApiKey, Dict, Options).
 omdb_search_dict(+ApiKey, -Dict, +Options) is det
Like omdb_fetch_dict/3 but for search queries.
   78omdb_search_dict(ApiKey, Dict, Options) :-
   79	omdb_call(search, ApiKey, Dict, Options).
 omdb_fetch(?KVPair, +Options) is nondet
As with omdb_fetch/3, but using the user supplied prolog_flag omdb_api_key instead.
   85omdb_fetch(Key=Value, Options) :-
   86	omdb_call(retrieval, Dict, Options),
   87	Value = Dict.Key.
 omdb_search(?KVPair, +Options) is nondet
As with omdb_search/3, but using the user supplied prolog_flag omdb_api_key instead.
   93omdb_search(Key=Value, Options) :-
   94	omdb_call(search, Dict, Options),
   95	Value = Dict.Key.
 omdb_search_results(?KVPair, +Options, ?NumResults) is nondet
As with omdb_search_results/4, but using the user supplied prolog_flag omdb_api_key instead.
  101omdb_search_results(Key=Value, Options, NumResults) :-
  102	omdb_search_dict(Dict, Options),
  103	NumResults = Dict.'totalResults',
  104	SearchResults = Dict.'Search',
  105	member(OneResult, SearchResults),
  106	Value = OneResult.Key.
 omdb_fetch_dict(-Dict, +Options) is det
As with omdb_fetch_dict/3, but using the user supplied prolog_flag omdb_api_key instead.
  112omdb_fetch_dict(Dict, Options) :-
  113	omdb_call(retrieval, Dict, Options).
 omdb_search_dict(+ApiKey, -Dict, +Options) is det
As with omdb_search_dict/3, but using the user supplied prolog_flag omdb_api_key instead.
  119omdb_search_dict(Dict, Options) :-
  120	omdb_call(search, Dict, Options).
  121
  122
  123%--------------------------------------------------------------------------------%
  124% Internal Predicates
  125%--------------------------------------------------------------------------------%
  126
  127
  128omdb_call(retrieval, ApiKey, Dict, Options) :-
  129	retrieval_query(Options, Template),
  130	make_connection(ApiKey, Template, Dict).
  131
  132omdb_call(search, ApiKey, Dict, Options) :-
  133	search_query(Options, Template),
  134	make_connection(ApiKey, Template, Dict).
  135
  136omdb_call(retrieval, Dict, Options) :-
  137	retrieval_query(Options, Template),
  138	current_prolog_flag(omdb_api_key, ApiKey),
  139	make_connection(ApiKey, Template, Dict).
  140
  141omdb_call(search, Dict, Options) :-
  142	retrieval_query(Options, Template),
  143	current_prolog_flag(omdb_api_key, ApiKey),
  144	make_connection(ApiKey, Template, Dict).
  145
  146make_connection(ApiKey, Template, Dict) :-
  147	omdb_api(API),
  148	format(atom(Request0), API, [Template]),
  149	format(atom(Request), '~a&apikey=~a', [Request0, ApiKey]),
  150	omdb_connect(Request, Dict).
  151
  152omdb_connect(Request, Dict) :-
  153	setup_call_cleanup(
  154		(	http_open(Request, Stream, [timeout(20)]),
  155	   		set_stream(Stream, encoding(utf8))
  156		),
  157		json_read_dict(Stream, Dict),
  158		close(Stream)
  159	).
  160
  161:- begin_tests(pl_omdb).  162
  163:- use_module(library(aggregate), [aggregate_all/3]).  164
  165get_key :-
  166	file_search_path(library, Path0),
  167	atomic(Path0),
  168	atom_concat(_, 'pl_omdb/prolog', Path0),
  169	!,
  170	atom_concat(Path0, '/test_files/key.txt', Path),
  171	read_file_to_string(Path, KeyLine, []),
  172	atom_concat(Key, '\n', KeyLine),
  173	set_prolog_flag(omdb_api_key, Key).
  174
  175:- get_key.  176
  177test(fetch_one_value) :-
  178	current_prolog_flag(omdb_api_key, Key),
  179	aggregate_all(
  180		count,
  181		omdb_fetch(Key, 'Released'=_Value, [title='Casino Royale',year='2006']),
  182		1
  183	).
  184
  185test(throw_error) :-
  186	current_prolog_flag(omdb_api_key, Key),
  187	catch(
  188		omdb_fetch(Key, 'Released'=_Value, [title='Casino Royale',year='200346']),
  189		Error,
  190		Error=error(
  191			existence_error(
  192				key,
  193				'Released',
  194				_{'Error':"Movie not found!", 'Response':"False"}
  195				),
  196				_
  197		)
  198	).
  199
  200test(search_title) :-
  201	current_prolog_flag(omdbi_api_key, Key),
  202	aggregate_all(
  203		count,
  204		omdb_search_results(
  205			Key,
  206			'Title'=_Value,
  207			[title='The Road to Casino Royale'],
  208			_NumResults
  209		),
  210		1
  211	).
  212
  213:- end_tests(pl_omdb).