1:- module(
    2  uri_ext,
    3  [
    4    append_segments/3,     % +Segments1, +Segments2, ?Segments3
    5    uri_comp_get/3,        % +Kind, +Uri, ?Compound
    6    uri_comp_set/4,        % +Kind, +Uri1, +Component, -Uri2
    7    uri_comps/2,           % ?Uri, ?Components
    8    uri_data_directory/2,  % +Uri, -Directory
    9    uri_data_file/3,       % +Uri, +Local, -File
   10    uri_file_extensions/2, % +Uri, -Extensions
   11    uri_file_is_fresh/2,   % +Uri, +File
   12    uri_local_name/2,      % +Uri, -Local
   13    uri_media_type/2,      % +Uri, -MediaType
   14    uri_relative_path/3,   % +Uri, +Local, -RelativePath
   15    uri_scheme/2,          % +Uri, ?Scheme
   16    uri_strip/2            % +Uri, -Base
   17  ]
   18).   19:- reexport(library(uri)).

   27:- use_module(library(apply)).   28:- use_module(library(lists)).   29:- use_module(library(plunit)).   30
   31:- use_module(library(conf)).   32:- use_module(library(dict)).   33:- use_module(library(file_ext)).   34:- use_module(library(http_client2)).

 append_segments(+Segments1:list(atom), +Segments2:list(atom), +Segments3:list(atom)) is semidet

append_segments(+Segments1:list(atom), +Segments2:list(atom), -Segments3:list(atom)) is det

Appends lists of path segments. Empty segments commonly appear at the beginning and end of URI paths.

   44append_segments(L1a, L2a, L3) :-
   45  exclude([X0]>>(X0==''), L1a, L1b),
   46  exclude([X0]>>(X0==''), L2a, L2b),
   47  append(L1b, L2b, L3).
   48
   49:- begin_tests(append_segments).   50
   51test('append_segments(+,+,+)', [forall(test_append_segments(L1,L2,L3))]) :-
   52  append_segments(L1, L2, L3).
   53test('append_segments(+,+,+)', [forall(test_append_segments(L1,L2,L3))]) :-
   54  append_segments(L1, L2, L3_),
   55  assertion(L3_ == L3).
   56
   57test_append_segments(['',a,b,c,''], [''], [a,b,c]).
   58
   59:- end_tests(append_segments).

 uri_comp_get(+Kind:oneof([authority,fragment,host,password,path,port,query,scheme,user]), +Uri:uri, +Component:term) is semidet

uri_comp_get(+Kind:oneof([authority,fragment,host,password,path,port,query,scheme,user]), +Uri:uri, -Component:term) is det

   70uri_comp_get(authority, Uri, Authority) :- !,
   71  uri_comps(Uri, uri(_,Authority,_,_,_)).
   72uri_comp_get(fragment, Uri, Fragment) :- !,
   73  uri_comps(Uri, uri(_,_,_,_,Fragment)).
   74uri_comp_get(host, Uri, Host) :- !,
   75  uri_comps(Uri, uri(_,auth(_,_,Host,_),_,_,_)).
   76uri_comp_get(password, Uri, Password) :- !,
   77  uri_comps(Uri, uri(_,auth(_,Password,_,_),_,_,_)).
   78uri_comp_get(path, Uri, Segments) :- !,
   79  uri_comps(Uri, uri(_,_,Segments,_,_)).
   80uri_comp_get(port, Uri, Port) :- !,
   81  uri_comps(Uri, uri(_,auth(_,_,_,Port),_,_,_)).
   82uri_comp_get(query, Uri, Query) :- !,
   83  uri_comps(Uri, uri(_,_,_,Query,_)).
   84uri_comp_get(scheme, Uri, Scheme) :- !,
   85  uri_comps(Uri, uri(Scheme,_,_,_,_)).
   86uri_comp_get(user, Uri, User) :- !,
   87  uri_comps(Uri, uri(_,auth(User,_,_,_),_,_,_)).

 uri_comp_set(+Kind:oneof([fragment,query]), +Uri1, +Component, -Uri2) is det

Change a specific URI component.

   95uri_comp_set(fragment, Uri1, Fragment, Uri2) :-
   96  uri_components(Uri1, uri_components(Scheme,Authority,Path,Query,_)),
   97  uri_components(Uri2, uri_components(Scheme,Authority,Path,Query,Fragment)).
   98uri_comp_set(query, Uri1, QueryComponents, Uri2) :-
   99  uri_components(Uri1, uri_components(Scheme,Authority,Path,_,Fragment)),
  100  uri_query_components(Query, QueryComponents),
  101  uri_components(Uri2, uri_components(Scheme,Authority,Path,Query,Fragment)).

 uri_comps(+Uri, -Components) is det

uri_comps(-Uri, +Components) is det

Components is a compound term of the form `uri(Scheme,Authority,Segments,Query,Fragment)', where:

• Authority is either an atom or a compound term of the form `auth(User,Password,Host,Port)'.
• Segments is a list of atomic path segments.
• Query is (1) a list of unary compound terms, or (2) a list of pairs, or (3) a flat dict (i.e., a dict with non-dict values).

  119uri_comps(Uri, uri(Scheme,AuthorityComp,Segments,QueryComponents,Fragment)) :-
  120  ground(Uri), !,
  121  uri_components(Uri, uri_components(Scheme,Authority,Path,Query,Fragment)),
  122  (   atom(Authority),
  123      var(AuthorityComp)
  124  ->  AuthorityComp = Authority
  125  ;   auth_comps_(Scheme, Authority, AuthorityComp)
  126  ),
  127  (atomic_list_concat([''|Segments], /, Path) -> true ; Segments = [Path]),
  128  (   var(Query)
  129  ->  QueryComponents = []
  130  ;   % @hack Currently needed because buggy URI query components are
  131      %       common.
  132      catch(uri_query_components(Query, QueryComponents0), _, fail)
  133  ->  list_to_set(QueryComponents0, QueryComponents)
  134  ;   QueryComponents = []
  135  ).
  136uri_comps(Uri, uri(Scheme,Authority0,Segments,QueryComponents,Fragment)) :-
  137  (   atom(Authority0)
  138  ->  Authority = Authority0
  139  ;   auth_comps_(Scheme, Authority, Authority0)
  140  ),
  141  (   var(Segments)
  142  ->  true
  143  ;   Segments == ['']
  144  ->  Path = '/'
  145  ;   atomic_list_concat([''|Segments], /, Path)
  146  ),
  147  (   var(QueryComponents)
  148  ->  true
  149  ;   is_list(QueryComponents)
  150  ->  uri_query_components(Query, QueryComponents)
  151  ;   is_dict(QueryComponents)
  152  ->  dict_pairs(QueryComponents, QueryPairs),
  153      uri_query_components(Query, QueryPairs)
  154  ;   atomic(QueryComponents)
  155  ->  Query = QueryComponents
  156  ;   type_error(uri_query_components, QueryComponents)
  157  ),
  158  uri_components(Uri, uri_components(Scheme,Authority,Path,Query,Fragment)).
  159
  160auth_comps_(_, Authority, auth(User,Password,Host,Port)) :-
  161  ground(Authority), !,
  162  uri_authority_components(Authority, uri_authority(User,Password,Host,Port)).
  163auth_comps_(Scheme, Authority, auth(User,Password,Host,Port0)) :-
  164  (   var(Port0)
  165  ->  true
  166  ;   % Leave out the port if it is the default port for the given
  167      % Scheme.
  168      ground(Scheme),
  169      http_open_cp:default_port(Scheme, Port0)
  170  ->  true
  171  ;   Port = Port0
  172  ),
  173  % Create the Authorityority string.
  174  uri_authority_components(Authority, uri_authority(User,Password,Host,Port)).

 uri_data_directory(+Uri:atom, -Directory:atom) is det

  180uri_data_directory(Uri, Dir3) :-
  181  data_directory(Dir1),
  182  uri_comps(Uri, uri(Scheme,auth(_,_,Host,_),Segments1,Query,_)),
  183  add_query_segments_(Segments1, Query, Segments2),
  184  exclude(==(''), Segments2, Segments3),
  185  directory_subdirectories(Dir2, [Scheme,Host|Segments3]),
  186  directory_file_path2(Dir1, Dir2, Dir3).
  187
  188add_query_segments_(Segments, [], Segments) :- !.
  189add_query_segments_(Segments1, Query, Segments3) :-
  190  maplist(query_segment_, Query, Segments2),
  191  append(Segments1, [?|Segments2], Segments3).
  192
  193query_segment_(Key=Value, Segment) :-
  194  format(atom(Segment), "~a=~a", [Key,Value]).

 uri_data_file(+Uri:atom, +Local:atom, -File:atom) is det

  200uri_data_file(Uri, Local, File) :-
  201  uri_data_directory(Uri, Dir),
  202  directory_file_path2(Dir, Local, File).

 uri_file_extensions(+Uri:atom, -Extensions:list(atom)) is det

  208uri_file_extensions(Uri, Extensions) :-
  209  uri_local_name(Uri, Local),
  210  file_extensions(Local, Extensions).

 uri_file_is_fresh(+Uri:uri, +File:atom) is det

  216uri_file_is_fresh(Uri, File) :-
  217  http_last_modified(Uri, LMod),
  218  file_is_fresh(File, LMod).

 uri_local_name(+Uri:atom, -Local:atom) is det

  224uri_local_name(Uri, Local) :-
  225  uri_comps(Uri, uri(_,_,Segments,_,_)),
  226  last(Segments, Local).

 uri_media_type(+Uri:atom, -MediaType:media_type) is det

  232uri_media_type(Uri, MediaType) :-
  233  uri_file_extensions(Uri, Extensions),
  234  file_extensions_media_type(Extensions, MediaType).

 uri_relative_path(+Uri:atom, +Local:atom, -RelativePath:atom) is det

  240uri_relative_path(Uri, Local, RelativePath) :-
  241  uri_comps(Uri, uri(Scheme,auth(_,_,Host,_),Segments1,_,_)),
  242  append(Segments1, [Local], Segments2),
  243  atomic_list_concat([Scheme,Host|Segments2], /, RelativePath).

 uri_scheme(+Uri:atom, +Scheme:atom) is semidet

uri_scheme(+Uri:atom, -Scheme:atom) is semidet

  250uri_scheme(Uri, Scheme) :-
  251  uri_components(Uri, uri_components(Scheme,_,_,_,_)).

 uri_strip(+Uri1:atom, -Uri2:atom) is det

Uri2 is like Uri1, but without the query and fragment components.

  259uri_strip(Uri1, Uri2) :-
  260  uri_comps(Uri1, uri(Scheme,Auth,Segments,_,_)),
  261  uri_comps(Uri2, uri(Scheme,Auth,Segments,_,_))