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-2019, VU University Amsterdam
    7                              CWI, Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(prolog_pack,
   37          [ pack_list_installed/0,
   38            pack_info/1,                % +Name
   39            pack_list/1,                % +Keyword
   40            pack_search/1,              % +Keyword
   41            pack_install/1,             % +Name
   42            pack_install/2,             % +Name, +Options
   43            pack_upgrade/1,             % +Name
   44            pack_rebuild/1,             % +Name
   45            pack_rebuild/0,             % All packages
   46            pack_remove/1,              % +Name
   47            pack_property/2,            % ?Name, ?Property
   48
   49            pack_url_file/2             % +URL, -File
   50          ]).   51:- use_module(library(apply)).   52:- use_module(library(error)).   53:- use_module(library(process)).   54:- use_module(library(option)).   55:- use_module(library(readutil)).   56:- use_module(library(lists)).   57:- use_module(library(filesex)).   58:- use_module(library(xpath)).   59:- use_module(library(settings)).   60:- use_module(library(uri)).   61:- use_module(library(http/http_open)).   62:- use_module(library(http/json)).   63:- use_module(library(http/http_client), []).   % plugin for POST support
   64:- use_module(library(prolog_config)).

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

See also
- Installed packages can be inspected using ?- doc_browser.
To be done
- Version logic
- Find and resolve conflicts
- Upgrade git packages
- Validate git packages
- Test packages: run tests from directory `test'. */
   81:- multifile
   82    environment/2.                          % Name, Value
   83
   84:- dynamic
   85    pack_requires/2,                        % Pack, Requirement
   86    pack_provides_db/2.                     % Pack, Provided
   87
   88
   89                 /*******************************
   90                 *          CONSTANTS           *
   91                 *******************************/
   92
   93:- setting(server, atom, 'https://www.swi-prolog.org/pack/',
   94           'Server to exchange pack information').   95
   96
   97                 /*******************************
   98                 *         PACKAGE INFO         *
   99                 *******************************/
 current_pack(?Pack) is nondet
True if Pack is a currently installed pack.
  105current_pack(Pack) :-
  106    '$pack':pack(Pack, _).
 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.
  116pack_list_installed :-
  117    findall(Pack, current_pack(Pack), Packages0),
  118    Packages0 \== [],
  119    !,
  120    sort(Packages0, Packages),
  121    length(Packages, Count),
  122    format('Installed packages (~D):~n~n', [Count]),
  123    maplist(pack_info(list), Packages),
  124    validate_dependencies.
  125pack_list_installed :-
  126    print_message(informational, pack(no_packages_installed)).
 pack_info(+Pack)
Print more detailed information about Pack.
  132pack_info(Name) :-
  133    pack_info(info, Name).
  134
  135pack_info(Level, Name) :-
  136    must_be(atom, Name),
  137    findall(Info, pack_info(Name, Level, Info), Infos0),
  138    (   Infos0 == []
  139    ->  print_message(warning, pack(no_pack_installed(Name))),
  140        fail
  141    ;   true
  142    ),
  143    update_dependency_db(Name, Infos0),
  144    findall(Def,  pack_default(Level, Infos, Def), Defs),
  145    append(Infos0, Defs, Infos1),
  146    sort(Infos1, Infos),
  147    show_info(Name, Infos, [info(Level)]).
  148
  149
  150show_info(_Name, _Properties, Options) :-
  151    option(silent(true), Options),
  152    !.
  153show_info(Name, Properties, Options) :-
  154    option(info(list), Options),
  155    !,
  156    memberchk(title(Title), Properties),
  157    memberchk(version(Version), Properties),
  158    format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
  159show_info(Name, Properties, _) :-
  160    !,
  161    print_property_value('Package'-'~w', [Name]),
  162    findall(Term, pack_level_info(info, Term, _, _), Terms),
  163    maplist(print_property(Properties), Terms).
  164
  165print_property(_, nl) :-
  166    !,
  167    format('~n').
  168print_property(Properties, Term) :-
  169    findall(Term, member(Term, Properties), Terms),
  170    Terms \== [],
  171    !,
  172    pack_level_info(_, Term, LabelFmt, _Def),
  173    (   LabelFmt = Label-FmtElem
  174    ->  true
  175    ;   Label = LabelFmt,
  176        FmtElem = '~w'
  177    ),
  178    multi_valued(Terms, FmtElem, FmtList, Values),
  179    atomic_list_concat(FmtList, ', ', Fmt),
  180    print_property_value(Label-Fmt, Values).
  181print_property(_, _).
  182
  183multi_valued([H], LabelFmt, [LabelFmt], Values) :-
  184    !,
  185    H =.. [_|Values].
  186multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
  187    H =.. [_|VH],
  188    append(VH, MoreValues, Values),
  189    multi_valued(T, LabelFmt, LT, MoreValues).
  190
  191
  192pvalue_column(24).
  193print_property_value(Prop-Fmt, Values) :-
  194    !,
  195    pvalue_column(C),
  196    atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
  197    format(Format, [Prop,C|Values]).
  198
  199pack_info(Name, Level, Info) :-
  200    '$pack':pack(Name, BaseDir),
  201    (   Info = directory(BaseDir)
  202    ;   pack_info_term(BaseDir, Info)
  203    ),
  204    pack_level_info(Level, Info, _Format, _Default).
  205
  206:- public pack_level_info/4.                    % used by web-server
  207
  208pack_level_info(_,    title(_),         'Title',                   '<no title>').
  209pack_level_info(_,    version(_),       'Installed version',       '<unknown>').
  210pack_level_info(info, directory(_),     'Installed in directory',  -).
  211pack_level_info(info, author(_, _),     'Author'-'~w <~w>',        -).
  212pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>',    -).
  213pack_level_info(info, packager(_, _),   'Packager'-'~w <~w>',      -).
  214pack_level_info(info, home(_),          'Home page',               -).
  215pack_level_info(info, download(_),      'Download URL',            -).
  216pack_level_info(_,    provides(_),      'Provides',                -).
  217pack_level_info(_,    requires(_),      'Requires',                -).
  218pack_level_info(_,    conflicts(_),     'Conflicts with',          -).
  219pack_level_info(_,    replaces(_),      'Replaces packages',       -).
  220pack_level_info(info, library(_),	'Provided libraries',      -).
  221
  222pack_default(Level, Infos, Def) :-
  223    pack_level_info(Level, ITerm, _Format, Def),
  224    Def \== (-),
  225    \+ memberchk(ITerm, Infos).
 pack_info_term(+PackDir, ?Info) is nondet
True when Info is meta-data for the package PackName.
  231pack_info_term(BaseDir, Info) :-
  232    directory_file_path(BaseDir, 'pack.pl', InfoFile),
  233    catch(
  234        setup_call_cleanup(
  235            open(InfoFile, read, In),
  236            term_in_stream(In, Info),
  237            close(In)),
  238        error(existence_error(source_sink, InfoFile), _),
  239        ( print_message(error, pack(no_meta_data(BaseDir))),
  240          fail
  241        )).
  242pack_info_term(BaseDir, library(Lib)) :-
  243    atom_concat(BaseDir, '/prolog/', LibDir),
  244    atom_concat(LibDir, '*.pl', Pattern),
  245    expand_file_name(Pattern, Files),
  246    maplist(atom_concat(LibDir), Plain, Files),
  247    convlist(base_name, Plain, Libs),
  248    member(Lib, Libs).
  249
  250base_name(File, Base) :-
  251    file_name_extension(Base, pl, File).
  252
  253term_in_stream(In, Term) :-
  254    repeat,
  255        read_term(In, Term0, []),
  256        (   Term0 == end_of_file
  257        ->  !, fail
  258        ;   Term = Term0,
  259            valid_info_term(Term0)
  260        ).
  261
  262valid_info_term(Term) :-
  263    Term =.. [Name|Args],
  264    same_length(Args, Types),
  265    Decl =.. [Name|Types],
  266    (   pack_info_term(Decl)
  267    ->  maplist(valid_info_arg, Types, Args)
  268    ;   print_message(warning, pack(invalid_info(Term))),
  269        fail
  270    ).
  271
  272valid_info_arg(Type, Arg) :-
  273    must_be(Type, Arg).
 pack_info_term(?Term) is nondet
True when Term describes name and arguments of a valid package info term.
  280pack_info_term(name(atom)).                     % Synopsis
  281pack_info_term(title(atom)).
  282pack_info_term(keywords(list(atom))).
  283pack_info_term(description(list(atom))).
  284pack_info_term(version(version)).
  285pack_info_term(author(atom, email_or_url)).     % Persons
  286pack_info_term(maintainer(atom, email_or_url)).
  287pack_info_term(packager(atom, email_or_url)).
  288pack_info_term(home(atom)).                     % Home page
  289pack_info_term(download(atom)).                 % Source
  290pack_info_term(provides(atom)).                 % Dependencies
  291pack_info_term(requires(dependency)).
  292pack_info_term(conflicts(dependency)).          % Conflicts with package
  293pack_info_term(replaces(atom)).                 % Replaces another package
  294pack_info_term(autoload(boolean)).              % Default installation options
  295
  296:- multifile
  297    error:has_type/2.  298
  299error:has_type(version, Version) :-
  300    atom(Version),
  301    version_data(Version, _Data).
  302error:has_type(email_or_url, Address) :-
  303    atom(Address),
  304    (   sub_atom(Address, _, _, _, @)
  305    ->  true
  306    ;   uri_is_global(Address)
  307    ).
  308error:has_type(dependency, Value) :-
  309    is_dependency(Value, _Token, _Version).
  310
  311version_data(Version, version(Data)) :-
  312    atomic_list_concat(Parts, '.', Version),
  313    maplist(atom_number, Parts, Data).
  314
  315is_dependency(Token, Token, *) :-
  316    atom(Token).
  317is_dependency(Term, Token, VersionCmp) :-
  318    Term =.. [Op,Token,Version],
  319    cmp(Op, _),
  320    version_data(Version, _),
  321    VersionCmp =.. [Op,Version].
  322
  323cmp(<,  @<).
  324cmp(=<, @=<).
  325cmp(==, ==).
  326cmp(>=, @>=).
  327cmp(>,  @>).
  328
  329
  330                 /*******************************
  331                 *            SEARCH            *
  332                 *******************************/
 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.
  361pack_list(Query) :-
  362    pack_search(Query).
  363
  364pack_search(Query) :-
  365    query_pack_server(search(Query), Result, []),
  366    (   Result == false
  367    ->  (   local_search(Query, Packs),
  368            Packs \== []
  369        ->  forall(member(pack(Pack, Stat, Title, Version, _), Packs),
  370                   format('~w ~w@~w ~28|- ~w~n',
  371                          [Stat, Pack, Version, Title]))
  372        ;   print_message(warning, pack(search_no_matches(Query)))
  373        )
  374    ;   Result = true(Hits),
  375        local_search(Query, Local),
  376        append(Hits, Local, All),
  377        sort(All, Sorted),
  378        list_hits(Sorted)
  379    ).
  380
  381list_hits([]).
  382list_hits([ pack(Pack, i, Title, Version, _),
  383            pack(Pack, p, Title, Version, _)
  384          | More
  385          ]) :-
  386    !,
  387    format('i ~w@~w ~28|- ~w~n', [Pack, Version, Title]),
  388    list_hits(More).
  389list_hits([ pack(Pack, i, Title, VersionI, _),
  390            pack(Pack, p, _,     VersionS, _)
  391          | More
  392          ]) :-
  393    !,
  394    version_data(VersionI, VDI),
  395    version_data(VersionS, VDS),
  396    (   VDI @< VDS
  397    ->  Tag = ('U')
  398    ;   Tag = ('A')
  399    ),
  400    format('~w ~w@~w(~w) ~28|- ~w~n', [Tag, Pack, VersionI, VersionS, Title]),
  401    list_hits(More).
  402list_hits([ pack(Pack, i, Title, VersionI, _)
  403          | More
  404          ]) :-
  405    !,
  406    format('l ~w@~w ~28|- ~w~n', [Pack, VersionI, Title]),
  407    list_hits(More).
  408list_hits([pack(Pack, Stat, Title, Version, _)|More]) :-
  409    format('~w ~w@~w ~28|- ~w~n', [Stat, Pack, Version, Title]),
  410    list_hits(More).
  411
  412
  413local_search(Query, Packs) :-
  414    findall(Pack, matching_installed_pack(Query, Pack), Packs).
  415
  416matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
  417    current_pack(Pack),
  418    findall(Term,
  419            ( pack_info(Pack, _, Term),
  420              search_info(Term)
  421            ), Info),
  422    (   sub_atom_icasechk(Pack, _, Query)
  423    ->  true
  424    ;   memberchk(title(Title), Info),
  425        sub_atom_icasechk(Title, _, Query)
  426    ),
  427    option(title(Title), Info, '<no title>'),
  428    option(version(Version), Info, '<no version>'),
  429    option(download(URL), Info, '<no download url>').
  430
  431search_info(title(_)).
  432search_info(version(_)).
  433search_info(download(_)).
  434
  435
  436                 /*******************************
  437                 *            INSTALL           *
  438                 *******************************/
 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.

  456pack_install(Spec) :-
  457    pack_default_options(Spec, Pack, [], Options),
  458    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.
  465pack_default_options(_Spec, Pack, OptsIn, Options) :-
  466    option(already_installed(pack(Pack,_Version)), OptsIn),
  467    !,
  468    Options = OptsIn.
  469pack_default_options(_Spec, Pack, OptsIn, Options) :-
  470    option(url(URL), OptsIn),
  471    !,
  472    (   option(git(_), OptsIn)
  473    ->  Options = OptsIn
  474    ;   git_url(URL, Pack)
  475    ->  Options = [git(true)|OptsIn]
  476    ;   Options = OptsIn
  477    ),
  478    (   nonvar(Pack)
  479    ->  true
  480    ;   option(pack(Pack), Options)
  481    ->  true
  482    ;   pack_version_file(Pack, _Version, URL)
  483    ).
  484pack_default_options(Archive, Pack, _, Options) :-      % Install from archive
  485    must_be(atom, Archive),
  486    \+ uri_is_global(Archive),
  487    expand_file_name(Archive, [File]),
  488    exists_file(File),
  489    !,
  490    pack_version_file(Pack, Version, File),
  491    uri_file_name(FileURL, File),
  492    Options = [url(FileURL), version(Version)].
  493pack_default_options(URL, Pack, _, Options) :-
  494    git_url(URL, Pack),
  495    !,
  496    Options = [git(true), url(URL)].
  497pack_default_options(FileURL, Pack, _, Options) :-      % Install from directory
  498    uri_file_name(FileURL, Dir),
  499    exists_directory(Dir),
  500    pack_info_term(Dir, name(Pack)),
  501    !,
  502    (   pack_info_term(Dir, version(Version))
  503    ->  uri_file_name(DirURL, Dir),
  504        Options = [url(DirURL), version(Version)]
  505    ;   throw(error(existence_error(key, version, Dir),_))
  506    ).
  507pack_default_options(URL, Pack, _, Options) :-          % Install from URL
  508    pack_version_file(Pack, Version, URL),
  509    download_url(URL),
  510    !,
  511    available_download_versions(URL, [URLVersion-LatestURL|_]),
  512    Options = [url(LatestURL)|VersionOptions],
  513    version_options(Version, URLVersion, VersionOptions).
  514pack_default_options(Pack, Pack, OptsIn, Options) :-    % Install from name
  515    \+ uri_is_global(Pack),                             % ignore URLs
  516    query_pack_server(locate(Pack), Reply, OptsIn),
  517    (   Reply = true(Results)
  518    ->  pack_select_candidate(Pack, Results, OptsIn, Options)
  519    ;   print_message(warning, pack(no_match(Pack))),
  520        fail
  521    ).
  522
  523version_options(Version, Version, [version(Version)]) :- !.
  524version_options(Version, _, [version(Version)]) :-
  525    Version = version(List),
  526    maplist(integer, List),
  527    !.
  528version_options(_, _, []).
 pack_select_candidate(+Pack, +AvailableVersions, +OptionsIn, -Options)
Select from available packages.
  534pack_select_candidate(Pack, [Version-_|_], Options,
  535                      [already_installed(pack(Pack, Installed))|Options]) :-
  536    current_pack(Pack),
  537    pack_info(Pack, _, version(InstalledAtom)),
  538    atom_version(InstalledAtom, Installed),
  539    Installed @>= Version,
  540    !.
  541pack_select_candidate(Pack, Available, Options, OptsOut) :-
  542    option(url(URL), Options),
  543    memberchk(_Version-URLs, Available),
  544    memberchk(URL, URLs),
  545    !,
  546    (   git_url(URL, Pack)
  547    ->  Extra = [git(true)]
  548    ;   Extra = []
  549    ),
  550    OptsOut = [url(URL), inquiry(true) | Extra].
  551pack_select_candidate(Pack, [Version-[URL]|_], Options,
  552                      [url(URL), git(true), inquiry(true)]) :-
  553    git_url(URL, Pack),
  554    !,
  555    confirm(install_from(Pack, Version, git(URL)), yes, Options).
  556pack_select_candidate(Pack, [Version-[URL]|More], Options,
  557                      [url(URL), inquiry(true)]) :-
  558    (   More == []
  559    ->  !
  560    ;   true
  561    ),
  562    confirm(install_from(Pack, Version, URL), yes, Options),
  563    !.
  564pack_select_candidate(Pack, [Version-URLs|_], Options,
  565                      [url(URL), inquiry(true)|Rest]) :-
  566    maplist(url_menu_item, URLs, Tagged),
  567    append(Tagged, [cancel=cancel], Menu),
  568    Menu = [Default=_|_],
  569    menu(pack(select_install_from(Pack, Version)),
  570         Menu, Default, Choice, Options),
  571    (   Choice == cancel
  572    ->  fail
  573    ;   Choice = git(URL)
  574    ->  Rest = [git(true)]
  575    ;   Choice = URL,
  576        Rest = []
  577    ).
  578
  579url_menu_item(URL, git(URL)=install_from(git(URL))) :-
  580    git_url(URL, _),
  581    !.
  582url_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
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.
git(+Boolean)
If true (default false unless URL ends with =.git=), assume the URL is a GIT repository.

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.

  613pack_install(Spec, Options) :-
  614    pack_default_options(Spec, Pack, Options, DefOptions),
  615    (   option(already_installed(Installed), DefOptions)
  616    ->  print_message(informational, pack(already_installed(Installed)))
  617    ;   merge_options(Options, DefOptions, PackOptions),
  618        update_dependency_db,
  619        pack_install_dir(PackDir, PackOptions),
  620        pack_install(Pack, PackDir, PackOptions)
  621    ).
  622
  623pack_install_dir(PackDir, Options) :-
  624    option(package_directory(PackDir), Options),
  625    !.
  626pack_install_dir(PackDir, _Options) :-          % TBD: global/user?
  627    absolute_file_name(pack(.), PackDir,
  628                       [ file_type(directory),
  629                         access(write),
  630                         file_errors(fail)
  631                       ]),
  632    !.
  633pack_install_dir(PackDir, Options) :-           % TBD: global/user?
  634    pack_create_install_dir(PackDir, Options).
  635
  636pack_create_install_dir(PackDir, Options) :-
  637    findall(Candidate = create_dir(Candidate),
  638            ( absolute_file_name(pack(.), Candidate, [solutions(all)]),
  639              \+ exists_file(Candidate),
  640              \+ exists_directory(Candidate),
  641              file_directory_name(Candidate, Super),
  642              (   exists_directory(Super)
  643              ->  access_file(Super, write)
  644              ;   true
  645              )
  646            ),
  647            Candidates0),
  648    list_to_set(Candidates0, Candidates),   % keep order
  649    pack_create_install_dir(Candidates, PackDir, Options).
  650
  651pack_create_install_dir(Candidates, PackDir, Options) :-
  652    Candidates = [Default=_|_],
  653    !,
  654    append(Candidates, [cancel=cancel], Menu),
  655    menu(pack(create_pack_dir), Menu, Default, Selected, Options),
  656    Selected \== cancel,
  657    (   catch(make_directory_path(Selected), E,
  658              (print_message(warning, E), fail))
  659    ->  PackDir = Selected
  660    ;   delete(Candidates, PackDir=create_dir(PackDir), Remaining),
  661        pack_create_install_dir(Remaining, PackDir, Options)
  662    ).
  663pack_create_install_dir(_, _, _) :-
  664    print_message(error, pack(cannot_create_dir(pack(.)))),
  665    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.
  680pack_install(Name, _, Options) :-
  681    current_pack(Name),
  682    option(upgrade(false), Options, false),
  683    print_message(error, pack(already_installed(Name))),
  684    pack_info(Name),
  685    print_message(information, pack(remove_with(Name))),
  686    !,
  687    fail.
  688pack_install(Name, PackDir, Options) :-
  689    option(url(URL), Options),
  690    uri_file_name(URL, Source),
  691    !,
  692    pack_install_from_local(Source, PackDir, Name, Options).
  693pack_install(Name, PackDir, Options) :-
  694    option(url(URL), Options),
  695    uri_components(URL, Components),
  696    uri_data(scheme, Components, Scheme),
  697    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).
  706pack_install_from_local(Source, PackTopDir, Name, Options) :-
  707    exists_directory(Source),
  708    !,
  709    directory_file_path(PackTopDir, Name, PackDir),
  710    prepare_pack_dir(PackDir, Options),
  711    copy_directory(Source, PackDir),
  712    pack_post_install(Name, PackDir, Options).
  713pack_install_from_local(Source, PackTopDir, Name, Options) :-
  714    exists_file(Source),
  715    directory_file_path(PackTopDir, Name, PackDir),
  716    prepare_pack_dir(PackDir, Options),
  717    pack_unpack(Source, PackDir, Name, Options),
  718    pack_post_install(Name, PackDir, Options).
 pack_unpack(+SourceFile, +PackDir, +Pack, +Options)
Unpack an archive to the given package dir.
  725:- if(exists_source(library(archive))).  726pack_unpack(Source, PackDir, Pack, Options) :-
  727    ensure_loaded_archive,
  728    pack_archive_info(Source, Pack, _Info, StripOptions),
  729    prepare_pack_dir(PackDir, Options),
  730    archive_extract(Source, PackDir,
  731                    [ exclude(['._*'])          % MacOS resource forks
  732                    | StripOptions
  733                    ]).
  734:- else.  735pack_unpack(_,_,_,_) :-
  736    existence_error(library, archive).
  737:- endif.  738
  739                 /*******************************
  740                 *             INFO             *
  741                 *******************************/
 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.
  755:- if(exists_source(library(archive))).  756ensure_loaded_archive :-
  757    current_predicate(archive_open/3),
  758    !.
  759ensure_loaded_archive :-
  760    use_module(library(archive)).
  761
  762pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
  763    ensure_loaded_archive,
  764    size_file(Archive, Bytes),
  765    setup_call_cleanup(
  766        archive_open(Archive, Handle, []),
  767        (   repeat,
  768            (   archive_next_header(Handle, InfoFile)
  769            ->  true
  770            ;   !, fail
  771            )
  772        ),
  773        archive_close(Handle)),
  774    file_base_name(InfoFile, 'pack.pl'),
  775    atom_concat(Prefix, 'pack.pl', InfoFile),
  776    strip_option(Prefix, Pack, Strip),
  777    setup_call_cleanup(
  778        archive_open_entry(Handle, Stream),
  779        read_stream_to_terms(Stream, Info),
  780        close(Stream)),
  781    !,
  782    must_be(ground, Info),
  783    maplist(valid_info_term, Info).
  784:- else.  785pack_archive_info(_, _, _, _) :-
  786    existence_error(library, archive).
  787:- endif.  788pack_archive_info(_, _, _, _) :-
  789    existence_error(pack_file, 'pack.pl').
  790
  791strip_option('', _, []) :- !.
  792strip_option('./', _, []) :- !.
  793strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
  794    atom_concat(PrefixDir, /, Prefix),
  795    file_base_name(PrefixDir, Base),
  796    (   Base == Pack
  797    ->  true
  798    ;   pack_version_file(Pack, _, Base)
  799    ->  true
  800    ;   \+ sub_atom(PrefixDir, _, _, _, /)
  801    ).
  802
  803read_stream_to_terms(Stream, Terms) :-
  804    read(Stream, Term0),
  805    read_stream_to_terms(Term0, Stream, Terms).
  806
  807read_stream_to_terms(end_of_file, _, []) :- !.
  808read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
  809    read(Stream, Term1),
  810    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.
  818pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
  819    exists_directory(GitDir),
  820    !,
  821    git_ls_tree(Entries, [directory(GitDir)]),
  822    git_hash(Hash, [directory(GitDir)]),
  823    maplist(arg(4), Entries, Sizes),
  824    sum_list(Sizes, Bytes),
  825    directory_file_path(GitDir, 'pack.pl', InfoFile),
  826    read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
  827    must_be(ground, Info),
  828    maplist(valid_info_term, Info).
 download_file_sanity_check(+Archive, +Pack, +Info) is semidet
Perform basic sanity checks on DownloadFile
  834download_file_sanity_check(Archive, Pack, Info) :-
  835    info_field(name(Name), Info),
  836    info_field(version(VersionAtom), Info),
  837    atom_version(VersionAtom, Version),
  838    pack_version_file(PackA, VersionA, Archive),
  839    must_match([Pack, PackA, Name], name),
  840    must_match([Version, VersionA], version).
  841
  842info_field(Field, Info) :-
  843    memberchk(Field, Info),
  844    ground(Field),
  845    !.
  846info_field(Field, _Info) :-
  847    functor(Field, FieldName, _),
  848    print_message(error, pack(missing(FieldName))),
  849    fail.
  850
  851must_match(Values, _Field) :-
  852    sort(Values, [_]),
  853    !.
  854must_match(Values, Field) :-
  855    print_message(error, pack(conflict(Field, Values))),
  856    fail.
  857
  858
  859                 /*******************************
  860                 *         INSTALLATION         *
  861                 *******************************/
 prepare_pack_dir(+Dir, +Options)
Prepare for installing the package into Dir. This should create Dir if it does not exist and warn if the directory already exists, asking to make it empty.
  869prepare_pack_dir(Dir, Options) :-
  870    exists_directory(Dir),
  871    !,
  872    (   empty_directory(Dir)
  873    ->  true
  874    ;   option(upgrade(true), Options)
  875    ->  delete_directory_contents(Dir)
  876    ;   confirm(remove_existing_pack(Dir), yes, Options),
  877        delete_directory_contents(Dir)
  878    ).
  879prepare_pack_dir(Dir, _) :-
  880    make_directory(Dir).
 empty_directory(+Directory) is semidet
True if Directory is empty (holds no files or sub-directories).
  886empty_directory(Dir) :-
  887    \+ ( directory_files(Dir, Entries),
  888         member(Entry, Entries),
  889         \+ special(Entry)
  890       ).
  891
  892special(.).
  893special(..).
 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.
  903pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
  904    option(git(true), Options),
  905    !,
  906    directory_file_path(PackTopDir, Pack, PackDir),
  907    prepare_pack_dir(PackDir, Options),
  908    run_process(path(git), [clone, URL, PackDir], []),
  909    pack_git_info(PackDir, Hash, Info),
  910    pack_inquiry(URL, git(Hash), Info, Options),
  911    show_info(Pack, Info, Options),
  912    confirm(git_post_install(PackDir, Pack), yes, Options),
  913    pack_post_install(Pack, PackDir, Options).
  914pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
  915    download_scheme(Scheme),
  916    directory_file_path(PackTopDir, Pack, PackDir),
  917    prepare_pack_dir(PackDir, Options),
  918    pack_download_dir(PackTopDir, DownLoadDir),
  919    download_file(URL, Pack, DownloadBase, Options),
  920    directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
  921    setup_call_cleanup(
  922        http_open(URL, In,
  923                  [ cert_verify_hook(ssl_verify)
  924                  ]),
  925        setup_call_cleanup(
  926            open(DownloadFile, write, Out, [type(binary)]),
  927            copy_stream_data(In, Out),
  928            close(Out)),
  929        close(In)),
  930    pack_archive_info(DownloadFile, Pack, Info, _),
  931    download_file_sanity_check(DownloadFile, Pack, Info),
  932    pack_inquiry(URL, DownloadFile, Info, Options),
  933    show_info(Pack, Info, Options),
  934    confirm(install_downloaded(DownloadFile), yes, Options),
  935    pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).
 download_file(+URL, +Pack, -File, +Options) is det
  939download_file(URL, Pack, File, Options) :-
  940    option(version(Version), Options),
  941    !,
  942    atom_version(VersionA, Version),
  943    file_name_extension(_, Ext, URL),
  944    format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
  945download_file(URL, Pack, File, _) :-
  946    file_base_name(URL,Basename),
  947    no_int_file_name_extension(Tag,Ext,Basename),
  948    tag_version(Tag,Version),
  949    !,
  950    atom_version(VersionA,Version),
  951    format(atom(File0), '~w-~w', [Pack, VersionA]),
  952    file_name_extension(File0, Ext, File).
  953download_file(URL, _, File, _) :-
  954    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.
  962pack_url_file(URL, FileID) :-
  963    github_release_url(URL, Pack, Version),
  964    !,
  965    download_file(URL, Pack, FileID, [version(Version)]).
  966pack_url_file(URL, FileID) :-
  967    file_base_name(URL, FileID).
  968
  969
  970:- 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.
  978ssl_verify(_SSL,
  979           _ProblemCertificate, _AllCertificates, _FirstCertificate,
  980           _Error).
  981
  982pack_download_dir(PackTopDir, DownLoadDir) :-
  983    directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
  984    (   exists_directory(DownLoadDir)
  985    ->  true
  986    ;   make_directory(DownLoadDir)
  987    ),
  988    (   access_file(DownLoadDir, write)
  989    ->  true
  990    ;   permission_error(write, directory, DownLoadDir)
  991    ).
 download_url(+URL) is det
True if URL looks like a URL we can download from.
  997download_url(URL) :-
  998    atom(URL),
  999    uri_components(URL, Components),
 1000    uri_data(scheme, Components, Scheme),
 1001    download_scheme(Scheme).
 1002
 1003download_scheme(http).
 1004download_scheme(https) :-
 1005    catch(use_module(library(http/http_ssl_plugin)),
 1006          E, (print_message(warning, E), fail)).
 pack_post_install(+Pack, +PackDir, +Options) is det
Process post installation work. Steps:
 1016pack_post_install(Pack, PackDir, Options) :-
 1017    post_install_foreign(Pack, PackDir,
 1018                         [ build_foreign(if_absent)
 1019                         | Options
 1020                         ]),
 1021    post_install_autoload(PackDir, Options),
 1022    '$pack_attach'(PackDir).
 pack_rebuild(+Pack) is det
Rebuilt possible foreign components of Pack.
 1028pack_rebuild(Pack) :-
 1029    '$pack':pack(Pack, BaseDir),
 1030    !,
 1031    catch(pack_make(BaseDir, [distclean], []), E,
 1032          print_message(warning, E)),
 1033    post_install_foreign(Pack, BaseDir, []).
 1034pack_rebuild(Pack) :-
 1035    existence_error(pack, Pack).
 pack_rebuild is det
Rebuild foreign components of all packages.
 1041pack_rebuild :-
 1042    forall(current_pack(Pack),
 1043           ( print_message(informational, pack(rebuild(Pack))),
 1044             pack_rebuild(Pack)
 1045           )).
 post_install_foreign(+Pack, +PackDir, +Options) is det
Install foreign parts of the package.
 1052post_install_foreign(Pack, PackDir, Options) :-
 1053    is_foreign_pack(PackDir),
 1054    !,
 1055    (   option(build_foreign(if_absent), Options),
 1056        foreign_present(PackDir)
 1057    ->  print_message(informational, pack(kept_foreign(Pack)))
 1058    ;   setup_path,
 1059        save_build_environment(PackDir),
 1060        configure_foreign(PackDir, Options),
 1061        make_foreign(PackDir, Options)
 1062    ).
 1063post_install_foreign(_, _, _).
 1064
 1065foreign_present(PackDir) :-
 1066    current_prolog_flag(arch, Arch),
 1067    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
 1068    exists_directory(ForeignBaseDir),
 1069    !,
 1070    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
 1071    exists_directory(ForeignDir),
 1072    current_prolog_flag(shared_object_extension, Ext),
 1073    atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
 1074    expand_file_name(Pattern, Files),
 1075    Files \== [].
 1076
 1077is_foreign_pack(PackDir) :-
 1078    foreign_file(File),
 1079    directory_file_path(PackDir, File, Path),
 1080    exists_file(Path),
 1081    !.
 1082
 1083foreign_file('configure.in').
 1084foreign_file('configure.ac').
 1085foreign_file('configure').
 1086foreign_file('Makefile').
 1087foreign_file('makefile').
 1088foreign_file('CMakeLists.txt').
 configure_foreign(+PackDir, +Options) is det
Run configure if it exists. If configure.ac or configure.in exists, first run autoheader and autoconf
 1096configure_foreign(PackDir, Options) :-
 1097    directory_file_path(PackDir, 'CMakeLists.txt', CMakeFile),
 1098    exists_file(CMakeFile),
 1099    !,
 1100    cmake_configure_foreign(PackDir, Options).
 1101configure_foreign(PackDir, Options) :-
 1102    make_configure(PackDir, Options),
 1103    directory_file_path(PackDir, configure, Configure),
 1104    exists_file(Configure),
 1105    !,
 1106    build_environment(BuildEnv),
 1107    run_process(path(bash), [Configure],
 1108                [ env(BuildEnv),
 1109                  directory(PackDir)
 1110                ]).
 1111configure_foreign(_, _).
 1112
 1113make_configure(PackDir, _Options) :-
 1114    directory_file_path(PackDir, 'configure', Configure),
 1115    exists_file(Configure),
 1116    !.
 1117make_configure(PackDir, _Options) :-
 1118    autoconf_master(ConfigMaster),
 1119    directory_file_path(PackDir, ConfigMaster, ConfigureIn),
 1120    exists_file(ConfigureIn),
 1121    !,
 1122    run_process(path(autoheader), [], [directory(PackDir)]),
 1123    run_process(path(autoconf),   [], [directory(PackDir)]).
 1124make_configure(_, _).
 1125
 1126autoconf_master('configure.ac').
 1127autoconf_master('configure.in').
 cmake_configure_foreign(+PackDir, +Options) is det
Create a build directory in PackDir and run `cmake ..`
 1133cmake_configure_foreign(PackDir, _Options) :-
 1134    directory_file_path(PackDir, build, BuildDir),
 1135    make_directory_path(BuildDir),
 1136    current_prolog_flag(executable, Exe),
 1137    format(atom(CDEF), '-DSWIPL=~w', [Exe]),
 1138    run_process(path(cmake), [CDEF, '..'],
 1139                [directory(BuildDir)]).
 make_foreign(+PackDir, +Options) is det
Generate the foreign executable.
 1146make_foreign(PackDir, Options) :-
 1147    pack_make(PackDir, [all, check, install], Options).
 1148
 1149pack_make(PackDir, Targets, _Options) :-
 1150    directory_file_path(PackDir, 'Makefile', Makefile),
 1151    exists_file(Makefile),
 1152    !,
 1153    build_environment(BuildEnv),
 1154    ProcessOptions = [ directory(PackDir), env(BuildEnv) ],
 1155    forall(member(Target, Targets),
 1156           run_process(path(make), [Target], ProcessOptions)).
 1157pack_make(PackDir, Targets, _Options) :-
 1158    directory_file_path(PackDir, 'CMakeLists.txt', CMakefile),
 1159    exists_file(CMakefile),
 1160    directory_file_path(PackDir, 'build', BuildDir),
 1161    exists_directory(BuildDir),
 1162    !,
 1163    (   Targets == [distclean]
 1164    ->  delete_directory_contents(BuildDir)
 1165    ;   build_environment(BuildEnv),
 1166        ProcessOptions = [ directory(BuildDir), env(BuildEnv) ],
 1167        forall(member(Target, Targets),
 1168               run_cmake_target(Target, BuildDir, ProcessOptions))
 1169    ).
 1170pack_make(_, _, _).
 1171
 1172run_cmake_target(check, BuildDir, ProcessOptions) :-
 1173    !,
 1174    (   directory_file_path(BuildDir, 'CTestTestfile.cmake', TestFile),
 1175        exists_file(TestFile)
 1176    ->  run_process(path(ctest), [], ProcessOptions)
 1177    ;   true
 1178    ).
 1179run_cmake_target(Target, _, ProcessOptions) :-
 1180    run_process(path(make), [Target], ProcessOptions).
 save_build_environment(+PackDir)
Create a shell-script build.env that contains the build environment.
 1187save_build_environment(PackDir) :-
 1188    directory_file_path(PackDir, 'buildenv.sh', EnvFile),
 1189    build_environment(Env),
 1190    setup_call_cleanup(
 1191        open(EnvFile, write, Out),
 1192        write_env_script(Out, Env),
 1193        close(Out)).
 1194
 1195write_env_script(Out, Env) :-
 1196    format(Out,
 1197           '# This file contains the environment that can be used to\n\c
 1198                # build the foreign pack outside Prolog.  This file must\n\c
 1199                # be loaded into a bourne-compatible shell using\n\c
 1200                #\n\c
 1201                #   $ source buildenv.sh\n\n',
 1202           []),
 1203    forall(member(Var=Value, Env),
 1204           format(Out, '~w=\'~w\'\n', [Var, Value])),
 1205    format(Out, '\nexport ', []),
 1206    forall(member(Var=_, Env),
 1207           format(Out, ' ~w', [Var])),
 1208    format(Out, '\n', []).
 1209
 1210build_environment(Env) :-
 1211    findall(Name=Value, environment(Name, Value), UserEnv),
 1212    findall(Name=Value,
 1213            ( def_environment(Name, Value),
 1214              \+ memberchk(Name=_, UserEnv)
 1215            ),
 1216            DefEnv),
 1217    append(UserEnv, DefEnv, Env).
 environment(-Name, -Value) is nondet
Hook to define the environment for building packs. This Multifile hook extends the process environment for building foreign extensions. A value provided by this hook overrules defaults provided by def_environment/2. In addition to changing the environment, this may be used to pass additional values to the environment, as in:
prolog_pack:environment('USER', User) :-
    getenv('USER', User).
Arguments:
Name- is an atom denoting a valid variable name
Value- is either an atom or number representing the value of the variable.
 def_environment(-Name, -Value) is nondet
True if Name=Value must appear in the environment for building foreign extensions.
 1244def_environment('PATH', Value) :-
 1245    getenv('PATH', PATH),
 1246    current_prolog_flag(executable, Exe),
 1247    file_directory_name(Exe, ExeDir),
 1248    prolog_to_os_filename(ExeDir, OsExeDir),
 1249    (   current_prolog_flag(windows, true)
 1250    ->  Sep = (;)
 1251    ;   Sep = (:)
 1252    ),
 1253    atomic_list_concat([OsExeDir, Sep, PATH], Value).
 1254def_environment('SWIPL', Value) :-
 1255    current_prolog_flag(executable, Value).
 1256def_environment('SWIPLVERSION', Value) :-
 1257    current_prolog_flag(version, Value).
 1258def_environment('SWIHOME', Value) :-
 1259    current_prolog_flag(home, Value).
 1260def_environment('SWIARCH', Value) :-
 1261    current_prolog_flag(arch, Value).
 1262def_environment('PACKSODIR', Value) :-
 1263    current_prolog_flag(arch, Arch),
 1264    atom_concat('lib/', Arch, Value).
 1265def_environment('SWISOLIB', Value) :-
 1266    current_prolog_flag(c_libplso, Value).
 1267def_environment('SWILIB', '-lswipl').
 1268def_environment('CC', Value) :-
 1269    (   getenv('CC', Value)
 1270    ->  true
 1271    ;   default_c_compiler(Value)
 1272    ->  true
 1273    ;   current_prolog_flag(c_cc, Value)
 1274    ).
 1275def_environment('LD', Value) :-
 1276    (   getenv('LD', Value)
 1277    ->  true
 1278    ;   current_prolog_flag(c_cc, Value)
 1279    ).
 1280def_environment('CFLAGS', Value) :-
 1281    (   getenv('CFLAGS', SystemFlags)
 1282    ->  Extra = [' ', SystemFlags]
 1283    ;   Extra = []
 1284    ),
 1285    current_prolog_flag(c_cflags, Value0),
 1286    current_prolog_flag(home, Home),
 1287    atomic_list_concat([Value0, ' -I"', Home, '/include"' | Extra], Value).
 1288def_environment('LDSOFLAGS', Value) :-
 1289    (   getenv('LDFLAGS', SystemFlags)
 1290    ->  Extra = [SystemFlags|System]
 1291    ;   Extra = System
 1292    ),
 1293    (   current_prolog_flag(windows, true)
 1294    ->  current_prolog_flag(home, Home),
 1295        atomic_list_concat(['-L"', Home, '/bin"'], SystemLib),
 1296        System = [SystemLib]
 1297    ;   apple_bundle_libdir(LibDir)
 1298    ->  atomic_list_concat(['-L"', LibDir, '"'], SystemLib),
 1299        System = [SystemLib]
 1300    ;   current_prolog_flag(c_libplso, '')
 1301    ->  System = []                 % ELF systems do not need this
 1302    ;   prolog_library_dir(SystemLibDir),
 1303        atomic_list_concat(['-L"',SystemLibDir,'"'], SystemLib),
 1304        System = [SystemLib]
 1305    ),
 1306    current_prolog_flag(c_ldflags, LDFlags),
 1307    atomic_list_concat([LDFlags, '-shared' | Extra], ' ', Value).
 1308def_environment('SOEXT', Value) :-
 1309    current_prolog_flag(shared_object_extension, Value).
 1310def_environment(Pass, Value) :-
 1311    pass_env(Pass),
 1312    getenv(Pass, Value).
 1313
 1314pass_env('TMP').
 1315pass_env('TEMP').
 1316pass_env('USER').
 1317pass_env('HOME').
 1318
 1319:- multifile
 1320    prolog:runtime_config/2. 1321
 1322prolog_library_dir(Dir) :-
 1323    prolog:runtime_config(c_libdir, Dir),
 1324    !.
 1325prolog_library_dir(Dir) :-
 1326    current_prolog_flag(home, Home),
 1327    (   current_prolog_flag(c_libdir, Rel)
 1328    ->  atomic_list_concat([Home, Rel], /, Dir)
 1329    ;   current_prolog_flag(arch, Arch)
 1330    ->  atomic_list_concat([Home, lib, Arch], /, Dir)
 1331    ).
 default_c_compiler(-CC) is semidet
Try to find a suitable C compiler for compiling packages with foreign code.
To be done
- Needs proper defaults for Windows. Find MinGW? Find MSVC?
 1340default_c_compiler(CC) :-
 1341    preferred_c_compiler(CC),
 1342    has_program(path(CC), _),
 1343    !.
 1344
 1345preferred_c_compiler(gcc).
 1346preferred_c_compiler(clang).
 1347preferred_c_compiler(cc).
 1348
 1349
 1350                 /*******************************
 1351                 *             PATHS            *
 1352                 *******************************/
 1353
 1354setup_path :-
 1355    has_program(path(make), _),
 1356    has_program(path(gcc), _),
 1357    !.
 1358setup_path :-
 1359    current_prolog_flag(windows, true),
 1360    !,
 1361    (   mingw_extend_path
 1362    ->  true
 1363    ;   print_message(error, pack(no_mingw))
 1364    ).
 1365setup_path.
 1366
 1367has_program(Program, Path) :-
 1368    exe_options(ExeOptions),
 1369    absolute_file_name(Program, Path,
 1370                       [ file_errors(fail)
 1371                       | ExeOptions
 1372                       ]).
 1373
 1374exe_options(Options) :-
 1375    current_prolog_flag(windows, true),
 1376    !,
 1377    Options = [ extensions(['',exe,com]), access(read) ].
 1378exe_options(Options) :-
 1379    Options = [ access(execute) ].
 1380
 1381mingw_extend_path :-
 1382    mingw_root(MinGW),
 1383    directory_file_path(MinGW, bin, MinGWBinDir),
 1384    atom_concat(MinGW, '/msys/*/bin', Pattern),
 1385    expand_file_name(Pattern, MsysDirs),
 1386    last(MsysDirs, MSysBinDir),
 1387    prolog_to_os_filename(MinGWBinDir, WinDirMinGW),
 1388    prolog_to_os_filename(MSysBinDir, WinDirMSYS),
 1389    getenv('PATH', Path0),
 1390    atomic_list_concat([WinDirMSYS, WinDirMinGW, Path0], ';', Path),
 1391    setenv('PATH', Path).
 1392
 1393mingw_root(MinGwRoot) :-
 1394    current_prolog_flag(executable, Exe),
 1395    sub_atom(Exe, 1, _, _, :),
 1396    sub_atom(Exe, 0, 1, _, PlDrive),
 1397    Drives = [PlDrive,c,d],
 1398    member(Drive, Drives),
 1399    format(atom(MinGwRoot), '~a:/MinGW', [Drive]),
 1400    exists_directory(MinGwRoot),
 1401    !.
 1402
 1403
 1404                 /*******************************
 1405                 *           AUTOLOAD           *
 1406                 *******************************/
 post_install_autoload(+PackDir, +Options)
Create an autoload index if the package demands such.
 1412post_install_autoload(PackDir, Options) :-
 1413    option(autoload(true), Options, true),
 1414    pack_info_term(PackDir, autoload(true)),
 1415    !,
 1416    directory_file_path(PackDir, prolog, PrologLibDir),
 1417    make_library_index(PrologLibDir).
 1418post_install_autoload(_, _).
 1419
 1420
 1421                 /*******************************
 1422                 *            UPGRADE           *
 1423                 *******************************/
 pack_upgrade(+Pack) is semidet
Try to upgrade the package Pack.
To be done
- Update dependencies when updating a pack from git?
 1431pack_upgrade(Pack) :-
 1432    pack_info(Pack, _, directory(Dir)),
 1433    directory_file_path(Dir, '.git', GitDir),
 1434    exists_directory(GitDir),
 1435    !,
 1436    print_message(informational, pack(git_fetch(Dir))),
 1437    git([fetch], [ directory(Dir) ]),
 1438    git_describe(V0, [ directory(Dir) ]),
 1439    git_describe(V1, [ directory(Dir), commit('origin/master') ]),
 1440    (   V0 == V1
 1441    ->  print_message(informational, pack(up_to_date(Pack)))
 1442    ;   confirm(upgrade(Pack, V0, V1), yes, []),
 1443        git([merge, 'origin/master'], [ directory(Dir) ]),
 1444        pack_rebuild(Pack)
 1445    ).
 1446pack_upgrade(Pack) :-
 1447    once(pack_info(Pack, _, version(VersionAtom))),
 1448    atom_version(VersionAtom, Version),
 1449    pack_info(Pack, _, download(URL)),
 1450    (   wildcard_pattern(URL)
 1451    ->  true
 1452    ;   github_url(URL, _User, _Repo)
 1453    ),
 1454    !,
 1455    available_download_versions(URL, [Latest-LatestURL|_Versions]),
 1456    (   Latest @> Version
 1457    ->  confirm(upgrade(Pack, Version, Latest), yes, []),
 1458        pack_install(Pack,
 1459                     [ url(LatestURL),
 1460                       upgrade(true),
 1461                       pack(Pack)
 1462                     ])
 1463    ;   print_message(informational, pack(up_to_date(Pack)))
 1464    ).
 1465pack_upgrade(Pack) :-
 1466    print_message(warning, pack(no_upgrade_info(Pack))).
 1467
 1468
 1469                 /*******************************
 1470                 *            REMOVE            *
 1471                 *******************************/
 pack_remove(+Name) is det
Remove the indicated package.
 1477pack_remove(Pack) :-
 1478    update_dependency_db,
 1479    (   setof(Dep, pack_depends_on(Dep, Pack), Deps)
 1480    ->  confirm_remove(Pack, Deps, Delete),
 1481        forall(member(P, Delete), pack_remove_forced(P))
 1482    ;   pack_remove_forced(Pack)
 1483    ).
 1484
 1485pack_remove_forced(Pack) :-
 1486    catch('$pack_detach'(Pack, BaseDir),
 1487          error(existence_error(pack, Pack), _),
 1488          fail),
 1489    !,
 1490    print_message(informational, pack(remove(BaseDir))),
 1491    delete_directory_and_contents(BaseDir).
 1492pack_remove_forced(Pack) :-
 1493    directory_file_path(Pack, 'pack.pl', PackFile),
 1494    absolute_file_name(pack(PackFile), PackPath,
 1495                       [ access(read),
 1496                         file_errors(fail)
 1497                       ]),
 1498    !,
 1499    file_directory_name(PackPath, BaseDir),
 1500    delete_directory_and_contents(BaseDir).
 1501pack_remove_forced(Pack) :-
 1502    print_message(informational, error(existence_error(pack, Pack),_)).
 1503
 1504confirm_remove(Pack, Deps, Delete) :-
 1505    print_message(warning, pack(depends(Pack, Deps))),
 1506    menu(pack(resolve_remove),
 1507         [ [Pack]      = remove_only(Pack),
 1508           [Pack|Deps] = remove_deps(Pack, Deps),
 1509           []          = cancel
 1510         ], [], Delete, []),
 1511    Delete \== [].
 1512
 1513
 1514                 /*******************************
 1515                 *           PROPERTIES         *
 1516                 *******************************/
 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)
 1539pack_property(Pack, Property) :-
 1540    findall(Pack-Property, pack_property_(Pack, Property), List),
 1541    member(Pack-Property, List).            % make det if applicable
 1542
 1543pack_property_(Pack, Property) :-
 1544    pack_info(Pack, _, Property).
 1545pack_property_(Pack, Property) :-
 1546    \+ \+ info_file(Property, _),
 1547    '$pack':pack(Pack, BaseDir),
 1548    access_file(BaseDir, read),
 1549    directory_files(BaseDir, Files),
 1550    member(File, Files),
 1551    info_file(Property, Pattern),
 1552    downcase_atom(File, Pattern),
 1553    directory_file_path(BaseDir, File, InfoFile),
 1554    arg(1, Property, InfoFile).
 1555
 1556info_file(readme(_), 'readme.txt').
 1557info_file(readme(_), 'readme').
 1558info_file(todo(_),   'todo.txt').
 1559info_file(todo(_),   'todo').
 1560
 1561
 1562                 /*******************************
 1563                 *             GIT              *
 1564                 *******************************/
 git_url(+URL, -Pack) is semidet
True if URL describes a git url for Pack
 1570git_url(URL, Pack) :-
 1571    uri_components(URL, Components),
 1572    uri_data(scheme, Components, Scheme),
 1573    uri_data(path, Components, Path),
 1574    (   Scheme == git
 1575    ->  true
 1576    ;   git_download_scheme(Scheme),
 1577        file_name_extension(_, git, Path)
 1578    ),
 1579    file_base_name(Path, PackExt),
 1580    (   file_name_extension(Pack, git, PackExt)
 1581    ->  true
 1582    ;   Pack = PackExt
 1583    ),
 1584    (   safe_pack_name(Pack)
 1585    ->  true
 1586    ;   domain_error(pack_name, Pack)
 1587    ).
 1588
 1589git_download_scheme(http).
 1590git_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.
 1597safe_pack_name(Name) :-
 1598    atom_length(Name, Len),
 1599    Len >= 3,                               % demand at least three length
 1600    atom_codes(Name, Codes),
 1601    maplist(safe_pack_char, Codes),
 1602    !.
 1603
 1604safe_pack_char(C) :- between(0'a, 0'z, C), !.
 1605safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 1606safe_pack_char(C) :- between(0'0, 0'9, C), !.
 1607safe_pack_char(0'_).
 1608
 1609
 1610                 /*******************************
 1611                 *         VERSION LOGIC        *
 1612                 *******************************/
 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.
 1621pack_version_file(Pack, Version, GitHubRelease) :-
 1622    atomic(GitHubRelease),
 1623    github_release_url(GitHubRelease, Pack, Version),
 1624    !.
 1625pack_version_file(Pack, Version, Path) :-
 1626    atomic(Path),
 1627    file_base_name(Path, File),
 1628    no_int_file_name_extension(Base, _Ext, File),
 1629    atom_codes(Base, Codes),
 1630    (   phrase(pack_version(Pack, Version), Codes),
 1631        safe_pack_name(Pack)
 1632    ->  true
 1633    ).
 1634
 1635no_int_file_name_extension(Base, Ext, File) :-
 1636    file_name_extension(Base0, Ext0, File),
 1637    \+ atom_number(Ext0, _),
 1638    !,
 1639    Base = Base0,
 1640    Ext = Ext0.
 1641no_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'
 1654github_release_url(URL, Pack, Version) :-
 1655    uri_components(URL, Components),
 1656    uri_data(authority, Components, 'github.com'),
 1657    uri_data(scheme, Components, Scheme),
 1658    download_scheme(Scheme),
 1659    uri_data(path, Components, Path),
 1660    atomic_list_concat(['',_Project,Pack,archive,File], /, Path),
 1661    file_name_extension(Tag, Ext, File),
 1662    github_archive_extension(Ext),
 1663    tag_version(Tag, Version),
 1664    !.
 1665
 1666github_archive_extension(tgz).
 1667github_archive_extension(zip).
 1668
 1669tag_version(Tag, Version) :-
 1670    version_tag_prefix(Prefix),
 1671    atom_concat(Prefix, AtomVersion, Tag),
 1672    atom_version(AtomVersion, Version).
 1673
 1674version_tag_prefix(v).
 1675version_tag_prefix('V').
 1676version_tag_prefix('').
 1677
 1678
 1679:- public
 1680    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 @>
 1688atom_version(Atom, version(Parts)) :-
 1689    (   atom(Atom)
 1690    ->  atom_codes(Atom, Codes),
 1691        phrase(version(Parts), Codes)
 1692    ;   atomic_list_concat(Parts, '.', Atom)
 1693    ).
 1694
 1695pack_version(Pack, version(Parts)) -->
 1696    string(Codes), "-",
 1697    version(Parts),
 1698    !,
 1699    { atom_codes(Pack, Codes)
 1700    }.
 1701
 1702version([_|T]) -->
 1703    "*",
 1704    !,
 1705    (   "."
 1706    ->  version(T)
 1707    ;   []
 1708    ).
 1709version([H|T]) -->
 1710    integer(H),
 1711    (   "."
 1712    ->  version(T)
 1713    ;   { T = [] }
 1714    ).
 1715
 1716integer(H)    --> digit(D0), digits(L), { number_codes(H, [D0|L]) }.
 1717digit(D)      --> [D], { code_type(D, digit) }.
 1718digits([H|T]) --> digit(H), !, digits(T).
 1719digits([])    --> [].
 1720
 1721
 1722                 /*******************************
 1723                 *       QUERY CENTRAL DB       *
 1724                 *******************************/
 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.
 1744pack_inquiry(_, _, _, Options) :-
 1745    option(inquiry(false), Options),
 1746    !.
 1747pack_inquiry(URL, DownloadFile, Info, Options) :-
 1748    setting(server, ServerBase),
 1749    ServerBase \== '',
 1750    atom_concat(ServerBase, query, Server),
 1751    (   option(inquiry(true), Options)
 1752    ->  true
 1753    ;   confirm(inquiry(Server), yes, Options)
 1754    ),
 1755    !,
 1756    (   DownloadFile = git(SHA1)
 1757    ->  true
 1758    ;   file_sha1(DownloadFile, SHA1)
 1759    ),
 1760    query_pack_server(install(URL, SHA1, Info), Reply, Options),
 1761    inquiry_result(Reply, URL, Options).
 1762pack_inquiry(_, _, _, _).
 query_pack_server(+Query, -Result, +Options)
Send a Prolog query to the package server and process its results.
 1770query_pack_server(Query, Result, Options) :-
 1771    setting(server, ServerBase),
 1772    ServerBase \== '',
 1773    atom_concat(ServerBase, query, Server),
 1774    format(codes(Data), '~q.~n', Query),
 1775    info_level(Informational, Options),
 1776    print_message(Informational, pack(contacting_server(Server))),
 1777    setup_call_cleanup(
 1778        http_open(Server, In,
 1779                  [ post(codes(application/'x-prolog', Data)),
 1780                    header(content_type, ContentType)
 1781                  ]),
 1782        read_reply(ContentType, In, Result),
 1783        close(In)),
 1784    message_severity(Result, Level, Informational),
 1785    print_message(Level, pack(server_reply(Result))).
 1786
 1787read_reply(ContentType, In, Result) :-
 1788    sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
 1789    !,
 1790    set_stream(In, encoding(utf8)),
 1791    read(In, Result).
 1792read_reply(ContentType, In, _Result) :-
 1793    read_string(In, 500, String),
 1794    print_message(error, pack(no_prolog_response(ContentType, String))),
 1795    fail.
 1796
 1797info_level(Level, Options) :-
 1798    option(silent(true), Options),
 1799    !,
 1800    Level = silent.
 1801info_level(informational, _).
 1802
 1803message_severity(true(_), Informational, Informational).
 1804message_severity(false, warning, _).
 1805message_severity(exception(_), error, _).
 inquiry_result(+Reply, +File, +Options) is semidet
Analyse the results of the inquiry and decide whether to continue or not.
 1813inquiry_result(Reply, File, Options) :-
 1814    findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation),
 1815    \+ member(cancel, Evaluation),
 1816    select_option(git(_), Options, Options1, _),
 1817    forall(member(install_dependencies(Resolution), Evaluation),
 1818           maplist(install_dependency(Options1), Resolution)).
 1819
 1820eval_inquiry(true(Reply), URL, Eval, _) :-
 1821    include(alt_hash, Reply, Alts),
 1822    Alts \== [],
 1823    print_message(warning, pack(alt_hashes(URL, Alts))),
 1824    (   memberchk(downloads(Count), Reply),
 1825        (   git_url(URL, _)
 1826        ->  Default = yes,
 1827            Eval = with_git_commits_in_same_version
 1828        ;   Default = no,
 1829            Eval = with_alt_hashes
 1830        ),
 1831        confirm(continue_with_alt_hashes(Count, URL), Default, [])
 1832    ->  true
 1833    ;   !,                          % Stop other rules
 1834        Eval = cancel
 1835    ).
 1836eval_inquiry(true(Reply), _, Eval, Options) :-
 1837    include(dependency, Reply, Deps),
 1838    Deps \== [],
 1839    select_dependency_resolution(Deps, Eval, Options),
 1840    (   Eval == cancel
 1841    ->  !
 1842    ;   true
 1843    ).
 1844eval_inquiry(true(Reply), URL, true, Options) :-
 1845    file_base_name(URL, File),
 1846    info_level(Informational, Options),
 1847    print_message(Informational, pack(inquiry_ok(Reply, File))).
 1848eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))),
 1849             URL, Eval, Options) :-
 1850    (   confirm(continue_with_modified_hash(URL), no, Options)
 1851    ->  Eval = true
 1852    ;   Eval = cancel
 1853    ).
 1854
 1855alt_hash(alt_hash(_,_,_)).
 1856dependency(dependency(_,_,_,_,_)).
 select_dependency_resolution(+Deps, -Eval, +Options)
Select a resolution.
To be done
- Exploit backtracking over resolve_dependencies/2.
 1865select_dependency_resolution(Deps, Eval, Options) :-
 1866    resolve_dependencies(Deps, Resolution),
 1867    exclude(local_dep, Resolution, ToBeDone),
 1868    (   ToBeDone == []
 1869    ->  !, Eval = true
 1870    ;   print_message(warning, pack(install_dependencies(Resolution))),
 1871        (   memberchk(_-unresolved, Resolution)
 1872        ->  Default = cancel
 1873        ;   Default = install_deps
 1874        ),
 1875        menu(pack(resolve_deps),
 1876             [ install_deps    = install_deps,
 1877               install_no_deps = install_no_deps,
 1878               cancel          = cancel
 1879             ], Default, Choice, Options),
 1880        (   Choice == cancel
 1881        ->  !, Eval = cancel
 1882        ;   Choice == install_no_deps
 1883        ->  !, Eval = install_no_deps
 1884        ;   !, Eval = install_dependencies(Resolution)
 1885        )
 1886    ).
 1887
 1888local_dep(_-resolved(_)).
 install_dependency(+Options, +TokenResolution)
Install dependencies for the given resolution.
To be done
- : Query URI to use
 1897install_dependency(Options,
 1898                   _Token-resolve(Pack, VersionAtom, [_URL|_], SubResolve)) :-
 1899    atom_version(VersionAtom, Version),
 1900    current_pack(Pack),
 1901    pack_info(Pack, _, version(InstalledAtom)),
 1902    atom_version(InstalledAtom, Installed),
 1903    Installed == Version,               % already installed
 1904    !,
 1905    maplist(install_dependency(Options), SubResolve).
 1906install_dependency(Options,
 1907                   _Token-resolve(Pack, VersionAtom, [URL|_], SubResolve)) :-
 1908    !,
 1909    atom_version(VersionAtom, Version),
 1910    merge_options([ url(URL),
 1911                    version(Version),
 1912                    interactive(false),
 1913                    inquiry(false),
 1914                    info(list),
 1915                    pack(Pack)
 1916                  ], Options, InstallOptions),
 1917    pack_install(Pack, InstallOptions),
 1918    maplist(install_dependency(Options), SubResolve).
 1919install_dependency(_, _-_).
 1920
 1921
 1922                 /*******************************
 1923                 *        WILDCARD URIs         *
 1924                 *******************************/
 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
 1933available_download_versions(URL, Versions) :-
 1934    wildcard_pattern(URL),
 1935    github_url(URL, User, Repo),
 1936    !,
 1937    findall(Version-VersionURL,
 1938            github_version(User, Repo, Version, VersionURL),
 1939            Versions).
 1940available_download_versions(URL, Versions) :-
 1941    wildcard_pattern(URL),
 1942    !,
 1943    file_directory_name(URL, DirURL0),
 1944    ensure_slash(DirURL0, DirURL),
 1945    print_message(informational, pack(query_versions(DirURL))),
 1946    setup_call_cleanup(
 1947        http_open(DirURL, In, []),
 1948        load_html(stream(In), DOM,
 1949                  [ syntax_errors(quiet)
 1950                  ]),
 1951        close(In)),
 1952    findall(MatchingURL,
 1953            absolute_matching_href(DOM, URL, MatchingURL),
 1954            MatchingURLs),
 1955    (   MatchingURLs == []
 1956    ->  print_message(warning, pack(no_matching_urls(URL)))
 1957    ;   true
 1958    ),
 1959    versioned_urls(MatchingURLs, VersionedURLs),
 1960    keysort(VersionedURLs, SortedVersions),
 1961    reverse(SortedVersions, Versions),
 1962    print_message(informational, pack(found_versions(Versions))).
 1963available_download_versions(URL, [Version-URL]) :-
 1964    (   pack_version_file(_Pack, Version0, URL)
 1965    ->  Version = Version0
 1966    ;   Version = unknown
 1967    ).
 github_url(+URL, -User, -Repo) is semidet
True when URL refers to a github repository.
 1973github_url(URL, User, Repo) :-
 1974    uri_components(URL, uri_components(https,'github.com',Path,_,_)),
 1975    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.
 1983github_version(User, Repo, Version, VersionURI) :-
 1984    atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
 1985    uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
 1986    setup_call_cleanup(
 1987      http_open(ApiUri, In,
 1988                [ request_header('Accept'='application/vnd.github.v3+json')
 1989                ]),
 1990      json_read_dict(In, Dicts),
 1991      close(In)),
 1992    member(Dict, Dicts),
 1993    atom_string(Tag, Dict.name),
 1994    tag_version(Tag, Version),
 1995    atom_string(VersionURI, Dict.zipball_url).
 1996
 1997wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
 1998wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
 1999
 2000ensure_slash(Dir, DirS) :-
 2001    (   sub_atom(Dir, _, _, 0, /)
 2002    ->  DirS = Dir
 2003    ;   atom_concat(Dir, /, DirS)
 2004    ).
 2005
 2006absolute_matching_href(DOM, Pattern, Match) :-
 2007    xpath(DOM, //a(@href), HREF),
 2008    uri_normalized(HREF, Pattern, Match),
 2009    wildcard_match(Pattern, Match).
 2010
 2011versioned_urls([], []).
 2012versioned_urls([H|T0], List) :-
 2013    file_base_name(H, File),
 2014    (   pack_version_file(_Pack, Version, File)
 2015    ->  List = [Version-H|T]
 2016    ;   List = T
 2017    ),
 2018    versioned_urls(T0, T).
 2019
 2020
 2021                 /*******************************
 2022                 *          DEPENDENCIES        *
 2023                 *******************************/
 update_dependency_db
Reload dependency declarations between packages.
 2029update_dependency_db :-
 2030    retractall(pack_requires(_,_)),
 2031    retractall(pack_provides_db(_,_)),
 2032    forall(current_pack(Pack),
 2033           (   findall(Info, pack_info(Pack, dependency, Info), Infos),
 2034               update_dependency_db(Pack, Infos)
 2035           )).
 2036
 2037update_dependency_db(Name, Info) :-
 2038    retractall(pack_requires(Name, _)),
 2039    retractall(pack_provides_db(Name, _)),
 2040    maplist(assert_dep(Name), Info).
 2041
 2042assert_dep(Pack, provides(Token)) :-
 2043    !,
 2044    assertz(pack_provides_db(Pack, Token)).
 2045assert_dep(Pack, requires(Token)) :-
 2046    !,
 2047    assertz(pack_requires(Pack, Token)).
 2048assert_dep(_, _).
 validate_dependencies is det
Validate all dependencies, reporting on failures
 2054validate_dependencies :-
 2055    unsatisfied_dependencies(Unsatisfied),
 2056    !,
 2057    print_message(warning, pack(unsatisfied(Unsatisfied))).
 2058validate_dependencies.
 2059
 2060
 2061unsatisfied_dependencies(Unsatisfied) :-
 2062    findall(Req-Pack, pack_requires(Pack, Req), Reqs0),
 2063    keysort(Reqs0, Reqs1),
 2064    group_pairs_by_key(Reqs1, GroupedReqs),
 2065    exclude(satisfied_dependency, GroupedReqs, Unsatisfied),
 2066    Unsatisfied \== [].
 2067
 2068satisfied_dependency(Needed-_By) :-
 2069    pack_provides(_, Needed),
 2070    !.
 2071satisfied_dependency(Needed-_By) :-
 2072    compound(Needed),
 2073    Needed =.. [Op, Pack, ReqVersion],
 2074    (   pack_provides(Pack, Pack)
 2075    ->  pack_info(Pack, _, version(PackVersion)),
 2076        version_data(PackVersion, PackData)
 2077    ;   Pack == prolog
 2078    ->  current_prolog_flag(version_data, swi(Major,Minor,Patch,_)),
 2079        PackData = [Major,Minor,Patch]
 2080    ),
 2081    version_data(ReqVersion, ReqData),
 2082    cmp(Op, Cmp),
 2083    call(Cmp, PackData, ReqData).
 pack_provides(?Package, ?Token) is multi
True if Pack provides Token. A package always provides itself.
 2089pack_provides(Pack, Pack) :-
 2090    current_pack(Pack).
 2091pack_provides(Pack, Token) :-
 2092    pack_provides_db(Pack, Token).
 pack_depends_on(?Pack, ?Dependency) is nondet
True if Pack requires Dependency, direct or indirect.
 2098pack_depends_on(Pack, Dependency) :-
 2099    (   atom(Pack)
 2100    ->  pack_depends_on_fwd(Pack, Dependency, [Pack])
 2101    ;   pack_depends_on_bwd(Pack, Dependency, [Dependency])
 2102    ).
 2103
 2104pack_depends_on_fwd(Pack, Dependency, Visited) :-
 2105    pack_depends_on_1(Pack, Dep1),
 2106    \+ memberchk(Dep1, Visited),
 2107    (   Dependency = Dep1
 2108    ;   pack_depends_on_fwd(Dep1, Dependency, [Dep1|Visited])
 2109    ).
 2110
 2111pack_depends_on_bwd(Pack, Dependency, Visited) :-
 2112    pack_depends_on_1(Dep1, Dependency),
 2113    \+ memberchk(Dep1, Visited),
 2114    (   Pack = Dep1
 2115    ;   pack_depends_on_bwd(Pack, Dep1, [Dep1|Visited])
 2116    ).
 2117
 2118pack_depends_on_1(Pack, Dependency) :-
 2119    atom(Dependency),
 2120    !,
 2121    pack_provides(Dependency, Token),
 2122    pack_requires(Pack, Token).
 2123pack_depends_on_1(Pack, Dependency) :-
 2124    pack_requires(Pack, Token),
 2125    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
 2142resolve_dependencies(Dependencies, Resolution) :-
 2143    maplist(dependency_pair, Dependencies, Pairs0),
 2144    keysort(Pairs0, Pairs1),
 2145    group_pairs_by_key(Pairs1, ByToken),
 2146    maplist(resolve_dep, ByToken, Resolution).
 2147
 2148dependency_pair(dependency(Token, Pack, Version, URLs, SubDeps),
 2149                Token-(Pack-pack(Version,URLs, SubDeps))).
 2150
 2151resolve_dep(Token-Pairs, Token-Resolution) :-
 2152    (   resolve_dep2(Token-Pairs, Resolution)
 2153    *-> true
 2154    ;   Resolution = unresolved
 2155    ).
 2156
 2157resolve_dep2(Token-_, resolved(Pack)) :-
 2158    pack_provides(Pack, Token).
 2159resolve_dep2(_-Pairs, resolve(Pack, VersionAtom, URLs, SubResolves)) :-
 2160    keysort(Pairs, Sorted),
 2161    group_pairs_by_key(Sorted, ByPack),
 2162    member(Pack-Versions, ByPack),
 2163    Pack \== (-),
 2164    maplist(version_pack, Versions, VersionData),
 2165    sort(VersionData, ByVersion),
 2166    reverse(ByVersion, ByVersionLatest),
 2167    member(pack(Version,URLs,SubDeps), ByVersionLatest),
 2168    atom_version(VersionAtom, Version),
 2169    include(dependency, SubDeps, Deps),
 2170    resolve_dependencies(Deps, SubResolves).
 2171
 2172version_pack(pack(VersionAtom,URLs,SubDeps),
 2173             pack(Version,URLs,SubDeps)) :-
 2174    atom_version(VersionAtom, Version).
 2175
 2176
 2177                 /*******************************
 2178                 *          RUN PROCESSES       *
 2179                 *******************************/
 run_process(+Executable, +Argv, +Options) is det
Run Executable. Defined options:
directory(+Dir)
Execute in the given directory
output(-Out)
Unify Out with a list of codes representing stdout of the command. Otherwise the output is handed to print_message/2 with level informational.
error(-Error)
As output(Out), but messages are printed at level error.
env(+Environment)
Environment passed to the new process.
 2196run_process(Executable, Argv, Options) :-
 2197    \+ option(output(_), Options),
 2198    \+ option(error(_), Options),
 2199    current_prolog_flag(unix, true),
 2200    current_prolog_flag(threads, true),
 2201    !,
 2202    process_create_options(Options, Extra),
 2203    process_create(Executable, Argv,
 2204                   [ stdout(pipe(Out)),
 2205                     stderr(pipe(Error)),
 2206                     process(PID)
 2207                   | Extra
 2208                   ]),
 2209    thread_create(relay_output([output-Out, error-Error]), Id, []),
 2210    process_wait(PID, Status),
 2211    thread_join(Id, _),
 2212    (   Status == exit(0)
 2213    ->  true
 2214    ;   throw(error(process_error(process(Executable, Argv), Status), _))
 2215    ).
 2216run_process(Executable, Argv, Options) :-
 2217    process_create_options(Options, Extra),
 2218    setup_call_cleanup(
 2219        process_create(Executable, Argv,
 2220                       [ stdout(pipe(Out)),
 2221                         stderr(pipe(Error)),
 2222                         process(PID)
 2223                       | Extra
 2224                       ]),
 2225        (   read_stream_to_codes(Out, OutCodes, []),
 2226            read_stream_to_codes(Error, ErrorCodes, []),
 2227            process_wait(PID, Status)
 2228        ),
 2229        (   close(Out),
 2230            close(Error)
 2231        )),
 2232    print_error(ErrorCodes, Options),
 2233    print_output(OutCodes, Options),
 2234    (   Status == exit(0)
 2235    ->  true
 2236    ;   throw(error(process_error(process(Executable, Argv), Status), _))
 2237    ).
 2238
 2239process_create_options(Options, Extra) :-
 2240    option(directory(Dir), Options, .),
 2241    (   option(env(Env), Options)
 2242    ->  Extra = [cwd(Dir), env(Env)]
 2243    ;   Extra = [cwd(Dir)]
 2244    ).
 2245
 2246relay_output([]) :- !.
 2247relay_output(Output) :-
 2248    pairs_values(Output, Streams),
 2249    wait_for_input(Streams, Ready, infinite),
 2250    relay(Ready, Output, NewOutputs),
 2251    relay_output(NewOutputs).
 2252
 2253relay([], Outputs, Outputs).
 2254relay([H|T], Outputs0, Outputs) :-
 2255    selectchk(Type-H, Outputs0, Outputs1),
 2256    (   at_end_of_stream(H)
 2257    ->  close(H),
 2258        relay(T, Outputs1, Outputs)
 2259    ;   read_pending_codes(H, Codes, []),
 2260        relay(Type, Codes),
 2261        relay(T, Outputs0, Outputs)
 2262    ).
 2263
 2264relay(error,  Codes) :-
 2265    set_prolog_flag(message_context, []),
 2266    print_error(Codes, []).
 2267relay(output, Codes) :-
 2268    print_output(Codes, []).
 2269
 2270print_output(OutCodes, Options) :-
 2271    option(output(Codes), Options),
 2272    !,
 2273    Codes = OutCodes.
 2274print_output(OutCodes, _) :-
 2275    print_message(informational, pack(process_output(OutCodes))).
 2276
 2277print_error(OutCodes, Options) :-
 2278    option(error(Codes), Options),
 2279    !,
 2280    Codes = OutCodes.
 2281print_error(OutCodes, _) :-
 2282    phrase(classify_message(Level), OutCodes, _),
 2283    print_message(Level, pack(process_output(OutCodes))).
 2284
 2285classify_message(error) -->
 2286    string(_), "fatal:",
 2287    !.
 2288classify_message(error) -->
 2289    string(_), "error:",
 2290    !.
 2291classify_message(warning) -->
 2292    string(_), "warning:",
 2293    !.
 2294classify_message(informational) -->
 2295    [].
 2296
 2297string([]) --> [].
 2298string([H|T]) --> [H], string(T).
 2299
 2300
 2301                 /*******************************
 2302                 *        USER INTERACTION      *
 2303                 *******************************/
 2304
 2305:- multifile prolog:message//1.
 menu(Question, +Alternatives, +Default, -Selection, +Options)
 2309menu(_Question, _Alternatives, Default, Selection, Options) :-
 2310    option(interactive(false), Options),
 2311    !,
 2312    Selection = Default.
 2313menu(Question, Alternatives, Default, Selection, _) :-
 2314    length(Alternatives, N),
 2315    between(1, 5, _),
 2316       print_message(query, Question),
 2317       print_menu(Alternatives, Default, 1),
 2318       print_message(query, pack(menu(select))),
 2319       read_selection(N, Choice),
 2320    !,
 2321    (   Choice == default
 2322    ->  Selection = Default
 2323    ;   nth1(Choice, Alternatives, Selection=_)
 2324    ->  true
 2325    ).
 2326
 2327print_menu([], _, _).
 2328print_menu([Value=Label|T], Default, I) :-
 2329    (   Value == Default
 2330    ->  print_message(query, pack(menu(default_item(I, Label))))
 2331    ;   print_message(query, pack(menu(item(I, Label))))
 2332    ),
 2333    I2 is I + 1,
 2334    print_menu(T, Default, I2).
 2335
 2336read_selection(Max, Choice) :-
 2337    get_single_char(Code),
 2338    (   answered_default(Code)
 2339    ->  Choice = default
 2340    ;   code_type(Code, digit(Choice)),
 2341        between(1, Max, Choice)
 2342    ->  true
 2343    ;   print_message(warning, pack(menu(reply(1,Max)))),
 2344        fail
 2345    ).
 confirm(+Question, +Default, +Options) is semidet
Ask for confirmation.
Arguments:
Default- is one of yes, no or none.
 2353confirm(_Question, Default, Options) :-
 2354    Default \== none,
 2355    option(interactive(false), Options, true),
 2356    !,
 2357    Default == yes.
 2358confirm(Question, Default, _) :-
 2359    between(1, 5, _),
 2360       print_message(query, pack(confirm(Question, Default))),
 2361       read_yes_no(YesNo, Default),
 2362    !,
 2363    format(user_error, '~N', []),
 2364    YesNo == yes.
 2365
 2366read_yes_no(YesNo, Default) :-
 2367    get_single_char(Code),
 2368    code_yes_no(Code, Default, YesNo),
 2369    !.
 2370
 2371code_yes_no(0'y, _, yes).
 2372code_yes_no(0'Y, _, yes).
 2373code_yes_no(0'n, _, no).
 2374code_yes_no(0'N, _, no).
 2375code_yes_no(_, none, _) :- !, fail.
 2376code_yes_no(C, Default, Default) :-
 2377    answered_default(C).
 2378
 2379answered_default(0'\r).
 2380answered_default(0'\n).
 2381answered_default(0'\s).
 2382
 2383
 2384                 /*******************************
 2385                 *            MESSAGES          *
 2386                 *******************************/
 2387
 2388:- multifile prolog:message//1. 2389
 2390prolog:message(pack(Message)) -->
 2391    message(Message).
 2392
 2393:- discontiguous
 2394    message//1,
 2395    label//1. 2396
 2397message(invalid_info(Term)) -->
 2398    [ 'Invalid package description: ~q'-[Term] ].
 2399message(directory_exists(Dir)) -->
 2400    [ 'Package target directory exists and is not empty:', nl,
 2401      '\t~q'-[Dir]
 2402    ].
 2403message(already_installed(pack(Pack, Version))) -->
 2404    { atom_version(AVersion, Version) },
 2405    [ 'Pack `~w'' is already installed @~w'-[Pack, AVersion] ].
 2406message(already_installed(Pack)) -->
 2407    [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
 2408message(invalid_name(File)) -->
 2409    [ '~w: A package archive must be named <pack>-<version>.<ext>'-[File] ],
 2410    no_tar_gz(File).
 2411
 2412no_tar_gz(File) -->
 2413    { sub_atom(File, _, _, 0, '.tar.gz') },
 2414    !,
 2415    [ nl,
 2416      'Package archive files must have a single extension.  E.g., \'.tgz\''-[]
 2417    ].
 2418no_tar_gz(_) --> [].
 2419
 2420message(kept_foreign(Pack)) -->
 2421    [ 'Found foreign libraries for target platform.'-[], nl,
 2422      'Use ?- pack_rebuild(~q). to rebuild from sources'-[Pack]
 2423    ].
 2424message(no_pack_installed(Pack)) -->
 2425    [ 'No pack ~q installed.  Use ?- pack_list(Pattern) to search'-[Pack] ].
 2426message(no_packages_installed) -->
 2427    { setting(server, ServerBase) },
 2428    [ 'There are no extra packages installed.', nl,
 2429      'Please visit ~wlist.'-[ServerBase]
 2430    ].
 2431message(remove_with(Pack)) -->
 2432    [ 'The package can be removed using: ?- ~q.'-[pack_remove(Pack)]
 2433    ].
 2434message(unsatisfied(Packs)) -->
 2435    [ 'The following dependencies are not satisfied:', nl ],
 2436    unsatisfied(Packs).
 2437message(depends(Pack, Deps)) -->
 2438    [ 'The following packages depend on `~w\':'-[Pack], nl ],
 2439    pack_list(Deps).
 2440message(remove(PackDir)) -->
 2441    [ 'Removing ~q and contents'-[PackDir] ].
 2442message(remove_existing_pack(PackDir)) -->
 2443    [ 'Remove old installation in ~q'-[PackDir] ].
 2444message(install_from(Pack, Version, git(URL))) -->
 2445    [ 'Install ~w@~w from GIT at ~w'-[Pack, Version, URL] ].
 2446message(install_from(Pack, Version, URL)) -->
 2447    [ 'Install ~w@~w from ~w'-[Pack, Version, URL] ].
 2448message(select_install_from(Pack, Version)) -->
 2449    [ 'Select download location for ~w@~w'-[Pack, Version] ].
 2450message(install_downloaded(File)) -->
 2451    { file_base_name(File, Base),
 2452      size_file(File, Size) },
 2453    [ 'Install "~w" (~D bytes)'-[Base, Size] ].
 2454message(git_post_install(PackDir, Pack)) -->
 2455    (   { is_foreign_pack(PackDir) }
 2456    ->  [ 'Run post installation scripts for pack "~w"'-[Pack] ]
 2457    ;   [ 'Activate pack "~w"'-[Pack] ]
 2458    ).
 2459message(no_meta_data(BaseDir)) -->
 2460    [ 'Cannot find pack.pl inside directory ~q.  Not a package?'-[BaseDir] ].
 2461message(inquiry(Server)) -->
 2462    [ 'Verify package status (anonymously)', nl,
 2463      '\tat "~w"'-[Server]
 2464    ].
 2465message(search_no_matches(Name)) -->
 2466    [ 'Search for "~w", returned no matching packages'-[Name] ].
 2467message(rebuild(Pack)) -->
 2468    [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
 2469message(upgrade(Pack, From, To)) -->
 2470    [ 'Upgrade "~w" from '-[Pack] ],
 2471    msg_version(From), [' to '-[]], msg_version(To).
 2472message(up_to_date(Pack)) -->
 2473    [ 'Package "~w" is up-to-date'-[Pack] ].
 2474message(query_versions(URL)) -->
 2475    [ 'Querying "~w" to find new versions ...'-[URL] ].
 2476message(no_matching_urls(URL)) -->
 2477    [ 'Could not find any matching URL: ~q'-[URL] ].
 2478message(found_versions([Latest-_URL|More])) -->
 2479    { length(More, Len),
 2480      atom_version(VLatest, Latest)
 2481    },
 2482    [ '    Latest version: ~w (~D older)'-[VLatest, Len] ].
 2483message(process_output(Codes)) -->
 2484    { split_lines(Codes, Lines) },
 2485    process_lines(Lines).
 2486message(contacting_server(Server)) -->
 2487    [ 'Contacting server at ~w ...'-[Server], flush ].
 2488message(server_reply(true(_))) -->
 2489    [ at_same_line, ' ok'-[] ].
 2490message(server_reply(false)) -->
 2491    [ at_same_line, ' done'-[] ].
 2492message(server_reply(exception(E))) -->
 2493    [ 'Server reported the following error:'-[], nl ],
 2494    '$messages':translate_message(E).
 2495message(cannot_create_dir(Alias)) -->
 2496    { setof(PackDir,
 2497            absolute_file_name(Alias, PackDir, [solutions(all)]),
 2498            PackDirs)
 2499    },
 2500    [ 'Cannot find a place to create a package directory.'-[],
 2501      'Considered:'-[]
 2502    ],
 2503    candidate_dirs(PackDirs).
 2504message(no_match(Name)) -->
 2505    [ 'No registered pack matches "~w"'-[Name] ].
 2506message(conflict(version, [PackV, FileV])) -->
 2507    ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
 2508    [', file claims version '-[]], msg_version(FileV).
 2509message(conflict(name, [PackInfo, FileInfo])) -->
 2510    ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
 2511    [', file claims ~w: ~p'-[FileInfo]].
 2512message(no_prolog_response(ContentType, String)) -->
 2513    [ 'Expected Prolog response.  Got content of type ~p'-[ContentType], nl,
 2514      '~s'-[String]
 2515    ].
 2516message(pack(no_upgrade_info(Pack))) -->
 2517    [ '~w: pack meta-data does not provide an upgradable URL'-[Pack] ].
 2518
 2519candidate_dirs([]) --> [].
 2520candidate_dirs([H|T]) --> [ nl, '    ~w'-[H] ], candidate_dirs(T).
 2521
 2522message(no_mingw) -->
 2523    [ 'Cannot find MinGW and/or MSYS.'-[] ].
 2524
 2525                                                % Questions
 2526message(resolve_remove) -->
 2527    [ nl, 'Please select an action:', nl, nl ].
 2528message(create_pack_dir) -->
 2529    [ nl, 'Create directory for packages', nl ].
 2530message(menu(item(I, Label))) -->
 2531    [ '~t(~d)~6|   '-[I] ],
 2532    label(Label).
 2533message(menu(default_item(I, Label))) -->
 2534    [ '~t(~d)~6| * '-[I] ],
 2535    label(Label).
 2536message(menu(select)) -->
 2537    [ nl, 'Your choice? ', flush ].
 2538message(confirm(Question, Default)) -->
 2539    message(Question),
 2540    confirm_default(Default),
 2541    [ flush ].
 2542message(menu(reply(Min,Max))) -->
 2543    (  { Max =:= Min+1 }
 2544    -> [ 'Please enter ~w or ~w'-[Min,Max] ]
 2545    ;  [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
 2546    ).
 2547
 2548% Alternate hashes for found for the same file
 2549
 2550message(alt_hashes(URL, _Alts)) -->
 2551    { git_url(URL, _)
 2552    },
 2553    !,
 2554    [ 'GIT repository was updated without updating version' ].
 2555message(alt_hashes(URL, Alts)) -->
 2556    { file_base_name(URL, File)
 2557    },
 2558    [ 'Found multiple versions of "~w".'-[File], nl,
 2559      'This could indicate a compromised or corrupted file', nl
 2560    ],
 2561    alt_hashes(Alts).
 2562message(continue_with_alt_hashes(Count, URL)) -->
 2563    [ 'Continue installation from "~w" (downloaded ~D times)'-[URL, Count] ].
 2564message(continue_with_modified_hash(_URL)) -->
 2565    [ 'Pack may be compromised.  Continue anyway'
 2566    ].
 2567message(modified_hash(_SHA1-URL, _SHA2-[URL])) -->
 2568    [ 'Content of ~q has changed.'-[URL]
 2569    ].
 2570
 2571alt_hashes([]) --> [].
 2572alt_hashes([H|T]) --> alt_hash(H), ( {T == []} -> [] ; [nl], alt_hashes(T) ).
 2573
 2574alt_hash(alt_hash(Count, URLs, Hash)) -->
 2575    [ '~t~d~8| ~w'-[Count, Hash] ],
 2576    alt_urls(URLs).
 2577
 2578alt_urls([]) --> [].
 2579alt_urls([H|T]) -->
 2580    [ nl, '    ~w'-[H] ],
 2581    alt_urls(T).
 2582
 2583% Installation dependencies gathered from inquiry server.
 2584
 2585message(install_dependencies(Resolution)) -->
 2586    [ 'Package depends on the following:' ],
 2587    msg_res_tokens(Resolution, 1).
 2588
 2589msg_res_tokens([], _) --> [].
 2590msg_res_tokens([H|T], L) --> msg_res_token(H, L), msg_res_tokens(T, L).
 2591
 2592msg_res_token(Token-unresolved, L) -->
 2593    res_indent(L),
 2594    [ '"~w" cannot be satisfied'-[Token] ].
 2595msg_res_token(Token-resolve(Pack, Version, [URL|_], SubResolves), L) -->
 2596    !,
 2597    res_indent(L),
 2598    [ '"~w", provided by ~w@~w from ~w'-[Token, Pack, Version, URL] ],
 2599    { L2 is L+1 },
 2600    msg_res_tokens(SubResolves, L2).
 2601msg_res_token(Token-resolved(Pack), L) -->
 2602    !,
 2603    res_indent(L),
 2604    [ '"~w", provided by installed pack ~w'-[Token,Pack] ].
 2605
 2606res_indent(L) -->
 2607    { I is L*2 },
 2608    [ nl, '~*c'-[I,0'\s] ].
 2609
 2610message(resolve_deps) -->
 2611    [ nl, 'What do you wish to do' ].
 2612label(install_deps) -->
 2613    [ 'Install proposed dependencies' ].
 2614label(install_no_deps) -->
 2615    [ 'Only install requested package' ].
 2616
 2617
 2618message(git_fetch(Dir)) -->
 2619    [ 'Running "git fetch" in ~q'-[Dir] ].
 2620
 2621% inquiry is blank
 2622
 2623message(inquiry_ok(Reply, File)) -->
 2624    { memberchk(downloads(Count), Reply),
 2625      memberchk(rating(VoteCount, Rating), Reply),
 2626      !,
 2627      length(Stars, Rating),
 2628      maplist(=(0'*), Stars)
 2629    },
 2630    [ '"~w" was downloaded ~D times.  Package rated ~s (~D votes)'-
 2631      [ File, Count, Stars, VoteCount ]
 2632    ].
 2633message(inquiry_ok(Reply, File)) -->
 2634    { memberchk(downloads(Count), Reply)
 2635    },
 2636    [ '"~w" was downloaded ~D times'-[ File, Count ] ].
 2637
 2638                                                % support predicates
 2639unsatisfied([]) --> [].
 2640unsatisfied([Needed-[By]|T]) -->
 2641    [ '  - "~w" is needed by package "~w"'-[Needed, By], nl ],
 2642    unsatisfied(T).
 2643unsatisfied([Needed-By|T]) -->
 2644    [ '  - "~w" is needed by the following packages:'-[Needed], nl ],
 2645    pack_list(By),
 2646    unsatisfied(T).
 2647
 2648pack_list([]) --> [].
 2649pack_list([H|T]) -->
 2650    [ '    - Package "~w"'-[H], nl ],
 2651    pack_list(T).
 2652
 2653process_lines([]) --> [].
 2654process_lines([H|T]) -->
 2655    [ '~s'-[H] ],
 2656    (   {T==[]}
 2657    ->  []
 2658    ;   [nl], process_lines(T)
 2659    ).
 2660
 2661split_lines([], []) :- !.
 2662split_lines(All, [Line1|More]) :-
 2663    append(Line1, [0'\n|Rest], All),
 2664    !,
 2665    split_lines(Rest, More).
 2666split_lines(Line, [Line]).
 2667
 2668label(remove_only(Pack)) -->
 2669    [ 'Only remove package ~w (break dependencies)'-[Pack] ].
 2670label(remove_deps(Pack, Deps)) -->
 2671    { length(Deps, Count) },
 2672    [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
 2673label(create_dir(Dir)) -->
 2674    [ '~w'-[Dir] ].
 2675label(install_from(git(URL))) -->
 2676    !,
 2677    [ 'GIT repository at ~w'-[URL] ].
 2678label(install_from(URL)) -->
 2679    [ '~w'-[URL] ].
 2680label(cancel) -->
 2681    [ 'Cancel' ].
 2682
 2683confirm_default(yes) -->
 2684    [ ' Y/n? ' ].
 2685confirm_default(no) -->
 2686    [ ' y/N? ' ].
 2687confirm_default(none) -->
 2688    [ ' y/n? ' ].
 2689
 2690msg_version(Version) -->
 2691    { atom(Version) },
 2692    !,
 2693    [ '~w'-[Version] ].
 2694msg_version(VersionData) -->
 2695    !,
 2696    { atom_version(Atom, VersionData) },
 2697    [ '~w'-[Atom] ]