View source with raw comments or as raw
    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-2023, 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)).

A package manager for Prolog

The library(prolog_pack) provides the SWI-Prolog package manager. This library lets you inspect installed packages, install packages, remove packages, etc. It is complemented by the built-in attach_packs/0 that makes installed packages available as libraries.

To make changes to a package:

Once you have made the changes, you should edit the pack.pl file to change the version item. After updating the git repo, issue a pack_install(package_name, [upgrade(true), test(true), rebuild(make)]) to cause the repository to refresh. You can simulate the full installation process by removing all the build files in the package (including any in submodules), running pack_install/1, and then running pack_install using a file:// URL.

See also
- Installed packages can be inspected using ?- doc_browser.
- library(build/tools)
To be done
- Version logic
- Find and resolve conflicts
- Upgrade git packages
- Validate git packages
- Test packages: run tests from directory `test'. */
  110:- multifile
  111    environment/2.                          % Name, Value
  112
  113:- dynamic
  114    pack_requires/2,                        % Pack, Requirement
  115    pack_provides_db/2.                     % Pack, Provided
  116
  117
  118                 /*******************************
  119                 *          CONSTANTS           *
  120                 *******************************/
  121
  122:- setting(server, atom, 'https://www.swi-prolog.org/pack/',
  123           'Server to exchange pack information').  124
  125
  126                 /*******************************
  127                 *         PACKAGE INFO         *
  128                 *******************************/
 current_pack(?Pack) is nondet
 current_pack(?Pack, ?Dir) is nondet
True if Pack is a currently installed pack.
  135current_pack(Pack) :-
  136    current_pack(Pack, _).
  137
  138current_pack(Pack, Dir) :-
  139    '$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.
  149pack_list_installed :-
  150    findall(Pack, current_pack(Pack), Packages0),
  151    Packages0 \== [],
  152    !,
  153    sort(Packages0, Packages),
  154    length(Packages, Count),
  155    format('Installed packages (~D):~n~n', [Count]),
  156    maplist(pack_info(list), Packages),
  157    validate_dependencies.
  158pack_list_installed :-
  159    print_message(informational, pack(no_packages_installed)).
 pack_info(+Pack)
Print more detailed information about Pack.
  165pack_info(Name) :-
  166    pack_info(info, Name).
  167
  168pack_info(Level, Name) :-
  169    must_be(atom, Name),
  170    findall(Info, pack_info(Name, Level, Info), Infos0),
  171    (   Infos0 == []
  172    ->  print_message(warning, pack(no_pack_installed(Name))),
  173        fail
  174    ;   true
  175    ),
  176    update_dependency_db(Name, Infos0),
  177    findall(Def,  pack_default(Level, Infos, Def), Defs),
  178    append(Infos0, Defs, Infos1),
  179    sort(Infos1, Infos),
  180    show_info(Name, Infos, [info(Level)]).
  181
  182
  183show_info(_Name, _Properties, Options) :-
  184    option(silent(true), Options),
  185    !.
  186show_info(Name, Properties, Options) :-
  187    option(info(list), Options),
  188    !,
  189    memberchk(title(Title), Properties),
  190    memberchk(version(Version), Properties),
  191    format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
  192show_info(Name, Properties, _) :-
  193    !,
  194    print_property_value('Package'-'~w', [Name]),
  195    findall(Term, pack_level_info(info, Term, _, _), Terms),
  196    maplist(print_property(Properties), Terms).
  197
  198print_property(_, nl) :-
  199    !,
  200    format('~n').
  201print_property(Properties, Term) :-
  202    findall(Term, member(Term, Properties), Terms),
  203    Terms \== [],
  204    !,
  205    pack_level_info(_, Term, LabelFmt, _Def),
  206    (   LabelFmt = Label-FmtElem
  207    ->  true
  208    ;   Label = LabelFmt,
  209        FmtElem = '~w'
  210    ),
  211    multi_valued(Terms, FmtElem, FmtList, Values),
  212    atomic_list_concat(FmtList, ', ', Fmt),
  213    print_property_value(Label-Fmt, Values).
  214print_property(_, _).
  215
  216multi_valued([H], LabelFmt, [LabelFmt], Values) :-
  217    !,
  218    H =.. [_|Values].
  219multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
  220    H =.. [_|VH],
  221    append(VH, MoreValues, Values),
  222    multi_valued(T, LabelFmt, LT, MoreValues).
  223
  224
  225pvalue_column(24).
  226print_property_value(Prop-Fmt, Values) :-
  227    !,
  228    pvalue_column(C),
  229    atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
  230    format(Format, [Prop,C|Values]).
  231
  232pack_info(Name, Level, Info) :-
  233    '$pack':pack(Name, BaseDir),
  234    (   Info = directory(BaseDir)
  235    ;   pack_info_term(BaseDir, Info)
  236    ),
  237    pack_level_info(Level, Info, _Format, _Default).
  238
  239:- public pack_level_info/4.                    % used by web-server
  240
  241pack_level_info(_,    title(_),         'Title',                   '<no title>').
  242pack_level_info(_,    version(_),       'Installed version',       '<unknown>').
  243pack_level_info(info, directory(_),     'Installed in directory',  -).
  244pack_level_info(info, author(_, _),     'Author'-'~w <~w>',        -).
  245pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>',    -).
  246pack_level_info(info, packager(_, _),   'Packager'-'~w <~w>',      -).
  247pack_level_info(info, home(_),          'Home page',               -).
  248pack_level_info(info, download(_),      'Download URL',            -).
  249pack_level_info(_,    provides(_),      'Provides',                -).
  250pack_level_info(_,    requires(_),      'Requires',                -).
  251pack_level_info(_,    conflicts(_),     'Conflicts with',          -).
  252pack_level_info(_,    replaces(_),      'Replaces packages',       -).
  253pack_level_info(info, library(_),	'Provided libraries',      -).
  254
  255pack_default(Level, Infos, Def) :-
  256    pack_level_info(Level, ITerm, _Format, Def),
  257    Def \== (-),
  258    \+ memberchk(ITerm, Infos).
 pack_info_term(+PackDir, ?Info) is nondet
True when Info is meta-data for the package PackName.
  264pack_info_term(BaseDir, Info) :-
  265    directory_file_path(BaseDir, 'pack.pl', InfoFile),
  266    catch(
  267        setup_call_cleanup(
  268            open(InfoFile, read, In),
  269            term_in_stream(In, Info),
  270            close(In)),
  271        error(existence_error(source_sink, InfoFile), _),
  272        ( print_message(error, pack(no_meta_data(BaseDir))),
  273          fail
  274        )).
  275pack_info_term(BaseDir, library(Lib)) :-
  276    atom_concat(BaseDir, '/prolog/', LibDir),
  277    atom_concat(LibDir, '*.pl', Pattern),
  278    expand_file_name(Pattern, Files),
  279    maplist(atom_concat(LibDir), Plain, Files),
  280    convlist(base_name, Plain, Libs),
  281    member(Lib, Libs).
  282
  283base_name(File, Base) :-
  284    file_name_extension(Base, pl, File).
  285
  286term_in_stream(In, Term) :-
  287    repeat,
  288        read_term(In, Term0, []),
  289        (   Term0 == end_of_file
  290        ->  !, fail
  291        ;   Term = Term0,
  292            valid_info_term(Term0)
  293        ).
  294
  295valid_info_term(Term) :-
  296    Term =.. [Name|Args],
  297    same_length(Args, Types),
  298    Decl =.. [Name|Types],
  299    (   pack_info_term(Decl)
  300    ->  maplist(valid_info_arg, Types, Args)
  301    ;   print_message(warning, pack(invalid_info(Term))),
  302        fail
  303    ).
  304
  305valid_info_arg(Type, Arg) :-
  306    must_be(Type, Arg).
 pack_info_term(?Term) is nondet
True when Term describes name and arguments of a valid package info term.
  313pack_info_term(name(atom)).                     % Synopsis
  314pack_info_term(title(atom)).
  315pack_info_term(keywords(list(atom))).
  316pack_info_term(description(list(atom))).
  317pack_info_term(version(version)).
  318pack_info_term(author(atom, email_or_url_or_empty)).     % Persons
  319pack_info_term(maintainer(atom, email_or_url)).
  320pack_info_term(packager(atom, email_or_url)).
  321pack_info_term(pack_version(nonneg)).           % Package convention version
  322pack_info_term(home(atom)).                     % Home page
  323pack_info_term(download(atom)).                 % Source
  324pack_info_term(provides(atom)).                 % Dependencies
  325pack_info_term(requires(dependency)).
  326pack_info_term(conflicts(dependency)).          % Conflicts with package
  327pack_info_term(replaces(atom)).                 % Replaces another package
  328pack_info_term(autoload(boolean)).              % Default installation options
  329
  330:- multifile
  331    error:has_type/2.  332
  333error:has_type(version, Version) :-
  334    atom(Version),
  335    version_data(Version, _Data).
  336error:has_type(email_or_url, Address) :-
  337    atom(Address),
  338    (   sub_atom(Address, _, _, _, @)
  339    ->  true
  340    ;   uri_is_global(Address)
  341    ).
  342error:has_type(email_or_url_or_empty, Address) :-
  343    (   Address == ''
  344    ->  true
  345    ;   error:has_type(email_or_url, Address)
  346    ).
  347error:has_type(dependency, Value) :-
  348    is_dependency(Value, _Token, _Version).
  349
  350version_data(Version, version(Data)) :-
  351    atomic_list_concat(Parts, '.', Version),
  352    maplist(atom_number, Parts, Data).
  353
  354is_dependency(Token, Token, *) :-
  355    atom(Token).
  356is_dependency(Term, Token, VersionCmp) :-
  357    Term =.. [Op,Token,Version],
  358    cmp(Op, _),
  359    version_data(Version, _),
  360    VersionCmp =.. [Op,Version].
  361
  362cmp(<,  @<).
  363cmp(=<, @=<).
  364cmp(==, ==).
  365cmp(>=, @>=).
  366cmp(>,  @>).
  367
  368
  369                 /*******************************
  370                 *            SEARCH            *
  371                 *******************************/
 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:

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.
  400pack_list(Query) :-
  401    pack_search(Query).
  402
  403pack_search(Query) :-
  404    query_pack_server(search(Query), Result, []),
  405    (   Result == false
  406    ->  (   local_search(Query, Packs),
  407            Packs \== []
  408        ->  forall(member(pack(Pack, Stat, Title, Version, _), Packs),
  409                   format('~w ~w@~w ~28|- ~w~n',
  410                          [Stat, Pack, Version, Title]))
  411        ;   print_message(warning, pack(search_no_matches(Query)))
  412        )
  413    ;   Result = true(Hits),
  414        local_search(Query, Local),
  415        append(Hits, Local, All),
  416        sort(All, Sorted),
  417        list_hits(Sorted)
  418    ).
  419
  420list_hits([]).
  421list_hits([ pack(Pack, i, Title, Version, _),
  422            pack(Pack, p, Title, Version, _)
  423          | More
  424          ]) :-
  425    !,
  426    format('i ~w@~w ~28|- ~w~n', [Pack, Version, Title]),
  427    list_hits(More).
  428list_hits([ pack(Pack, i, Title, VersionI, _),
  429            pack(Pack, p, _,     VersionS, _)
  430          | More
  431          ]) :-
  432    !,
  433    version_data(VersionI, VDI),
  434    version_data(VersionS, VDS),
  435    (   VDI @< VDS
  436    ->  Tag = ('U')
  437    ;   Tag = ('A')
  438    ),
  439    format('~w ~w@~w(~w) ~28|- ~w~n', [Tag, Pack, VersionI, VersionS, Title]),
  440    list_hits(More).
  441list_hits([ pack(Pack, i, Title, VersionI, _)
  442          | More
  443          ]) :-
  444    !,
  445    format('l ~w@~w ~28|- ~w~n', [Pack, VersionI, Title]),
  446    list_hits(More).
  447list_hits([pack(Pack, Stat, Title, Version, _)|More]) :-
  448    format('~w ~w@~w ~28|- ~w~n', [Stat, Pack, Version, Title]),
  449    list_hits(More).
  450
  451
  452local_search(Query, Packs) :-
  453    findall(Pack, matching_installed_pack(Query, Pack), Packs).
  454
  455matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
  456    current_pack(Pack),
  457    findall(Term,
  458            ( pack_info(Pack, _, Term),
  459              search_info(Term)
  460            ), Info),
  461    (   sub_atom_icasechk(Pack, _, Query)
  462    ->  true
  463    ;   memberchk(title(Title), Info),
  464        sub_atom_icasechk(Title, _, Query)
  465    ),
  466    option(title(Title), Info, '<no title>'),
  467    option(version(Version), Info, '<no version>'),
  468    option(download(URL), Info, '<no download url>').
  469
  470search_info(title(_)).
  471search_info(version(_)).
  472search_info(download(_)).
  473
  474
  475                 /*******************************
  476                 *            INSTALL           *
  477                 *******************************/
 pack_install(+Spec:atom) is det
Install a package. Spec is one of

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

  498pack_install(Spec) :-
  499    pack_default_options(Spec, Pack, [], Options),
  500    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.
  507pack_default_options(_Spec, Pack, OptsIn, Options) :-
  508    option(already_installed(pack(Pack,_Version)), OptsIn),
  509    !,
  510    Options = OptsIn.
  511pack_default_options(_Spec, Pack, OptsIn, Options) :-
  512    option(url(URL), OptsIn),
  513    !,
  514    (   option(git(_), OptsIn)
  515    ->  Options = OptsIn
  516    ;   git_url(URL, Pack)
  517    ->  Options = [git(true)|OptsIn]
  518    ;   Options = OptsIn
  519    ),
  520    (   nonvar(Pack)
  521    ->  true
  522    ;   option(pack(Pack), Options)
  523    ->  true
  524    ;   pack_version_file(Pack, _Version, URL)
  525    ).
  526pack_default_options(Archive, Pack, _, Options) :-      % Install from archive
  527    must_be(atom, Archive),
  528    \+ uri_is_global(Archive),
  529    expand_file_name(Archive, [File]),
  530    exists_file(File),
  531    !,
  532    pack_version_file(Pack, Version, File),
  533    uri_file_name(FileURL, File),
  534    Options = [url(FileURL), version(Version)].
  535pack_default_options(URL, Pack, _, Options) :-
  536    git_url(URL, Pack),
  537    !,
  538    Options = [git(true), url(URL)].
  539pack_default_options(FileURL, Pack, _, Options) :-      % Install from directory
  540    uri_file_name(FileURL, Dir),
  541    exists_directory(Dir),
  542    pack_info_term(Dir, name(Pack)),
  543    !,
  544    (   pack_info_term(Dir, version(Version))
  545    ->  uri_file_name(DirURL, Dir),
  546        Options = [url(DirURL), version(Version)]
  547    ;   throw(error(existence_error(key, version, Dir),_))
  548    ).
  549pack_default_options('.', Pack, _, Options) :-          % Install from CWD
  550    pack_info_term('.', name(Pack)),
  551    !,
  552    working_directory(Dir, Dir),
  553    (   pack_info_term(Dir, version(Version))
  554    ->  uri_file_name(DirURL, Dir),
  555        Options = [url(DirURL), version(Version) | Options1],
  556        (   current_prolog_flag(windows, true)
  557        ->  Options1 = []
  558        ;   Options1 = [link(true), rebuild(make)]
  559        )
  560    ;   throw(error(existence_error(key, version, Dir),_))
  561    ).
  562pack_default_options(URL, Pack, _, Options) :-          % Install from URL
  563    pack_version_file(Pack, Version, URL),
  564    download_url(URL),
  565    !,
  566    available_download_versions(URL, [URLVersion-LatestURL|_]),
  567    Options = [url(LatestURL)|VersionOptions],
  568    version_options(Version, URLVersion, VersionOptions).
  569pack_default_options(Pack, Pack, OptsIn, Options) :-    % Install from name
  570    \+ uri_is_global(Pack),                             % ignore URLs
  571    query_pack_server(locate(Pack), Reply, OptsIn),
  572    (   Reply = true(Results)
  573    ->  pack_select_candidate(Pack, Results, OptsIn, Options)
  574    ;   print_message(warning, pack(no_match(Pack))),
  575        fail
  576    ).
  577
  578version_options(Version, Version, [version(Version)]) :- !.
  579version_options(Version, _, [version(Version)]) :-
  580    Version = version(List),
  581    maplist(integer, List),
  582    !.
  583version_options(_, _, []).
 pack_select_candidate(+Pack, +AvailableVersions, +OptionsIn, -Options)
Select from available packages.
  589pack_select_candidate(Pack, [AtomVersion-_|_], Options,
  590                      [already_installed(pack(Pack, Installed))|Options]) :-
  591    current_pack(Pack),
  592    pack_info(Pack, _, version(InstalledAtom)),
  593    atom_version(InstalledAtom, Installed),
  594    atom_version(AtomVersion, Version),
  595    Installed @>= Version,
  596    in_explicit_pack_dir(Pack, Options),
  597    !.
  598pack_select_candidate(Pack, Available, Options, OptsOut) :-
  599    option(url(URL), Options),
  600    memberchk(_Version-URLs, Available),
  601    memberchk(URL, URLs),
  602    !,
  603    (   git_url(URL, Pack)
  604    ->  Extra = [git(true)]
  605    ;   Extra = []
  606    ),
  607    OptsOut = [url(URL), inquiry(true) | Extra].
  608pack_select_candidate(Pack, [Version-[URL]|_], Options,
  609                      [url(URL), git(true), inquiry(true)]) :-
  610    git_url(URL, Pack),
  611    !,
  612    confirm(install_from(Pack, Version, git(URL)), yes, Options).
  613pack_select_candidate(Pack, [Version-[URL]|More], Options,
  614                      [url(URL), inquiry(true) | Upgrade]) :-
  615    (   More == []
  616    ->  !
  617    ;   true
  618    ),
  619    confirm(install_from(Pack, Version, URL), yes, Options),
  620    !,
  621    add_upgrade(Pack, Upgrade).
  622pack_select_candidate(Pack, [Version-URLs|_], Options,
  623                      [url(URL), inquiry(true)|Rest]) :-
  624    maplist(url_menu_item, URLs, Tagged),
  625    append(Tagged, [cancel=cancel], Menu),
  626    Menu = [Default=_|_],
  627    menu(pack(select_install_from(Pack, Version)),
  628         Menu, Default, Choice, Options),
  629    (   Choice == cancel
  630    ->  fail
  631    ;   Choice = git(URL)
  632    ->  Rest = [git(true)|Upgrade]
  633    ;   Choice = URL,
  634        Rest = Upgrade
  635    ),
  636    add_upgrade(Pack, Upgrade).
  637
  638add_upgrade(Pack, Options) :-
  639    current_pack(Pack),
  640    !,
  641    Options = [upgrade(true)].
  642add_upgrade(_, []).
  643
  644url_menu_item(URL, git(URL)=install_from(git(URL))) :-
  645    git_url(URL, _),
  646    !.
  647url_menu_item(URL, URL=install_from(URL)).
 in_explicit_pack_dir(+Pack, +Options) is semidet
True when Pack is installed in the explicit target directory.
  653in_explicit_pack_dir(Pack, Options) :-
  654    option(package_directory(Root), Options),
  655    current_pack(Pack, PackDir),
  656    file_directory_name(PackDir, Parent),
  657    same_file(Parent, Root).
 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.
insecure(+Boolean)
When true (default false), do not perform any checks on SSL certificates when downloading using https.
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.

  710pack_install(Spec, Options) :-
  711    pack_default_options(Spec, Pack, Options, DefOptions),
  712    (   option(already_installed(Installed), DefOptions)
  713    ->  print_message(informational, pack(already_installed(Installed)))
  714    ;   merge_options(Options, DefOptions, PackOptions),
  715        update_dependency_db,
  716        pack_install_dir(PackDir, PackOptions),
  717        pack_install(Pack, PackDir, PackOptions)
  718    ).
  719
  720pack_install_dir(PackDir, Options) :-
  721    option(package_directory(PackDir), Options),
  722    !.
  723pack_install_dir(PackDir, Options) :-
  724    base_alias(Alias, Options),
  725    absolute_file_name(Alias, PackDir,
  726                       [ file_type(directory),
  727                         access(write),
  728                         file_errors(fail)
  729                       ]),
  730    !.
  731pack_install_dir(PackDir, Options) :-
  732    pack_create_install_dir(PackDir, Options).
  733
  734base_alias(Alias, Options) :-
  735    option(global(true), Options),
  736    !,
  737    Alias = common_app_data(pack).
  738base_alias(Alias, Options) :-
  739    option(global(false), Options),
  740    !,
  741    Alias = user_app_data(pack).
  742base_alias(Alias, _Options) :-
  743    Alias = pack('.').
  744
  745pack_create_install_dir(PackDir, Options) :-
  746    base_alias(Alias, Options),
  747    findall(Candidate = create_dir(Candidate),
  748            ( absolute_file_name(Alias, Candidate, [solutions(all)]),
  749              \+ exists_file(Candidate),
  750              \+ exists_directory(Candidate),
  751              file_directory_name(Candidate, Super),
  752              (   exists_directory(Super)
  753              ->  access_file(Super, write)
  754              ;   true
  755              )
  756            ),
  757            Candidates0),
  758    list_to_set(Candidates0, Candidates),   % keep order
  759    pack_create_install_dir(Candidates, PackDir, Options).
  760
  761pack_create_install_dir(Candidates, PackDir, Options) :-
  762    Candidates = [Default=_|_],
  763    !,
  764    append(Candidates, [cancel=cancel], Menu),
  765    menu(pack(create_pack_dir), Menu, Default, Selected, Options),
  766    Selected \== cancel,
  767    (   catch(make_directory_path(Selected), E,
  768              (print_message(warning, E), fail))
  769    ->  PackDir = Selected
  770    ;   delete(Candidates, PackDir=create_dir(PackDir), Remaining),
  771        pack_create_install_dir(Remaining, PackDir, Options)
  772    ).
  773pack_create_install_dir(_, _, _) :-
  774    print_message(error, pack(cannot_create_dir(pack(.)))),
  775    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.
  790pack_install(Name, _, Options) :-
  791    current_pack(Name, Dir),
  792    option(upgrade(false), Options, false),
  793    \+ pack_is_in_local_dir(Name, Dir, Options),
  794    (   option(package_directory(_), Options)
  795    ->  in_explicit_pack_dir(Name, Options)
  796    ;   true
  797    ),
  798    print_message(error, pack(already_installed(Name))),
  799    pack_info(Name),
  800    print_message(information, pack(remove_with(Name))),
  801    !,
  802    fail.
  803pack_install(Name, PackDir, Options) :-
  804    option(url(URL), Options),
  805    uri_file_name(URL, Source),
  806    !,
  807    pack_install_from_local(Source, PackDir, Name, Options).
  808pack_install(Name, PackDir, Options) :-
  809    option(url(URL), Options),
  810    uri_components(URL, Components),
  811    uri_data(scheme, Components, Scheme),
  812    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).
  821pack_install_from_local(Source, PackTopDir, Name, Options) :-
  822    exists_directory(Source),
  823    !,
  824    directory_file_path(PackTopDir, Name, PackDir),
  825    (   option(link(true), Options)
  826    ->  (   same_file(Source, PackDir)
  827        ->  true
  828        ;   atom_concat(PackTopDir, '/', PackTopDirS),
  829            relative_file_name(Source, PackTopDirS, RelPath),
  830            link_file(RelPath, PackDir, symbolic),
  831            assertion(same_file(Source, PackDir))
  832        )
  833    ;   prepare_pack_dir(PackDir, Options),
  834        copy_directory(Source, PackDir)
  835    ),
  836    pack_post_install(Name, PackDir, Options).
  837pack_install_from_local(Source, PackTopDir, Name, Options) :-
  838    exists_file(Source),
  839    directory_file_path(PackTopDir, Name, PackDir),
  840    prepare_pack_dir(PackDir, Options),
  841    pack_unpack(Source, PackDir, Name, Options),
  842    pack_post_install(Name, PackDir, Options).
  843
  844pack_is_in_local_dir(_Pack, PackDir, Options) :-
  845    option(url(DirURL), Options),
  846    uri_file_name(DirURL, Dir),
  847    same_file(PackDir, Dir).
 pack_unpack(+SourceFile, +PackDir, +Pack, +Options)
Unpack an archive to the given package dir.
  854:- if(exists_source(library(archive))).  855pack_unpack(Source, PackDir, Pack, Options) :-
  856    ensure_loaded_archive,
  857    pack_archive_info(Source, Pack, _Info, StripOptions),
  858    prepare_pack_dir(PackDir, Options),
  859    archive_extract(Source, PackDir,
  860                    [ exclude(['._*'])          % MacOS resource forks
  861                    | StripOptions
  862                    ]).
  863:- else.  864pack_unpack(_,_,_,_) :-
  865    existence_error(library, archive).
  866:- endif.  867
  868                 /*******************************
  869                 *             INFO             *
  870                 *******************************/
 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.
  884:- if(exists_source(library(archive))).  885ensure_loaded_archive :-
  886    current_predicate(archive_open/3),
  887    !.
  888ensure_loaded_archive :-
  889    use_module(library(archive)).
  890
  891pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
  892    ensure_loaded_archive,
  893    size_file(Archive, Bytes),
  894    setup_call_cleanup(
  895        archive_open(Archive, Handle, []),
  896        (   repeat,
  897            (   archive_next_header(Handle, InfoFile)
  898            ->  true
  899            ;   !, fail
  900            )
  901        ),
  902        archive_close(Handle)),
  903    file_base_name(InfoFile, 'pack.pl'),
  904    atom_concat(Prefix, 'pack.pl', InfoFile),
  905    strip_option(Prefix, Pack, Strip),
  906    setup_call_cleanup(
  907        archive_open_entry(Handle, Stream),
  908        read_stream_to_terms(Stream, Info),
  909        close(Stream)),
  910    !,
  911    must_be(ground, Info),
  912    maplist(valid_info_term, Info).
  913:- else.  914pack_archive_info(_, _, _, _) :-
  915    existence_error(library, archive).
  916:- endif.  917pack_archive_info(_, _, _, _) :-
  918    existence_error(pack_file, 'pack.pl').
  919
  920strip_option('', _, []) :- !.
  921strip_option('./', _, []) :- !.
  922strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
  923    atom_concat(PrefixDir, /, Prefix),
  924    file_base_name(PrefixDir, Base),
  925    (   Base == Pack
  926    ->  true
  927    ;   pack_version_file(Pack, _, Base)
  928    ->  true
  929    ;   \+ sub_atom(PrefixDir, _, _, _, /)
  930    ).
  931
  932read_stream_to_terms(Stream, Terms) :-
  933    read(Stream, Term0),
  934    read_stream_to_terms(Term0, Stream, Terms).
  935
  936read_stream_to_terms(end_of_file, _, []) :- !.
  937read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
  938    read(Stream, Term1),
  939    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.
  947pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
  948    exists_directory(GitDir),
  949    !,
  950    git_ls_tree(Entries, [directory(GitDir)]),
  951    git_hash(Hash, [directory(GitDir)]),
  952    maplist(arg(4), Entries, Sizes),
  953    sum_list(Sizes, Bytes),
  954    directory_file_path(GitDir, 'pack.pl', InfoFile),
  955    read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
  956    must_be(ground, Info),
  957    maplist(valid_info_term, Info).
 download_file_sanity_check(+Archive, +Pack, +Info) is semidet
Perform basic sanity checks on DownloadFile
  963download_file_sanity_check(Archive, Pack, Info) :-
  964    info_field(name(Name), Info),
  965    info_field(version(VersionAtom), Info),
  966    atom_version(VersionAtom, Version),
  967    pack_version_file(PackA, VersionA, Archive),
  968    must_match([Pack, PackA, Name], name),
  969    must_match([Version, VersionA], version).
  970
  971info_field(Field, Info) :-
  972    memberchk(Field, Info),
  973    ground(Field),
  974    !.
  975info_field(Field, _Info) :-
  976    functor(Field, FieldName, _),
  977    print_message(error, pack(missing(FieldName))),
  978    fail.
  979
  980must_match(Values, _Field) :-
  981    sort(Values, [_]),
  982    !.
  983must_match(Values, Field) :-
  984    print_message(error, pack(conflict(Field, Values))),
  985    fail.
  986
  987
  988                 /*******************************
  989                 *         INSTALLATION         *
  990                 *******************************/
 prepare_pack_dir(+Dir, +Options)
Prepare for installing the package into Dir. This
 1002prepare_pack_dir(Dir, Options) :-
 1003    exists_directory(Dir),
 1004    !,
 1005    (   empty_directory(Dir)
 1006    ->  true
 1007    ;   (   option(upgrade(true), Options)
 1008        ;   confirm(remove_existing_pack(Dir), yes, Options)
 1009        )
 1010    ->  delete_directory_and_contents(Dir),
 1011        make_directory(Dir)
 1012    ).
 1013prepare_pack_dir(Dir, _) :-
 1014    make_directory(Dir).
 empty_directory(+Directory) is semidet
True if Directory is empty (holds no files or sub-directories).
 1020empty_directory(Dir) :-
 1021    \+ ( directory_files(Dir, Entries),
 1022         member(Entry, Entries),
 1023         \+ special(Entry)
 1024       ).
 1025
 1026special(.).
 1027special(..).
 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.
 1037pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
 1038    option(git(true), Options),
 1039    !,
 1040    directory_file_path(PackTopDir, Pack, PackDir),
 1041    prepare_pack_dir(PackDir, Options),
 1042    run_process(path(git), [clone, URL, PackDir], []),
 1043    pack_git_info(PackDir, Hash, Info),
 1044    pack_inquiry(URL, git(Hash), Info, Options),
 1045    show_info(Pack, Info, Options),
 1046    confirm(git_post_install(PackDir, Pack), yes, Options),
 1047    pack_post_install(Pack, PackDir, Options).
 1048pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
 1049    download_scheme(Scheme),
 1050    directory_file_path(PackTopDir, Pack, PackDir),
 1051    prepare_pack_dir(PackDir, Options),
 1052    pack_download_dir(PackTopDir, DownLoadDir),
 1053    download_file(URL, Pack, DownloadBase, Options),
 1054    directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
 1055    (   option(insecure(true), Options, false)
 1056    ->  TLSOptions = [cert_verify_hook(ssl_verify)]
 1057    ;   TLSOptions = []
 1058    ),
 1059    setup_call_cleanup(
 1060        http_open(URL, In, TLSOptions),
 1061        setup_call_cleanup(
 1062            open(DownloadFile, write, Out, [type(binary)]),
 1063            copy_stream_data(In, Out),
 1064            close(Out)),
 1065        close(In)),
 1066    pack_archive_info(DownloadFile, Pack, Info, _),
 1067    download_file_sanity_check(DownloadFile, Pack, Info),
 1068    pack_inquiry(URL, DownloadFile, Info, Options),
 1069    show_info(Pack, Info, Options),
 1070    confirm(install_downloaded(DownloadFile), yes, Options),
 1071    pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).
 download_file(+URL, +Pack, -File, +Options) is det
 1075download_file(URL, Pack, File, Options) :-
 1076    option(version(Version), Options),
 1077    !,
 1078    atom_version(VersionA, Version),
 1079    file_name_extension(_, Ext, URL),
 1080    format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
 1081download_file(URL, Pack, File, _) :-
 1082    file_base_name(URL,Basename),
 1083    no_int_file_name_extension(Tag,Ext,Basename),
 1084    tag_version(Tag,Version),
 1085    !,
 1086    atom_version(VersionA,Version),
 1087    format(atom(File0), '~w-~w', [Pack, VersionA]),
 1088    file_name_extension(File0, Ext, File).
 1089download_file(URL, _, File, _) :-
 1090    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.
 1098pack_url_file(URL, FileID) :-
 1099    github_release_url(URL, Pack, Version),
 1100    !,
 1101    download_file(URL, Pack, FileID, [version(Version)]).
 1102pack_url_file(URL, FileID) :-
 1103    file_base_name(URL, FileID).
 1104
 1105
 1106:- public ssl_verify/5. 1107
 1108%   ssl_verify(+SSL, +ProblemCert, +AllCerts, +FirstCert, +Error)
 1109%
 1110%   Currently we accept  all  certificates.   We  organise  our  own
 1111%   security using SHA1 signatures, so  we   do  not  care about the
 1112%   source of the data.
 1113
 1114ssl_verify(_SSL,
 1115           _ProblemCertificate, _AllCertificates, _FirstCertificate,
 1116           _Error).
 1117
 1118pack_download_dir(PackTopDir, DownLoadDir) :-
 1119    directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
 1120    (   exists_directory(DownLoadDir)
 1121    ->  true
 1122    ;   make_directory(DownLoadDir)
 1123    ),
 1124    (   access_file(DownLoadDir, write)
 1125    ->  true
 1126    ;   permission_error(write, directory, DownLoadDir)
 1127    ).
 download_url(+URL) is det
True if URL looks like a URL we can download from.
 1133download_url(URL) :-
 1134    atom(URL),
 1135    uri_components(URL, Components),
 1136    uri_data(scheme, Components, Scheme),
 1137    download_scheme(Scheme).
 1138
 1139download_scheme(http).
 1140download_scheme(https) :-
 1141    catch(use_module(library(http/http_ssl_plugin)),
 1142          E, (print_message(warning, E), fail)).
 pack_post_install(+Pack, +PackDir, +Options) is det
Process post installation work. Steps:
 1152pack_post_install(Pack, PackDir, Options) :-
 1153    post_install_foreign(Pack, PackDir, Options),
 1154    post_install_autoload(PackDir, Options),
 1155    attach_packs(PackDir, [duplicate(warning)]).
 pack_rebuild(+Pack) is det
Rebuild possible foreign components of Pack.
 1161pack_rebuild(Pack) :-
 1162    current_pack(Pack, PackDir),
 1163    !,
 1164    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 1165pack_rebuild(Pack) :-
 1166    unattached_pacth(Pack, PackDir),
 1167    !,
 1168    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 1169pack_rebuild(Pack) :-
 1170    existence_error(pack, Pack).
 1171
 1172unattached_pacth(Pack, BaseDir) :-
 1173    directory_file_path(Pack, 'pack.pl', PackFile),
 1174    absolute_file_name(pack(PackFile), PackPath,
 1175                       [ access(read),
 1176                         file_errors(fail)
 1177                       ]),
 1178    file_directory_name(PackPath, BaseDir).
 pack_rebuild is det
Rebuild foreign components of all packages.
 1184pack_rebuild :-
 1185    forall(current_pack(Pack),
 1186           ( print_message(informational, pack(rebuild(Pack))),
 1187             pack_rebuild(Pack)
 1188           )).
 post_install_foreign(+Pack, +PackDir, +Options) is det
Install foreign parts of the package.
 1195post_install_foreign(Pack, PackDir, Options) :-
 1196    is_foreign_pack(PackDir, _),
 1197    !,
 1198    (   pack_info_term(PackDir, pack_version(Version))
 1199    ->  true
 1200    ;   Version = 1
 1201    ),
 1202    option(rebuild(Rebuild), Options, if_absent),
 1203    (   Rebuild == if_absent,
 1204        foreign_present(PackDir)
 1205    ->  print_message(informational, pack(kept_foreign(Pack)))
 1206    ;   BuildSteps0 = [[dependencies], [configure], build, [test], install],
 1207        (   Rebuild == true
 1208        ->  BuildSteps1 = [distclean|BuildSteps0]
 1209        ;   BuildSteps1 = BuildSteps0
 1210        ),
 1211        (   option(test(false), Options)
 1212        ->  delete(BuildSteps1, [test], BuildSteps)
 1213        ;   BuildSteps = BuildSteps1
 1214        ),
 1215        build_steps(BuildSteps, PackDir, [pack_version(Version)|Options])
 1216    ).
 1217post_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.
 1226foreign_present(PackDir) :-
 1227    current_prolog_flag(arch, Arch),
 1228    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
 1229    exists_directory(ForeignBaseDir),
 1230    !,
 1231    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
 1232    exists_directory(ForeignDir),
 1233    current_prolog_flag(shared_object_extension, Ext),
 1234    atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
 1235    expand_file_name(Pattern, Files),
 1236    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.
 1243is_foreign_pack(PackDir, Type) :-
 1244    foreign_file(File, Type),
 1245    directory_file_path(PackDir, File, Path),
 1246    exists_file(Path).
 1247
 1248foreign_file('CMakeLists.txt', cmake).
 1249foreign_file('configure',      configure).
 1250foreign_file('configure.in',   autoconf).
 1251foreign_file('configure.ac',   autoconf).
 1252foreign_file('Makefile.am',    automake).
 1253foreign_file('Makefile',       make).
 1254foreign_file('makefile',       make).
 1255foreign_file('conanfile.txt',  conan).
 1256foreign_file('conanfile.py',   conan).
 1257
 1258
 1259                 /*******************************
 1260                 *           AUTOLOAD           *
 1261                 *******************************/
 post_install_autoload(+PackDir, +Options)
Create an autoload index if the package demands such.
 1267post_install_autoload(PackDir, Options) :-
 1268    option(autoload(true), Options, true),
 1269    pack_info_term(PackDir, autoload(true)),
 1270    !,
 1271    directory_file_path(PackDir, prolog, PrologLibDir),
 1272    make_library_index(PrologLibDir).
 1273post_install_autoload(_, _).
 1274
 1275
 1276                 /*******************************
 1277                 *            UPGRADE           *
 1278                 *******************************/
 pack_upgrade(+Pack) is semidet
Try to upgrade the package Pack.
To be done
- Update dependencies when updating a pack from git?
 1286pack_upgrade(Pack) :-
 1287    pack_info(Pack, _, directory(Dir)),
 1288    directory_file_path(Dir, '.git', GitDir),
 1289    exists_directory(GitDir),
 1290    !,
 1291    print_message(informational, pack(git_fetch(Dir))),
 1292    git([fetch], [ directory(Dir) ]),
 1293    git_describe(V0, [ directory(Dir) ]),
 1294    git_describe(V1, [ directory(Dir), commit('origin/master') ]),
 1295    (   V0 == V1
 1296    ->  print_message(informational, pack(up_to_date(Pack)))
 1297    ;   confirm(upgrade(Pack, V0, V1), yes, []),
 1298        git([merge, 'origin/master'], [ directory(Dir) ]),
 1299        pack_rebuild(Pack)
 1300    ).
 1301pack_upgrade(Pack) :-
 1302    once(pack_info(Pack, _, version(VersionAtom))),
 1303    atom_version(VersionAtom, Version),
 1304    pack_info(Pack, _, download(URL)),
 1305    (   wildcard_pattern(URL)
 1306    ->  true
 1307    ;   github_url(URL, _User, _Repo)
 1308    ),
 1309    !,
 1310    available_download_versions(URL, [Latest-LatestURL|_Versions]),
 1311    (   Latest @> Version
 1312    ->  confirm(upgrade(Pack, Version, Latest), yes, []),
 1313        pack_install(Pack,
 1314                     [ url(LatestURL),
 1315                       upgrade(true),
 1316                       pack(Pack)
 1317                     ])
 1318    ;   print_message(informational, pack(up_to_date(Pack)))
 1319    ).
 1320pack_upgrade(Pack) :-
 1321    print_message(warning, pack(no_upgrade_info(Pack))).
 1322
 1323
 1324                 /*******************************
 1325                 *            REMOVE            *
 1326                 *******************************/
 pack_remove(+Name) is det
Remove the indicated package.
 1332pack_remove(Pack) :-
 1333    update_dependency_db,
 1334    (   setof(Dep, pack_depends_on(Dep, Pack), Deps)
 1335    ->  confirm_remove(Pack, Deps, Delete),
 1336        forall(member(P, Delete), pack_remove_forced(P))
 1337    ;   pack_remove_forced(Pack)
 1338    ).
 1339
 1340pack_remove_forced(Pack) :-
 1341    catch('$pack_detach'(Pack, BaseDir),
 1342          error(existence_error(pack, Pack), _),
 1343          fail),
 1344    !,
 1345    print_message(informational, pack(remove(BaseDir))),
 1346    delete_directory_and_contents(BaseDir).
 1347pack_remove_forced(Pack) :-
 1348    unattached_pacth(Pack, BaseDir),
 1349    !,
 1350    delete_directory_and_contents(BaseDir).
 1351pack_remove_forced(Pack) :-
 1352    print_message(informational, error(existence_error(pack, Pack),_)).
 1353
 1354confirm_remove(Pack, Deps, Delete) :-
 1355    print_message(warning, pack(depends(Pack, Deps))),
 1356    menu(pack(resolve_remove),
 1357         [ [Pack]      = remove_only(Pack),
 1358           [Pack|Deps] = remove_deps(Pack, Deps),
 1359           []          = cancel
 1360         ], [], Delete, []),
 1361    Delete \== [].
 1362
 1363
 1364                 /*******************************
 1365                 *           PROPERTIES         *
 1366                 *******************************/
 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)
 1389pack_property(Pack, Property) :-
 1390    findall(Pack-Property, pack_property_(Pack, Property), List),
 1391    member(Pack-Property, List).            % make det if applicable
 1392
 1393pack_property_(Pack, Property) :-
 1394    pack_info(Pack, _, Property).
 1395pack_property_(Pack, Property) :-
 1396    \+ \+ info_file(Property, _),
 1397    '$pack':pack(Pack, BaseDir),
 1398    access_file(BaseDir, read),
 1399    directory_files(BaseDir, Files),
 1400    member(File, Files),
 1401    info_file(Property, Pattern),
 1402    downcase_atom(File, Pattern),
 1403    directory_file_path(BaseDir, File, InfoFile),
 1404    arg(1, Property, InfoFile).
 1405
 1406info_file(readme(_), 'readme.txt').
 1407info_file(readme(_), 'readme').
 1408info_file(todo(_),   'todo.txt').
 1409info_file(todo(_),   'todo').
 1410
 1411
 1412                 /*******************************
 1413                 *             GIT              *
 1414                 *******************************/
 git_url(+URL, -Pack) is semidet
True if URL describes a git url for Pack
 1420git_url(URL, Pack) :-
 1421    uri_components(URL, Components),
 1422    uri_data(scheme, Components, Scheme),
 1423    nonvar(Scheme),                         % must be full URL
 1424    uri_data(path, Components, Path),
 1425    (   Scheme == git
 1426    ->  true
 1427    ;   git_download_scheme(Scheme),
 1428        file_name_extension(_, git, Path)
 1429    ;   git_download_scheme(Scheme),
 1430        catch(git_ls_remote(URL, _, [refs(['HEAD']), error(_)]), _, fail)
 1431    ->  true
 1432    ),
 1433    file_base_name(Path, PackExt),
 1434    (   file_name_extension(Pack, git, PackExt)
 1435    ->  true
 1436    ;   Pack = PackExt
 1437    ),
 1438    (   safe_pack_name(Pack)
 1439    ->  true
 1440    ;   domain_error(pack_name, Pack)
 1441    ).
 1442
 1443git_download_scheme(http).
 1444git_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.
 1451safe_pack_name(Name) :-
 1452    atom_length(Name, Len),
 1453    Len >= 3,                               % demand at least three length
 1454    atom_codes(Name, Codes),
 1455    maplist(safe_pack_char, Codes),
 1456    !.
 1457
 1458safe_pack_char(C) :- between(0'a, 0'z, C), !.
 1459safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 1460safe_pack_char(C) :- between(0'0, 0'9, C), !.
 1461safe_pack_char(0'_).
 1462
 1463
 1464                 /*******************************
 1465                 *         VERSION LOGIC        *
 1466                 *******************************/
 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.
 1475pack_version_file(Pack, Version, GitHubRelease) :-
 1476    atomic(GitHubRelease),
 1477    github_release_url(GitHubRelease, Pack, Version),
 1478    !.
 1479pack_version_file(Pack, Version, Path) :-
 1480    atomic(Path),
 1481    file_base_name(Path, File),
 1482    no_int_file_name_extension(Base, _Ext, File),
 1483    atom_codes(Base, Codes),
 1484    (   phrase(pack_version(Pack, Version), Codes),
 1485        safe_pack_name(Pack)
 1486    ->  true
 1487    ).
 1488
 1489no_int_file_name_extension(Base, Ext, File) :-
 1490    file_name_extension(Base0, Ext0, File),
 1491    \+ atom_number(Ext0, _),
 1492    !,
 1493    Base = Base0,
 1494    Ext = Ext0.
 1495no_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'
 1508github_release_url(URL, Pack, Version) :-
 1509    uri_components(URL, Components),
 1510    uri_data(authority, Components, 'github.com'),
 1511    uri_data(scheme, Components, Scheme),
 1512    download_scheme(Scheme),
 1513    uri_data(path, Components, Path),
 1514    github_archive_path(Archive,Pack,File),
 1515    atomic_list_concat(Archive, /, Path),
 1516    file_name_extension(Tag, Ext, File),
 1517    github_archive_extension(Ext),
 1518    tag_version(Tag, Version),
 1519    !.
 1520
 1521github_archive_path(['',_User,Pack,archive,File],Pack,File).
 1522github_archive_path(['',_User,Pack,archive,refs,tags,File],Pack,File).
 1523
 1524github_archive_extension(tgz).
 1525github_archive_extension(zip).
 1526
 1527tag_version(Tag, Version) :-
 1528    version_tag_prefix(Prefix),
 1529    atom_concat(Prefix, AtomVersion, Tag),
 1530    atom_version(AtomVersion, Version).
 1531
 1532version_tag_prefix(v).
 1533version_tag_prefix('V').
 1534version_tag_prefix('').
 1535
 1536
 1537:- public
 1538    atom_version/2. 1539
 1540%   atom_version(?Atom, ?Version)
 1541%
 1542%   Translate   between   atomic   version   representation   and   term
 1543%   representation.  The  term  representation  is  a  list  of  version
 1544%   components as integers and can be compared using `@>`
 1545
 1546atom_version(Atom, version(Parts)) :-
 1547    (   atom(Atom)
 1548    ->  atom_codes(Atom, Codes),
 1549        phrase(version(Parts), Codes)
 1550    ;   atomic_list_concat(Parts, '.', Atom)
 1551    ).
 1552
 1553pack_version(Pack, version(Parts)) -->
 1554    string(Codes), "-",
 1555    version(Parts),
 1556    !,
 1557    { atom_codes(Pack, Codes)
 1558    }.
 1559
 1560version([_|T]) -->
 1561    "*",
 1562    !,
 1563    (   "."
 1564    ->  version(T)
 1565    ;   []
 1566    ).
 1567version([H|T]) -->
 1568    integer(H),
 1569    (   "."
 1570    ->  version(T)
 1571    ;   { T = [] }
 1572    ).
 1573
 1574                 /*******************************
 1575                 *       QUERY CENTRAL DB       *
 1576                 *******************************/
 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.
 1596pack_inquiry(_, _, _, Options) :-
 1597    option(inquiry(false), Options),
 1598    !.
 1599pack_inquiry(URL, DownloadFile, Info, Options) :-
 1600    setting(server, ServerBase),
 1601    ServerBase \== '',
 1602    atom_concat(ServerBase, query, Server),
 1603    (   option(inquiry(true), Options)
 1604    ->  true
 1605    ;   confirm(inquiry(Server), yes, Options)
 1606    ),
 1607    !,
 1608    (   DownloadFile = git(SHA1)
 1609    ->  true
 1610    ;   file_sha1(DownloadFile, SHA1)
 1611    ),
 1612    query_pack_server(install(URL, SHA1, Info), Reply, Options),
 1613    inquiry_result(Reply, URL, Options).
 1614pack_inquiry(_, _, _, _).
 query_pack_server(+Query, -Result, +Options)
Send a Prolog query to the package server and process its results.
 1622query_pack_server(Query, Result, Options) :-
 1623    setting(server, ServerBase),
 1624    ServerBase \== '',
 1625    atom_concat(ServerBase, query, Server),
 1626    format(codes(Data), '~q.~n', Query),
 1627    info_level(Informational, Options),
 1628    print_message(Informational, pack(contacting_server(Server))),
 1629    setup_call_cleanup(
 1630        http_open(Server, In,
 1631                  [ post(codes(application/'x-prolog', Data)),
 1632                    header(content_type, ContentType)
 1633                  ]),
 1634        read_reply(ContentType, In, Result),
 1635        close(In)),
 1636    message_severity(Result, Level, Informational),
 1637    print_message(Level, pack(server_reply(Result))).
 1638
 1639read_reply(ContentType, In, Result) :-
 1640    sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
 1641    !,
 1642    set_stream(In, encoding(utf8)),
 1643    read(In, Result).
 1644read_reply(ContentType, In, _Result) :-
 1645    read_string(In, 500, String),
 1646    print_message(error, pack(no_prolog_response(ContentType, String))),
 1647    fail.
 1648
 1649info_level(Level, Options) :-
 1650    option(silent(true), Options),
 1651    !,
 1652    Level = silent.
 1653info_level(informational, _).
 1654
 1655message_severity(true(_), Informational, Informational).
 1656message_severity(false, warning, _).
 1657message_severity(exception(_), error, _).
 inquiry_result(+Reply, +File, +Options) is semidet
Analyse the results of the inquiry and decide whether to continue or not.
 1665inquiry_result(Reply, File, Options) :-
 1666    findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation),
 1667    \+ member(cancel, Evaluation),
 1668    select_option(git(_), Options, Options1, _),
 1669    forall(member(install_dependencies(Resolution), Evaluation),
 1670           maplist(install_dependency(Options1), Resolution)).
 1671
 1672eval_inquiry(true(Reply), URL, Eval, _) :-
 1673    include(alt_hash, Reply, Alts),
 1674    Alts \== [],
 1675    print_message(warning, pack(alt_hashes(URL, Alts))),
 1676    (   memberchk(downloads(Count), Reply),
 1677        (   git_url(URL, _)
 1678        ->  Default = yes,
 1679            Eval = with_git_commits_in_same_version
 1680        ;   Default = no,
 1681            Eval = with_alt_hashes
 1682        ),
 1683        confirm(continue_with_alt_hashes(Count, URL), Default, [])
 1684    ->  true
 1685    ;   !,                          % Stop other rules
 1686        Eval = cancel
 1687    ).
 1688eval_inquiry(true(Reply), _, Eval, Options) :-
 1689    include(dependency, Reply, Deps),
 1690    Deps \== [],
 1691    select_dependency_resolution(Deps, Eval, Options),
 1692    (   Eval == cancel
 1693    ->  !
 1694    ;   true
 1695    ).
 1696eval_inquiry(true(Reply), URL, true, Options) :-
 1697    file_base_name(URL, File),
 1698    info_level(Informational, Options),
 1699    print_message(Informational, pack(inquiry_ok(Reply, File))).
 1700eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))),
 1701             URL, Eval, Options) :-
 1702    (   confirm(continue_with_modified_hash(URL), no, Options)
 1703    ->  Eval = true
 1704    ;   Eval = cancel
 1705    ).
 1706
 1707alt_hash(alt_hash(_,_,_)).
 1708dependency(dependency(_,_,_,_,_)).
 select_dependency_resolution(+Deps, -Eval, +Options)
Select a resolution.
To be done
- Exploit backtracking over resolve_dependencies/2.
 1717select_dependency_resolution(Deps, Eval, Options) :-
 1718    resolve_dependencies(Deps, Resolution),
 1719    exclude(local_dep, Resolution, ToBeDone),
 1720    (   ToBeDone == []
 1721    ->  !, Eval = true
 1722    ;   print_message(warning, pack(install_dependencies(Resolution))),
 1723        (   memberchk(_-unresolved, Resolution)
 1724        ->  Default = cancel
 1725        ;   Default = install_deps
 1726        ),
 1727        menu(pack(resolve_deps),
 1728             [ install_deps    = install_deps,
 1729               install_no_deps = install_no_deps,
 1730               cancel          = cancel
 1731             ], Default, Choice, Options),
 1732        (   Choice == cancel
 1733        ->  !, Eval = cancel
 1734        ;   Choice == install_no_deps
 1735        ->  !, Eval = install_no_deps
 1736        ;   !, Eval = install_dependencies(Resolution)
 1737        )
 1738    ).
 1739
 1740local_dep(_-resolved(_)).
 install_dependency(+Options, +TokenResolution)
Install dependencies for the given resolution.
To be done
- : Query URI to use
 1749install_dependency(Options,
 1750                   _Token-resolve(Pack, VersionAtom, [_URL|_], SubResolve)) :-
 1751    atom_version(VersionAtom, Version),
 1752    current_pack(Pack),
 1753    pack_info(Pack, _, version(InstalledAtom)),
 1754    atom_version(InstalledAtom, Installed),
 1755    Installed == Version,               % already installed
 1756    !,
 1757    maplist(install_dependency(Options), SubResolve).
 1758install_dependency(Options,
 1759                   _Token-resolve(Pack, VersionAtom, [URL|_], SubResolve)) :-
 1760    !,
 1761    atom_version(VersionAtom, Version),
 1762    merge_options([ url(URL),
 1763                    version(Version),
 1764                    interactive(false),
 1765                    inquiry(false),
 1766                    info(list),
 1767                    pack(Pack)
 1768                  ], Options, InstallOptions),
 1769    pack_install(Pack, InstallOptions),
 1770    maplist(install_dependency(Options), SubResolve).
 1771install_dependency(_, _-_).
 1772
 1773
 1774                 /*******************************
 1775                 *        WILDCARD URIs         *
 1776                 *******************************/
 available_download_versions(+URL, -Versions) is det
Deal with wildcard URLs, returning a list of Version-URL pairs, sorted by version.
To be done
- Deal with protocols other than HTTP
 1785available_download_versions(URL, Versions) :-
 1786    wildcard_pattern(URL),
 1787    github_url(URL, User, Repo),
 1788    !,
 1789    findall(Version-VersionURL,
 1790            github_version(User, Repo, Version, VersionURL),
 1791            Versions).
 1792available_download_versions(URL, Versions) :-
 1793    wildcard_pattern(URL),
 1794    !,
 1795    file_directory_name(URL, DirURL0),
 1796    ensure_slash(DirURL0, DirURL),
 1797    print_message(informational, pack(query_versions(DirURL))),
 1798    setup_call_cleanup(
 1799        http_open(DirURL, In, []),
 1800        load_html(stream(In), DOM,
 1801                  [ syntax_errors(quiet)
 1802                  ]),
 1803        close(In)),
 1804    findall(MatchingURL,
 1805            absolute_matching_href(DOM, URL, MatchingURL),
 1806            MatchingURLs),
 1807    (   MatchingURLs == []
 1808    ->  print_message(warning, pack(no_matching_urls(URL)))
 1809    ;   true
 1810    ),
 1811    versioned_urls(MatchingURLs, VersionedURLs),
 1812    keysort(VersionedURLs, SortedVersions),
 1813    reverse(SortedVersions, Versions),
 1814    print_message(informational, pack(found_versions(Versions))).
 1815available_download_versions(URL, [Version-URL]) :-
 1816    (   pack_version_file(_Pack, Version0, URL)
 1817    ->  Version = Version0
 1818    ;   Version = unknown
 1819    ).
 github_url(+URL, -User, -Repo) is semidet
True when URL refers to a github repository.
 1825github_url(URL, User, Repo) :-
 1826    uri_components(URL, uri_components(https,'github.com',Path,_,_)),
 1827    atomic_list_concat(['',User,Repo|_], /, Path).
 github_version(+User, +Repo, -Version, -VersionURI) is nondet
True when Version is a release version and VersionURI is the download location for the zip file.
 1835github_version(User, Repo, Version, VersionURI) :-
 1836    atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
 1837    uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
 1838    setup_call_cleanup(
 1839      http_open(ApiUri, In,
 1840                [ request_header('Accept'='application/vnd.github.v3+json')
 1841                ]),
 1842      json_read_dict(In, Dicts),
 1843      close(In)),
 1844    member(Dict, Dicts),
 1845    atom_string(Tag, Dict.name),
 1846    tag_version(Tag, Version),
 1847    atom_string(VersionURI, Dict.zipball_url).
 1848
 1849wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
 1850wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
 1851
 1852ensure_slash(Dir, DirS) :-
 1853    (   sub_atom(Dir, _, _, 0, /)
 1854    ->  DirS = Dir
 1855    ;   atom_concat(Dir, /, DirS)
 1856    ).
 1857
 1858absolute_matching_href(DOM, Pattern, Match) :-
 1859    xpath(DOM, //a(@href), HREF),
 1860    uri_normalized(HREF, Pattern, Match),
 1861    wildcard_match(Pattern, Match).
 1862
 1863versioned_urls([], []).
 1864versioned_urls([H|T0], List) :-
 1865    file_base_name(H, File),
 1866    (   pack_version_file(_Pack, Version, File)
 1867    ->  List = [Version-H|T]
 1868    ;   List = T
 1869    ),
 1870    versioned_urls(T0, T).
 1871
 1872
 1873                 /*******************************
 1874                 *          DEPENDENCIES        *
 1875                 *******************************/
 update_dependency_db
Reload dependency declarations between packages.
 1881update_dependency_db :-
 1882    retractall(pack_requires(_,_)),
 1883    retractall(pack_provides_db(_,_)),
 1884    forall(current_pack(Pack),
 1885           (   findall(Info, pack_info(Pack, dependency, Info), Infos),
 1886               update_dependency_db(Pack, Infos)
 1887           )).
 1888
 1889update_dependency_db(Name, Info) :-
 1890    retractall(pack_requires(Name, _)),
 1891    retractall(pack_provides_db(Name, _)),
 1892    maplist(assert_dep(Name), Info).
 1893
 1894assert_dep(Pack, provides(Token)) :-
 1895    !,
 1896    assertz(pack_provides_db(Pack, Token)).
 1897assert_dep(Pack, requires(Token)) :-
 1898    !,
 1899    assertz(pack_requires(Pack, Token)).
 1900assert_dep(_, _).
 validate_dependencies is det
Validate all dependencies, reporting on failures
 1906validate_dependencies :-
 1907    unsatisfied_dependencies(Unsatisfied),
 1908    !,
 1909    print_message(warning, pack(unsatisfied(Unsatisfied))).
 1910validate_dependencies.
 1911
 1912
 1913unsatisfied_dependencies(Unsatisfied) :-
 1914    findall(Req-Pack, pack_requires(Pack, Req), Reqs0),
 1915    keysort(Reqs0, Reqs1),
 1916    group_pairs_by_key(Reqs1, GroupedReqs),
 1917    exclude(satisfied_dependency, GroupedReqs, Unsatisfied),
 1918    Unsatisfied \== [].
 1919
 1920satisfied_dependency(Needed-_By) :-
 1921    pack_provides(_, Needed),
 1922    !.
 1923satisfied_dependency(Needed-_By) :-
 1924    compound(Needed),
 1925    Needed =.. [Op, Pack, ReqVersion],
 1926    (   pack_provides(Pack, Pack)
 1927    ->  pack_info(Pack, _, version(PackVersion)),
 1928        version_data(PackVersion, PackData)
 1929    ;   Pack == prolog
 1930    ->  current_prolog_flag(version_data, swi(Major,Minor,Patch,_)),
 1931        PackData = [Major,Minor,Patch]
 1932    ),
 1933    version_data(ReqVersion, ReqData),
 1934    cmp(Op, Cmp),
 1935    call(Cmp, PackData, ReqData).
 pack_provides(?Package, ?Token) is multi
True if Pack provides Token. A package always provides itself.
 1941pack_provides(Pack, Pack) :-
 1942    current_pack(Pack).
 1943pack_provides(Pack, Token) :-
 1944    pack_provides_db(Pack, Token).
 pack_depends_on(?Pack, ?Dependency) is nondet
True if Pack requires Dependency, direct or indirect.
 1950pack_depends_on(Pack, Dependency) :-
 1951    (   atom(Pack)
 1952    ->  pack_depends_on_fwd(Pack, Dependency, [Pack])
 1953    ;   pack_depends_on_bwd(Pack, Dependency, [Dependency])
 1954    ).
 1955
 1956pack_depends_on_fwd(Pack, Dependency, Visited) :-
 1957    pack_depends_on_1(Pack, Dep1),
 1958    \+ memberchk(Dep1, Visited),
 1959    (   Dependency = Dep1
 1960    ;   pack_depends_on_fwd(Dep1, Dependency, [Dep1|Visited])
 1961    ).
 1962
 1963pack_depends_on_bwd(Pack, Dependency, Visited) :-
 1964    pack_depends_on_1(Dep1, Dependency),
 1965    \+ memberchk(Dep1, Visited),
 1966    (   Pack = Dep1
 1967    ;   pack_depends_on_bwd(Pack, Dep1, [Dep1|Visited])
 1968    ).
 1969
 1970pack_depends_on_1(Pack, Dependency) :-
 1971    atom(Dependency),
 1972    !,
 1973    pack_provides(Dependency, Token),
 1974    pack_requires(Pack, Token).
 1975pack_depends_on_1(Pack, Dependency) :-
 1976    pack_requires(Pack, Token),
 1977    pack_provides(Dependency, Token).
 resolve_dependencies(+Dependencies, -Resolution) is multi
Resolve dependencies as reported by the remote package server.
Arguments:
Dependencies- is a list of dependency(Token, Pack, Version, URLs, SubDeps)
Resolution- is a list of items
  • Token-resolved(Pack)
  • Token-resolve(Pack, Version, URLs, SubResolve)
  • Token-unresolved
To be done
- Watch out for conflicts
- If there are different packs that resolve a token, make an intelligent choice instead of using the first
 1994resolve_dependencies(Dependencies, Resolution) :-
 1995    maplist(dependency_pair, Dependencies, Pairs0),
 1996    keysort(Pairs0, Pairs1),
 1997    group_pairs_by_key(Pairs1, ByToken),
 1998    maplist(resolve_dep, ByToken, Resolution).
 1999
 2000dependency_pair(dependency(Token, Pack, Version, URLs, SubDeps),
 2001                Token-(Pack-pack(Version,URLs, SubDeps))).
 2002
 2003resolve_dep(Token-Pairs, Token-Resolution) :-
 2004    (   resolve_dep2(Token-Pairs, Resolution)
 2005    *-> true
 2006    ;   Resolution = unresolved
 2007    ).
 2008
 2009resolve_dep2(Token-_, resolved(Pack)) :-
 2010    pack_provides(Pack, Token).
 2011resolve_dep2(_-Pairs, resolve(Pack, VersionAtom, URLs, SubResolves)) :-
 2012    keysort(Pairs, Sorted),
 2013    group_pairs_by_key(Sorted, ByPack),
 2014    member(Pack-Versions, ByPack),
 2015    Pack \== (-),
 2016    maplist(version_pack, Versions, VersionData),
 2017    sort(VersionData, ByVersion),
 2018    reverse(ByVersion, ByVersionLatest),
 2019    member(pack(Version,URLs,SubDeps), ByVersionLatest),
 2020    atom_version(VersionAtom, Version),
 2021    include(dependency, SubDeps, Deps),
 2022    resolve_dependencies(Deps, SubResolves).
 2023
 2024version_pack(pack(VersionAtom,URLs,SubDeps),
 2025             pack(Version,URLs,SubDeps)) :-
 2026    atom_version(VersionAtom, Version).
 pack_attach(+Dir, +Options) is det
Attach a single package in Dir. The Dir is expected to contain the file pack.pl and a prolog directory. Options processed:
duplicate(+Action)
What to do if the same package is already installed in a different directory. Action is one of
warning
Warn and ignore the package
keep
Silently ignore the package
replace
Unregister the existing and insert the new package
search(+Where)
Determines the order of searching package library directories. Default is last, alternative is first.
See also
- attach_packs/2 to attach multiple packs from a directory.
 2050pack_attach(Dir, Options) :-
 2051    '$pack_attach'(Dir, Options).
 2052
 2053
 2054                 /*******************************
 2055                 *        USER INTERACTION      *
 2056                 *******************************/
 2057
 2058:- multifile prolog:message//1.
 menu(Question, +Alternatives, +Default, -Selection, +Options)
 2062menu(_Question, _Alternatives, Default, Selection, Options) :-
 2063    option(interactive(false), Options),
 2064    !,
 2065    Selection = Default.
 2066menu(Question, Alternatives, Default, Selection, _) :-
 2067    length(Alternatives, N),
 2068    between(1, 5, _),
 2069       print_message(query, Question),
 2070       print_menu(Alternatives, Default, 1),
 2071       print_message(query, pack(menu(select))),
 2072       read_selection(N, Choice),
 2073    !,
 2074    (   Choice == default
 2075    ->  Selection = Default
 2076    ;   nth1(Choice, Alternatives, Selection=_)
 2077    ->  true
 2078    ).
 2079
 2080print_menu([], _, _).
 2081print_menu([Value=Label|T], Default, I) :-
 2082    (   Value == Default
 2083    ->  print_message(query, pack(menu(default_item(I, Label))))
 2084    ;   print_message(query, pack(menu(item(I, Label))))
 2085    ),
 2086    I2 is I + 1,
 2087    print_menu(T, Default, I2).
 2088
 2089read_selection(Max, Choice) :-
 2090    get_single_char(Code),
 2091    (   answered_default(Code)
 2092    ->  Choice = default
 2093    ;   code_type(Code, digit(Choice)),
 2094        between(1, Max, Choice)
 2095    ->  true
 2096    ;   print_message(warning, pack(menu(reply(1,Max)))),
 2097        fail
 2098    ).
 confirm(+Question, +Default, +Options) is semidet
Ask for confirmation.
Arguments:
Default- is one of yes, no or none.
 2106confirm(_Question, Default, Options) :-
 2107    Default \== none,
 2108    option(interactive(false), Options, true),
 2109    !,
 2110    Default == yes.
 2111confirm(Question, Default, _) :-
 2112    between(1, 5, _),
 2113       print_message(query, pack(confirm(Question, Default))),
 2114       read_yes_no(YesNo, Default),
 2115    !,
 2116    format(user_error, '~N', []),
 2117    YesNo == yes.
 2118
 2119read_yes_no(YesNo, Default) :-
 2120    get_single_char(Code),
 2121    code_yes_no(Code, Default, YesNo),
 2122    !.
 2123
 2124code_yes_no(0'y, _, yes).
 2125code_yes_no(0'Y, _, yes).
 2126code_yes_no(0'n, _, no).
 2127code_yes_no(0'N, _, no).
 2128code_yes_no(_, none, _) :- !, fail.
 2129code_yes_no(C, Default, Default) :-
 2130    answered_default(C).
 2131
 2132answered_default(0'\r).
 2133answered_default(0'\n).
 2134answered_default(0'\s).
 2135
 2136
 2137                 /*******************************
 2138                 *            MESSAGES          *
 2139                 *******************************/
 2140
 2141:- multifile prolog:message//1. 2142
 2143prolog:message(pack(Message)) -->
 2144    message(Message).
 2145
 2146:- discontiguous
 2147    message//1,
 2148    label//1. 2149
 2150message(invalid_info(Term)) -->
 2151    [ 'Invalid package description: ~q'-[Term] ].
 2152message(directory_exists(Dir)) -->
 2153    [ 'Package target directory exists and is not empty:', nl,
 2154      '\t~q'-[Dir]
 2155    ].
 2156message(already_installed(pack(Pack, Version))) -->
 2157    { atom_version(AVersion, Version) },
 2158    [ 'Pack `~w'' is already installed @~w'-[Pack, AVersion] ].
 2159message(already_installed(Pack)) -->
 2160    [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
 2161message(invalid_name(File)) -->
 2162    [ '~w: A package archive must be named <pack>-<version>.<ext>'-[File] ],
 2163    no_tar_gz(File).
 2164
 2165no_tar_gz(File) -->
 2166    { sub_atom(File, _, _, 0, '.tar.gz') },
 2167    !,
 2168    [ nl,
 2169      'Package archive files must have a single extension.  E.g., \'.tgz\''-[]
 2170    ].
 2171no_tar_gz(_) --> [].
 2172
 2173message(kept_foreign(Pack)) -->
 2174    [ 'Found foreign libraries for target platform.'-[], nl,
 2175      'Use ?- pack_rebuild(~q). to rebuild from sources'-[Pack]
 2176    ].
 2177message(no_pack_installed(Pack)) -->
 2178    [ 'No pack ~q installed.  Use ?- pack_list(Pattern) to search'-[Pack] ].
 2179message(no_packages_installed) -->
 2180    { setting(server, ServerBase) },
 2181    [ 'There are no extra packages installed.', nl,
 2182      'Please visit ~wlist.'-[ServerBase]
 2183    ].
 2184message(remove_with(Pack)) -->
 2185    [ 'The package can be removed using: ?- ~q.'-[pack_remove(Pack)]
 2186    ].
 2187message(unsatisfied(Packs)) -->
 2188    [ 'The following dependencies are not satisfied:', nl ],
 2189    unsatisfied(Packs).
 2190message(depends(Pack, Deps)) -->
 2191    [ 'The following packages depend on `~w\':'-[Pack], nl ],
 2192    pack_list(Deps).
 2193message(remove(PackDir)) -->
 2194    [ 'Removing ~q and contents'-[PackDir] ].
 2195message(remove_existing_pack(PackDir)) -->
 2196    [ 'Remove old installation in ~q'-[PackDir] ].
 2197message(install_from(Pack, Version, git(URL))) -->
 2198    [ 'Install ~w@~w from GIT at ~w'-[Pack, Version, URL] ].
 2199message(install_from(Pack, Version, URL)) -->
 2200    [ 'Install ~w@~w from ~w'-[Pack, Version, URL] ].
 2201message(select_install_from(Pack, Version)) -->
 2202    [ 'Select download location for ~w@~w'-[Pack, Version] ].
 2203message(install_downloaded(File)) -->
 2204    { file_base_name(File, Base),
 2205      size_file(File, Size) },
 2206    [ 'Install "~w" (~D bytes)'-[Base, Size] ].
 2207message(git_post_install(PackDir, Pack)) -->
 2208    (   { is_foreign_pack(PackDir, _) }
 2209    ->  [ 'Run post installation scripts for pack "~w"'-[Pack] ]
 2210    ;   [ 'Activate pack "~w"'-[Pack] ]
 2211    ).
 2212message(no_meta_data(BaseDir)) -->
 2213    [ 'Cannot find pack.pl inside directory ~q.  Not a package?'-[BaseDir] ].
 2214message(inquiry(Server)) -->
 2215    [ 'Verify package status (anonymously)', nl,
 2216      '\tat "~w"'-[Server]
 2217    ].
 2218message(search_no_matches(Name)) -->
 2219    [ 'Search for "~w", returned no matching packages'-[Name] ].
 2220message(rebuild(Pack)) -->
 2221    [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
 2222message(upgrade(Pack, From, To)) -->
 2223    [ 'Upgrade "~w" from '-[Pack] ],
 2224    msg_version(From), [' to '-[]], msg_version(To).
 2225message(up_to_date(Pack)) -->
 2226    [ 'Package "~w" is up-to-date'-[Pack] ].
 2227message(query_versions(URL)) -->
 2228    [ 'Querying "~w" to find new versions ...'-[URL] ].
 2229message(no_matching_urls(URL)) -->
 2230    [ 'Could not find any matching URL: ~q'-[URL] ].
 2231message(found_versions([Latest-_URL|More])) -->
 2232    { length(More, Len),
 2233      atom_version(VLatest, Latest)
 2234    },
 2235    [ '    Latest version: ~w (~D older)'-[VLatest, Len] ].
 2236message(process_output(Codes)) -->
 2237    { split_lines(Codes, Lines) },
 2238    process_lines(Lines).
 2239message(contacting_server(Server)) -->
 2240    [ 'Contacting server at ~w ...'-[Server], flush ].
 2241message(server_reply(true(_))) -->
 2242    [ at_same_line, ' ok'-[] ].
 2243message(server_reply(false)) -->
 2244    [ at_same_line, ' done'-[] ].
 2245message(server_reply(exception(E))) -->
 2246    [ 'Server reported the following error:'-[], nl ],
 2247    '$messages':translate_message(E).
 2248message(cannot_create_dir(Alias)) -->
 2249    { findall(PackDir,
 2250              absolute_file_name(Alias, PackDir, [solutions(all)]),
 2251              PackDirs0),
 2252      sort(PackDirs0, PackDirs)
 2253    },
 2254    [ 'Cannot find a place to create a package directory.'-[],
 2255      'Considered:'-[]
 2256    ],
 2257    candidate_dirs(PackDirs).
 2258message(no_match(Name)) -->
 2259    [ 'No registered pack matches "~w"'-[Name] ].
 2260message(conflict(version, [PackV, FileV])) -->
 2261    ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
 2262    [', file claims version '-[]], msg_version(FileV).
 2263message(conflict(name, [PackInfo, FileInfo])) -->
 2264    ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
 2265    [', file claims ~w: ~p'-[FileInfo]].
 2266message(no_prolog_response(ContentType, String)) -->
 2267    [ 'Expected Prolog response.  Got content of type ~p'-[ContentType], nl,
 2268      '~s'-[String]
 2269    ].
 2270message(pack(no_upgrade_info(Pack))) -->
 2271    [ '~w: pack meta-data does not provide an upgradable URL'-[Pack] ].
 2272
 2273candidate_dirs([]) --> [].
 2274candidate_dirs([H|T]) --> [ nl, '    ~w'-[H] ], candidate_dirs(T).
 2275
 2276                                                % Questions
 2277message(resolve_remove) -->
 2278    [ nl, 'Please select an action:', nl, nl ].
 2279message(create_pack_dir) -->
 2280    [ nl, 'Create directory for packages', nl ].
 2281message(menu(item(I, Label))) -->
 2282    [ '~t(~d)~6|   '-[I] ],
 2283    label(Label).
 2284message(menu(default_item(I, Label))) -->
 2285    [ '~t(~d)~6| * '-[I] ],
 2286    label(Label).
 2287message(menu(select)) -->
 2288    [ nl, 'Your choice? ', flush ].
 2289message(confirm(Question, Default)) -->
 2290    message(Question),
 2291    confirm_default(Default),
 2292    [ flush ].
 2293message(menu(reply(Min,Max))) -->
 2294    (  { Max =:= Min+1 }
 2295    -> [ 'Please enter ~w or ~w'-[Min,Max] ]
 2296    ;  [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
 2297    ).
 2298
 2299% Alternate hashes for found for the same file
 2300
 2301message(alt_hashes(URL, _Alts)) -->
 2302    { git_url(URL, _)
 2303    },
 2304    !,
 2305    [ 'GIT repository was updated without updating version' ].
 2306message(alt_hashes(URL, Alts)) -->
 2307    { file_base_name(URL, File)
 2308    },
 2309    [ 'Found multiple versions of "~w".'-[File], nl,
 2310      'This could indicate a compromised or corrupted file', nl
 2311    ],
 2312    alt_hashes(Alts).
 2313message(continue_with_alt_hashes(Count, URL)) -->
 2314    [ 'Continue installation from "~w" (downloaded ~D times)'-[URL, Count] ].
 2315message(continue_with_modified_hash(_URL)) -->
 2316    [ 'Pack may be compromised.  Continue anyway'
 2317    ].
 2318message(modified_hash(_SHA1-URL, _SHA2-[URL])) -->
 2319    [ 'Content of ~q has changed.'-[URL]
 2320    ].
 2321
 2322alt_hashes([]) --> [].
 2323alt_hashes([H|T]) --> alt_hash(H), ( {T == []} -> [] ; [nl], alt_hashes(T) ).
 2324
 2325alt_hash(alt_hash(Count, URLs, Hash)) -->
 2326    [ '~t~d~8| ~w'-[Count, Hash] ],
 2327    alt_urls(URLs).
 2328
 2329alt_urls([]) --> [].
 2330alt_urls([H|T]) -->
 2331    [ nl, '    ~w'-[H] ],
 2332    alt_urls(T).
 2333
 2334% Installation dependencies gathered from inquiry server.
 2335
 2336message(install_dependencies(Resolution)) -->
 2337    [ 'Package depends on the following:' ],
 2338    msg_res_tokens(Resolution, 1).
 2339
 2340msg_res_tokens([], _) --> [].
 2341msg_res_tokens([H|T], L) --> msg_res_token(H, L), msg_res_tokens(T, L).
 2342
 2343msg_res_token(Token-unresolved, L) -->
 2344    res_indent(L),
 2345    [ '"~w" cannot be satisfied'-[Token] ].
 2346msg_res_token(Token-resolve(Pack, Version, [URL|_], SubResolves), L) -->
 2347    !,
 2348    res_indent(L),
 2349    [ '"~w", provided by ~w@~w from ~w'-[Token, Pack, Version, URL] ],
 2350    { L2 is L+1 },
 2351    msg_res_tokens(SubResolves, L2).
 2352msg_res_token(Token-resolved(Pack), L) -->
 2353    !,
 2354    res_indent(L),
 2355    [ '"~w", provided by installed pack ~w'-[Token,Pack] ].
 2356
 2357res_indent(L) -->
 2358    { I is L*2 },
 2359    [ nl, '~*c'-[I,0'\s] ].
 2360
 2361message(resolve_deps) -->
 2362    [ nl, 'What do you wish to do' ].
 2363label(install_deps) -->
 2364    [ 'Install proposed dependencies' ].
 2365label(install_no_deps) -->
 2366    [ 'Only install requested package' ].
 2367
 2368
 2369message(git_fetch(Dir)) -->
 2370    [ 'Running "git fetch" in ~q'-[Dir] ].
 2371
 2372% inquiry is blank
 2373
 2374message(inquiry_ok(Reply, File)) -->
 2375    { memberchk(downloads(Count), Reply),
 2376      memberchk(rating(VoteCount, Rating), Reply),
 2377      !,
 2378      length(Stars, Rating),
 2379      maplist(=(0'*), Stars)
 2380    },
 2381    [ '"~w" was downloaded ~D times.  Package rated ~s (~D votes)'-
 2382      [ File, Count, Stars, VoteCount ]
 2383    ].
 2384message(inquiry_ok(Reply, File)) -->
 2385    { memberchk(downloads(Count), Reply)
 2386    },
 2387    [ '"~w" was downloaded ~D times'-[ File, Count ] ].
 2388
 2389                                                % support predicates
 2390unsatisfied([]) --> [].
 2391unsatisfied([Needed-[By]|T]) -->
 2392    [ '  - "~w" is needed by package "~w"'-[Needed, By], nl ],
 2393    unsatisfied(T).
 2394unsatisfied([Needed-By|T]) -->
 2395    [ '  - "~w" is needed by the following packages:'-[Needed], nl ],
 2396    pack_list(By),
 2397    unsatisfied(T).
 2398
 2399pack_list([]) --> [].
 2400pack_list([H|T]) -->
 2401    [ '    - Package "~w"'-[H], nl ],
 2402    pack_list(T).
 2403
 2404process_lines([]) --> [].
 2405process_lines([H|T]) -->
 2406    [ '~s'-[H] ],
 2407    (   {T==[]}
 2408    ->  []
 2409    ;   [nl], process_lines(T)
 2410    ).
 2411
 2412split_lines([], []) :- !.
 2413split_lines(All, [Line1|More]) :-
 2414    append(Line1, [0'\n|Rest], All),
 2415    !,
 2416    split_lines(Rest, More).
 2417split_lines(Line, [Line]).
 2418
 2419label(remove_only(Pack)) -->
 2420    [ 'Only remove package ~w (break dependencies)'-[Pack] ].
 2421label(remove_deps(Pack, Deps)) -->
 2422    { length(Deps, Count) },
 2423    [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
 2424label(create_dir(Dir)) -->
 2425    [ '~w'-[Dir] ].
 2426label(install_from(git(URL))) -->
 2427    !,
 2428    [ 'GIT repository at ~w'-[URL] ].
 2429label(install_from(URL)) -->
 2430    [ '~w'-[URL] ].
 2431label(cancel) -->
 2432    [ 'Cancel' ].
 2433
 2434confirm_default(yes) -->
 2435    [ ' Y/n? ' ].
 2436confirm_default(no) -->
 2437    [ ' y/N? ' ].
 2438confirm_default(none) -->
 2439    [ ' y/n? ' ].
 2440
 2441msg_version(Version) -->
 2442    { atom(Version) },
 2443    !,
 2444    [ '~w'-[Version] ].
 2445msg_version(VersionData) -->
 2446    !,
 2447    { atom_version(Atom, VersionData) },
 2448    [ '~w'-[Atom] ]