1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2012-2021, VU University Amsterdam
    7                              CWI, Amsterdam
    8                              SWI-Prolog Solutions b.v.
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(prolog_pack,
   38          [ pack_list_installed/0,
   39            pack_info/1,                % +Name
   40            pack_list/1,                % +Keyword
   41            pack_search/1,              % +Keyword
   42            pack_install/1,             % +Name
   43            pack_install/2,             % +Name, +Options
   44            pack_upgrade/1,             % +Name
   45            pack_rebuild/1,             % +Name
   46            pack_rebuild/0,             % All packages
   47            pack_remove/1,              % +Name
   48            pack_property/2,            % ?Name, ?Property
   49            pack_attach/2,              % +Dir, +Options
   50
   51            pack_url_file/2             % +URL, -File
   52          ]).   53:- use_module(library(apply)).   54:- use_module(library(error)).   55:- use_module(library(option)).   56:- use_module(library(readutil)).   57:- use_module(library(lists)).   58:- use_module(library(filesex)).   59:- use_module(library(xpath)).   60:- use_module(library(settings)).   61:- use_module(library(uri)).   62:- use_module(library(dcg/basics)).   63:- use_module(library(http/http_open)).   64:- use_module(library(http/json)).   65:- use_module(library(http/http_client), []).   % plugin for POST support
   66:- use_module(library(prolog_config)).   67:- use_module(library(debug), [assertion/1]).   68:- use_module(library(pairs), [group_pairs_by_key/2]).   69% Stuff we may not have and may not need
   70:- autoload(library(git)).   71:- autoload(library(sgml)).   72:- autoload(library(sha)).   73:- autoload(library(build/tools)).

   90:- multifile
   91    environment/2.                          % Name, Value
   92
   93:- dynamic
   94    pack_requires/2,                        % Pack, Requirement
   95    pack_provides_db/2.                     % Pack, Provided
   96
   97
   98                 /*******************************
   99                 *          CONSTANTS           *
  100                 *******************************/
  101
  102:- setting(server, atom, 'https://www.swi-prolog.org/pack/',
  103           'Server to exchange pack information').  104
  105
  106                 /*******************************
  107                 *         PACKAGE INFO         *
  108                 *******************************/

 current_pack(?Pack) is nondet

 current_pack(?Pack, ?Dir) is nondet

True if Pack is a currently installed pack.

  115current_pack(Pack) :-
  116    current_pack(Pack, _).
  117
  118current_pack(Pack, Dir) :-
  119    '$pack':pack(Pack, Dir).

 pack_list_installed is det

List currently installed packages. Unlike pack_list/1, only locally installed packages are displayed and no connection is made to the internet.

See also

- Use pack_list/1 to find packages.

  129pack_list_installed :-
  130    findall(Pack, current_pack(Pack), Packages0),
  131    Packages0 \== [],
  132    !,
  133    sort(Packages0, Packages),
  134    length(Packages, Count),
  135    format('Installed packages (~D):~n~n', [Count]),
  136    maplist(pack_info(list), Packages),
  137    validate_dependencies.
  138pack_list_installed :-
  139    print_message(informational, pack(no_packages_installed)).

 pack_info(+Pack)

Print more detailed information about Pack.

  145pack_info(Name) :-
  146    pack_info(info, Name).
  147
  148pack_info(Level, Name) :-
  149    must_be(atom, Name),
  150    findall(Info, pack_info(Name, Level, Info), Infos0),
  151    (   Infos0 == []
  152    ->  print_message(warning, pack(no_pack_installed(Name))),
  153        fail
  154    ;   true
  155    ),
  156    update_dependency_db(Name, Infos0),
  157    findall(Def,  pack_default(Level, Infos, Def), Defs),
  158    append(Infos0, Defs, Infos1),
  159    sort(Infos1, Infos),
  160    show_info(Name, Infos, [info(Level)]).
  161
  162
  163show_info(_Name, _Properties, Options) :-
  164    option(silent(true), Options),
  165    !.
  166show_info(Name, Properties, Options) :-
  167    option(info(list), Options),
  168    !,
  169    memberchk(title(Title), Properties),
  170    memberchk(version(Version), Properties),
  171    format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
  172show_info(Name, Properties, _) :-
  173    !,
  174    print_property_value('Package'-'~w', [Name]),
  175    findall(Term, pack_level_info(info, Term, _, _), Terms),
  176    maplist(print_property(Properties), Terms).
  177
  178print_property(_, nl) :-
  179    !,
  180    format('~n').
  181print_property(Properties, Term) :-
  182    findall(Term, member(Term, Properties), Terms),
  183    Terms \== [],
  184    !,
  185    pack_level_info(_, Term, LabelFmt, _Def),
  186    (   LabelFmt = Label-FmtElem
  187    ->  true
  188    ;   Label = LabelFmt,
  189        FmtElem = '~w'
  190    ),
  191    multi_valued(Terms, FmtElem, FmtList, Values),
  192    atomic_list_concat(FmtList, ', ', Fmt),
  193    print_property_value(Label-Fmt, Values).
  194print_property(_, _).
  195
  196multi_valued([H], LabelFmt, [LabelFmt], Values) :-
  197    !,
  198    H =.. [_|Values].
  199multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
  200    H =.. [_|VH],
  201    append(VH, MoreValues, Values),
  202    multi_valued(T, LabelFmt, LT, MoreValues).
  203
  204
  205pvalue_column(24).
  206print_property_value(Prop-Fmt, Values) :-
  207    !,
  208    pvalue_column(C),
  209    atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
  210    format(Format, [Prop,C|Values]).
  211
  212pack_info(Name, Level, Info) :-
  213    '$pack':pack(Name, BaseDir),
  214    (   Info = directory(BaseDir)
  215    ;   pack_info_term(BaseDir, Info)
  216    ),
  217    pack_level_info(Level, Info, _Format, _Default).
  218
  219:- public pack_level_info/4.                    % used by web-server
  220
  221pack_level_info(_,    title(_),         'Title',                   '<no title>').
  222pack_level_info(_,    version(_),       'Installed version',       '<unknown>').
  223pack_level_info(info, directory(_),     'Installed in directory',  -).
  224pack_level_info(info, author(_, _),     'Author'-'~w <~w>',        -).
  225pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>',    -).
  226pack_level_info(info, packager(_, _),   'Packager'-'~w <~w>',      -).
  227pack_level_info(info, home(_),          'Home page',               -).
  228pack_level_info(info, download(_),      'Download URL',            -).
  229pack_level_info(_,    provides(_),      'Provides',                -).
  230pack_level_info(_,    requires(_),      'Requires',                -).
  231pack_level_info(_,    conflicts(_),     'Conflicts with',          -).
  232pack_level_info(_,    replaces(_),      'Replaces packages',       -).
  233pack_level_info(info, library(_),	'Provided libraries',      -).
  234
  235pack_default(Level, Infos, Def) :-
  236    pack_level_info(Level, ITerm, _Format, Def),
  237    Def \== (-),
  238    \+ memberchk(ITerm, Infos).

 pack_info_term(+PackDir, ?Info) is nondet

True when Info is meta-data for the package PackName.

  244pack_info_term(BaseDir, Info) :-
  245    directory_file_path(BaseDir, 'pack.pl', InfoFile),
  246    catch(
  247        setup_call_cleanup(
  248            open(InfoFile, read, In),
  249            term_in_stream(In, Info),
  250            close(In)),
  251        error(existence_error(source_sink, InfoFile), _),
  252        ( print_message(error, pack(no_meta_data(BaseDir))),
  253          fail
  254        )).
  255pack_info_term(BaseDir, library(Lib)) :-
  256    atom_concat(BaseDir, '/prolog/', LibDir),
  257    atom_concat(LibDir, '*.pl', Pattern),
  258    expand_file_name(Pattern, Files),
  259    maplist(atom_concat(LibDir), Plain, Files),
  260    convlist(base_name, Plain, Libs),
  261    member(Lib, Libs).
  262
  263base_name(File, Base) :-
  264    file_name_extension(Base, pl, File).
  265
  266term_in_stream(In, Term) :-
  267    repeat,
  268        read_term(In, Term0, []),
  269        (   Term0 == end_of_file
  270        ->  !, fail
  271        ;   Term = Term0,
  272            valid_info_term(Term0)
  273        ).
  274
  275valid_info_term(Term) :-
  276    Term =.. [Name|Args],
  277    same_length(Args, Types),
  278    Decl =.. [Name|Types],
  279    (   pack_info_term(Decl)
  280    ->  maplist(valid_info_arg, Types, Args)
  281    ;   print_message(warning, pack(invalid_info(Term))),
  282        fail
  283    ).
  284
  285valid_info_arg(Type, Arg) :-
  286    must_be(Type, Arg).

 pack_info_term(?Term) is nondet

True when Term describes name and arguments of a valid package info term.

  293pack_info_term(name(atom)).                     % Synopsis
  294pack_info_term(title(atom)).
  295pack_info_term(keywords(list(atom))).
  296pack_info_term(description(list(atom))).
  297pack_info_term(version(version)).
  298pack_info_term(author(atom, email_or_url_or_empty)).     % Persons
  299pack_info_term(maintainer(atom, email_or_url)).
  300pack_info_term(packager(atom, email_or_url)).
  301pack_info_term(pack_version(nonneg)).           % Package convention version
  302pack_info_term(home(atom)).                     % Home page
  303pack_info_term(download(atom)).                 % Source
  304pack_info_term(provides(atom)).                 % Dependencies
  305pack_info_term(requires(dependency)).
  306pack_info_term(conflicts(dependency)).          % Conflicts with package
  307pack_info_term(replaces(atom)).                 % Replaces another package
  308pack_info_term(autoload(boolean)).              % Default installation options
  309
  310:- multifile
  311    error:has_type/2.  312
  313error:has_type(version, Version) :-
  314    atom(Version),
  315    version_data(Version, _Data).
  316error:has_type(email_or_url, Address) :-
  317    atom(Address),
  318    (   sub_atom(Address, _, _, _, @)
  319    ->  true
  320    ;   uri_is_global(Address)
  321    ).
  322error:has_type(email_or_url_or_empty, Address) :-
  323    (   Address == ''
  324    ->  true
  325    ;   error:has_type(email_or_url, Address)
  326    ).
  327error:has_type(dependency, Value) :-
  328    is_dependency(Value, _Token, _Version).
  329
  330version_data(Version, version(Data)) :-
  331    atomic_list_concat(Parts, '.', Version),
  332    maplist(atom_number, Parts, Data).
  333
  334is_dependency(Token, Token, *) :-
  335    atom(Token).
  336is_dependency(Term, Token, VersionCmp) :-
  337    Term =.. [Op,Token,Version],
  338    cmp(Op, _),
  339    version_data(Version, _),
  340    VersionCmp =.. [Op,Version].
  341
  342cmp(<,  @<).
  343cmp(=<, @=<).
  344cmp(==, ==).
  345cmp(>=, @>=).
  346cmp(>,  @>).
  347
  348
  349                 /*******************************
  350                 *            SEARCH            *
  351                 *******************************/

 pack_search(+Query) is det

 pack_list(+Query) is det

Query package server and installed packages and display results. Query is matches case-insensitively against the name and title of known and installed packages. For each matching package, a single line is displayed that provides:

• Installation status
  • p: package, not installed
  • i: installed package; up-to-date with public version
  • U: installed package; can be upgraded
  • A: installed package; newer than publically available
  • l: installed package; not on server
• Name@Version
• Name@Version(ServerVersion)
• Title

Hint: ?- pack_list(''). lists all packages.

The predicates pack_list/1 and pack_search/1 are synonyms. Both contact the package server at http://www.swi-prolog.org to find available packages.

See also

- pack_list_installed/0 to list installed packages without contacting the server.

  380pack_list(Query) :-
  381    pack_search(Query).
  382
  383pack_search(Query) :-
  384    query_pack_server(search(Query), Result, []),
  385    (   Result == false
  386    ->  (   local_search(Query, Packs),
  387            Packs \== []
  388        ->  forall(member(pack(Pack, Stat, Title, Version, _), Packs),
  389                   format('~w ~w@~w ~28|- ~w~n',
  390                          [Stat, Pack, Version, Title]))
  391        ;   print_message(warning, pack(search_no_matches(Query)))
  392        )
  393    ;   Result = true(Hits),
  394        local_search(Query, Local),
  395        append(Hits, Local, All),
  396        sort(All, Sorted),
  397        list_hits(Sorted)
  398    ).
  399
  400list_hits([]).
  401list_hits([ pack(Pack, i, Title, Version, _),
  402            pack(Pack, p, Title, Version, _)
  403          | More
  404          ]) :-
  405    !,
  406    format('i ~w@~w ~28|- ~w~n', [Pack, Version, Title]),
  407    list_hits(More).
  408list_hits([ pack(Pack, i, Title, VersionI, _),
  409            pack(Pack, p, _,     VersionS, _)
  410          | More
  411          ]) :-
  412    !,
  413    version_data(VersionI, VDI),
  414    version_data(VersionS, VDS),
  415    (   VDI @< VDS
  416    ->  Tag = ('U')
  417    ;   Tag = ('A')
  418    ),
  419    format('~w ~w@~w(~w) ~28|- ~w~n', [Tag, Pack, VersionI, VersionS, Title]),
  420    list_hits(More).
  421list_hits([ pack(Pack, i, Title, VersionI, _)
  422          | More
  423          ]) :-
  424    !,
  425    format('l ~w@~w ~28|- ~w~n', [Pack, VersionI, Title]),
  426    list_hits(More).
  427list_hits([pack(Pack, Stat, Title, Version, _)|More]) :-
  428    format('~w ~w@~w ~28|- ~w~n', [Stat, Pack, Version, Title]),
  429    list_hits(More).
  430
  431
  432local_search(Query, Packs) :-
  433    findall(Pack, matching_installed_pack(Query, Pack), Packs).
  434
  435matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
  436    current_pack(Pack),
  437    findall(Term,
  438            ( pack_info(Pack, _, Term),
  439              search_info(Term)
  440            ), Info),
  441    (   sub_atom_icasechk(Pack, _, Query)
  442    ->  true
  443    ;   memberchk(title(Title), Info),
  444        sub_atom_icasechk(Title, _, Query)
  445    ),
  446    option(title(Title), Info, '<no title>'),
  447    option(version(Version), Info, '<no version>'),
  448    option(download(URL), Info, '<no download url>').
  449
  450search_info(title(_)).
  451search_info(version(_)).
  452search_info(download(_)).
  453
  454
  455                 /*******************************
  456                 *            INSTALL           *
  457                 *******************************/

 pack_install(+Spec:atom) is det

Install a package. Spec is one of

• Archive file name
• HTTP URL of an archive file name. This URL may contain a star (*) for the version. In this case pack_install asks for the directory content and selects the latest version.
• GIT URL (not well supported yet)
• A local directory name given as file:// URL or '.'
• A package name. This queries the package repository at http://www.swi-prolog.org

After resolving the type of package, pack_install/2 is used to do the actual installation.

  475pack_install(Spec) :-
  476    pack_default_options(Spec, Pack, [], Options),
  477    pack_install(Pack, [pack(Pack)|Options]).

 pack_default_options(+Spec, -Pack, +OptionsIn, -Options) is det

Establish the pack name (Pack) and install options from a specification and options (OptionsIn) provided by the user.

  484pack_default_options(_Spec, Pack, OptsIn, Options) :-
  485    option(already_installed(pack(Pack,_Version)), OptsIn),
  486    !,
  487    Options = OptsIn.
  488pack_default_options(_Spec, Pack, OptsIn, Options) :-
  489    option(url(URL), OptsIn),
  490    !,
  491    (   option(git(_), OptsIn)
  492    ->  Options = OptsIn
  493    ;   git_url(URL, Pack)
  494    ->  Options = [git(true)|OptsIn]
  495    ;   Options = OptsIn
  496    ),
  497    (   nonvar(Pack)
  498    ->  true
  499    ;   option(pack(Pack), Options)
  500    ->  true
  501    ;   pack_version_file(Pack, _Version, URL)
  502    ).
  503pack_default_options(Archive, Pack, _, Options) :-      % Install from archive
  504    must_be(atom, Archive),
  505    \+ uri_is_global(Archive),
  506    expand_file_name(Archive, [File]),
  507    exists_file(File),
  508    !,
  509    pack_version_file(Pack, Version, File),
  510    uri_file_name(FileURL, File),
  511    Options = [url(FileURL), version(Version)].
  512pack_default_options(URL, Pack, _, Options) :-
  513    git_url(URL, Pack),
  514    !,
  515    Options = [git(true), url(URL)].
  516pack_default_options(FileURL, Pack, _, Options) :-      % Install from directory
  517    uri_file_name(FileURL, Dir),
  518    exists_directory(Dir),
  519    pack_info_term(Dir, name(Pack)),
  520    !,
  521    (   pack_info_term(Dir, version(Version))
  522    ->  uri_file_name(DirURL, Dir),
  523        Options = [url(DirURL), version(Version)]
  524    ;   throw(error(existence_error(key, version, Dir),_))
  525    ).
  526pack_default_options('.', Pack, _, Options) :-          % Install from CWD
  527    pack_info_term('.', name(Pack)),
  528    !,
  529    working_directory(Dir, Dir),
  530    (   pack_info_term(Dir, version(Version))
  531    ->  uri_file_name(DirURL, Dir),
  532        Options = [url(DirURL), version(Version) | Options1],
  533        (   current_prolog_flag(windows, true)
  534        ->  Options1 = []
  535        ;   Options1 = [link(true), rebuild(make)]
  536        )
  537    ;   throw(error(existence_error(key, version, Dir),_))
  538    ).
  539pack_default_options(URL, Pack, _, Options) :-          % Install from URL
  540    pack_version_file(Pack, Version, URL),
  541    download_url(URL),
  542    !,
  543    available_download_versions(URL, [URLVersion-LatestURL|_]),
  544    Options = [url(LatestURL)|VersionOptions],
  545    version_options(Version, URLVersion, VersionOptions).
  546pack_default_options(Pack, Pack, OptsIn, Options) :-    % Install from name
  547    \+ uri_is_global(Pack),                             % ignore URLs
  548    query_pack_server(locate(Pack), Reply, OptsIn),
  549    (   Reply = true(Results)
  550    ->  pack_select_candidate(Pack, Results, OptsIn, Options)
  551    ;   print_message(warning, pack(no_match(Pack))),
  552        fail
  553    ).
  554
  555version_options(Version, Version, [version(Version)]) :- !.
  556version_options(Version, _, [version(Version)]) :-
  557    Version = version(List),
  558    maplist(integer, List),
  559    !.
  560version_options(_, _, []).

 pack_select_candidate(+Pack, +AvailableVersions, +OptionsIn, -Options)

Select from available packages.

  566pack_select_candidate(Pack, [AtomVersion-_|_], Options,
  567                      [already_installed(pack(Pack, Installed))|Options]) :-
  568    current_pack(Pack),
  569    pack_info(Pack, _, version(InstalledAtom)),
  570    atom_version(InstalledAtom, Installed),
  571    atom_version(AtomVersion, Version),
  572    Installed @>= Version,
  573    !.
  574pack_select_candidate(Pack, Available, Options, OptsOut) :-
  575    option(url(URL), Options),
  576    memberchk(_Version-URLs, Available),
  577    memberchk(URL, URLs),
  578    !,
  579    (   git_url(URL, Pack)
  580    ->  Extra = [git(true)]
  581    ;   Extra = []
  582    ),
  583    OptsOut = [url(URL), inquiry(true) | Extra].
  584pack_select_candidate(Pack, [Version-[URL]|_], Options,
  585                      [url(URL), git(true), inquiry(true)]) :-
  586    git_url(URL, Pack),
  587    !,
  588    confirm(install_from(Pack, Version, git(URL)), yes, Options).
  589pack_select_candidate(Pack, [Version-[URL]|More], Options,
  590                      [url(URL), inquiry(true) | Upgrade]) :-
  591    (   More == []
  592    ->  !
  593    ;   true
  594    ),
  595    confirm(install_from(Pack, Version, URL), yes, Options),
  596    !,
  597    add_upgrade(Pack, Upgrade).
  598pack_select_candidate(Pack, [Version-URLs|_], Options,
  599                      [url(URL), inquiry(true)|Rest]) :-
  600    maplist(url_menu_item, URLs, Tagged),
  601    append(Tagged, [cancel=cancel], Menu),
  602    Menu = [Default=_|_],
  603    menu(pack(select_install_from(Pack, Version)),
  604         Menu, Default, Choice, Options),
  605    (   Choice == cancel
  606    ->  fail
  607    ;   Choice = git(URL)
  608    ->  Rest = [git(true)|Upgrade]
  609    ;   Choice = URL,
  610        Rest = Upgrade
  611    ),
  612    add_upgrade(Pack, Upgrade).
  613
  614add_upgrade(Pack, Options) :-
  615    current_pack(Pack),
  616    !,
  617    Options = [upgrade(true)].
  618add_upgrade(_, []).
  619
  620url_menu_item(URL, git(URL)=install_from(git(URL))) :-
  621    git_url(URL, _),
  622    !.
  623url_menu_item(URL, URL=install_from(URL)).

 pack_install(+Name, +Options) is det

Install package Name. Processes the options below. Default options as would be used by pack_install/1 are used to complete the provided Options.

url(+URL)

Source for downloading the package

package_directory(+Dir)

Directory into which to install the package.

global(+Boolean)

If true, install in the XDG common application data path, making the pack accessible to everyone. If false, install in the XDG user application data path, making the pack accessible for the current user only. If the option is absent, use the first existing and writable directory. If that doesn't exist find locations where it can be created and prompt the user to do so.

interactive(+Boolean)

Use default answer without asking the user if there is a default action.

silent(+Boolean)

If true (default false), suppress informational progress messages.

upgrade(+Boolean)

If true (default false), upgrade package if it is already installed.

rebuild(Condition)

Rebuild the foreign components. Condition is one of if_absent (default, do nothing if the directory with foreign resources exists), make (run make) or true (run `make distclean` followed by the default configure and build steps).

test(Boolean)

If true (default), run the pack tests.

git(+Boolean)

If true (default false unless URL ends with =.git=), assume the URL is a GIT repository.

link(+Boolean)

Can be used if the installation source is a local directory and the file system supports symbolic links. In this case the system adds the current directory to the pack registration using a symbolic link and performs the local installation steps.

Non-interactive installation can be established using the option interactive(false). It is adviced to install from a particular trusted URL instead of the plain pack name for unattented operation.

  674pack_install(Spec, Options) :-
  675    pack_default_options(Spec, Pack, Options, DefOptions),
  676    (   option(already_installed(Installed), DefOptions)
  677    ->  print_message(informational, pack(already_installed(Installed)))
  678    ;   merge_options(Options, DefOptions, PackOptions),
  679        update_dependency_db,
  680        pack_install_dir(PackDir, PackOptions),
  681        pack_install(Pack, PackDir, PackOptions)
  682    ).
  683
  684pack_install_dir(PackDir, Options) :-
  685    option(package_directory(PackDir), Options),
  686    !.
  687pack_install_dir(PackDir, Options) :-
  688    base_alias(Alias, Options),
  689    absolute_file_name(Alias, PackDir,
  690                       [ file_type(directory),
  691                         access(write),
  692                         file_errors(fail)
  693                       ]),
  694    !.
  695pack_install_dir(PackDir, Options) :-
  696    pack_create_install_dir(PackDir, Options).
  697
  698base_alias(Alias, Options) :-
  699    option(global(true), Options),
  700    !,
  701    Alias = common_app_data(pack).
  702base_alias(Alias, Options) :-
  703    option(global(false), Options),
  704    !,
  705    Alias = user_app_data(pack).
  706base_alias(Alias, _Options) :-
  707    Alias = pack('.').
  708
  709pack_create_install_dir(PackDir, Options) :-
  710    base_alias(Alias, Options),
  711    findall(Candidate = create_dir(Candidate),
  712            ( absolute_file_name(Alias, Candidate, [solutions(all)]),
  713              \+ exists_file(Candidate),
  714              \+ exists_directory(Candidate),
  715              file_directory_name(Candidate, Super),
  716              (   exists_directory(Super)
  717              ->  access_file(Super, write)
  718              ;   true
  719              )
  720            ),
  721            Candidates0),
  722    list_to_set(Candidates0, Candidates),   % keep order
  723    pack_create_install_dir(Candidates, PackDir, Options).
  724
  725pack_create_install_dir(Candidates, PackDir, Options) :-
  726    Candidates = [Default=_|_],
  727    !,
  728    append(Candidates, [cancel=cancel], Menu),
  729    menu(pack(create_pack_dir), Menu, Default, Selected, Options),
  730    Selected \== cancel,
  731    (   catch(make_directory_path(Selected), E,
  732              (print_message(warning, E), fail))
  733    ->  PackDir = Selected
  734    ;   delete(Candidates, PackDir=create_dir(PackDir), Remaining),
  735        pack_create_install_dir(Remaining, PackDir, Options)
  736    ).
  737pack_create_install_dir(_, _, _) :-
  738    print_message(error, pack(cannot_create_dir(pack(.)))),
  739    fail.

 pack_install(+Pack, +PackDir, +Options)

Install package Pack into PackDir. Options:

url(URL)

Install from the given URL, URL is either a file://, a git URL or a download URL.

upgrade(Boolean)

If Pack is already installed and Boolean is true, update the package to the latest version. If Boolean is false print an error and fail.

  754pack_install(Name, _, Options) :-
  755    current_pack(Name, Dir),
  756    option(upgrade(false), Options, false),
  757    \+ pack_is_in_local_dir(Name, Dir, Options),
  758    print_message(error, pack(already_installed(Name))),
  759    pack_info(Name),
  760    print_message(information, pack(remove_with(Name))),
  761    !,
  762    fail.
  763pack_install(Name, PackDir, Options) :-
  764    option(url(URL), Options),
  765    uri_file_name(URL, Source),
  766    !,
  767    pack_install_from_local(Source, PackDir, Name, Options).
  768pack_install(Name, PackDir, Options) :-
  769    option(url(URL), Options),
  770    uri_components(URL, Components),
  771    uri_data(scheme, Components, Scheme),
  772    pack_install_from_url(Scheme, URL, PackDir, Name, Options).

 pack_install_from_local(+Source, +PackTopDir, +Name, +Options)

Install a package from a local media.

To be done

- Provide an option to install directories using a link (or file-links).

  781pack_install_from_local(Source, PackTopDir, Name, Options) :-
  782    exists_directory(Source),
  783    !,
  784    directory_file_path(PackTopDir, Name, PackDir),
  785    (   option(link(true), Options)
  786    ->  (   same_file(Source, PackDir)
  787        ->  true
  788        ;   atom_concat(PackTopDir, '/', PackTopDirS),
  789            relative_file_name(Source, PackTopDirS, RelPath),
  790            link_file(RelPath, PackDir, symbolic),
  791            assertion(same_file(Source, PackDir))
  792        )
  793    ;   prepare_pack_dir(PackDir, Options),
  794        copy_directory(Source, PackDir)
  795    ),
  796    pack_post_install(Name, PackDir, Options).
  797pack_install_from_local(Source, PackTopDir, Name, Options) :-
  798    exists_file(Source),
  799    directory_file_path(PackTopDir, Name, PackDir),
  800    prepare_pack_dir(PackDir, Options),
  801    pack_unpack(Source, PackDir, Name, Options),
  802    pack_post_install(Name, PackDir, Options).
  803
  804pack_is_in_local_dir(_Pack, PackDir, Options) :-
  805    option(url(DirURL), Options),
  806    uri_file_name(DirURL, Dir),
  807    same_file(PackDir, Dir).

 pack_unpack(+SourceFile, +PackDir, +Pack, +Options)

Unpack an archive to the given package dir.

  814:- if(exists_source(library(archive))).  815pack_unpack(Source, PackDir, Pack, Options) :-
  816    ensure_loaded_archive,
  817    pack_archive_info(Source, Pack, _Info, StripOptions),
  818    prepare_pack_dir(PackDir, Options),
  819    archive_extract(Source, PackDir,
  820                    [ exclude(['._*'])          % MacOS resource forks
  821                    | StripOptions
  822                    ]).
  823:- else.  824pack_unpack(_,_,_,_) :-
  825    existence_error(library, archive).
  826:- endif.  827
  828                 /*******************************
  829                 *             INFO             *
  830                 *******************************/

 pack_archive_info(+Archive, +Pack, -Info, -Strip)

True when Archive archives Pack. Info is unified with the terms from pack.pl in the pack and Strip is the strip-option for archive_extract/3.

Requires library(archive), which is lazily loaded when needed.

Errors

- existence_error(pack_file, 'pack.pl') if the archive doesn't contain pack.pl

- Syntax errors if pack.pl cannot be parsed.

  844:- if(exists_source(library(archive))).  845ensure_loaded_archive :-
  846    current_predicate(archive_open/3),
  847    !.
  848ensure_loaded_archive :-
  849    use_module(library(archive)).
  850
  851pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
  852    ensure_loaded_archive,
  853    size_file(Archive, Bytes),
  854    setup_call_cleanup(
  855        archive_open(Archive, Handle, []),
  856        (   repeat,
  857            (   archive_next_header(Handle, InfoFile)
  858            ->  true
  859            ;   !, fail
  860            )
  861        ),
  862        archive_close(Handle)),
  863    file_base_name(InfoFile, 'pack.pl'),
  864    atom_concat(Prefix, 'pack.pl', InfoFile),
  865    strip_option(Prefix, Pack, Strip),
  866    setup_call_cleanup(
  867        archive_open_entry(Handle, Stream),
  868        read_stream_to_terms(Stream, Info),
  869        close(Stream)),
  870    !,
  871    must_be(ground, Info),
  872    maplist(valid_info_term, Info).
  873:- else.  874pack_archive_info(_, _, _, _) :-
  875    existence_error(library, archive).
  876:- endif.  877pack_archive_info(_, _, _, _) :-
  878    existence_error(pack_file, 'pack.pl').
  879
  880strip_option('', _, []) :- !.
  881strip_option('./', _, []) :- !.
  882strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
  883    atom_concat(PrefixDir, /, Prefix),
  884    file_base_name(PrefixDir, Base),
  885    (   Base == Pack
  886    ->  true
  887    ;   pack_version_file(Pack, _, Base)
  888    ->  true
  889    ;   \+ sub_atom(PrefixDir, _, _, _, /)
  890    ).
  891
  892read_stream_to_terms(Stream, Terms) :-
  893    read(Stream, Term0),
  894    read_stream_to_terms(Term0, Stream, Terms).
  895
  896read_stream_to_terms(end_of_file, _, []) :- !.
  897read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
  898    read(Stream, Term1),
  899    read_stream_to_terms(Term1, Stream, Terms).

 pack_git_info(+GitDir, -Hash, -Info) is det

Retrieve info from a cloned git repository that is compatible with pack_archive_info/4.

  907pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
  908    exists_directory(GitDir),
  909    !,
  910    git_ls_tree(Entries, [directory(GitDir)]),
  911    git_hash(Hash, [directory(GitDir)]),
  912    maplist(arg(4), Entries, Sizes),
  913    sum_list(Sizes, Bytes),
  914    directory_file_path(GitDir, 'pack.pl', InfoFile),
  915    read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
  916    must_be(ground, Info),
  917    maplist(valid_info_term, Info).

 download_file_sanity_check(+Archive, +Pack, +Info) is semidet

Perform basic sanity checks on DownloadFile

  923download_file_sanity_check(Archive, Pack, Info) :-
  924    info_field(name(Name), Info),
  925    info_field(version(VersionAtom), Info),
  926    atom_version(VersionAtom, Version),
  927    pack_version_file(PackA, VersionA, Archive),
  928    must_match([Pack, PackA, Name], name),
  929    must_match([Version, VersionA], version).
  930
  931info_field(Field, Info) :-
  932    memberchk(Field, Info),
  933    ground(Field),
  934    !.
  935info_field(Field, _Info) :-
  936    functor(Field, FieldName, _),
  937    print_message(error, pack(missing(FieldName))),
  938    fail.
  939
  940must_match(Values, _Field) :-
  941    sort(Values, [_]),
  942    !.
  943must_match(Values, Field) :-
  944    print_message(error, pack(conflict(Field, Values))),
  945    fail.
  946
  947
  948                 /*******************************
  949                 *         INSTALLATION         *
  950                 *******************************/

 prepare_pack_dir(+Dir, +Options)

Prepare for installing the package into Dir. This

• If the directory exist and is empty, done.
• Else if the directory exists, remove the directory and recreate it. Note that if the directory is a symlink this just deletes the link.
• Else create the directory.

  962prepare_pack_dir(Dir, Options) :-
  963    exists_directory(Dir),
  964    !,
  965    (   empty_directory(Dir)
  966    ->  true
  967    ;   (   option(upgrade(true), Options)
  968        ;   confirm(remove_existing_pack(Dir), yes, Options)
  969        )
  970    ->  delete_directory_and_contents(Dir),
  971        make_directory(Dir)
  972    ).
  973prepare_pack_dir(Dir, _) :-
  974    make_directory(Dir).

 empty_directory(+Directory) is semidet

True if Directory is empty (holds no files or sub-directories).

  980empty_directory(Dir) :-
  981    \+ ( directory_files(Dir, Entries),
  982         member(Entry, Entries),
  983         \+ special(Entry)
  984       ).
  985
  986special(.).
  987special(..).

 pack_install_from_url(+Scheme, +URL, +PackDir, +Pack, +Options)

Install a package from a remote source. For git repositories, we simply clone. Archives are downloaded. We currently use the built-in HTTP client. For complete coverage, we should consider using an external (e.g., curl) if available.

  997pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
  998    option(git(true), Options),
  999    !,
 1000    directory_file_path(PackTopDir, Pack, PackDir),
 1001    prepare_pack_dir(PackDir, Options),
 1002    run_process(path(git), [clone, URL, PackDir], []),
 1003    pack_git_info(PackDir, Hash, Info),
 1004    pack_inquiry(URL, git(Hash), Info, Options),
 1005    show_info(Pack, Info, Options),
 1006    confirm(git_post_install(PackDir, Pack), yes, Options),
 1007    pack_post_install(Pack, PackDir, Options).
 1008pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
 1009    download_scheme(Scheme),
 1010    directory_file_path(PackTopDir, Pack, PackDir),
 1011    prepare_pack_dir(PackDir, Options),
 1012    pack_download_dir(PackTopDir, DownLoadDir),
 1013    download_file(URL, Pack, DownloadBase, Options),
 1014    directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
 1015    setup_call_cleanup(
 1016        http_open(URL, In,
 1017                  [ cert_verify_hook(ssl_verify)
 1018                  ]),
 1019        setup_call_cleanup(
 1020            open(DownloadFile, write, Out, [type(binary)]),
 1021            copy_stream_data(In, Out),
 1022            close(Out)),
 1023        close(In)),
 1024    pack_archive_info(DownloadFile, Pack, Info, _),
 1025    download_file_sanity_check(DownloadFile, Pack, Info),
 1026    pack_inquiry(URL, DownloadFile, Info, Options),
 1027    show_info(Pack, Info, Options),
 1028    confirm(install_downloaded(DownloadFile), yes, Options),
 1029    pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).

 download_file(+URL, +Pack, -File, +Options) is det

 1033download_file(URL, Pack, File, Options) :-
 1034    option(version(Version), Options),
 1035    !,
 1036    atom_version(VersionA, Version),
 1037    file_name_extension(_, Ext, URL),
 1038    format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
 1039download_file(URL, Pack, File, _) :-
 1040    file_base_name(URL,Basename),
 1041    no_int_file_name_extension(Tag,Ext,Basename),
 1042    tag_version(Tag,Version),
 1043    !,
 1044    atom_version(VersionA,Version),
 1045    format(atom(File0), '~w-~w', [Pack, VersionA]),
 1046    file_name_extension(File0, Ext, File).
 1047download_file(URL, _, File, _) :-
 1048    file_base_name(URL, File).

 pack_url_file(+URL, -File) is det

True if File is a unique id for the referenced pack and version. Normally, that is simply the base name, but GitHub archives destroy this picture. Needed by the pack manager.

 1056pack_url_file(URL, FileID) :-
 1057    github_release_url(URL, Pack, Version),
 1058    !,
 1059    download_file(URL, Pack, FileID, [version(Version)]).
 1060pack_url_file(URL, FileID) :-
 1061    file_base_name(URL, FileID).
 1062
 1063
 1064:- public ssl_verify/5.

 ssl_verify(+SSL, +ProblemCert, +AllCerts, +FirstCert, +Error)

Currently we accept all certificates. We organise our own security using SHA1 signatures, so we do not care about the source of the data.

 1072ssl_verify(_SSL,
 1073           _ProblemCertificate, _AllCertificates, _FirstCertificate,
 1074           _Error).
 1075
 1076pack_download_dir(PackTopDir, DownLoadDir) :-
 1077    directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
 1078    (   exists_directory(DownLoadDir)
 1079    ->  true
 1080    ;   make_directory(DownLoadDir)
 1081    ),
 1082    (   access_file(DownLoadDir, write)
 1083    ->  true
 1084    ;   permission_error(write, directory, DownLoadDir)
 1085    ).

 download_url(+URL) is det

True if URL looks like a URL we can download from.

 1091download_url(URL) :-
 1092    atom(URL),
 1093    uri_components(URL, Components),
 1094    uri_data(scheme, Components, Scheme),
 1095    download_scheme(Scheme).
 1096
 1097download_scheme(http).
 1098download_scheme(https) :-
 1099    catch(use_module(library(http/http_ssl_plugin)),
 1100          E, (print_message(warning, E), fail)).

 pack_post_install(+Pack, +PackDir, +Options) is det

Process post installation work. Steps:

• Create foreign resources
• Register directory as autoload library
• Attach the package

 1110pack_post_install(Pack, PackDir, Options) :-
 1111    post_install_foreign(Pack, PackDir, Options),
 1112    post_install_autoload(PackDir, Options),
 1113    '$pack_attach'(PackDir).

 pack_rebuild(+Pack) is det

Rebuilt possible foreign components of Pack.

 1119pack_rebuild(Pack) :-
 1120    current_pack(Pack, PackDir),
 1121    !,
 1122    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 1123pack_rebuild(Pack) :-
 1124    unattached_pacth(Pack, PackDir),
 1125    !,
 1126    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 1127pack_rebuild(Pack) :-
 1128    existence_error(pack, Pack).
 1129
 1130unattached_pacth(Pack, BaseDir) :-
 1131    directory_file_path(Pack, 'pack.pl', PackFile),
 1132    absolute_file_name(pack(PackFile), PackPath,
 1133                       [ access(read),
 1134                         file_errors(fail)
 1135                       ]),
 1136    file_directory_name(PackPath, BaseDir).

 pack_rebuild is det

Rebuild foreign components of all packages.

 1142pack_rebuild :-
 1143    forall(current_pack(Pack),
 1144           ( print_message(informational, pack(rebuild(Pack))),
 1145             pack_rebuild(Pack)
 1146           )).

 post_install_foreign(+Pack, +PackDir, +Options) is det

Install foreign parts of the package.

 1153post_install_foreign(Pack, PackDir, Options) :-
 1154    is_foreign_pack(PackDir, _),
 1155    !,
 1156    (   pack_info_term(PackDir, pack_version(Version))
 1157    ->  true
 1158    ;   Version = 1
 1159    ),
 1160    option(rebuild(Rebuild), Options, if_absent),
 1161    (   Rebuild == if_absent,
 1162        foreign_present(PackDir)
 1163    ->  print_message(informational, pack(kept_foreign(Pack)))
 1164    ;   BuildSteps0 = [[dependencies], [configure], build, [test], install],
 1165        (   Rebuild == true
 1166        ->  BuildSteps1 = [distclean|BuildSteps0]
 1167        ;   BuildSteps1 = BuildSteps0
 1168        ),
 1169        (   option(test(false), Options)
 1170        ->  delete(BuildSteps1, [test], BuildSteps)
 1171        ;   BuildSteps = BuildSteps1
 1172        ),
 1173        build_steps(BuildSteps, PackDir, [pack_version(Version)|Options])
 1174    ).
 1175post_install_foreign(_, _, _).

 foreign_present(+PackDir) is semidet

True if we find one or more modules in the pack lib directory for the current architecture. Does not check that these can be loaded, nor whether all required modules are present.

 1184foreign_present(PackDir) :-
 1185    current_prolog_flag(arch, Arch),
 1186    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
 1187    exists_directory(ForeignBaseDir),
 1188    !,
 1189    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
 1190    exists_directory(ForeignDir),
 1191    current_prolog_flag(shared_object_extension, Ext),
 1192    atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
 1193    expand_file_name(Pattern, Files),
 1194    Files \== [].

 is_foreign_pack(+PackDir, -Type) is nondet

True when PackDir contains files that indicate the need for a specific class of build tools indicated by Type.

 1201is_foreign_pack(PackDir, Type) :-
 1202    foreign_file(File, Type),
 1203    directory_file_path(PackDir, File, Path),
 1204    exists_file(Path).
 1205
 1206foreign_file('CMakeLists.txt', cmake).
 1207foreign_file('configure',      configure).
 1208foreign_file('configure.in',   autoconf).
 1209foreign_file('configure.ac',   autoconf).
 1210foreign_file('Makefile.am',    automake).
 1211foreign_file('Makefile',       make).
 1212foreign_file('makefile',       make).
 1213foreign_file('conanfile.txt',  conan).
 1214foreign_file('conanfile.py',   conan).
 1215
 1216
 1217                 /*******************************
 1218                 *           AUTOLOAD           *
 1219                 *******************************/

 post_install_autoload(+PackDir, +Options)

Create an autoload index if the package demands such.

 1225post_install_autoload(PackDir, Options) :-
 1226    option(autoload(true), Options, true),
 1227    pack_info_term(PackDir, autoload(true)),
 1228    !,
 1229    directory_file_path(PackDir, prolog, PrologLibDir),
 1230    make_library_index(PrologLibDir).
 1231post_install_autoload(_, _).
 1232
 1233
 1234                 /*******************************
 1235                 *            UPGRADE           *
 1236                 *******************************/

 pack_upgrade(+Pack) is semidet

Try to upgrade the package Pack.

To be done

- Update dependencies when updating a pack from git?

 1244pack_upgrade(Pack) :-
 1245    pack_info(Pack, _, directory(Dir)),
 1246    directory_file_path(Dir, '.git', GitDir),
 1247    exists_directory(GitDir),
 1248    !,
 1249    print_message(informational, pack(git_fetch(Dir))),
 1250    git([fetch], [ directory(Dir) ]),
 1251    git_describe(V0, [ directory(Dir) ]),
 1252    git_describe(V1, [ directory(Dir), commit('origin/master') ]),
 1253    (   V0 == V1
 1254    ->  print_message(informational, pack(up_to_date(Pack)))
 1255    ;   confirm(upgrade(Pack, V0, V1), yes, []),
 1256        git([merge, 'origin/master'], [ directory(Dir) ]),
 1257        pack_rebuild(Pack)
 1258    ).
 1259pack_upgrade(Pack) :-
 1260    once(pack_info(Pack, _, version(VersionAtom))),
 1261    atom_version(VersionAtom, Version),
 1262    pack_info(Pack, _, download(URL)),
 1263    (   wildcard_pattern(URL)
 1264    ->  true
 1265    ;   github_url(URL, _User, _Repo)
 1266    ),
 1267    !,
 1268    available_download_versions(URL, [Latest-LatestURL|_Versions]),
 1269    (   Latest @> Version
 1270    ->  confirm(upgrade(Pack, Version, Latest), yes, []),
 1271        pack_install(Pack,
 1272                     [ url(LatestURL),
 1273                       upgrade(true),
 1274                       pack(Pack)
 1275                     ])
 1276    ;   print_message(informational, pack(up_to_date(Pack)))
 1277    ).
 1278pack_upgrade(Pack) :-
 1279    print_message(warning, pack(no_upgrade_info(Pack))).
 1280
 1281
 1282                 /*******************************
 1283                 *            REMOVE            *
 1284                 *******************************/

 pack_remove(+Name) is det

Remove the indicated package.

 1290pack_remove(Pack) :-
 1291    update_dependency_db,
 1292    (   setof(Dep, pack_depends_on(Dep, Pack), Deps)
 1293    ->  confirm_remove(Pack, Deps, Delete),
 1294        forall(member(P, Delete), pack_remove_forced(P))
 1295    ;   pack_remove_forced(Pack)
 1296    ).
 1297
 1298pack_remove_forced(Pack) :-
 1299    catch('$pack_detach'(Pack, BaseDir),
 1300          error(existence_error(pack, Pack), _),
 1301          fail),
 1302    !,
 1303    print_message(informational, pack(remove(BaseDir))),
 1304    delete_directory_and_contents(BaseDir).
 1305pack_remove_forced(Pack) :-
 1306    unattached_pacth(Pack, BaseDir),
 1307    !,
 1308    delete_directory_and_contents(BaseDir).
 1309pack_remove_forced(Pack) :-
 1310    print_message(informational, error(existence_error(pack, Pack),_)).
 1311
 1312confirm_remove(Pack, Deps, Delete) :-
 1313    print_message(warning, pack(depends(Pack, Deps))),
 1314    menu(pack(resolve_remove),
 1315         [ [Pack]      = remove_only(Pack),
 1316           [Pack|Deps] = remove_deps(Pack, Deps),
 1317           []          = cancel
 1318         ], [], Delete, []),
 1319    Delete \== [].
 1320
 1321
 1322                 /*******************************
 1323                 *           PROPERTIES         *
 1324                 *******************************/

 pack_property(?Pack, ?Property) is nondet

True when Property is a property of an installed Pack. This interface is intended for programs that wish to interact with the package manager. Defined properties are:

directory(Directory)

Directory into which the package is installed

version(Version)

Installed version

title(Title)

Full title of the package

author(Author)

Registered author

download(URL)

Official download URL

readme(File)

Package README file (if present)

todo(File)

Package TODO file (if present)

 1347pack_property(Pack, Property) :-
 1348    findall(Pack-Property, pack_property_(Pack, Property), List),
 1349    member(Pack-Property, List).            % make det if applicable
 1350
 1351pack_property_(Pack, Property) :-
 1352    pack_info(Pack, _, Property).
 1353pack_property_(Pack, Property) :-
 1354    \+ \+ info_file(Property, _),
 1355    '$pack':pack(Pack, BaseDir),
 1356    access_file(BaseDir, read),
 1357    directory_files(BaseDir, Files),
 1358    member(File, Files),
 1359    info_file(Property, Pattern),
 1360    downcase_atom(File, Pattern),
 1361    directory_file_path(BaseDir, File, InfoFile),
 1362    arg(1, Property, InfoFile).
 1363
 1364info_file(readme(_), 'readme.txt').
 1365info_file(readme(_), 'readme').
 1366info_file(todo(_),   'todo.txt').
 1367info_file(todo(_),   'todo').
 1368
 1369
 1370                 /*******************************
 1371                 *             GIT              *
 1372                 *******************************/

 git_url(+URL, -Pack) is semidet

True if URL describes a git url for Pack

 1378git_url(URL, Pack) :-
 1379    uri_components(URL, Components),
 1380    uri_data(scheme, Components, Scheme),
 1381    nonvar(Scheme),                         % must be full URL
 1382    uri_data(path, Components, Path),
 1383    (   Scheme == git
 1384    ->  true
 1385    ;   git_download_scheme(Scheme),
 1386        file_name_extension(_, git, Path)
 1387    ;   git_download_scheme(Scheme),
 1388        catch(git_ls_remote(URL, _, [refs(['HEAD']), error(_)]), _, fail)
 1389    ->  true
 1390    ),
 1391    file_base_name(Path, PackExt),
 1392    (   file_name_extension(Pack, git, PackExt)
 1393    ->  true
 1394    ;   Pack = PackExt
 1395    ),
 1396    (   safe_pack_name(Pack)
 1397    ->  true
 1398    ;   domain_error(pack_name, Pack)
 1399    ).
 1400
 1401git_download_scheme(http).
 1402git_download_scheme(https).

 safe_pack_name(+Name:atom) is semidet

Verifies that Name is a valid pack name. This avoids trickery with pack file names to make shell commands behave unexpectly.

 1409safe_pack_name(Name) :-
 1410    atom_length(Name, Len),
 1411    Len >= 3,                               % demand at least three length
 1412    atom_codes(Name, Codes),
 1413    maplist(safe_pack_char, Codes),
 1414    !.
 1415
 1416safe_pack_char(C) :- between(0'a, 0'z, C), !.
 1417safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 1418safe_pack_char(C) :- between(0'0, 0'9, C), !.
 1419safe_pack_char(0'_).
 1420
 1421
 1422                 /*******************************
 1423                 *         VERSION LOGIC        *
 1424                 *******************************/

 pack_version_file(-Pack, -Version, +File) is semidet

True if File is the name of a file or URL of a file that contains Pack at Version. File must have an extension and the basename must be of the form <pack>-<n>{.<m>}*. E.g., mypack-1.5.

 1433pack_version_file(Pack, Version, GitHubRelease) :-
 1434    atomic(GitHubRelease),
 1435    github_release_url(GitHubRelease, Pack, Version),
 1436    !.
 1437pack_version_file(Pack, Version, Path) :-
 1438    atomic(Path),
 1439    file_base_name(Path, File),
 1440    no_int_file_name_extension(Base, _Ext, File),
 1441    atom_codes(Base, Codes),
 1442    (   phrase(pack_version(Pack, Version), Codes),
 1443        safe_pack_name(Pack)
 1444    ->  true
 1445    ).
 1446
 1447no_int_file_name_extension(Base, Ext, File) :-
 1448    file_name_extension(Base0, Ext0, File),
 1449    \+ atom_number(Ext0, _),
 1450    !,
 1451    Base = Base0,
 1452    Ext = Ext0.
 1453no_int_file_name_extension(File, '', File).

 github_release_url(+URL, -Pack, -Version) is semidet

True when URL is the URL of a GitHub release. Such releases are accessible as

https:/github.com/<owner>/<pack>/archive/[vV]?<version>.zip'

 1466github_release_url(URL, Pack, Version) :-
 1467    uri_components(URL, Components),
 1468    uri_data(authority, Components, 'github.com'),
 1469    uri_data(scheme, Components, Scheme),
 1470    download_scheme(Scheme),
 1471    uri_data(path, Components, Path),
 1472    github_archive_path(Archive,Pack,File),
 1473    atomic_list_concat(Archive, /, Path),
 1474    file_name_extension(Tag, Ext, File),
 1475    github_archive_extension(Ext),
 1476    tag_version(Tag, Version),
 1477    !.
 1478
 1479github_archive_path(['',_User,Pack,archive,File],Pack,File).
 1480github_archive_path(['',_User,Pack,archive,refs,tags,File],Pack,File).
 1481
 1482github_archive_extension(tgz).
 1483github_archive_extension(zip).
 1484
 1485tag_version(Tag, Version) :-
 1486    version_tag_prefix(Prefix),
 1487    atom_concat(Prefix, AtomVersion, Tag),
 1488    atom_version(AtomVersion, Version).
 1489
 1490version_tag_prefix(v).
 1491version_tag_prefix('V').
 1492version_tag_prefix('').
 1493
 1494
 1495:- public
 1496    atom_version/2.

 atom_version(?Atom, ?Version)

Translate between atomic version representation and term representation. The term representation is a list of version components as integers and can be compared using @>

 1504atom_version(Atom, version(Parts)) :-
 1505    (   atom(Atom)
 1506    ->  atom_codes(Atom, Codes),
 1507        phrase(version(Parts), Codes)
 1508    ;   atomic_list_concat(Parts, '.', Atom)
 1509    ).
 1510
 1511pack_version(Pack, version(Parts)) -->
 1512    string(Codes), "-",
 1513    version(Parts),
 1514    !,
 1515    { atom_codes(Pack, Codes)
 1516    }.
 1517
 1518version([_|T]) -->
 1519    "*",
 1520    !,
 1521    (   "."
 1522    ->  version(T)
 1523    ;   []
 1524    ).
 1525version([H|T]) -->
 1526    integer(H),
 1527    (   "."
 1528    ->  version(T)
 1529    ;   { T = [] }
 1530    ).
 1531
 1532                 /*******************************
 1533                 *       QUERY CENTRAL DB       *
 1534                 *******************************/

 pack_inquiry(+URL, +DownloadFile, +Info, +Options) is semidet

Query the status of a package with the central repository. To do this, we POST a Prolog document containing the URL, info and the SHA1 hash to http://www.swi-prolog.org/pack/eval. The server replies using a list of Prolog terms, described below. The only member that is always included is downloads (with default value 0).

alt_hash(Count, URLs, Hash)

A file with the same base-name, but a different hash was found at URLs and downloaded Count times.

downloads(Count)

Number of times a file with this hash was downloaded.

rating(VoteCount, Rating)

User rating (1..5), provided based on VoteCount votes.

dependency(Token, Pack, Version, URLs, SubDeps)

Required tokens can be provided by the given provides.

 1554pack_inquiry(_, _, _, Options) :-
 1555    option(inquiry(false), Options),
 1556    !.
 1557pack_inquiry(URL, DownloadFile, Info, Options) :-
 1558    setting(server, ServerBase),
 1559    ServerBase \== '',
 1560    atom_concat(ServerBase, query, Server),
 1561    (   option(inquiry(true), Options)
 1562    ->  true
 1563    ;   confirm(inquiry(Server), yes, Options)
 1564    ),
 1565    !,
 1566    (   DownloadFile = git(SHA1)
 1567    ->  true
 1568    ;   file_sha1(DownloadFile, SHA1)
 1569    ),
 1570    query_pack_server(install(URL, SHA1, Info), Reply, Options),
 1571    inquiry_result(Reply, URL, Options).
 1572pack_inquiry(_, _, _, _).

 query_pack_server(+Query, -Result, +Options)

Send a Prolog query to the package server and process its results.

 1580query_pack_server(Query, Result, Options) :-
 1581    setting(server, ServerBase),
 1582    ServerBase \== '',
 1583    atom_concat(ServerBase, query, Server),
 1584    format(codes(Data), '~q.~n', Query),
 1585    info_level(Informational, Options),
 1586    print_message(Informational, pack(contacting_server(Server))),
 1587    setup_call_cleanup(
 1588        http_open(Server, In,
 1589                  [ post(codes(application/'x-prolog', Data)),
 1590                    header(content_type, ContentType)
 1591                  ]),
 1592        read_reply(ContentType, In, Result),
 1593        close(In)),
 1594    message_severity(Result, Level, Informational),
 1595    print_message(Level, pack(server_reply(Result))).
 1596
 1597read_reply(ContentType, In, Result) :-
 1598    sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
 1599    !,
 1600    set_stream(In, encoding(utf8)),
 1601    read(In, Result).
 1602read_reply(ContentType, In, _Result) :-
 1603    read_string(In, 500, String),
 1604    print_message(error, pack(no_prolog_response(ContentType, String))),
 1605    fail.
 1606
 1607info_level(Level, Options) :-
 1608    option(silent(true), Options),
 1609    !,
 1610    Level = silent.
 1611info_level(informational, _).
 1612
 1613message_severity(true(_), Informational, Informational).
 1614message_severity(false, warning, _).
 1615message_severity(exception(_), error, _).

 inquiry_result(+Reply, +File, +Options) is semidet

Analyse the results of the inquiry and decide whether to continue or not.

 1623inquiry_result(Reply, File, Options) :-
 1624    findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation),
 1625    \+ member(cancel, Evaluation),
 1626    select_option(git(_), Options, Options1, _),
 1627    forall(member(install_dependencies(Resolution), Evaluation),
 1628           maplist(install_dependency(Options1), Resolution)).
 1629
 1630eval_inquiry(true(Reply), URL, Eval, _) :-
 1631    include(alt_hash, Reply, Alts),
 1632    Alts \== [],
 1633    print_message(warning, pack(alt_hashes(URL, Alts))),
 1634    (   memberchk(downloads(Count), Reply),
 1635        (   git_url(URL, _)
 1636        ->  Default = yes,
 1637            Eval = with_git_commits_in_same_version
 1638        ;   Default = no,
 1639            Eval = with_alt_hashes
 1640        ),
 1641        confirm(continue_with_alt_hashes(Count, URL), Default, [])
 1642    ->  true
 1643    ;   !,                          % Stop other rules
 1644        Eval = cancel
 1645    ).
 1646eval_inquiry(true(Reply), _, Eval, Options) :-
 1647    include(dependency, Reply, Deps),
 1648    Deps \== [],
 1649    select_dependency_resolution(Deps, Eval, Options),
 1650    (   Eval == cancel
 1651    ->  !
 1652    ;   true
 1653    ).
 1654eval_inquiry(true(Reply), URL, true, Options) :-
 1655    file_base_name(URL, File),
 1656    info_level(Informational, Options),
 1657    print_message(Informational, pack(inquiry_ok(Reply, File))).
 1658eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))),
 1659             URL, Eval, Options) :-
 1660    (   confirm(continue_with_modified_hash(URL), no, Options)
 1661    ->  Eval = true
 1662    ;   Eval = cancel
 1663    ).
 1664
 1665alt_hash(alt_hash(_,_,_)).
 1666dependency(dependency(_,_,_,_,_)).

 select_dependency_resolution(+Deps, -Eval, +Options)

Select a resolution.

To be done

- Exploit backtracking over resolve_dependencies/2.

 1675select_dependency_resolution(Deps, Eval, Options) :-
 1676    resolve_dependencies(Deps, Resolution),
 1677    exclude(local_dep, Resolution, ToBeDone),
 1678    (   ToBeDone == []
 1679    ->  !, Eval = true
 1680    ;   print_message(warning, pack(install_dependencies(Resolution))),
 1681        (   memberchk(_-unresolved, Resolution)
 1682        ->  Default = cancel
 1683        ;   Default = install_deps
 1684        ),
 1685        menu(pack(resolve_deps),
 1686             [ install_deps    = install_deps,
 1687               install_no_deps = install_no_deps,
 1688               cancel          = cancel
 1689             ], Default, Choice, Options),
 1690        (   Choice == cancel
 1691        ->  !, Eval = cancel
 1692        ;   Choice == install_no_deps
 1693        ->  !, Eval = install_no_deps
 1694        ;   !, Eval = install_dependencies(Resolution)
 1695        )
 1696    ).
 1697
 1698local_dep(_-resolved(_)).