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

A package manager for Prolog

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

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'. */
   90:- multifile
   91    environment/2.                          % Name, Value
   92
   93:- dynamic
   94    pack_requires/2,                        % Pack, Requirement
   95    pack_provides_db/2.                     % Pack, Provided
   96
   97
   98                 /*******************************
   99                 *          CONSTANTS           *
  100                 *******************************/
  101
  102:- setting(server, atom, 'https://www.swi-prolog.org/pack/',
  103           'Server to exchange pack information').  104
  105
  106                 /*******************************
  107                 *         PACKAGE INFO         *
  108                 *******************************/
 current_pack(?Pack) is nondet
 current_pack(?Pack, ?Dir) is nondet
True if Pack is a currently installed pack.
  115current_pack(Pack) :-
  116    current_pack(Pack, _).
  117
  118current_pack(Pack, Dir) :-
  119    '$pack':pack(Pack, Dir).
 pack_list_installed is det
List currently installed packages. Unlike pack_list/1, only locally installed packages are displayed and no connection is made to the internet.
See also
- Use pack_list/1 to find packages.
  129pack_list_installed :-
  130    findall(Pack, current_pack(Pack), Packages0),
  131    Packages0 \== [],
  132    !,
  133    sort(Packages0, Packages),
  134    length(Packages, Count),
  135    format('Installed packages (~D):~n~n', [Count]),
  136    maplist(pack_info(list), Packages),
  137    validate_dependencies.
  138pack_list_installed :-
  139    print_message(informational, pack(no_packages_installed)).
 pack_info(+Pack)
Print more detailed information about Pack.
  145pack_info(Name) :-
  146    pack_info(info, Name).
  147
  148pack_info(Level, Name) :-
  149    must_be(atom, Name),
  150    findall(Info, pack_info(Name, Level, Info), Infos0),
  151    (   Infos0 == []
  152    ->  print_message(warning, pack(no_pack_installed(Name))),
  153        fail
  154    ;   true
  155    ),
  156    update_dependency_db(Name, Infos0),
  157    findall(Def,  pack_default(Level, Infos, Def), Defs),
  158    append(Infos0, Defs, Infos1),
  159    sort(Infos1, Infos),
  160    show_info(Name, Infos, [info(Level)]).
  161
  162
  163show_info(_Name, _Properties, Options) :-
  164    option(silent(true), Options),
  165    !.
  166show_info(Name, Properties, Options) :-
  167    option(info(list), Options),
  168    !,
  169    memberchk(title(Title), Properties),
  170    memberchk(version(Version), Properties),
  171    format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
  172show_info(Name, Properties, _) :-
  173    !,
  174    print_property_value('Package'-'~w', [Name]),
  175    findall(Term, pack_level_info(info, Term, _, _), Terms),
  176    maplist(print_property(Properties), Terms).
  177
  178print_property(_, nl) :-
  179    !,
  180    format('~n').
  181print_property(Properties, Term) :-
  182    findall(Term, member(Term, Properties), Terms),
  183    Terms \== [],
  184    !,
  185    pack_level_info(_, Term, LabelFmt, _Def),
  186    (   LabelFmt = Label-FmtElem
  187    ->  true
  188    ;   Label = LabelFmt,
  189        FmtElem = '~w'
  190    ),
  191    multi_valued(Terms, FmtElem, FmtList, Values),
  192    atomic_list_concat(FmtList, ', ', Fmt),
  193    print_property_value(Label-Fmt, Values).
  194print_property(_, _).
  195
  196multi_valued([H], LabelFmt, [LabelFmt], Values) :-
  197    !,
  198    H =.. [_|Values].
  199multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
  200    H =.. [_|VH],
  201    append(VH, MoreValues, Values),
  202    multi_valued(T, LabelFmt, LT, MoreValues).
  203
  204
  205pvalue_column(24).
  206print_property_value(Prop-Fmt, Values) :-
  207    !,
  208    pvalue_column(C),
  209    atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
  210    format(Format, [Prop,C|Values]).
  211
  212pack_info(Name, Level, Info) :-
  213    '$pack':pack(Name, BaseDir),
  214    (   Info = directory(BaseDir)
  215    ;   pack_info_term(BaseDir, Info)
  216    ),
  217    pack_level_info(Level, Info, _Format, _Default).
  218
  219:- public pack_level_info/4.                    % used by web-server
  220
  221pack_level_info(_,    title(_),         'Title',                   '<no title>').
  222pack_level_info(_,    version(_),       'Installed version',       '<unknown>').
  223pack_level_info(info, directory(_),     'Installed in directory',  -).
  224pack_level_info(info, author(_, _),     'Author'-'~w <~w>',        -).
  225pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>',    -).
  226pack_level_info(info, packager(_, _),   'Packager'-'~w <~w>',      -).
  227pack_level_info(info, home(_),          'Home page',               -).
  228pack_level_info(info, download(_),      'Download URL',            -).
  229pack_level_info(_,    provides(_),      'Provides',                -).
  230pack_level_info(_,    requires(_),      'Requires',                -).
  231pack_level_info(_,    conflicts(_),     'Conflicts with',          -).
  232pack_level_info(_,    replaces(_),      'Replaces packages',       -).
  233pack_level_info(info, library(_),	'Provided libraries',      -).
  234
  235pack_default(Level, Infos, Def) :-
  236    pack_level_info(Level, ITerm, _Format, Def),
  237    Def \== (-),
  238    \+ memberchk(ITerm, Infos).
 pack_info_term(+PackDir, ?Info) is nondet
True when Info is meta-data for the package PackName.
  244pack_info_term(BaseDir, Info) :-
  245    directory_file_path(BaseDir, 'pack.pl', InfoFile),
  246    catch(
  247        setup_call_cleanup(
  248            open(InfoFile, read, In),
  249            term_in_stream(In, Info),
  250            close(In)),
  251        error(existence_error(source_sink, InfoFile), _),
  252        ( print_message(error, pack(no_meta_data(BaseDir))),
  253          fail
  254        )).
  255pack_info_term(BaseDir, library(Lib)) :-
  256    atom_concat(BaseDir, '/prolog/', LibDir),
  257    atom_concat(LibDir, '*.pl', Pattern),
  258    expand_file_name(Pattern, Files),
  259    maplist(atom_concat(LibDir), Plain, Files),
  260    convlist(base_name, Plain, Libs),
  261    member(Lib, Libs).
  262
  263base_name(File, Base) :-
  264    file_name_extension(Base, pl, File).
  265
  266term_in_stream(In, Term) :-
  267    repeat,
  268        read_term(In, Term0, []),
  269        (   Term0 == end_of_file
  270        ->  !, fail
  271        ;   Term = Term0,
  272            valid_info_term(Term0)
  273        ).
  274
  275valid_info_term(Term) :-
  276    Term =.. [Name|Args],
  277    same_length(Args, Types),
  278    Decl =.. [Name|Types],
  279    (   pack_info_term(Decl)
  280    ->  maplist(valid_info_arg, Types, Args)
  281    ;   print_message(warning, pack(invalid_info(Term))),
  282        fail
  283    ).
  284
  285valid_info_arg(Type, Arg) :-
  286    must_be(Type, Arg).
 pack_info_term(?Term) is nondet
True when Term describes name and arguments of a valid package info term.
  293pack_info_term(name(atom)).                     % Synopsis
  294pack_info_term(title(atom)).
  295pack_info_term(keywords(list(atom))).
  296pack_info_term(description(list(atom))).
  297pack_info_term(version(version)).
  298pack_info_term(author(atom, email_or_url_or_empty)).     % Persons
  299pack_info_term(maintainer(atom, email_or_url)).
  300pack_info_term(packager(atom, email_or_url)).
  301pack_info_term(pack_version(nonneg)).           % Package convention version
  302pack_info_term(home(atom)).                     % Home page
  303pack_info_term(download(atom)).                 % Source
  304pack_info_term(provides(atom)).                 % Dependencies
  305pack_info_term(requires(dependency)).
  306pack_info_term(conflicts(dependency)).          % Conflicts with package
  307pack_info_term(replaces(atom)).                 % Replaces another package
  308pack_info_term(autoload(boolean)).              % Default installation options
  309
  310:- multifile
  311    error:has_type/2.  312
  313error:has_type(version, Version) :-
  314    atom(Version),
  315    version_data(Version, _Data).
  316error:has_type(email_or_url, Address) :-
  317    atom(Address),
  318    (   sub_atom(Address, _, _, _, @)
  319    ->  true
  320    ;   uri_is_global(Address)
  321    ).
  322error:has_type(email_or_url_or_empty, Address) :-
  323    (   Address == ''
  324    ->  true
  325    ;   error:has_type(email_or_url, Address)
  326    ).
  327error:has_type(dependency, Value) :-
  328    is_dependency(Value, _Token, _Version).
  329
  330version_data(Version, version(Data)) :-
  331    atomic_list_concat(Parts, '.', Version),
  332    maplist(atom_number, Parts, Data).
  333
  334is_dependency(Token, Token, *) :-
  335    atom(Token).
  336is_dependency(Term, Token, VersionCmp) :-
  337    Term =.. [Op,Token,Version],
  338    cmp(Op, _),
  339    version_data(Version, _),
  340    VersionCmp =.. [Op,Version].
  341
  342cmp(<,  @<).
  343cmp(=<, @=<).
  344cmp(==, ==).
  345cmp(>=, @>=).
  346cmp(>,  @>).
  347
  348
  349                 /*******************************
  350                 *            SEARCH            *
  351                 *******************************/
 pack_search(+Query) is det
 pack_list(+Query) is det
Query package server and installed packages and display results. Query is matches case-insensitively against the name and title of known and installed packages. For each matching package, a single line is displayed that provides:

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

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

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

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

  475pack_install(Spec) :-
  476    pack_default_options(Spec, Pack, [], Options),
  477    pack_install(Pack, [pack(Pack)|Options]).
 pack_default_options(+Spec, -Pack, +OptionsIn, -Options) is det
Establish the pack name (Pack) and install options from a specification and options (OptionsIn) provided by the user.
  484pack_default_options(_Spec, Pack, OptsIn, Options) :-
  485    option(already_installed(pack(Pack,_Version)), OptsIn),
  486    !,
  487    Options = OptsIn.
  488pack_default_options(_Spec, Pack, OptsIn, Options) :-
  489    option(url(URL), OptsIn),
  490    !,
  491    (   option(git(_), OptsIn)
  492    ->  Options = OptsIn
  493    ;   git_url(URL, Pack)
  494    ->  Options = [git(true)|OptsIn]
  495    ;   Options = OptsIn
  496    ),
  497    (   nonvar(Pack)
  498    ->  true
  499    ;   option(pack(Pack), Options)
  500    ->  true
  501    ;   pack_version_file(Pack, _Version, URL)
  502    ).
  503pack_default_options(Archive, Pack, _, Options) :-      % Install from archive
  504    must_be(atom, Archive),
  505    \+ uri_is_global(Archive),
  506    expand_file_name(Archive, [File]),
  507    exists_file(File),
  508    !,
  509    pack_version_file(Pack, Version, File),
  510    uri_file_name(FileURL, File),
  511    Options = [url(FileURL), version(Version)].
  512pack_default_options(URL, Pack, _, Options) :-
  513    git_url(URL, Pack),
  514    !,
  515    Options = [git(true), url(URL)].
  516pack_default_options(FileURL, Pack, _, Options) :-      % Install from directory
  517    uri_file_name(FileURL, Dir),
  518    exists_directory(Dir),
  519    pack_info_term(Dir, name(Pack)),
  520    !,
  521    (   pack_info_term(Dir, version(Version))
  522    ->  uri_file_name(DirURL, Dir),
  523        Options = [url(DirURL), version(Version)]
  524    ;   throw(error(existence_error(key, version, Dir),_))
  525    ).
  526pack_default_options('.', Pack, _, Options) :-          % Install from CWD
  527    pack_info_term('.', name(Pack)),
  528    !,
  529    working_directory(Dir, Dir),
  530    (   pack_info_term(Dir, version(Version))
  531    ->  uri_file_name(DirURL, Dir),
  532        Options = [url(DirURL), version(Version) | Options1],
  533        (   current_prolog_flag(windows, true)
  534        ->  Options1 = []
  535        ;   Options1 = [link(true), rebuild(make)]
  536        )
  537    ;   throw(error(existence_error(key, version, Dir),_))
  538    ).
  539pack_default_options(URL, Pack, _, Options) :-          % Install from URL
  540    pack_version_file(Pack, Version, URL),
  541    download_url(URL),
  542    !,
  543    available_download_versions(URL, [URLVersion-LatestURL|_]),
  544    Options = [url(LatestURL)|VersionOptions],
  545    version_options(Version, URLVersion, VersionOptions).
  546pack_default_options(Pack, Pack, OptsIn, Options) :-    % Install from name
  547    \+ uri_is_global(Pack),                             % ignore URLs
  548    query_pack_server(locate(Pack), Reply, OptsIn),
  549    (   Reply = true(Results)
  550    ->  pack_select_candidate(Pack, Results, OptsIn, Options)
  551    ;   print_message(warning, pack(no_match(Pack))),
  552        fail
  553    ).
  554
  555version_options(Version, Version, [version(Version)]) :- !.
  556version_options(Version, _, [version(Version)]) :-
  557    Version = version(List),
  558    maplist(integer, List),
  559    !.
  560version_options(_, _, []).
 pack_select_candidate(+Pack, +AvailableVersions, +OptionsIn, -Options)
Select from available packages.
  566pack_select_candidate(Pack, [Version-_|_], Options,
  567                      [already_installed(pack(Pack, Installed))|Options]) :-
  568    current_pack(Pack),
  569    pack_info(Pack, _, version(InstalledAtom)),
  570    atom_version(InstalledAtom, Installed),
  571    Installed @>= Version,
  572    !.
  573pack_select_candidate(Pack, Available, Options, OptsOut) :-
  574    option(url(URL), Options),
  575    memberchk(_Version-URLs, Available),
  576    memberchk(URL, URLs),
  577    !,
  578    (   git_url(URL, Pack)
  579    ->  Extra = [git(true)]
  580    ;   Extra = []
  581    ),
  582    OptsOut = [url(URL), inquiry(true) | Extra].
  583pack_select_candidate(Pack, [Version-[URL]|_], Options,
  584                      [url(URL), git(true), inquiry(true)]) :-
  585    git_url(URL, Pack),
  586    !,
  587    confirm(install_from(Pack, Version, git(URL)), yes, Options).
  588pack_select_candidate(Pack, [Version-[URL]|More], Options,
  589                      [url(URL), inquiry(true)]) :-
  590    (   More == []
  591    ->  !
  592    ;   true
  593    ),
  594    confirm(install_from(Pack, Version, URL), yes, Options),
  595    !.
  596pack_select_candidate(Pack, [Version-URLs|_], Options,
  597                      [url(URL), inquiry(true)|Rest]) :-
  598    maplist(url_menu_item, URLs, Tagged),
  599    append(Tagged, [cancel=cancel], Menu),
  600    Menu = [Default=_|_],
  601    menu(pack(select_install_from(Pack, Version)),
  602         Menu, Default, Choice, Options),
  603    (   Choice == cancel
  604    ->  fail
  605    ;   Choice = git(URL)
  606    ->  Rest = [git(true)]
  607    ;   Choice = URL,
  608        Rest = []
  609    ).
  610
  611url_menu_item(URL, git(URL)=install_from(git(URL))) :-
  612    git_url(URL, _),
  613    !.
  614url_menu_item(URL, URL=install_from(URL)).
 pack_install(+Name, +Options) is det
Install package Name. Processes the options below. Default options as would be used by pack_install/1 are used to complete the provided Options.
url(+URL)
Source for downloading the package
package_directory(+Dir)
Directory into which to install the package.
global(+Boolean)
If true, install in the XDG common application data path, making the pack accessible to everyone. If false, install in the XDG user application data path, making the pack accessible for the current user only. If the option is absent, use the first existing and writable directory. If that doesn't exist find locations where it can be created and prompt the user to do so.
interactive(+Boolean)
Use default answer without asking the user if there is a default action.
silent(+Boolean)
If true (default false), suppress informational progress messages.
upgrade(+Boolean)
If true (default false), upgrade package if it is already installed.
rebuild(Condition)
Rebuild the foreign components. Condition is one of if_absent (default, do nothing if the directory with foreign resources exists), make (run make) or true (run `make distclean` followed by the default configure and build steps).
test(Boolean)
If true (default), run the pack tests.
git(+Boolean)
If true (default false unless URL ends with =.git=), assume the URL is a GIT repository.
link(+Boolean)
Can be used if the installation source is a local directory and the file system supports symbolic links. In this case the system adds the current directory to the pack registration using a symbolic link and performs the local installation steps.

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

  665pack_install(Spec, Options) :-
  666    pack_default_options(Spec, Pack, Options, DefOptions),
  667    (   option(already_installed(Installed), DefOptions)
  668    ->  print_message(informational, pack(already_installed(Installed)))
  669    ;   merge_options(Options, DefOptions, PackOptions),
  670        update_dependency_db,
  671        pack_install_dir(PackDir, PackOptions),
  672        pack_install(Pack, PackDir, PackOptions)
  673    ).
  674
  675pack_install_dir(PackDir, Options) :-
  676    option(package_directory(PackDir), Options),
  677    !.
  678pack_install_dir(PackDir, Options) :-
  679    base_alias(Alias, Options),
  680    absolute_file_name(Alias, PackDir,
  681                       [ file_type(directory),
  682                         access(write),
  683                         file_errors(fail)
  684                       ]),
  685    !.
  686pack_install_dir(PackDir, Options) :-
  687    pack_create_install_dir(PackDir, Options).
  688
  689base_alias(Alias, Options) :-
  690    option(global(true), Options),
  691    !,
  692    Alias = common_app_data(pack).
  693base_alias(Alias, Options) :-
  694    option(global(false), Options),
  695    !,
  696    Alias = user_app_data(pack).
  697base_alias(Alias, _Options) :-
  698    Alias = pack('.').
  699
  700pack_create_install_dir(PackDir, Options) :-
  701    base_alias(Alias, Options),
  702    findall(Candidate = create_dir(Candidate),
  703            ( absolute_file_name(Alias, Candidate, [solutions(all)]),
  704              \+ exists_file(Candidate),
  705              \+ exists_directory(Candidate),
  706              file_directory_name(Candidate, Super),
  707              (   exists_directory(Super)
  708              ->  access_file(Super, write)
  709              ;   true
  710              )
  711            ),
  712            Candidates0),
  713    list_to_set(Candidates0, Candidates),   % keep order
  714    pack_create_install_dir(Candidates, PackDir, Options).
  715
  716pack_create_install_dir(Candidates, PackDir, Options) :-
  717    Candidates = [Default=_|_],
  718    !,
  719    append(Candidates, [cancel=cancel], Menu),
  720    menu(pack(create_pack_dir), Menu, Default, Selected, Options),
  721    Selected \== cancel,
  722    (   catch(make_directory_path(Selected), E,
  723              (print_message(warning, E), fail))
  724    ->  PackDir = Selected
  725    ;   delete(Candidates, PackDir=create_dir(PackDir), Remaining),
  726        pack_create_install_dir(Remaining, PackDir, Options)
  727    ).
  728pack_create_install_dir(_, _, _) :-
  729    print_message(error, pack(cannot_create_dir(pack(.)))),
  730    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.
  745pack_install(Name, _, Options) :-
  746    current_pack(Name, Dir),
  747    option(upgrade(false), Options, false),
  748    \+ pack_is_in_local_dir(Name, Dir, Options),
  749    print_message(error, pack(already_installed(Name))),
  750    pack_info(Name),
  751    print_message(information, pack(remove_with(Name))),
  752    !,
  753    fail.
  754pack_install(Name, PackDir, Options) :-
  755    option(url(URL), Options),
  756    uri_file_name(URL, Source),
  757    !,
  758    pack_install_from_local(Source, PackDir, Name, Options).
  759pack_install(Name, PackDir, Options) :-
  760    option(url(URL), Options),
  761    uri_components(URL, Components),
  762    uri_data(scheme, Components, Scheme),
  763    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).
  772pack_install_from_local(Source, PackTopDir, Name, Options) :-
  773    exists_directory(Source),
  774    !,
  775    directory_file_path(PackTopDir, Name, PackDir),
  776    (   option(link(true), Options)
  777    ->  (   same_file(Source, PackDir)
  778        ->  true
  779        ;   atom_concat(PackTopDir, '/', PackTopDirS),
  780            relative_file_name(Source, PackTopDirS, RelPath),
  781            link_file(RelPath, PackDir, symbolic),
  782            assertion(same_file(Source, PackDir))
  783        )
  784    ;   prepare_pack_dir(PackDir, Options),
  785        copy_directory(Source, PackDir)
  786    ),
  787    pack_post_install(Name, PackDir, Options).
  788pack_install_from_local(Source, PackTopDir, Name, Options) :-
  789    exists_file(Source),
  790    directory_file_path(PackTopDir, Name, PackDir),
  791    prepare_pack_dir(PackDir, Options),
  792    pack_unpack(Source, PackDir, Name, Options),
  793    pack_post_install(Name, PackDir, Options).
  794
  795pack_is_in_local_dir(_Pack, PackDir, Options) :-
  796    option(url(DirURL), Options),
  797    uri_file_name(DirURL, Dir),
  798    same_file(PackDir, Dir).
 pack_unpack(+SourceFile, +PackDir, +Pack, +Options)
Unpack an archive to the given package dir.
  805:- if(exists_source(library(archive))).  806pack_unpack(Source, PackDir, Pack, Options) :-
  807    ensure_loaded_archive,
  808    pack_archive_info(Source, Pack, _Info, StripOptions),
  809    prepare_pack_dir(PackDir, Options),
  810    archive_extract(Source, PackDir,
  811                    [ exclude(['._*'])          % MacOS resource forks
  812                    | StripOptions
  813                    ]).
  814:- else.  815pack_unpack(_,_,_,_) :-
  816    existence_error(library, archive).
  817:- endif.  818
  819                 /*******************************
  820                 *             INFO             *
  821                 *******************************/
 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.
  835:- if(exists_source(library(archive))).  836ensure_loaded_archive :-
  837    current_predicate(archive_open/3),
  838    !.
  839ensure_loaded_archive :-
  840    use_module(library(archive)).
  841
  842pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
  843    ensure_loaded_archive,
  844    size_file(Archive, Bytes),
  845    setup_call_cleanup(
  846        archive_open(Archive, Handle, []),
  847        (   repeat,
  848            (   archive_next_header(Handle, InfoFile)
  849            ->  true
  850            ;   !, fail
  851            )
  852        ),
  853        archive_close(Handle)),
  854    file_base_name(InfoFile, 'pack.pl'),
  855    atom_concat(Prefix, 'pack.pl', InfoFile),
  856    strip_option(Prefix, Pack, Strip),
  857    setup_call_cleanup(
  858        archive_open_entry(Handle, Stream),
  859        read_stream_to_terms(Stream, Info),
  860        close(Stream)),
  861    !,
  862    must_be(ground, Info),
  863    maplist(valid_info_term, Info).
  864:- else.  865pack_archive_info(_, _, _, _) :-
  866    existence_error(library, archive).
  867:- endif.  868pack_archive_info(_, _, _, _) :-
  869    existence_error(pack_file, 'pack.pl').
  870
  871strip_option('', _, []) :- !.
  872strip_option('./', _, []) :- !.
  873strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
  874    atom_concat(PrefixDir, /, Prefix),
  875    file_base_name(PrefixDir, Base),
  876    (   Base == Pack
  877    ->  true
  878    ;   pack_version_file(Pack, _, Base)
  879    ->  true
  880    ;   \+ sub_atom(PrefixDir, _, _, _, /)
  881    ).
  882
  883read_stream_to_terms(Stream, Terms) :-
  884    read(Stream, Term0),
  885    read_stream_to_terms(Term0, Stream, Terms).
  886
  887read_stream_to_terms(end_of_file, _, []) :- !.
  888read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
  889    read(Stream, Term1),
  890    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.
  898pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
  899    exists_directory(GitDir),
  900    !,
  901    git_ls_tree(Entries, [directory(GitDir)]),
  902    git_hash(Hash, [directory(GitDir)]),
  903    maplist(arg(4), Entries, Sizes),
  904    sum_list(Sizes, Bytes),
  905    directory_file_path(GitDir, 'pack.pl', InfoFile),
  906    read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
  907    must_be(ground, Info),
  908    maplist(valid_info_term, Info).
 download_file_sanity_check(+Archive, +Pack, +Info) is semidet
Perform basic sanity checks on DownloadFile
  914download_file_sanity_check(Archive, Pack, Info) :-
  915    info_field(name(Name), Info),
  916    info_field(version(VersionAtom), Info),
  917    atom_version(VersionAtom, Version),
  918    pack_version_file(PackA, VersionA, Archive),
  919    must_match([Pack, PackA, Name], name),
  920    must_match([Version, VersionA], version).
  921
  922info_field(Field, Info) :-
  923    memberchk(Field, Info),
  924    ground(Field),
  925    !.
  926info_field(Field, _Info) :-
  927    functor(Field, FieldName, _),
  928    print_message(error, pack(missing(FieldName))),
  929    fail.
  930
  931must_match(Values, _Field) :-
  932    sort(Values, [_]),
  933    !.
  934must_match(Values, Field) :-
  935    print_message(error, pack(conflict(Field, Values))),
  936    fail.
  937
  938
  939                 /*******************************
  940                 *         INSTALLATION         *
  941                 *******************************/
 prepare_pack_dir(+Dir, +Options)
Prepare for installing the package into Dir. This
  953prepare_pack_dir(Dir, Options) :-
  954    exists_directory(Dir),
  955    !,
  956    (   empty_directory(Dir)
  957    ->  true
  958    ;   (   option(upgrade(true), Options)
  959        ;   confirm(remove_existing_pack(Dir), yes, Options)
  960        )
  961    ->  delete_directory_and_contents(Dir),
  962        make_directory(Dir)
  963    ).
  964prepare_pack_dir(Dir, _) :-
  965    make_directory(Dir).
 empty_directory(+Directory) is semidet
True if Directory is empty (holds no files or sub-directories).
  971empty_directory(Dir) :-
  972    \+ ( directory_files(Dir, Entries),
  973         member(Entry, Entries),
  974         \+ special(Entry)
  975       ).
  976
  977special(.).
  978special(..).
 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.
  988pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
  989    option(git(true), Options),
  990    !,
  991    directory_file_path(PackTopDir, Pack, PackDir),
  992    prepare_pack_dir(PackDir, Options),
  993    run_process(path(git), [clone, URL, PackDir], []),
  994    pack_git_info(PackDir, Hash, Info),
  995    pack_inquiry(URL, git(Hash), Info, Options),
  996    show_info(Pack, Info, Options),
  997    confirm(git_post_install(PackDir, Pack), yes, Options),
  998    pack_post_install(Pack, PackDir, Options).
  999pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
 1000    download_scheme(Scheme),
 1001    directory_file_path(PackTopDir, Pack, PackDir),
 1002    prepare_pack_dir(PackDir, Options),
 1003    pack_download_dir(PackTopDir, DownLoadDir),
 1004    download_file(URL, Pack, DownloadBase, Options),
 1005    directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
 1006    setup_call_cleanup(
 1007        http_open(URL, In,
 1008                  [ cert_verify_hook(ssl_verify)
 1009                  ]),
 1010        setup_call_cleanup(
 1011            open(DownloadFile, write, Out, [type(binary)]),
 1012            copy_stream_data(In, Out),
 1013            close(Out)),
 1014        close(In)),
 1015    pack_archive_info(DownloadFile, Pack, Info, _),
 1016    download_file_sanity_check(DownloadFile, Pack, Info),
 1017    pack_inquiry(URL, DownloadFile, Info, Options),
 1018    show_info(Pack, Info, Options),
 1019    confirm(install_downloaded(DownloadFile), yes, Options),
 1020    pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).
 download_file(+URL, +Pack, -File, +Options) is det
 1024download_file(URL, Pack, File, Options) :-
 1025    option(version(Version), Options),
 1026    !,
 1027    atom_version(VersionA, Version),
 1028    file_name_extension(_, Ext, URL),
 1029    format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
 1030download_file(URL, Pack, File, _) :-
 1031    file_base_name(URL,Basename),
 1032    no_int_file_name_extension(Tag,Ext,Basename),
 1033    tag_version(Tag,Version),
 1034    !,
 1035    atom_version(VersionA,Version),
 1036    format(atom(File0), '~w-~w', [Pack, VersionA]),
 1037    file_name_extension(File0, Ext, File).
 1038download_file(URL, _, File, _) :-
 1039    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.
 1047pack_url_file(URL, FileID) :-
 1048    github_release_url(URL, Pack, Version),
 1049    !,
 1050    download_file(URL, Pack, FileID, [version(Version)]).
 1051pack_url_file(URL, FileID) :-
 1052    file_base_name(URL, FileID).
 1053
 1054
 1055:- 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.
 1063ssl_verify(_SSL,
 1064           _ProblemCertificate, _AllCertificates, _FirstCertificate,
 1065           _Error).
 1066
 1067pack_download_dir(PackTopDir, DownLoadDir) :-
 1068    directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
 1069    (   exists_directory(DownLoadDir)
 1070    ->  true
 1071    ;   make_directory(DownLoadDir)
 1072    ),
 1073    (   access_file(DownLoadDir, write)
 1074    ->  true
 1075    ;   permission_error(write, directory, DownLoadDir)
 1076    ).
 download_url(+URL) is det
True if URL looks like a URL we can download from.
 1082download_url(URL) :-
 1083    atom(URL),
 1084    uri_components(URL, Components),
 1085    uri_data(scheme, Components, Scheme),
 1086    download_scheme(Scheme).
 1087
 1088download_scheme(http).
 1089download_scheme(https) :-
 1090    catch(use_module(library(http/http_ssl_plugin)),
 1091          E, (print_message(warning, E), fail)).
 pack_post_install(+Pack, +PackDir, +Options) is det
Process post installation work. Steps:
 1101pack_post_install(Pack, PackDir, Options) :-
 1102    post_install_foreign(Pack, PackDir, Options),
 1103    post_install_autoload(PackDir, Options),
 1104    '$pack_attach'(PackDir).
 pack_rebuild(+Pack) is det
Rebuilt possible foreign components of Pack.
 1110pack_rebuild(Pack) :-
 1111    current_pack(Pack, PackDir),
 1112    !,
 1113    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 1114pack_rebuild(Pack) :-
 1115    unattached_pacth(Pack, PackDir),
 1116    !,
 1117    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 1118pack_rebuild(Pack) :-
 1119    existence_error(pack, Pack).
 1120
 1121unattached_pacth(Pack, BaseDir) :-
 1122    directory_file_path(Pack, 'pack.pl', PackFile),
 1123    absolute_file_name(pack(PackFile), PackPath,
 1124                       [ access(read),
 1125                         file_errors(fail)
 1126                       ]),
 1127    file_directory_name(PackPath, BaseDir).
 pack_rebuild is det
Rebuild foreign components of all packages.
 1133pack_rebuild :-
 1134    forall(current_pack(Pack),
 1135           ( print_message(informational, pack(rebuild(Pack))),
 1136             pack_rebuild(Pack)
 1137           )).
 post_install_foreign(+Pack, +PackDir, +Options) is det
Install foreign parts of the package.
 1144post_install_foreign(Pack, PackDir, Options) :-
 1145    is_foreign_pack(PackDir, _),
 1146    !,
 1147    (   pack_info_term(PackDir, pack_version(Version))
 1148    ->  true
 1149    ;   Version = 1
 1150    ),
 1151    option(rebuild(Rebuild), Options, if_absent),
 1152    (   Rebuild == if_absent,
 1153        foreign_present(PackDir)
 1154    ->  print_message(informational, pack(kept_foreign(Pack)))
 1155    ;   BuildSteps0 = [[dependencies], [configure], build, [test], install],
 1156        (   Rebuild == true
 1157        ->  BuildSteps1 = [distclean|BuildSteps0]
 1158        ;   BuildSteps1 = BuildSteps0
 1159        ),
 1160        (   option(test(false), Options)
 1161        ->  delete(BuildSteps1, [test], BuildSteps)
 1162        ;   BuildSteps = BuildSteps1
 1163        ),
 1164        build_steps(BuildSteps, PackDir, [pack_version(Version)|Options])
 1165    ).
 1166post_install_foreign(_, _, _).
 foreign_present(+PackDir) is semidet
True if we find one or more modules in the pack lib directory for the current architecture. Does not check that these can be loaded, nor whether all required modules are present.
 1175foreign_present(PackDir) :-
 1176    current_prolog_flag(arch, Arch),
 1177    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
 1178    exists_directory(ForeignBaseDir),
 1179    !,
 1180    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
 1181    exists_directory(ForeignDir),
 1182    current_prolog_flag(shared_object_extension, Ext),
 1183    atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
 1184    expand_file_name(Pattern, Files),
 1185    Files \== [].
 is_foreign_pack(+PackDir, -Type) is nondet
True when PackDir contains files that indicate the need for a specific class of build tools indicated by Type.
 1192is_foreign_pack(PackDir, Type) :-
 1193    foreign_file(File, Type),
 1194    directory_file_path(PackDir, File, Path),
 1195    exists_file(Path).
 1196
 1197foreign_file('CMakeLists.txt', cmake).
 1198foreign_file('configure',      configure).
 1199foreign_file('configure.in',   autoconf).
 1200foreign_file('configure.ac',   autoconf).
 1201foreign_file('Makefile.am',    automake).
 1202foreign_file('Makefile',       make).
 1203foreign_file('makefile',       make).
 1204foreign_file('conanfile.txt',  conan).
 1205foreign_file('conanfile.py',   conan).
 1206
 1207
 1208                 /*******************************
 1209                 *           AUTOLOAD           *
 1210                 *******************************/
 post_install_autoload(+PackDir, +Options)
Create an autoload index if the package demands such.
 1216post_install_autoload(PackDir, Options) :-
 1217    option(autoload(true), Options, true),
 1218    pack_info_term(PackDir, autoload(true)),
 1219    !,
 1220    directory_file_path(PackDir, prolog, PrologLibDir),
 1221    make_library_index(PrologLibDir).
 1222post_install_autoload(_, _).
 1223
 1224
 1225                 /*******************************
 1226                 *            UPGRADE           *
 1227                 *******************************/
 pack_upgrade(+Pack) is semidet
Try to upgrade the package Pack.
To be done
- Update dependencies when updating a pack from git?
 1235pack_upgrade(Pack) :-
 1236    pack_info(Pack, _, directory(Dir)),
 1237    directory_file_path(Dir, '.git', GitDir),
 1238    exists_directory(GitDir),
 1239    !,
 1240    print_message(informational, pack(git_fetch(Dir))),
 1241    git([fetch], [ directory(Dir) ]),
 1242    git_describe(V0, [ directory(Dir) ]),
 1243    git_describe(V1, [ directory(Dir), commit('origin/master') ]),
 1244    (   V0 == V1
 1245    ->  print_message(informational, pack(up_to_date(Pack)))
 1246    ;   confirm(upgrade(Pack, V0, V1), yes, []),
 1247        git([merge, 'origin/master'], [ directory(Dir) ]),
 1248        pack_rebuild(Pack)
 1249    ).
 1250pack_upgrade(Pack) :-
 1251    once(pack_info(Pack, _, version(VersionAtom))),
 1252    atom_version(VersionAtom, Version),
 1253    pack_info(Pack, _, download(URL)),
 1254    (   wildcard_pattern(URL)
 1255    ->  true
 1256    ;   github_url(URL, _User, _Repo)
 1257    ),
 1258    !,
 1259    available_download_versions(URL, [Latest-LatestURL|_Versions]),
 1260    (   Latest @> Version
 1261    ->  confirm(upgrade(Pack, Version, Latest), yes, []),
 1262        pack_install(Pack,
 1263                     [ url(LatestURL),
 1264                       upgrade(true),
 1265                       pack(Pack)
 1266                     ])
 1267    ;   print_message(informational, pack(up_to_date(Pack)))
 1268    ).
 1269pack_upgrade(Pack) :-
 1270    print_message(warning, pack(no_upgrade_info(Pack))).
 1271
 1272
 1273                 /*******************************
 1274                 *            REMOVE            *
 1275                 *******************************/
 pack_remove(+Name) is det
Remove the indicated package.
 1281pack_remove(Pack) :-
 1282    update_dependency_db,
 1283    (   setof(Dep, pack_depends_on(Dep, Pack), Deps)
 1284    ->  confirm_remove(Pack, Deps, Delete),
 1285        forall(member(P, Delete), pack_remove_forced(P))
 1286    ;   pack_remove_forced(Pack)
 1287    ).
 1288
 1289pack_remove_forced(Pack) :-
 1290    catch('$pack_detach'(Pack, BaseDir),
 1291          error(existence_error(pack, Pack), _),
 1292          fail),
 1293    !,
 1294    print_message(informational, pack(remove(BaseDir))),
 1295    delete_directory_and_contents(BaseDir).
 1296pack_remove_forced(Pack) :-
 1297    unattached_pacth(Pack, BaseDir),
 1298    !,
 1299    delete_directory_and_contents(BaseDir).
 1300pack_remove_forced(Pack) :-
 1301    print_message(informational, error(existence_error(pack, Pack),_)).
 1302
 1303confirm_remove(Pack, Deps, Delete) :-
 1304    print_message(warning, pack(depends(Pack, Deps))),
 1305    menu(pack(resolve_remove),
 1306         [ [Pack]      = remove_only(Pack),
 1307           [Pack|Deps] = remove_deps(Pack, Deps),
 1308           []          = cancel
 1309         ], [], Delete, []),
 1310    Delete \== [].
 1311
 1312
 1313                 /*******************************
 1314                 *           PROPERTIES         *
 1315                 *******************************/
 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)
 1338pack_property(Pack, Property) :-
 1339    findall(Pack-Property, pack_property_(Pack, Property), List),
 1340    member(Pack-Property, List).            % make det if applicable
 1341
 1342pack_property_(Pack, Property) :-
 1343    pack_info(Pack, _, Property).
 1344pack_property_(Pack, Property) :-
 1345    \+ \+ info_file(Property, _),
 1346    '$pack':pack(Pack, BaseDir),
 1347    access_file(BaseDir, read),
 1348    directory_files(BaseDir, Files),
 1349    member(File, Files),
 1350    info_file(Property, Pattern),
 1351    downcase_atom(File, Pattern),
 1352    directory_file_path(BaseDir, File, InfoFile),
 1353    arg(1, Property, InfoFile).
 1354
 1355info_file(readme(_), 'readme.txt').
 1356info_file(readme(_), 'readme').
 1357info_file(todo(_),   'todo.txt').
 1358info_file(todo(_),   'todo').
 1359
 1360
 1361                 /*******************************
 1362                 *             GIT              *
 1363                 *******************************/
 git_url(+URL, -Pack) is semidet
True if URL describes a git url for Pack
 1369git_url(URL, Pack) :-
 1370    uri_components(URL, Components),
 1371    uri_data(scheme, Components, Scheme),
 1372    uri_data(path, Components, Path),
 1373    (   Scheme == git
 1374    ->  true
 1375    ;   git_download_scheme(Scheme),
 1376        file_name_extension(_, git, Path)
 1377    ),
 1378    file_base_name(Path, PackExt),
 1379    (   file_name_extension(Pack, git, PackExt)
 1380    ->  true
 1381    ;   Pack = PackExt
 1382    ),
 1383    (   safe_pack_name(Pack)
 1384    ->  true
 1385    ;   domain_error(pack_name, Pack)
 1386    ).
 1387
 1388git_download_scheme(http).
 1389git_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.
 1396safe_pack_name(Name) :-
 1397    atom_length(Name, Len),
 1398    Len >= 3,                               % demand at least three length
 1399    atom_codes(Name, Codes),
 1400    maplist(safe_pack_char, Codes),
 1401    !.
 1402
 1403safe_pack_char(C) :- between(0'a, 0'z, C), !.
 1404safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 1405safe_pack_char(C) :- between(0'0, 0'9, C), !.
 1406safe_pack_char(0'_).
 1407
 1408
 1409                 /*******************************
 1410                 *         VERSION LOGIC        *
 1411                 *******************************/
 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.
 1420pack_version_file(Pack, Version, GitHubRelease) :-
 1421    atomic(GitHubRelease),
 1422    github_release_url(GitHubRelease, Pack, Version),
 1423    !.
 1424pack_version_file(Pack, Version, Path) :-
 1425    atomic(Path),
 1426    file_base_name(Path, File),
 1427    no_int_file_name_extension(Base, _Ext, File),
 1428    atom_codes(Base, Codes),
 1429    (   phrase(pack_version(Pack, Version), Codes),
 1430        safe_pack_name(Pack)
 1431    ->  true
 1432    ).
 1433
 1434no_int_file_name_extension(Base, Ext, File) :-
 1435    file_name_extension(Base0, Ext0, File),
 1436    \+ atom_number(Ext0, _),
 1437    !,
 1438    Base = Base0,
 1439    Ext = Ext0.
 1440no_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'
 1453github_release_url(URL, Pack, Version) :-
 1454    uri_components(URL, Components),
 1455    uri_data(authority, Components, 'github.com'),
 1456    uri_data(scheme, Components, Scheme),
 1457    download_scheme(Scheme),
 1458    uri_data(path, Components, Path),
 1459    atomic_list_concat(['',_Project,Pack,archive,File], /, Path),
 1460    file_name_extension(Tag, Ext, File),
 1461    github_archive_extension(Ext),
 1462    tag_version(Tag, Version),
 1463    !.
 1464
 1465github_archive_extension(tgz).
 1466github_archive_extension(zip).
 1467
 1468tag_version(Tag, Version) :-
 1469    version_tag_prefix(Prefix),
 1470    atom_concat(Prefix, AtomVersion, Tag),
 1471    atom_version(AtomVersion, Version).
 1472
 1473version_tag_prefix(v).
 1474version_tag_prefix('V').
 1475version_tag_prefix('').
 1476
 1477
 1478:- public
 1479    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 @>
 1487atom_version(Atom, version(Parts)) :-
 1488    (   atom(Atom)
 1489    ->  atom_codes(Atom, Codes),
 1490        phrase(version(Parts), Codes)
 1491    ;   atomic_list_concat(Parts, '.', Atom)
 1492    ).
 1493
 1494pack_version(Pack, version(Parts)) -->
 1495    string(Codes), "-",
 1496    version(Parts),
 1497    !,
 1498    { atom_codes(Pack, Codes)
 1499    }.
 1500
 1501version([_|T]) -->
 1502    "*",
 1503    !,
 1504    (   "."
 1505    ->  version(T)
 1506    ;   []
 1507    ).
 1508version([H|T]) -->
 1509    integer(H),
 1510    (   "."
 1511    ->  version(T)
 1512    ;   { T = [] }
 1513    ).
 1514
 1515                 /*******************************
 1516                 *       QUERY CENTRAL DB       *
 1517                 *******************************/
 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.
 1537pack_inquiry(_, _, _, Options) :-
 1538    option(inquiry(false), Options),
 1539    !.
 1540pack_inquiry(URL, DownloadFile, Info, Options) :-
 1541    setting(server, ServerBase),
 1542    ServerBase \== '',
 1543    atom_concat(ServerBase, query, Server),
 1544    (   option(inquiry(true), Options)
 1545    ->  true
 1546    ;   confirm(inquiry(Server), yes, Options)
 1547    ),
 1548    !,
 1549    (   DownloadFile = git(SHA1)
 1550    ->  true
 1551    ;   file_sha1(DownloadFile, SHA1)
 1552    ),
 1553    query_pack_server(install(URL, SHA1, Info), Reply, Options),
 1554    inquiry_result(Reply, URL, Options).
 1555pack_inquiry(_, _, _, _).
 query_pack_server(+Query, -Result, +Options)
Send a Prolog query to the package server and process its results.
 1563query_pack_server(Query, Result, Options) :-
 1564    setting(server, ServerBase),
 1565    ServerBase \== '',
 1566    atom_concat(ServerBase, query, Server),
 1567    format(codes(Data), '~q.~n', Query),
 1568    info_level(Informational, Options),
 1569    print_message(Informational, pack(contacting_server(Server))),
 1570    setup_call_cleanup(
 1571        http_open(Server, In,
 1572                  [ post(codes(application/'x-prolog', Data)),
 1573                    header(content_type, ContentType)
 1574                  ]),
 1575        read_reply(ContentType, In, Result),
 1576        close(In)),
 1577    message_severity(Result, Level, Informational),
 1578    print_message(Level, pack(server_reply(Result))).
 1579
 1580read_reply(ContentType, In, Result) :-
 1581    sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
 1582    !,
 1583    set_stream(In, encoding(utf8)),
 1584    read(In, Result).
 1585read_reply(ContentType, In, _Result) :-
 1586    read_string(In, 500, String),
 1587    print_message(error, pack(no_prolog_response(ContentType, String))),
 1588    fail.
 1589
 1590info_level(Level, Options) :-
 1591    option(silent(true), Options),
 1592    !,
 1593    Level = silent.
 1594info_level(informational, _).
 1595
 1596message_severity(true(_), Informational, Informational).
 1597message_severity(false, warning, _).
 1598message_severity(exception(_), error, _).
 inquiry_result(+Reply, +File, +Options) is semidet
Analyse the results of the inquiry and decide whether to continue or not.
 1606inquiry_result(Reply, File, Options) :-
 1607    findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation),
 1608    \+ member(cancel, Evaluation),
 1609    select_option(git(_), Options, Options1, _),
 1610    forall(member(install_dependencies(Resolution), Evaluation),
 1611           maplist(install_dependency(Options1), Resolution)).
 1612
 1613eval_inquiry(true(Reply), URL, Eval, _) :-
 1614    include(alt_hash, Reply, Alts),
 1615    Alts \== [],
 1616    print_message(warning, pack(alt_hashes(URL, Alts))),
 1617    (   memberchk(downloads(Count), Reply),
 1618        (   git_url(URL, _)
 1619        ->  Default = yes,
 1620            Eval = with_git_commits_in_same_version
 1621        ;   Default = no,
 1622            Eval = with_alt_hashes
 1623        ),
 1624        confirm(continue_with_alt_hashes(Count, URL), Default, [])
 1625    ->  true
 1626    ;   !,                          % Stop other rules
 1627        Eval = cancel
 1628    ).
 1629eval_inquiry(true(Reply), _, Eval, Options) :-
 1630    include(dependency, Reply, Deps),
 1631    Deps \== [],
 1632    select_dependency_resolution(Deps, Eval, Options),
 1633    (   Eval == cancel
 1634    ->  !
 1635    ;   true
 1636    ).
 1637eval_inquiry(true(Reply), URL, true, Options) :-
 1638    file_base_name(URL, File),
 1639    info_level(Informational, Options),
 1640    print_message(Informational, pack(inquiry_ok(Reply, File))).
 1641eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))),
 1642             URL, Eval, Options) :-
 1643    (   confirm(continue_with_modified_hash(URL), no, Options)
 1644    ->  Eval = true
 1645    ;   Eval = cancel
 1646    ).
 1647
 1648alt_hash(alt_hash(_,_,_)).
 1649dependency(dependency(_,_,_,_,_)).
 select_dependency_resolution(+Deps, -Eval, +Options)
Select a resolution.
To be done
- Exploit backtracking over resolve_dependencies/2.
 1658select_dependency_resolution(Deps, Eval, Options) :-
 1659    resolve_dependencies(Deps, Resolution),
 1660    exclude(local_dep, Resolution, ToBeDone),
 1661    (   ToBeDone == []
 1662    ->  !, Eval = true
 1663    ;   print_message(warning, pack(install_dependencies(Resolution))),
 1664        (   memberchk(_-unresolved, Resolution)
 1665        ->  Default = cancel
 1666        ;   Default = install_deps
 1667        ),
 1668        menu(pack(resolve_deps),
 1669             [ install_deps    = install_deps,
 1670               install_no_deps = install_no_deps,
 1671               cancel          = cancel
 1672             ], Default, Choice, Options),
 1673        (   Choice == cancel
 1674        ->  !, Eval = cancel
 1675        ;   Choice == install_no_deps
 1676        ->  !, Eval = install_no_deps
 1677        ;   !, Eval = install_dependencies(Resolution)
 1678        )
 1679    ).
 1680
 1681local_dep(_-resolved(_)).
 install_dependency(+Options, +TokenResolution)
Install dependencies for the given resolution.
To be done
- : Query URI to use
 1690install_dependency(Options,
 1691                   _Token-resolve(Pack, VersionAtom, [_URL|_], SubResolve)) :-
 1692    atom_version(VersionAtom, Version),
 1693    current_pack(Pack),
 1694    pack_info(Pack, _, version(InstalledAtom)),
 1695    atom_version(InstalledAtom, Installed),
 1696    Installed == Version,               % already installed
 1697    !,
 1698    maplist(install_dependency(Options), SubResolve).
 1699install_dependency(Options,
 1700                   _Token-resolve(Pack, VersionAtom, [URL|_], SubResolve)) :-
 1701    !,
 1702    atom_version(VersionAtom, Version),
 1703    merge_options([ url(URL),
 1704                    version(Version),
 1705                    interactive(false),
 1706                    inquiry(false),
 1707                    info(list),
 1708                    pack(Pack)
 1709                  ], Options, InstallOptions),
 1710    pack_install(Pack, InstallOptions),
 1711    maplist(install_dependency(Options), SubResolve).
 1712install_dependency(_, _-_).
 1713
 1714
 1715                 /*******************************
 1716                 *        WILDCARD URIs         *
 1717                 *******************************/
 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
 1726available_download_versions(URL, Versions) :-
 1727    wildcard_pattern(URL),
 1728    github_url(URL, User, Repo),
 1729    !,
 1730    findall(Version-VersionURL,
 1731            github_version(User, Repo, Version, VersionURL),
 1732            Versions).
 1733available_download_versions(URL, Versions) :-
 1734    wildcard_pattern(URL),
 1735    !,
 1736    file_directory_name(URL, DirURL0),
 1737    ensure_slash(DirURL0, DirURL),
 1738    print_message(informational, pack(query_versions(DirURL))),
 1739    setup_call_cleanup(
 1740        http_open(DirURL, In, []),
 1741        load_html(stream(In), DOM,
 1742                  [ syntax_errors(quiet)
 1743                  ]),
 1744        close(In)),
 1745    findall(MatchingURL,
 1746            absolute_matching_href(DOM, URL, MatchingURL),
 1747            MatchingURLs),
 1748    (   MatchingURLs == []
 1749    ->  print_message(warning, pack(no_matching_urls(URL)))
 1750    ;   true
 1751    ),
 1752    versioned_urls(MatchingURLs, VersionedURLs),
 1753    keysort(VersionedURLs, SortedVersions),
 1754    reverse(SortedVersions, Versions),
 1755    print_message(informational, pack(found_versions(Versions))).
 1756available_download_versions(URL, [Version-URL]) :-
 1757    (   pack_version_file(_Pack, Version0, URL)
 1758    ->  Version = Version0
 1759    ;   Version = unknown
 1760    ).
 github_url(+URL, -User, -Repo) is semidet
True when URL refers to a github repository.
 1766github_url(URL, User, Repo) :-
 1767    uri_components(URL, uri_components(https,'github.com',Path,_,_)),
 1768    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.
 1776github_version(User, Repo, Version, VersionURI) :-
 1777    atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
 1778    uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
 1779    setup_call_cleanup(
 1780      http_open(ApiUri, In,
 1781                [ request_header('Accept'='application/vnd.github.v3+json')
 1782                ]),
 1783      json_read_dict(In, Dicts),
 1784      close(In)),
 1785    member(Dict, Dicts),
 1786    atom_string(Tag, Dict.name),
 1787    tag_version(Tag, Version),
 1788    atom_string(VersionURI, Dict.zipball_url).
 1789
 1790wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
 1791wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
 1792
 1793ensure_slash(Dir, DirS) :-
 1794    (   sub_atom(Dir, _, _, 0, /)
 1795    ->  DirS = Dir
 1796    ;   atom_concat(Dir, /, DirS)
 1797    ).
 1798
 1799absolute_matching_href(DOM, Pattern, Match) :-
 1800    xpath(DOM, //a(@href), HREF),
 1801    uri_normalized(HREF, Pattern, Match),
 1802    wildcard_match(Pattern, Match).
 1803
 1804versioned_urls([], []).
 1805versioned_urls([H|T0], List) :-
 1806    file_base_name(H, File),
 1807    (   pack_version_file(_Pack, Version, File)
 1808    ->  List = [Version-H|T]
 1809    ;   List = T
 1810    ),
 1811    versioned_urls(T0, T).
 1812
 1813
 1814                 /*******************************
 1815                 *          DEPENDENCIES        *
 1816                 *******************************/
 update_dependency_db
Reload dependency declarations between packages.
 1822update_dependency_db :-
 1823    retractall(pack_requires(_,_)),
 1824    retractall(pack_provides_db(_,_)),
 1825    forall(current_pack(Pack),
 1826           (   findall(Info, pack_info(Pack, dependency, Info), Infos),
 1827               update_dependency_db(Pack, Infos)
 1828           )).
 1829
 1830update_dependency_db(Name, Info) :-
 1831    retractall(pack_requires(Name, _)),
 1832    retractall(pack_provides_db(Name, _)),
 1833    maplist(assert_dep(Name), Info).
 1834
 1835assert_dep(Pack, provides(Token)) :-
 1836    !,
 1837    assertz(pack_provides_db(Pack, Token)).
 1838assert_dep(Pack, requires(Token)) :-
 1839    !,
 1840    assertz(pack_requires(Pack, Token)).
 1841assert_dep(_, _).
 validate_dependencies is det
Validate all dependencies, reporting on failures
 1847validate_dependencies :-
 1848    unsatisfied_dependencies(Unsatisfied),
 1849    !,
 1850    print_message(warning, pack(unsatisfied(Unsatisfied))).
 1851validate_dependencies.
 1852
 1853
 1854unsatisfied_dependencies(Unsatisfied) :-
 1855    findall(Req-Pack, pack_requires(Pack, Req), Reqs0),
 1856    keysort(Reqs0, Reqs1),
 1857    group_pairs_by_key(Reqs1, GroupedReqs),
 1858    exclude(satisfied_dependency, GroupedReqs, Unsatisfied),
 1859    Unsatisfied \== [].
 1860
 1861satisfied_dependency(Needed-_By) :-
 1862    pack_provides(_, Needed),
 1863    !.
 1864satisfied_dependency(Needed-_By) :-
 1865    compound(Needed),
 1866    Needed =.. [Op, Pack, ReqVersion],
 1867    (   pack_provides(Pack, Pack)
 1868    ->  pack_info(Pack, _, version(PackVersion)),
 1869        version_data(PackVersion, PackData)
 1870    ;   Pack == prolog
 1871    ->  current_prolog_flag(version_data, swi(Major,Minor,Patch,_)),
 1872        PackData = [Major,Minor,Patch]
 1873    ),
 1874    version_data(ReqVersion, ReqData),
 1875    cmp(Op, Cmp),
 1876    call(Cmp, PackData, ReqData).
 pack_provides(?Package, ?Token) is multi
True if Pack provides Token. A package always provides itself.
 1882pack_provides(Pack, Pack) :-
 1883    current_pack(Pack).
 1884pack_provides(Pack, Token) :-
 1885    pack_provides_db(Pack, Token).
 pack_depends_on(?Pack, ?Dependency) is nondet
True if Pack requires Dependency, direct or indirect.
 1891pack_depends_on(Pack, Dependency) :-
 1892    (   atom(Pack)
 1893    ->  pack_depends_on_fwd(Pack, Dependency, [Pack])
 1894    ;   pack_depends_on_bwd(Pack, Dependency, [Dependency])
 1895    ).
 1896
 1897pack_depends_on_fwd(Pack, Dependency, Visited) :-
 1898    pack_depends_on_1(Pack, Dep1),
 1899    \+ memberchk(Dep1, Visited),
 1900    (   Dependency = Dep1
 1901    ;   pack_depends_on_fwd(Dep1, Dependency, [Dep1|Visited])
 1902    ).
 1903
 1904pack_depends_on_bwd(Pack, Dependency, Visited) :-
 1905    pack_depends_on_1(Dep1, Dependency),
 1906    \+ memberchk(Dep1, Visited),
 1907    (   Pack = Dep1
 1908    ;   pack_depends_on_bwd(Pack, Dep1, [Dep1|Visited])
 1909    ).
 1910
 1911pack_depends_on_1(Pack, Dependency) :-
 1912    atom(Dependency),
 1913    !,
 1914    pack_provides(Dependency, Token),
 1915    pack_requires(Pack, Token).
 1916pack_depends_on_1(Pack, Dependency) :-
 1917    pack_requires(Pack, Token),
 1918    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
 1935resolve_dependencies(Dependencies, Resolution) :-
 1936    maplist(dependency_pair, Dependencies, Pairs0),
 1937    keysort(Pairs0, Pairs1),
 1938    group_pairs_by_key(Pairs1, ByToken),
 1939    maplist(resolve_dep, ByToken, Resolution).
 1940
 1941dependency_pair(dependency(Token, Pack, Version, URLs, SubDeps),
 1942                Token-(Pack-pack(Version,URLs, SubDeps))).
 1943
 1944resolve_dep(Token-Pairs, Token-Resolution) :-
 1945    (   resolve_dep2(Token-Pairs, Resolution)
 1946    *-> true
 1947    ;   Resolution = unresolved
 1948    ).
 1949
 1950resolve_dep2(Token-_, resolved(Pack)) :-
 1951    pack_provides(Pack, Token).
 1952resolve_dep2(_-Pairs, resolve(Pack, VersionAtom, URLs, SubResolves)) :-
 1953    keysort(Pairs, Sorted),
 1954    group_pairs_by_key(Sorted, ByPack),
 1955    member(Pack-Versions, ByPack),
 1956    Pack \== (-),
 1957    maplist(version_pack, Versions, VersionData),
 1958    sort(VersionData, ByVersion),
 1959    reverse(ByVersion, ByVersionLatest),
 1960    member(pack(Version,URLs,SubDeps), ByVersionLatest),
 1961    atom_version(VersionAtom, Version),
 1962    include(dependency, SubDeps, Deps),
 1963    resolve_dependencies(Deps, SubResolves).
 1964
 1965version_pack(pack(VersionAtom,URLs,SubDeps),
 1966             pack(Version,URLs,SubDeps)) :-
 1967    atom_version(VersionAtom, Version).
 pack_attach(+Dir, +Options) is det
Attach a single package in Dir. The Dir is expected to contain the file pack.pl and a prolog directory. Options processed:
duplicate(+Action)
What to do if the same package is already installed in a different directory. Action is one of
warning
Warn and ignore the package
keep
Silently ignore the package
replace
Unregister the existing and insert the new package
search(+Where)
Determines the order of searching package library directories. Default is last, alternative is first.
See also
- attach_packs/2 to attach multiple packs from a directory.
 1991pack_attach(Dir, Options) :-
 1992    '$pack_attach'(Dir, Options).
 1993
 1994
 1995                 /*******************************
 1996                 *        USER INTERACTION      *
 1997                 *******************************/
 1998
 1999:- multifile prolog:message//1.
 menu(Question, +Alternatives, +Default, -Selection, +Options)
 2003menu(_Question, _Alternatives, Default, Selection, Options) :-
 2004    option(interactive(false), Options),
 2005    !,
 2006    Selection = Default.
 2007menu(Question, Alternatives, Default, Selection, _) :-
 2008    length(Alternatives, N),
 2009    between(1, 5, _),
 2010       print_message(query, Question),
 2011       print_menu(Alternatives, Default, 1),
 2012       print_message(query, pack(menu(select))),
 2013       read_selection(N, Choice),
 2014    !,
 2015    (   Choice == default
 2016    ->  Selection = Default
 2017    ;   nth1(Choice, Alternatives, Selection=_)
 2018    ->  true
 2019    ).
 2020
 2021print_menu([], _, _).
 2022print_menu([Value=Label|T], Default, I) :-
 2023    (   Value == Default
 2024    ->  print_message(query, pack(menu(default_item(I, Label))))
 2025    ;   print_message(query, pack(menu(item(I, Label))))
 2026    ),
 2027    I2 is I + 1,
 2028    print_menu(T, Default, I2).
 2029
 2030read_selection(Max, Choice) :-
 2031    get_single_char(Code),
 2032    (   answered_default(Code)
 2033    ->  Choice = default
 2034    ;   code_type(Code, digit(Choice)),
 2035        between(1, Max, Choice)
 2036    ->  true
 2037    ;   print_message(warning, pack(menu(reply(1,Max)))),
 2038        fail
 2039    ).
 confirm(+Question, +Default, +Options) is semidet
Ask for confirmation.
Arguments:
Default- is one of yes, no or none.
 2047confirm(_Question, Default, Options) :-
 2048    Default \== none,
 2049    option(interactive(false), Options, true),
 2050    !,
 2051    Default == yes.
 2052confirm(Question, Default, _) :-
 2053    between(1, 5, _),
 2054       print_message(query, pack(confirm(Question, Default))),
 2055       read_yes_no(YesNo, Default),
 2056    !,
 2057    format(user_error, '~N', []),
 2058    YesNo == yes.
 2059
 2060read_yes_no(YesNo, Default) :-
 2061    get_single_char(Code),
 2062    code_yes_no(Code, Default, YesNo),
 2063    !.
 2064
 2065code_yes_no(0'y, _, yes).
 2066code_yes_no(0'Y, _, yes).
 2067code_yes_no(0'n, _, no).
 2068code_yes_no(0'N, _, no).
 2069code_yes_no(_, none, _) :- !, fail.
 2070code_yes_no(C, Default, Default) :-
 2071    answered_default(C).
 2072
 2073answered_default(0'\r).
 2074answered_default(0'\n).
 2075answered_default(0'\s).
 2076
 2077
 2078                 /*******************************
 2079                 *            MESSAGES          *
 2080                 *******************************/
 2081
 2082:- multifile prolog:message//1. 2083
 2084prolog:message(pack(Message)) -->
 2085    message(Message).
 2086
 2087:- discontiguous
 2088    message//1,
 2089    label//1. 2090
 2091message(invalid_info(Term)) -->
 2092    [ 'Invalid package description: ~q'-[Term] ].
 2093message(directory_exists(Dir)) -->
 2094    [ 'Package target directory exists and is not empty:', nl,
 2095      '\t~q'-[Dir]
 2096    ].
 2097message(already_installed(pack(Pack, Version))) -->
 2098    { atom_version(AVersion, Version) },
 2099    [ 'Pack `~w'' is already installed @~w'-[Pack, AVersion] ].
 2100message(already_installed(Pack)) -->
 2101    [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
 2102message(invalid_name(File)) -->
 2103    [ '~w: A package archive must be named <pack>-<version>.<ext>'-[File] ],
 2104    no_tar_gz(File).
 2105
 2106no_tar_gz(File) -->
 2107    { sub_atom(File, _, _, 0, '.tar.gz') },
 2108    !,
 2109    [ nl,
 2110      'Package archive files must have a single extension.  E.g., \'.tgz\''-[]
 2111    ].
 2112no_tar_gz(_) --> [].
 2113
 2114message(kept_foreign(Pack)) -->
 2115    [ 'Found foreign libraries for target platform.'-[], nl,
 2116      'Use ?- pack_rebuild(~q). to rebuild from sources'-[Pack]
 2117    ].
 2118message(no_pack_installed(Pack)) -->
 2119    [ 'No pack ~q installed.  Use ?- pack_list(Pattern) to search'-[Pack] ].
 2120message(no_packages_installed) -->
 2121    { setting(server, ServerBase) },
 2122    [ 'There are no extra packages installed.', nl,
 2123      'Please visit ~wlist.'-[ServerBase]
 2124    ].
 2125message(remove_with(Pack)) -->
 2126    [ 'The package can be removed using: ?- ~q.'-[pack_remove(Pack)]
 2127    ].
 2128message(unsatisfied(Packs)) -->
 2129    [ 'The following dependencies are not satisfied:', nl ],
 2130    unsatisfied(Packs).
 2131message(depends(Pack, Deps)) -->
 2132    [ 'The following packages depend on `~w\':'-[Pack], nl ],
 2133    pack_list(Deps).
 2134message(remove(PackDir)) -->
 2135    [ 'Removing ~q and contents'-[PackDir] ].
 2136message(remove_existing_pack(PackDir)) -->
 2137    [ 'Remove old installation in ~q'-[PackDir] ].
 2138message(install_from(Pack, Version, git(URL))) -->
 2139    [ 'Install ~w@~w from GIT at ~w'-[Pack, Version, URL] ].
 2140message(install_from(Pack, Version, URL)) -->
 2141    [ 'Install ~w@~w from ~w'-[Pack, Version, URL] ].
 2142message(select_install_from(Pack, Version)) -->
 2143    [ 'Select download location for ~w@~w'-[Pack, Version] ].
 2144message(install_downloaded(File)) -->
 2145    { file_base_name(File, Base),
 2146      size_file(File, Size) },
 2147    [ 'Install "~w" (~D bytes)'-[Base, Size] ].
 2148message(git_post_install(PackDir, Pack)) -->
 2149    (   { is_foreign_pack(PackDir, _) }
 2150    ->  [ 'Run post installation scripts for pack "~w"'-[Pack] ]
 2151    ;   [ 'Activate pack "~w"'-[Pack] ]
 2152    ).
 2153message(no_meta_data(BaseDir)) -->
 2154    [ 'Cannot find pack.pl inside directory ~q.  Not a package?'-[BaseDir] ].
 2155message(inquiry(Server)) -->
 2156    [ 'Verify package status (anonymously)', nl,
 2157      '\tat "~w"'-[Server]
 2158    ].
 2159message(search_no_matches(Name)) -->
 2160    [ 'Search for "~w", returned no matching packages'-[Name] ].
 2161message(rebuild(Pack)) -->
 2162    [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
 2163message(upgrade(Pack, From, To)) -->
 2164    [ 'Upgrade "~w" from '-[Pack] ],
 2165    msg_version(From), [' to '-[]], msg_version(To).
 2166message(up_to_date(Pack)) -->
 2167    [ 'Package "~w" is up-to-date'-[Pack] ].
 2168message(query_versions(URL)) -->
 2169    [ 'Querying "~w" to find new versions ...'-[URL] ].
 2170message(no_matching_urls(URL)) -->
 2171    [ 'Could not find any matching URL: ~q'-[URL] ].
 2172message(found_versions([Latest-_URL|More])) -->
 2173    { length(More, Len),
 2174      atom_version(VLatest, Latest)
 2175    },
 2176    [ '    Latest version: ~w (~D older)'-[VLatest, Len] ].
 2177message(process_output(Codes)) -->
 2178    { split_lines(Codes, Lines) },
 2179    process_lines(Lines).
 2180message(contacting_server(Server)) -->
 2181    [ 'Contacting server at ~w ...'-[Server], flush ].
 2182message(server_reply(true(_))) -->
 2183    [ at_same_line, ' ok'-[] ].
 2184message(server_reply(false)) -->
 2185    [ at_same_line, ' done'-[] ].
 2186message(server_reply(exception(E))) -->
 2187    [ 'Server reported the following error:'-[], nl ],
 2188    '$messages':translate_message(E).
 2189message(cannot_create_dir(Alias)) -->
 2190    { findall(PackDir,
 2191              absolute_file_name(Alias, PackDir, [solutions(all)]),
 2192              PackDirs0),
 2193      sort(PackDirs0, PackDirs)
 2194    },
 2195    [ 'Cannot find a place to create a package directory.'-[],
 2196      'Considered:'-[]
 2197    ],
 2198    candidate_dirs(PackDirs).
 2199message(no_match(Name)) -->
 2200    [ 'No registered pack matches "~w"'-[Name] ].
 2201message(conflict(version, [PackV, FileV])) -->
 2202    ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
 2203    [', file claims version '-[]], msg_version(FileV).
 2204message(conflict(name, [PackInfo, FileInfo])) -->
 2205    ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
 2206    [', file claims ~w: ~p'-[FileInfo]].
 2207message(no_prolog_response(ContentType, String)) -->
 2208    [ 'Expected Prolog response.  Got content of type ~p'-[ContentType], nl,
 2209      '~s'-[String]
 2210    ].
 2211message(pack(no_upgrade_info(Pack))) -->
 2212    [ '~w: pack meta-data does not provide an upgradable URL'-[Pack] ].
 2213
 2214candidate_dirs([]) --> [].
 2215candidate_dirs([H|T]) --> [ nl, '    ~w'-[H] ], candidate_dirs(T).
 2216
 2217                                                % Questions
 2218message(resolve_remove) -->
 2219    [ nl, 'Please select an action:', nl, nl ].
 2220message(create_pack_dir) -->
 2221    [ nl, 'Create directory for packages', nl ].
 2222message(menu(item(I, Label))) -->
 2223    [ '~t(~d)~6|   '-[I] ],
 2224    label(Label).
 2225message(menu(default_item(I, Label))) -->
 2226    [ '~t(~d)~6| * '-[I] ],
 2227    label(Label).
 2228message(menu(select)) -->
 2229    [ nl, 'Your choice? ', flush ].
 2230message(confirm(Question, Default)) -->
 2231    message(Question),
 2232    confirm_default(Default),
 2233    [ flush ].
 2234message(menu(reply(Min,Max))) -->
 2235    (  { Max =:= Min+1 }
 2236    -> [ 'Please enter ~w or ~w'-[Min,Max] ]
 2237    ;  [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
 2238    ).
 2239
 2240% Alternate hashes for found for the same file
 2241
 2242message(alt_hashes(URL, _Alts)) -->
 2243    { git_url(URL, _)
 2244    },
 2245    !,
 2246    [ 'GIT repository was updated without updating version' ].
 2247message(alt_hashes(URL, Alts)) -->
 2248    { file_base_name(URL, File)
 2249    },
 2250    [ 'Found multiple versions of "~w".'-[File], nl,
 2251      'This could indicate a compromised or corrupted file', nl
 2252    ],
 2253    alt_hashes(Alts).
 2254message(continue_with_alt_hashes(Count, URL)) -->
 2255    [ 'Continue installation from "~w" (downloaded ~D times)'-[URL, Count] ].
 2256message(continue_with_modified_hash(_URL)) -->
 2257    [ 'Pack may be compromised.  Continue anyway'
 2258    ].
 2259message(modified_hash(_SHA1-URL, _SHA2-[URL])) -->
 2260    [ 'Content of ~q has changed.'-[URL]
 2261    ].
 2262
 2263alt_hashes([]) --> [].
 2264alt_hashes([H|T]) --> alt_hash(H), ( {T == []} -> [] ; [nl], alt_hashes(T) ).
 2265
 2266alt_hash(alt_hash(Count, URLs, Hash)) -->
 2267    [ '~t~d~8| ~w'-[Count, Hash] ],
 2268    alt_urls(URLs).
 2269
 2270alt_urls([]) --> [].
 2271alt_urls([H|T]) -->
 2272    [ nl, '    ~w'-[H] ],
 2273    alt_urls(T).
 2274
 2275% Installation dependencies gathered from inquiry server.
 2276
 2277message(install_dependencies(Resolution)) -->
 2278    [ 'Package depends on the following:' ],
 2279    msg_res_tokens(Resolution, 1).
 2280
 2281msg_res_tokens([], _) --> [].
 2282msg_res_tokens([H|T], L) --> msg_res_token(H, L), msg_res_tokens(T, L).
 2283
 2284msg_res_token(Token-unresolved, L) -->
 2285    res_indent(L),
 2286    [ '"~w" cannot be satisfied'-[Token] ].
 2287msg_res_token(Token-resolve(Pack, Version, [URL|_], SubResolves), L) -->
 2288    !,
 2289    res_indent(L),
 2290    [ '"~w", provided by ~w@~w from ~w'-[Token, Pack, Version, URL] ],
 2291    { L2 is L+1 },
 2292    msg_res_tokens(SubResolves, L2).
 2293msg_res_token(Token-resolved(Pack), L) -->
 2294    !,
 2295    res_indent(L),
 2296    [ '"~w", provided by installed pack ~w'-[Token,Pack] ].
 2297
 2298res_indent(L) -->
 2299    { I is L*2 },
 2300    [ nl, '~*c'-[I,0'\s] ].
 2301
 2302message(resolve_deps) -->
 2303    [ nl, 'What do you wish to do' ].
 2304label(install_deps) -->
 2305    [ 'Install proposed dependencies' ].
 2306label(install_no_deps) -->
 2307    [ 'Only install requested package' ].
 2308
 2309
 2310message(git_fetch(Dir)) -->
 2311    [ 'Running "git fetch" in ~q'-[Dir] ].
 2312
 2313% inquiry is blank
 2314
 2315message(inquiry_ok(Reply, File)) -->
 2316    { memberchk(downloads(Count), Reply),
 2317      memberchk(rating(VoteCount, Rating), Reply),
 2318      !,
 2319      length(Stars, Rating),
 2320      maplist(=(0'*), Stars)
 2321    },
 2322    [ '"~w" was downloaded ~D times.  Package rated ~s (~D votes)'-
 2323      [ File, Count, Stars, VoteCount ]
 2324    ].
 2325message(inquiry_ok(Reply, File)) -->
 2326    { memberchk(downloads(Count), Reply)
 2327    },
 2328    [ '"~w" was downloaded ~D times'-[ File, Count ] ].
 2329
 2330                                                % support predicates
 2331unsatisfied([]) --> [].
 2332unsatisfied([Needed-[By]|T]) -->
 2333    [ '  - "~w" is needed by package "~w"'-[Needed, By], nl ],
 2334    unsatisfied(T).
 2335unsatisfied([Needed-By|T]) -->
 2336    [ '  - "~w" is needed by the following packages:'-[Needed], nl ],
 2337    pack_list(By),
 2338    unsatisfied(T).
 2339
 2340pack_list([]) --> [].
 2341pack_list([H|T]) -->
 2342    [ '    - Package "~w"'-[H], nl ],
 2343    pack_list(T).
 2344
 2345process_lines([]) --> [].
 2346process_lines([H|T]) -->
 2347    [ '~s'-[H] ],
 2348    (   {T==[]}
 2349    ->  []
 2350    ;   [nl], process_lines(T)
 2351    ).
 2352
 2353split_lines([], []) :- !.
 2354split_lines(All, [Line1|More]) :-
 2355    append(Line1, [0'\n|Rest], All),
 2356    !,
 2357    split_lines(Rest, More).
 2358split_lines(Line, [Line]).
 2359
 2360label(remove_only(Pack)) -->
 2361    [ 'Only remove package ~w (break dependencies)'-[Pack] ].
 2362label(remove_deps(Pack, Deps)) -->
 2363    { length(Deps, Count) },
 2364    [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
 2365label(create_dir(Dir)) -->
 2366    [ '~w'-[Dir] ].
 2367label(install_from(git(URL))) -->
 2368    !,
 2369    [ 'GIT repository at ~w'-[URL] ].
 2370label(install_from(URL)) -->
 2371    [ '~w'-[URL] ].
 2372label(cancel) -->
 2373    [ 'Cancel' ].
 2374
 2375confirm_default(yes) -->
 2376    [ ' Y/n? ' ].
 2377confirm_default(no) -->
 2378    [ ' y/N? ' ].
 2379confirm_default(none) -->
 2380    [ ' y/n? ' ].
 2381
 2382msg_version(Version) -->
 2383    { atom(Version) },
 2384    !,
 2385    [ '~w'-[Version] ].
 2386msg_version(VersionData) -->
 2387    !,
 2388    { atom_version(Atom, VersionData) },
 2389    [ '~w'-[Atom] ]