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

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

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

  614pack_install(Spec, Options) :-
  615    pack_default_options(Spec, Pack, Options, DefOptions),
  616    (   option(already_installed(Installed), DefOptions)
  617    ->  print_message(informational, pack(already_installed(Installed)))
  618    ;   merge_options(Options, DefOptions, PackOptions),
  619        update_dependency_db,
  620        pack_install_dir(PackDir, PackOptions),
  621        pack_install(Pack, PackDir, PackOptions)
  622    ).
  623
  624pack_install_dir(PackDir, Options) :-
  625    option(package_directory(PackDir), Options),
  626    !.
  627pack_install_dir(PackDir, _Options) :-          % TBD: global/user?
  628    absolute_file_name(pack(.), PackDir,
  629                       [ file_type(directory),
  630                         access(write),
  631                         file_errors(fail)
  632                       ]),
  633    !.
  634pack_install_dir(PackDir, Options) :-           % TBD: global/user?
  635    pack_create_install_dir(PackDir, Options).
  636
  637pack_create_install_dir(PackDir, Options) :-
  638    findall(Candidate = create_dir(Candidate),
  639            ( absolute_file_name(pack(.), Candidate, [solutions(all)]),
  640              \+ exists_file(Candidate),
  641              \+ exists_directory(Candidate),
  642              file_directory_name(Candidate, Super),
  643              (   exists_directory(Super)
  644              ->  access_file(Super, write)
  645              ;   true
  646              )
  647            ),
  648            Candidates0),
  649    list_to_set(Candidates0, Candidates),   % keep order
  650    pack_create_install_dir(Candidates, PackDir, Options).
  651
  652pack_create_install_dir(Candidates, PackDir, Options) :-
  653    Candidates = [Default=_|_],
  654    !,
  655    append(Candidates, [cancel=cancel], Menu),
  656    menu(pack(create_pack_dir), Menu, Default, Selected, Options),
  657    Selected \== cancel,
  658    (   catch(make_directory_path(Selected), E,
  659              (print_message(warning, E), fail))
  660    ->  PackDir = Selected
  661    ;   delete(Candidates, PackDir=create_dir(PackDir), Remaining),
  662        pack_create_install_dir(Remaining, PackDir, Options)
  663    ).
  664pack_create_install_dir(_, _, _) :-
  665    print_message(error, pack(cannot_create_dir(pack(.)))),
  666    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.
  681pack_install(Name, _, Options) :-
  682    current_pack(Name),
  683    option(upgrade(false), Options, false),
  684    print_message(error, pack(already_installed(Name))),
  685    pack_info(Name),
  686    print_message(information, pack(remove_with(Name))),
  687    !,
  688    fail.
  689pack_install(Name, PackDir, Options) :-
  690    option(url(URL), Options),
  691    uri_file_name(URL, Source),
  692    !,
  693    pack_install_from_local(Source, PackDir, Name, Options).
  694pack_install(Name, PackDir, Options) :-
  695    option(url(URL), Options),
  696    uri_components(URL, Components),
  697    uri_data(scheme, Components, Scheme),
  698    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).
  707pack_install_from_local(Source, PackTopDir, Name, Options) :-
  708    exists_directory(Source),
  709    !,
  710    directory_file_path(PackTopDir, Name, PackDir),
  711    prepare_pack_dir(PackDir, Options),
  712    copy_directory(Source, PackDir),
  713    pack_post_install(Name, PackDir, Options).
  714pack_install_from_local(Source, PackTopDir, Name, Options) :-
  715    exists_file(Source),
  716    directory_file_path(PackTopDir, Name, PackDir),
  717    prepare_pack_dir(PackDir, Options),
  718    pack_unpack(Source, PackDir, Name, Options),
  719    pack_post_install(Name, PackDir, Options).
 pack_unpack(+SourceFile, +PackDir, +Pack, +Options)
Unpack an archive to the given package dir.
  726:- if(current_predicate(archive_extract/3)).  727pack_unpack(Source, PackDir, Pack, Options) :-
  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.
Errors
- existence_error(pack_file, 'pack.pl') if the archive doesn't contain pack.pl
- Syntax errors if pack.pl cannot be parsed.
  753:- if(current_predicate(archive_open/3)).  754pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
  755    size_file(Archive, Bytes),
  756    setup_call_cleanup(
  757        archive_open(Archive, Handle, []),
  758        (   repeat,
  759            (   archive_next_header(Handle, InfoFile)
  760            ->  true
  761            ;   !, fail
  762            )
  763        ),
  764        archive_close(Handle)),
  765    file_base_name(InfoFile, 'pack.pl'),
  766    atom_concat(Prefix, 'pack.pl', InfoFile),
  767    strip_option(Prefix, Pack, Strip),
  768    setup_call_cleanup(
  769        archive_open_entry(Handle, Stream),
  770        read_stream_to_terms(Stream, Info),
  771        close(Stream)),
  772    !,
  773    must_be(ground, Info),
  774    maplist(valid_info_term, Info).
  775:- else.  776pack_archive_info(_, _, _, _) :-
  777    existence_error(library, archive).
  778:- endif.  779pack_archive_info(_, _, _, _) :-
  780    existence_error(pack_file, 'pack.pl').
  781
  782strip_option('', _, []) :- !.
  783strip_option('./', _, []) :- !.
  784strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
  785    atom_concat(PrefixDir, /, Prefix),
  786    file_base_name(PrefixDir, Base),
  787    (   Base == Pack
  788    ->  true
  789    ;   pack_version_file(Pack, _, Base)
  790    ->  true
  791    ;   \+ sub_atom(PrefixDir, _, _, _, /)
  792    ).
  793
  794read_stream_to_terms(Stream, Terms) :-
  795    read(Stream, Term0),
  796    read_stream_to_terms(Term0, Stream, Terms).
  797
  798read_stream_to_terms(end_of_file, _, []) :- !.
  799read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
  800    read(Stream, Term1),
  801    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.
  809pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
  810    exists_directory(GitDir),
  811    !,
  812    git_ls_tree(Entries, [directory(GitDir)]),
  813    git_hash(Hash, [directory(GitDir)]),
  814    maplist(arg(4), Entries, Sizes),
  815    sum_list(Sizes, Bytes),
  816    directory_file_path(GitDir, 'pack.pl', InfoFile),
  817    read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
  818    must_be(ground, Info),
  819    maplist(valid_info_term, Info).
 download_file_sanity_check(+Archive, +Pack, +Info) is semidet
Perform basic sanity checks on DownloadFile
  825download_file_sanity_check(Archive, Pack, Info) :-
  826    info_field(name(Name), Info),
  827    info_field(version(VersionAtom), Info),
  828    atom_version(VersionAtom, Version),
  829    pack_version_file(PackA, VersionA, Archive),
  830    must_match([Pack, PackA, Name], name),
  831    must_match([Version, VersionA], version).
  832
  833info_field(Field, Info) :-
  834    memberchk(Field, Info),
  835    ground(Field),
  836    !.
  837info_field(Field, _Info) :-
  838    functor(Field, FieldName, _),
  839    print_message(error, pack(missing(FieldName))),
  840    fail.
  841
  842must_match(Values, _Field) :-
  843    sort(Values, [_]),
  844    !.
  845must_match(Values, Field) :-
  846    print_message(error, pack(conflict(Field, Values))),
  847    fail.
  848
  849
  850                 /*******************************
  851                 *         INSTALLATION         *
  852                 *******************************/
 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.
  860prepare_pack_dir(Dir, Options) :-
  861    exists_directory(Dir),
  862    !,
  863    (   empty_directory(Dir)
  864    ->  true
  865    ;   option(upgrade(true), Options)
  866    ->  delete_directory_contents(Dir)
  867    ;   confirm(remove_existing_pack(Dir), yes, Options),
  868        delete_directory_contents(Dir)
  869    ).
  870prepare_pack_dir(Dir, _) :-
  871    make_directory(Dir).
 empty_directory(+Directory) is semidet
True if Directory is empty (holds no files or sub-directories).
  877empty_directory(Dir) :-
  878    \+ ( directory_files(Dir, Entries),
  879         member(Entry, Entries),
  880         \+ special(Entry)
  881       ).
  882
  883special(.).
  884special(..).
 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.
  894pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
  895    option(git(true), Options),
  896    !,
  897    directory_file_path(PackTopDir, Pack, PackDir),
  898    prepare_pack_dir(PackDir, Options),
  899    run_process(path(git), [clone, URL, PackDir], []),
  900    pack_git_info(PackDir, Hash, Info),
  901    pack_inquiry(URL, git(Hash), Info, Options),
  902    show_info(Pack, Info, Options),
  903    confirm(git_post_install(PackDir, Pack), yes, Options),
  904    pack_post_install(Pack, PackDir, Options).
  905pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
  906    download_scheme(Scheme),
  907    directory_file_path(PackTopDir, Pack, PackDir),
  908    prepare_pack_dir(PackDir, Options),
  909    pack_download_dir(PackTopDir, DownLoadDir),
  910    download_file(URL, Pack, DownloadBase, Options),
  911    directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
  912    setup_call_cleanup(
  913        http_open(URL, In,
  914                  [ cert_verify_hook(ssl_verify)
  915                  ]),
  916        setup_call_cleanup(
  917            open(DownloadFile, write, Out, [type(binary)]),
  918            copy_stream_data(In, Out),
  919            close(Out)),
  920        close(In)),
  921    pack_archive_info(DownloadFile, Pack, Info, _),
  922    download_file_sanity_check(DownloadFile, Pack, Info),
  923    pack_inquiry(URL, DownloadFile, Info, Options),
  924    show_info(Pack, Info, Options),
  925    confirm(install_downloaded(DownloadFile), yes, Options),
  926    pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).
 download_file(+URL, +Pack, -File, +Options) is det
  930download_file(URL, Pack, File, Options) :-
  931    option(version(Version), Options),
  932    !,
  933    atom_version(VersionA, Version),
  934    file_name_extension(_, Ext, URL),
  935    format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
  936download_file(URL, Pack, File, _) :-
  937    file_base_name(URL,Basename),
  938    no_int_file_name_extension(Tag,Ext,Basename),
  939    tag_version(Tag,Version),
  940    !,
  941    atom_version(VersionA,Version),
  942    format(atom(File0), '~w-~w', [Pack, VersionA]),
  943    file_name_extension(File0, Ext, File).
  944download_file(URL, _, File, _) :-
  945    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.
  953pack_url_file(URL, FileID) :-
  954    github_release_url(URL, Pack, Version),
  955    !,
  956    download_file(URL, Pack, FileID, [version(Version)]).
  957pack_url_file(URL, FileID) :-
  958    file_base_name(URL, FileID).
  959
  960
  961:- 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.
  969ssl_verify(_SSL,
  970           _ProblemCertificate, _AllCertificates, _FirstCertificate,
  971           _Error).
  972
  973pack_download_dir(PackTopDir, DownLoadDir) :-
  974    directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
  975    (   exists_directory(DownLoadDir)
  976    ->  true
  977    ;   make_directory(DownLoadDir)
  978    ),
  979    (   access_file(DownLoadDir, write)
  980    ->  true
  981    ;   permission_error(write, directory, DownLoadDir)
  982    ).
 download_url(+URL) is det
True if URL looks like a URL we can download from.
  988download_url(URL) :-
  989    atom(URL),
  990    uri_components(URL, Components),
  991    uri_data(scheme, Components, Scheme),
  992    download_scheme(Scheme).
  993
  994download_scheme(http).
  995download_scheme(https) :-
  996    catch(use_module(library(http/http_ssl_plugin)),
  997          E, (print_message(warning, E), fail)).
 pack_post_install(+Pack, +PackDir, +Options) is det
Process post installation work. Steps:
 1007pack_post_install(Pack, PackDir, Options) :-
 1008    post_install_foreign(Pack, PackDir,
 1009                         [ build_foreign(if_absent)
 1010                         | Options
 1011                         ]),
 1012    post_install_autoload(PackDir, Options),
 1013    '$pack_attach'(PackDir).
 pack_rebuild(+Pack) is det
Rebuilt possible foreign components of Pack.
 1019pack_rebuild(Pack) :-
 1020    '$pack':pack(Pack, BaseDir),
 1021    !,
 1022    catch(pack_make(BaseDir, [distclean], []), E,
 1023          print_message(warning, E)),
 1024    post_install_foreign(Pack, BaseDir, []).
 1025pack_rebuild(Pack) :-
 1026    existence_error(pack, Pack).
 pack_rebuild is det
Rebuild foreign components of all packages.
 1032pack_rebuild :-
 1033    forall(current_pack(Pack),
 1034           ( print_message(informational, pack(rebuild(Pack))),
 1035             pack_rebuild(Pack)
 1036           )).
 post_install_foreign(+Pack, +PackDir, +Options) is det
Install foreign parts of the package.
 1043post_install_foreign(Pack, PackDir, Options) :-
 1044    is_foreign_pack(PackDir),
 1045    !,
 1046    (   option(build_foreign(if_absent), Options),
 1047        foreign_present(PackDir)
 1048    ->  print_message(informational, pack(kept_foreign(Pack)))
 1049    ;   setup_path,
 1050        save_build_environment(PackDir),
 1051        configure_foreign(PackDir, Options),
 1052        make_foreign(PackDir, Options)
 1053    ).
 1054post_install_foreign(_, _, _).
 1055
 1056foreign_present(PackDir) :-
 1057    current_prolog_flag(arch, Arch),
 1058    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
 1059    exists_directory(ForeignBaseDir),
 1060    !,
 1061    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
 1062    exists_directory(ForeignDir),
 1063    current_prolog_flag(shared_object_extension, Ext),
 1064    atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
 1065    expand_file_name(Pattern, Files),
 1066    Files \== [].
 1067
 1068is_foreign_pack(PackDir) :-
 1069    foreign_file(File),
 1070    directory_file_path(PackDir, File, Path),
 1071    exists_file(Path),
 1072    !.
 1073
 1074foreign_file('configure.in').
 1075foreign_file('configure.ac').
 1076foreign_file('configure').
 1077foreign_file('Makefile').
 1078foreign_file('makefile').
 configure_foreign(+PackDir, +Options) is det
Run configure if it exists. If configure.ac or configure.in exists, first run autoheader and autoconf
 1086configure_foreign(PackDir, Options) :-
 1087    make_configure(PackDir, Options),
 1088    directory_file_path(PackDir, configure, Configure),
 1089    exists_file(Configure),
 1090    !,
 1091    build_environment(BuildEnv),
 1092    run_process(path(bash), [Configure],
 1093                [ env(BuildEnv),
 1094                  directory(PackDir)
 1095                ]).
 1096configure_foreign(_, _).
 1097
 1098make_configure(PackDir, _Options) :-
 1099    directory_file_path(PackDir, 'configure', Configure),
 1100    exists_file(Configure),
 1101    !.
 1102make_configure(PackDir, _Options) :-
 1103    autoconf_master(ConfigMaster),
 1104    directory_file_path(PackDir, ConfigMaster, ConfigureIn),
 1105    exists_file(ConfigureIn),
 1106    !,
 1107    run_process(path(autoheader), [], [directory(PackDir)]),
 1108    run_process(path(autoconf),   [], [directory(PackDir)]).
 1109make_configure(_, _).
 1110
 1111autoconf_master('configure.ac').
 1112autoconf_master('configure.in').
 make_foreign(+PackDir, +Options) is det
Generate the foreign executable.
 1119make_foreign(PackDir, Options) :-
 1120    pack_make(PackDir, [all, check, install], Options).
 1121
 1122pack_make(PackDir, Targets, _Options) :-
 1123    directory_file_path(PackDir, 'Makefile', Makefile),
 1124    exists_file(Makefile),
 1125    !,
 1126    build_environment(BuildEnv),
 1127    ProcessOptions = [ directory(PackDir), env(BuildEnv) ],
 1128    forall(member(Target, Targets),
 1129           run_process(path(make), [Target], ProcessOptions)).
 1130pack_make(_, _, _).
 save_build_environment(+PackDir)
Create a shell-script build.env that contains the build environment.
 1137save_build_environment(PackDir) :-
 1138    directory_file_path(PackDir, 'buildenv.sh', EnvFile),
 1139    build_environment(Env),
 1140    setup_call_cleanup(
 1141        open(EnvFile, write, Out),
 1142        write_env_script(Out, Env),
 1143        close(Out)).
 1144
 1145write_env_script(Out, Env) :-
 1146    format(Out,
 1147           '# This file contains the environment that can be used to\n\c
 1148                # build the foreign pack outside Prolog.  This file must\n\c
 1149                # be loaded into a bourne-compatible shell using\n\c
 1150                #\n\c
 1151                #   $ source buildenv.sh\n\n',
 1152           []),
 1153    forall(member(Var=Value, Env),
 1154           format(Out, '~w=\'~w\'\n', [Var, Value])),
 1155    format(Out, '\nexport ', []),
 1156    forall(member(Var=_, Env),
 1157           format(Out, ' ~w', [Var])),
 1158    format(Out, '\n', []).
 1159
 1160build_environment(Env) :-
 1161    findall(Name=Value, environment(Name, Value), UserEnv),
 1162    findall(Name=Value,
 1163            ( def_environment(Name, Value),
 1164              \+ memberchk(Name=_, UserEnv)
 1165            ),
 1166            DefEnv),
 1167    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.
 1194def_environment('PATH', Value) :-
 1195    getenv('PATH', PATH),
 1196    current_prolog_flag(executable, Exe),
 1197    file_directory_name(Exe, ExeDir),
 1198    prolog_to_os_filename(ExeDir, OsExeDir),
 1199    (   current_prolog_flag(windows, true)
 1200    ->  Sep = (;)
 1201    ;   Sep = (:)
 1202    ),
 1203    atomic_list_concat([OsExeDir, Sep, PATH], Value).
 1204def_environment('SWIPL', Value) :-
 1205    current_prolog_flag(executable, Value).
 1206def_environment('SWIPLVERSION', Value) :-
 1207    current_prolog_flag(version, Value).
 1208def_environment('SWIHOME', Value) :-
 1209    current_prolog_flag(home, Value).
 1210def_environment('SWIARCH', Value) :-
 1211    current_prolog_flag(arch, Value).
 1212def_environment('PACKSODIR', Value) :-
 1213    current_prolog_flag(arch, Arch),
 1214    atom_concat('lib/', Arch, Value).
 1215def_environment('SWISOLIB', Value) :-
 1216    current_prolog_flag(c_libplso, Value).
 1217def_environment('SWILIB', '-lswipl').
 1218def_environment('CC', Value) :-
 1219    (   getenv('CC', value)
 1220    ->  true
 1221    ;   current_prolog_flag(c_cc, Value)
 1222    ).
 1223def_environment('LD', Value) :-
 1224    (   getenv('LD', Value)
 1225    ->  true
 1226    ;   current_prolog_flag(c_cc, Value)
 1227    ).
 1228def_environment('CFLAGS', Value) :-
 1229    (   getenv('CFLAGS', SystemFlags)
 1230    ->  Extra = [' ', SystemFlags]
 1231    ;   Extra = []
 1232    ),
 1233    current_prolog_flag(c_cflags, Value0),
 1234    current_prolog_flag(home, Home),
 1235    atomic_list_concat([Value0, ' -I"', Home, '/include"' | Extra], Value).
 1236def_environment('LDSOFLAGS', Value) :-
 1237    (   getenv('LDFLAGS', SystemFlags)
 1238    ->  Extra = [' ', SystemFlags|System]
 1239    ;   Extra = System
 1240    ),
 1241    (   current_prolog_flag(windows, true)
 1242    ->  current_prolog_flag(home, Home),
 1243        atomic_list_concat([' -L"', Home, '/bin"'], SystemLib),
 1244        System = [SystemLib]
 1245    ;   current_prolog_flag(shared_object_extension, so)
 1246    ->  System = []                 % ELF systems do not need this
 1247    ;   current_prolog_flag(home, Home),
 1248        current_prolog_flag(arch, Arch),
 1249        atomic_list_concat([' -L"', Home, '/lib/', Arch, '"'], SystemLib),
 1250        System = [SystemLib]
 1251    ),
 1252    current_prolog_flag(c_ldflags, LDFlags),
 1253    atomic_list_concat([LDFlags, ' -shared' | Extra], Value).
 1254def_environment('SOEXT', Value) :-
 1255    current_prolog_flag(shared_object_extension, Value).
 1256def_environment(Pass, Value) :-
 1257    pass_env(Pass),
 1258    getenv(Pass, Value).
 1259
 1260pass_env('TMP').
 1261pass_env('TEMP').
 1262pass_env('USER').
 1263pass_env('HOME').
 1264
 1265                 /*******************************
 1266                 *             PATHS            *
 1267                 *******************************/
 1268
 1269setup_path :-
 1270    has_program(path(make), _),
 1271    has_program(path(gcc), _),
 1272    !.
 1273setup_path :-
 1274    current_prolog_flag(windows, true),
 1275    !,
 1276    (   mingw_extend_path
 1277    ->  true
 1278    ;   print_message(error, pack(no_mingw))
 1279    ).
 1280setup_path.
 1281
 1282has_program(Program, Path) :-
 1283    exe_options(ExeOptions),
 1284    absolute_file_name(Program, Path,
 1285                       [ file_errors(fail)
 1286                       | ExeOptions
 1287                       ]).
 1288
 1289exe_options(Options) :-
 1290    current_prolog_flag(windows, true),
 1291    !,
 1292    Options = [ extensions(['',exe,com]), access(read) ].
 1293exe_options(Options) :-
 1294    Options = [ access(execute) ].
 1295
 1296mingw_extend_path :-
 1297    mingw_root(MinGW),
 1298    directory_file_path(MinGW, bin, MinGWBinDir),
 1299    atom_concat(MinGW, '/msys/*/bin', Pattern),
 1300    expand_file_name(Pattern, MsysDirs),
 1301    last(MsysDirs, MSysBinDir),
 1302    prolog_to_os_filename(MinGWBinDir, WinDirMinGW),
 1303    prolog_to_os_filename(MSysBinDir, WinDirMSYS),
 1304    getenv('PATH', Path0),
 1305    atomic_list_concat([WinDirMSYS, WinDirMinGW, Path0], ';', Path),
 1306    setenv('PATH', Path).
 1307
 1308mingw_root(MinGwRoot) :-
 1309    current_prolog_flag(executable, Exe),
 1310    sub_atom(Exe, 1, _, _, :),
 1311    sub_atom(Exe, 0, 1, _, PlDrive),
 1312    Drives = [PlDrive,c,d],
 1313    member(Drive, Drives),
 1314    format(atom(MinGwRoot), '~a:/MinGW', [Drive]),
 1315    exists_directory(MinGwRoot),
 1316    !.
 1317
 1318
 1319                 /*******************************
 1320                 *           AUTOLOAD           *
 1321                 *******************************/
 post_install_autoload(+PackDir, +Options)
Create an autoload index if the package demands such.
 1327post_install_autoload(PackDir, Options) :-
 1328    option(autoload(true), Options, true),
 1329    pack_info_term(PackDir, autoload(true)),
 1330    !,
 1331    directory_file_path(PackDir, prolog, PrologLibDir),
 1332    make_library_index(PrologLibDir).
 1333post_install_autoload(_, _).
 1334
 1335
 1336                 /*******************************
 1337                 *            UPGRADE           *
 1338                 *******************************/
 pack_upgrade(+Pack) is semidet
Try to upgrade the package Pack.
To be done
- Update dependencies when updating a pack from git?
 1346pack_upgrade(Pack) :-
 1347    pack_info(Pack, _, directory(Dir)),
 1348    directory_file_path(Dir, '.git', GitDir),
 1349    exists_directory(GitDir),
 1350    !,
 1351    print_message(informational, pack(git_fetch(Dir))),
 1352    git([fetch], [ directory(Dir) ]),
 1353    git_describe(V0, [ directory(Dir) ]),
 1354    git_describe(V1, [ directory(Dir), commit('origin/master') ]),
 1355    (   V0 == V1
 1356    ->  print_message(informational, pack(up_to_date(Pack)))
 1357    ;   confirm(upgrade(Pack, V0, V1), yes, []),
 1358        git([merge, 'origin/master'], [ directory(Dir) ]),
 1359        pack_rebuild(Pack)
 1360    ).
 1361pack_upgrade(Pack) :-
 1362    once(pack_info(Pack, _, version(VersionAtom))),
 1363    atom_version(VersionAtom, Version),
 1364    pack_info(Pack, _, download(URL)),
 1365    (   wildcard_pattern(URL)
 1366    ->  true
 1367    ;   github_url(URL, _User, _Repo)
 1368    ),
 1369    !,
 1370    available_download_versions(URL, [Latest-LatestURL|_Versions]),
 1371    (   Latest @> Version
 1372    ->  confirm(upgrade(Pack, Version, Latest), yes, []),
 1373        pack_install(Pack,
 1374                     [ url(LatestURL),
 1375                       upgrade(true),
 1376                       pack(Pack)
 1377                     ])
 1378    ;   print_message(informational, pack(up_to_date(Pack)))
 1379    ).
 1380pack_upgrade(Pack) :-
 1381    print_message(warning, pack(no_upgrade_info(Pack))).
 1382
 1383
 1384                 /*******************************
 1385                 *            REMOVE            *
 1386                 *******************************/
 pack_remove(+Name) is det
Remove the indicated package.
 1392pack_remove(Pack) :-
 1393    update_dependency_db,
 1394    (   setof(Dep, pack_depends_on(Dep, Pack), Deps)
 1395    ->  confirm_remove(Pack, Deps, Delete),
 1396        forall(member(P, Delete), pack_remove_forced(P))
 1397    ;   pack_remove_forced(Pack)
 1398    ).
 1399
 1400pack_remove_forced(Pack) :-
 1401    '$pack_detach'(Pack, BaseDir),
 1402    print_message(informational, pack(remove(BaseDir))),
 1403    delete_directory_and_contents(BaseDir).
 1404
 1405confirm_remove(Pack, Deps, Delete) :-
 1406    print_message(warning, pack(depends(Pack, Deps))),
 1407    menu(pack(resolve_remove),
 1408         [ [Pack]      = remove_only(Pack),
 1409           [Pack|Deps] = remove_deps(Pack, Deps),
 1410           []          = cancel
 1411         ], [], Delete, []),
 1412    Delete \== [].
 1413
 1414
 1415                 /*******************************
 1416                 *           PROPERTIES         *
 1417                 *******************************/
 pack_property(?Pack, ?Property) is nondet
True when Property is a property of 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)
 1440pack_property(Pack, Property) :-
 1441    findall(Pack-Property, pack_property_(Pack, Property), List),
 1442    member(Pack-Property, List).            % make det if applicable
 1443
 1444pack_property_(Pack, Property) :-
 1445    pack_info(Pack, _, Property).
 1446pack_property_(Pack, Property) :-
 1447    \+ \+ info_file(Property, _),
 1448    '$pack':pack(Pack, BaseDir),
 1449    access_file(BaseDir, read),
 1450    directory_files(BaseDir, Files),
 1451    member(File, Files),
 1452    info_file(Property, Pattern),
 1453    downcase_atom(File, Pattern),
 1454    directory_file_path(BaseDir, File, InfoFile),
 1455    arg(1, Property, InfoFile).
 1456
 1457info_file(readme(_), 'readme.txt').
 1458info_file(readme(_), 'readme').
 1459info_file(todo(_),   'todo.txt').
 1460info_file(todo(_),   'todo').
 1461
 1462
 1463                 /*******************************
 1464                 *             GIT              *
 1465                 *******************************/
 git_url(+URL, -Pack) is semidet
True if URL describes a git url for Pack
 1471git_url(URL, Pack) :-
 1472    uri_components(URL, Components),
 1473    uri_data(scheme, Components, Scheme),
 1474    uri_data(path, Components, Path),
 1475    (   Scheme == git
 1476    ->  true
 1477    ;   git_download_scheme(Scheme),
 1478        file_name_extension(_, git, Path)
 1479    ),
 1480    file_base_name(Path, PackExt),
 1481    (   file_name_extension(Pack, git, PackExt)
 1482    ->  true
 1483    ;   Pack = PackExt
 1484    ),
 1485    (   safe_pack_name(Pack)
 1486    ->  true
 1487    ;   domain_error(pack_name, Pack)
 1488    ).
 1489
 1490git_download_scheme(http).
 1491git_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.
 1498safe_pack_name(Name) :-
 1499    atom_length(Name, Len),
 1500    Len >= 3,                               % demand at least three length
 1501    atom_codes(Name, Codes),
 1502    maplist(safe_pack_char, Codes),
 1503    !.
 1504
 1505safe_pack_char(C) :- between(0'a, 0'z, C), !.
 1506safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 1507safe_pack_char(C) :- between(0'0, 0'9, C), !.
 1508safe_pack_char(0'_).
 1509
 1510
 1511                 /*******************************
 1512                 *         VERSION LOGIC        *
 1513                 *******************************/
 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.
 1522pack_version_file(Pack, Version, GitHubRelease) :-
 1523    atomic(GitHubRelease),
 1524    github_release_url(GitHubRelease, Pack, Version),
 1525    !.
 1526pack_version_file(Pack, Version, Path) :-
 1527    atomic(Path),
 1528    file_base_name(Path, File),
 1529    no_int_file_name_extension(Base, _Ext, File),
 1530    atom_codes(Base, Codes),
 1531    (   phrase(pack_version(Pack, Version), Codes),
 1532        safe_pack_name(Pack)
 1533    ->  true
 1534    ).
 1535
 1536no_int_file_name_extension(Base, Ext, File) :-
 1537    file_name_extension(Base0, Ext0, File),
 1538    \+ atom_number(Ext0, _),
 1539    !,
 1540    Base = Base0,
 1541    Ext = Ext0.
 1542no_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'
 1555github_release_url(URL, Pack, Version) :-
 1556    uri_components(URL, Components),
 1557    uri_data(authority, Components, 'github.com'),
 1558    uri_data(scheme, Components, Scheme),
 1559    download_scheme(Scheme),
 1560    uri_data(path, Components, Path),
 1561    atomic_list_concat(['',_Project,Pack,archive,File], /, Path),
 1562    file_name_extension(Tag, Ext, File),
 1563    github_archive_extension(Ext),
 1564    tag_version(Tag, Version),
 1565    !.
 1566
 1567github_archive_extension(tgz).
 1568github_archive_extension(zip).
 1569
 1570tag_version(Tag, Version) :-
 1571    version_tag_prefix(Prefix),
 1572    atom_concat(Prefix, AtomVersion, Tag),
 1573    atom_version(AtomVersion, Version).
 1574
 1575version_tag_prefix(v).
 1576version_tag_prefix('V').
 1577version_tag_prefix('').
 1578
 1579
 1580:- public
 1581    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 @>
 1589atom_version(Atom, version(Parts)) :-
 1590    (   atom(Atom)
 1591    ->  atom_codes(Atom, Codes),
 1592        phrase(version(Parts), Codes)
 1593    ;   atomic_list_concat(Parts, '.', Atom)
 1594    ).
 1595
 1596pack_version(Pack, version(Parts)) -->
 1597    string(Codes), "-",
 1598    version(Parts),
 1599    !,
 1600    { atom_codes(Pack, Codes)
 1601    }.
 1602
 1603version([_|T]) -->
 1604    "*",
 1605    !,
 1606    (   "."
 1607    ->  version(T)
 1608    ;   []
 1609    ).
 1610version([H|T]) -->
 1611    integer(H),
 1612    (   "."
 1613    ->  version(T)
 1614    ;   { T = [] }
 1615    ).
 1616
 1617integer(H)    --> digit(D0), digits(L), { number_codes(H, [D0|L]) }.
 1618digit(D)      --> [D], { code_type(D, digit) }.
 1619digits([H|T]) --> digit(H), !, digits(T).
 1620digits([])    --> [].
 1621
 1622
 1623                 /*******************************
 1624                 *       QUERY CENTRAL DB       *
 1625                 *******************************/
 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 is downloads (which may be 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.
 1645pack_inquiry(_, _, _, Options) :-
 1646    option(inquiry(false), Options),
 1647    !.
 1648pack_inquiry(URL, DownloadFile, Info, Options) :-
 1649    setting(server, ServerBase),
 1650    ServerBase \== '',
 1651    atom_concat(ServerBase, query, Server),
 1652    (   option(inquiry(true), Options)
 1653    ->  true
 1654    ;   confirm(inquiry(Server), yes, Options)
 1655    ),
 1656    !,
 1657    (   DownloadFile = git(SHA1)
 1658    ->  true
 1659    ;   file_sha1(DownloadFile, SHA1)
 1660    ),
 1661    query_pack_server(install(URL, SHA1, Info), Reply, Options),
 1662    inquiry_result(Reply, URL, Options).
 1663pack_inquiry(_, _, _, _).
 query_pack_server(+Query, -Result, +Options)
Send a Prolog query to the package server and process its results.
 1671query_pack_server(Query, Result, Options) :-
 1672    setting(server, ServerBase),
 1673    ServerBase \== '',
 1674    atom_concat(ServerBase, query, Server),
 1675    format(codes(Data), '~q.~n', Query),
 1676    info_level(Informational, Options),
 1677    print_message(Informational, pack(contacting_server(Server))),
 1678    setup_call_cleanup(
 1679        http_open(Server, In,
 1680                  [ post(codes(application/'x-prolog', Data)),
 1681                    header(content_type, ContentType)
 1682                  ]),
 1683        read_reply(ContentType, In, Result),
 1684        close(In)),
 1685    message_severity(Result, Level, Informational),
 1686    print_message(Level, pack(server_reply(Result))).
 1687
 1688read_reply(ContentType, In, Result) :-
 1689    sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
 1690    !,
 1691    set_stream(In, encoding(utf8)),
 1692    read(In, Result).
 1693read_reply(ContentType, In, _Result) :-
 1694    read_string(In, 500, String),
 1695    print_message(error, pack(no_prolog_response(ContentType, String))),
 1696    fail.
 1697
 1698info_level(Level, Options) :-
 1699    option(silent(true), Options),
 1700    !,
 1701    Level = silent.
 1702info_level(informational, _).
 1703
 1704message_severity(true(_), Informational, Informational).
 1705message_severity(false, warning, _).
 1706message_severity(exception(_), error, _).
 inquiry_result(+Reply, +File, +Options) is semidet
Analyse the results of the inquiry and decide whether to continue or not.
 1714inquiry_result(Reply, File, Options) :-
 1715    findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation),
 1716    \+ member(cancel, Evaluation),
 1717    select_option(git(_), Options, Options1, _),
 1718    forall(member(install_dependencies(Resolution), Evaluation),
 1719           maplist(install_dependency(Options1), Resolution)).
 1720
 1721eval_inquiry(true(Reply), URL, Eval, _) :-
 1722    include(alt_hash, Reply, Alts),
 1723    Alts \== [],
 1724    print_message(warning, pack(alt_hashes(URL, Alts))),
 1725    (   memberchk(downloads(Count), Reply),
 1726        (   git_url(URL, _)
 1727        ->  Default = yes,
 1728            Eval = with_git_commits_in_same_version
 1729        ;   Default = no,
 1730            Eval = with_alt_hashes
 1731        ),
 1732        confirm(continue_with_alt_hashes(Count, URL), Default, [])
 1733    ->  true
 1734    ;   !,                          % Stop other rules
 1735        Eval = cancel
 1736    ).
 1737eval_inquiry(true(Reply), _, Eval, Options) :-
 1738    include(dependency, Reply, Deps),
 1739    Deps \== [],
 1740    select_dependency_resolution(Deps, Eval, Options),
 1741    (   Eval == cancel
 1742    ->  !
 1743    ;   true
 1744    ).
 1745eval_inquiry(true(Reply), URL, true, Options) :-
 1746    file_base_name(URL, File),
 1747    info_level(Informational, Options),
 1748    print_message(Informational, pack(inquiry_ok(Reply, File))).
 1749eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))),
 1750             URL, Eval, Options) :-
 1751    (   confirm(continue_with_modified_hash(URL), no, Options)
 1752    ->  Eval = true
 1753    ;   Eval = cancel
 1754    ).
 1755
 1756alt_hash(alt_hash(_,_,_)).
 1757dependency(dependency(_,_,_,_,_)).
 select_dependency_resolution(+Deps, -Eval, +Options)
Select a resolution.
To be done
- Exploit backtracking over resolve_dependencies/2.
 1766select_dependency_resolution(Deps, Eval, Options) :-
 1767    resolve_dependencies(Deps, Resolution),
 1768    exclude(local_dep, Resolution, ToBeDone),
 1769    (   ToBeDone == []
 1770    ->  !, Eval = true
 1771    ;   print_message(warning, pack(install_dependencies(Resolution))),
 1772        (   memberchk(_-unresolved, Resolution)
 1773        ->  Default = cancel
 1774        ;   Default = install_deps
 1775        ),
 1776        menu(pack(resolve_deps),
 1777             [ install_deps    = install_deps,
 1778               install_no_deps = install_no_deps,
 1779               cancel          = cancel
 1780             ], Default, Choice, Options),
 1781        (   Choice == cancel
 1782        ->  !, Eval = cancel
 1783        ;   Choice == install_no_deps
 1784        ->  !, Eval = install_no_deps
 1785        ;   !, Eval = install_dependencies(Resolution)
 1786        )
 1787    ).
 1788
 1789local_dep(_-resolved(_)).
 install_dependency(+Options, +TokenResolution)
Install dependencies for the given resolution.
To be done
- : Query URI to use
 1798install_dependency(Options,
 1799                   _Token-resolve(Pack, VersionAtom, [_URL|_], SubResolve)) :-
 1800    atom_version(VersionAtom, Version),
 1801    current_pack(Pack),
 1802    pack_info(Pack, _, version(InstalledAtom)),
 1803    atom_version(InstalledAtom, Installed),
 1804    Installed == Version,               % already installed
 1805    !,
 1806    maplist(install_dependency(Options), SubResolve).
 1807install_dependency(Options,
 1808                   _Token-resolve(Pack, VersionAtom, [URL|_], SubResolve)) :-
 1809    !,
 1810    atom_version(VersionAtom, Version),
 1811    merge_options([ url(URL),
 1812                    version(Version),
 1813                    interactive(false),
 1814                    inquiry(false),
 1815                    info(list),
 1816                    pack(Pack)
 1817                  ], Options, InstallOptions),
 1818    pack_install(Pack, InstallOptions),
 1819    maplist(install_dependency(Options), SubResolve).
 1820install_dependency(_, _-_).
 1821
 1822
 1823                 /*******************************
 1824                 *        WILDCARD URIs         *
 1825                 *******************************/
 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
 1834available_download_versions(URL, Versions) :-
 1835    wildcard_pattern(URL),
 1836    github_url(URL, User, Repo),
 1837    !,
 1838    findall(Version-VersionURL,
 1839            github_version(User, Repo, Version, VersionURL),
 1840            Versions).
 1841available_download_versions(URL, Versions) :-
 1842    wildcard_pattern(URL),
 1843    !,
 1844    file_directory_name(URL, DirURL0),
 1845    ensure_slash(DirURL0, DirURL),
 1846    print_message(informational, pack(query_versions(DirURL))),
 1847    setup_call_cleanup(
 1848        http_open(DirURL, In, []),
 1849        load_html(stream(In), DOM,
 1850                  [ syntax_errors(quiet)
 1851                  ]),
 1852        close(In)),
 1853    findall(MatchingURL,
 1854            absolute_matching_href(DOM, URL, MatchingURL),
 1855            MatchingURLs),
 1856    (   MatchingURLs == []
 1857    ->  print_message(warning, pack(no_matching_urls(URL)))
 1858    ;   true
 1859    ),
 1860    versioned_urls(MatchingURLs, VersionedURLs),
 1861    keysort(VersionedURLs, SortedVersions),
 1862    reverse(SortedVersions, Versions),
 1863    print_message(informational, pack(found_versions(Versions))).
 1864available_download_versions(URL, [Version-URL]) :-
 1865    (   pack_version_file(_Pack, Version0, URL)
 1866    ->  Version = Version0
 1867    ;   Version = unknown
 1868    ).
 github_url(+URL, -User, -Repo) is semidet
True when URL refers to a github repository.
 1874github_url(URL, User, Repo) :-
 1875    uri_components(URL, uri_components(https,'github.com',Path,_,_)),
 1876    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.
 1884github_version(User, Repo, Version, VersionURI) :-
 1885    atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
 1886    uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
 1887    setup_call_cleanup(
 1888      http_open(ApiUri, In,
 1889                [ request_header('Accept'='application/vnd.github.v3+json')
 1890                ]),
 1891      json_read_dict(In, Dicts),
 1892      close(In)),
 1893    member(Dict, Dicts),
 1894    atom_string(Tag, Dict.name),
 1895    tag_version(Tag, Version),
 1896    atom_string(VersionURI, Dict.zipball_url).
 1897
 1898wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
 1899wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
 1900
 1901ensure_slash(Dir, DirS) :-
 1902    (   sub_atom(Dir, _, _, 0, /)
 1903    ->  DirS = Dir
 1904    ;   atom_concat(Dir, /, DirS)
 1905    ).
 1906
 1907absolute_matching_href(DOM, Pattern, Match) :-
 1908    xpath(DOM, //a(@href), HREF),
 1909    uri_normalized(HREF, Pattern, Match),
 1910    wildcard_match(Pattern, Match).
 1911
 1912versioned_urls([], []).
 1913versioned_urls([H|T0], List) :-
 1914    file_base_name(H, File),
 1915    (   pack_version_file(_Pack, Version, File)
 1916    ->  List = [Version-H|T]
 1917    ;   List = T
 1918    ),
 1919    versioned_urls(T0, T).
 1920
 1921
 1922                 /*******************************
 1923                 *          DEPENDENCIES        *
 1924                 *******************************/
 update_dependency_db
Reload dependency declarations between packages.
 1930update_dependency_db :-
 1931    retractall(pack_requires(_,_)),
 1932    retractall(pack_provides_db(_,_)),
 1933    forall(current_pack(Pack),
 1934           (   findall(Info, pack_info(Pack, dependency, Info), Infos),
 1935               update_dependency_db(Pack, Infos)
 1936           )).
 1937
 1938update_dependency_db(Name, Info) :-
 1939    retractall(pack_requires(Name, _)),
 1940    retractall(pack_provides_db(Name, _)),
 1941    maplist(assert_dep(Name), Info).
 1942
 1943assert_dep(Pack, provides(Token)) :-
 1944    !,
 1945    assertz(pack_provides_db(Pack, Token)).
 1946assert_dep(Pack, requires(Token)) :-
 1947    !,
 1948    assertz(pack_requires(Pack, Token)).
 1949assert_dep(_, _).
 validate_dependencies is det
Validate all dependencies, reporting on failures
 1955validate_dependencies :-
 1956    unsatisfied_dependencies(Unsatisfied),
 1957    !,
 1958    print_message(warning, pack(unsatisfied(Unsatisfied))).
 1959validate_dependencies.
 1960
 1961
 1962unsatisfied_dependencies(Unsatisfied) :-
 1963    findall(Req-Pack, pack_requires(Pack, Req), Reqs0),
 1964    keysort(Reqs0, Reqs1),
 1965    group_pairs_by_key(Reqs1, GroupedReqs),
 1966    exclude(satisfied_dependency, GroupedReqs, Unsatisfied),
 1967    Unsatisfied \== [].
 1968
 1969satisfied_dependency(Needed-_By) :-
 1970    pack_provides(_, Needed),
 1971    !.
 1972satisfied_dependency(Needed-_By) :-
 1973    compound(Needed),
 1974    Needed =.. [Op, Pack, ReqVersion],
 1975    (   pack_provides(Pack, Pack)
 1976    ->  pack_info(Pack, _, version(PackVersion)),
 1977        version_data(PackVersion, PackData)
 1978    ;   Pack == prolog
 1979    ->  current_prolog_flag(version_data, swi(Major,Minor,Patch,_)),
 1980        PackData = [Major,Minor,Patch]
 1981    ),
 1982    version_data(ReqVersion, ReqData),
 1983    cmp(Op, Cmp),
 1984    call(Cmp, PackData, ReqData).
 pack_provides(?Package, ?Token) is multi
True if Pack provides Token. A package always provides itself.
 1990pack_provides(Pack, Pack) :-
 1991    current_pack(Pack).
 1992pack_provides(Pack, Token) :-
 1993    pack_provides_db(Pack, Token).
 pack_depends_on(?Pack, ?Dependency) is nondet
True if Pack requires Dependency, direct or indirect.
 1999pack_depends_on(Pack, Dependency) :-
 2000    (   atom(Pack)
 2001    ->  pack_depends_on_fwd(Pack, Dependency, [Pack])
 2002    ;   pack_depends_on_bwd(Pack, Dependency, [Dependency])
 2003    ).
 2004
 2005pack_depends_on_fwd(Pack, Dependency, Visited) :-
 2006    pack_depends_on_1(Pack, Dep1),
 2007    \+ memberchk(Dep1, Visited),
 2008    (   Dependency = Dep1
 2009    ;   pack_depends_on_fwd(Dep1, Dependency, [Dep1|Visited])
 2010    ).
 2011
 2012pack_depends_on_bwd(Pack, Dependency, Visited) :-
 2013    pack_depends_on_1(Dep1, Dependency),
 2014    \+ memberchk(Dep1, Visited),
 2015    (   Pack = Dep1
 2016    ;   pack_depends_on_bwd(Pack, Dep1, [Dep1|Visited])
 2017    ).
 2018
 2019pack_depends_on_1(Pack, Dependency) :-
 2020    atom(Dependency),
 2021    !,
 2022    pack_provides(Dependency, Token),
 2023    pack_requires(Pack, Token).
 2024pack_depends_on_1(Pack, Dependency) :-
 2025    pack_requires(Pack, Token),
 2026    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
 2043resolve_dependencies(Dependencies, Resolution) :-
 2044    maplist(dependency_pair, Dependencies, Pairs0),
 2045    keysort(Pairs0, Pairs1),
 2046    group_pairs_by_key(Pairs1, ByToken),
 2047    maplist(resolve_dep, ByToken, Resolution).
 2048
 2049dependency_pair(dependency(Token, Pack, Version, URLs, SubDeps),
 2050                Token-(Pack-pack(Version,URLs, SubDeps))).
 2051
 2052resolve_dep(Token-Pairs, Token-Resolution) :-
 2053    (   resolve_dep2(Token-Pairs, Resolution)
 2054    *-> true
 2055    ;   Resolution = unresolved
 2056    ).
 2057
 2058resolve_dep2(Token-_, resolved(Pack)) :-
 2059    pack_provides(Pack, Token).
 2060resolve_dep2(_-Pairs, resolve(Pack, VersionAtom, URLs, SubResolves)) :-
 2061    keysort(Pairs, Sorted),
 2062    group_pairs_by_key(Sorted, ByPack),
 2063    member(Pack-Versions, ByPack),
 2064    Pack \== (-),
 2065    maplist(version_pack, Versions, VersionData),
 2066    sort(VersionData, ByVersion),
 2067    reverse(ByVersion, ByVersionLatest),
 2068    member(pack(Version,URLs,SubDeps), ByVersionLatest),
 2069    atom_version(VersionAtom, Version),
 2070    include(dependency, SubDeps, Deps),
 2071    resolve_dependencies(Deps, SubResolves).
 2072
 2073version_pack(pack(VersionAtom,URLs,SubDeps),
 2074             pack(Version,URLs,SubDeps)) :-
 2075    atom_version(VersionAtom, Version).
 2076
 2077
 2078                 /*******************************
 2079                 *          RUN PROCESSES       *
 2080                 *******************************/
 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.
 2097run_process(Executable, Argv, Options) :-
 2098    \+ option(output(_), Options),
 2099    \+ option(error(_), Options),
 2100    current_prolog_flag(unix, true),
 2101    current_prolog_flag(threads, true),
 2102    !,
 2103    process_create_options(Options, Extra),
 2104    process_create(Executable, Argv,
 2105                   [ stdout(pipe(Out)),
 2106                     stderr(pipe(Error)),
 2107                     process(PID)
 2108                   | Extra
 2109                   ]),
 2110    thread_create(relay_output([output-Out, error-Error]), Id, []),
 2111    process_wait(PID, Status),
 2112    thread_join(Id, _),
 2113    (   Status == exit(0)
 2114    ->  true
 2115    ;   throw(error(process_error(process(Executable, Argv), Status), _))
 2116    ).
 2117run_process(Executable, Argv, Options) :-
 2118    process_create_options(Options, Extra),
 2119    setup_call_cleanup(
 2120        process_create(Executable, Argv,
 2121                       [ stdout(pipe(Out)),
 2122                         stderr(pipe(Error)),
 2123                         process(PID)
 2124                       | Extra
 2125                       ]),
 2126        (   read_stream_to_codes(Out, OutCodes, []),
 2127            read_stream_to_codes(Error, ErrorCodes, []),
 2128            process_wait(PID, Status)
 2129        ),
 2130        (   close(Out),
 2131            close(Error)
 2132        )),
 2133    print_error(ErrorCodes, Options),
 2134    print_output(OutCodes, Options),
 2135    (   Status == exit(0)
 2136    ->  true
 2137    ;   throw(error(process_error(process(Executable, Argv), Status), _))
 2138    ).
 2139
 2140process_create_options(Options, Extra) :-
 2141    option(directory(Dir), Options, .),
 2142    (   option(env(Env), Options)
 2143    ->  Extra = [cwd(Dir), env(Env)]
 2144    ;   Extra = [cwd(Dir)]
 2145    ).
 2146
 2147relay_output([]) :- !.
 2148relay_output(Output) :-
 2149    pairs_values(Output, Streams),
 2150    wait_for_input(Streams, Ready, infinite),
 2151    relay(Ready, Output, NewOutputs),
 2152    relay_output(NewOutputs).
 2153
 2154relay([], Outputs, Outputs).
 2155relay([H|T], Outputs0, Outputs) :-
 2156    selectchk(Type-H, Outputs0, Outputs1),
 2157    (   at_end_of_stream(H)
 2158    ->  close(H),
 2159        relay(T, Outputs1, Outputs)
 2160    ;   read_pending_codes(H, Codes, []),
 2161        relay(Type, Codes),
 2162        relay(T, Outputs0, Outputs)
 2163    ).
 2164
 2165relay(error,  Codes) :-
 2166    set_prolog_flag(thread_message_prefix, false),
 2167    print_error(Codes, []).
 2168relay(output, Codes) :-
 2169    print_output(Codes, []).
 2170
 2171print_output(OutCodes, Options) :-
 2172    option(output(Codes), Options),
 2173    !,
 2174    Codes = OutCodes.
 2175print_output(OutCodes, _) :-
 2176    print_message(informational, pack(process_output(OutCodes))).
 2177
 2178print_error(OutCodes, Options) :-
 2179    option(error(Codes), Options),
 2180    !,
 2181    Codes = OutCodes.
 2182print_error(OutCodes, _) :-
 2183    phrase(classify_message(Level), OutCodes, _),
 2184    print_message(Level, pack(process_output(OutCodes))).
 2185
 2186classify_message(error) -->
 2187    string(_), "fatal:",
 2188    !.
 2189classify_message(error) -->
 2190    string(_), "error:",
 2191    !.
 2192classify_message(warning) -->
 2193    string(_), "warning:",
 2194    !.
 2195classify_message(informational) -->
 2196    [].
 2197
 2198string([]) --> [].
 2199string([H|T]) --> [H], string(T).
 2200
 2201
 2202                 /*******************************
 2203                 *        USER INTERACTION      *
 2204                 *******************************/
 2205
 2206:- multifile prolog:message//1.
 menu(Question, +Alternatives, +Default, -Selection, +Options)
 2210menu(_Question, _Alternatives, Default, Selection, Options) :-
 2211    option(interactive(false), Options),
 2212    !,
 2213    Selection = Default.
 2214menu(Question, Alternatives, Default, Selection, _) :-
 2215    length(Alternatives, N),
 2216    between(1, 5, _),
 2217       print_message(query, Question),
 2218       print_menu(Alternatives, Default, 1),
 2219       print_message(query, pack(menu(select))),
 2220       read_selection(N, Choice),
 2221    !,
 2222    (   Choice == default
 2223    ->  Selection = Default
 2224    ;   nth1(Choice, Alternatives, Selection=_)
 2225    ->  true
 2226    ).
 2227
 2228print_menu([], _, _).
 2229print_menu([Value=Label|T], Default, I) :-
 2230    (   Value == Default
 2231    ->  print_message(query, pack(menu(default_item(I, Label))))
 2232    ;   print_message(query, pack(menu(item(I, Label))))
 2233    ),
 2234    I2 is I + 1,
 2235    print_menu(T, Default, I2).
 2236
 2237read_selection(Max, Choice) :-
 2238    get_single_char(Code),
 2239    (   answered_default(Code)
 2240    ->  Choice = default
 2241    ;   code_type(Code, digit(Choice)),
 2242        between(1, Max, Choice)
 2243    ->  true
 2244    ;   print_message(warning, pack(menu(reply(1,Max)))),
 2245        fail
 2246    ).
 confirm(+Question, +Default, +Options) is semidet
Ask for confirmation.
Arguments:
Default- is one of yes, no or none.
 2254confirm(_Question, Default, Options) :-
 2255    Default \== none,
 2256    option(interactive(false), Options, true),
 2257    !,
 2258    Default == yes.
 2259confirm(Question, Default, _) :-
 2260    between(1, 5, _),
 2261       print_message(query, pack(confirm(Question, Default))),
 2262       read_yes_no(YesNo, Default),
 2263    !,
 2264    format(user_error, '~N', []),
 2265    YesNo == yes.
 2266
 2267read_yes_no(YesNo, Default) :-
 2268    get_single_char(Code),
 2269    code_yes_no(Code, Default, YesNo),
 2270    !.
 2271
 2272code_yes_no(0'y, _, yes).
 2273code_yes_no(0'Y, _, yes).
 2274code_yes_no(0'n, _, no).
 2275code_yes_no(0'N, _, no).
 2276code_yes_no(_, none, _) :- !, fail.
 2277code_yes_no(C, Default, Default) :-
 2278    answered_default(C).
 2279
 2280answered_default(0'\r).
 2281answered_default(0'\n).
 2282answered_default(0'\s).
 2283
 2284
 2285                 /*******************************
 2286                 *            MESSAGES          *
 2287                 *******************************/
 2288
 2289:- multifile prolog:message//1. 2290
 2291prolog:message(pack(Message)) -->
 2292    message(Message).
 2293
 2294:- discontiguous
 2295    message//1,
 2296    label//1. 2297
 2298message(invalid_info(Term)) -->
 2299    [ 'Invalid package description: ~q'-[Term] ].
 2300message(directory_exists(Dir)) -->
 2301    [ 'Package target directory exists and is not empty:', nl,
 2302      '\t~q'-[Dir]
 2303    ].
 2304message(already_installed(pack(Pack, Version))) -->
 2305    { atom_version(AVersion, Version) },
 2306    [ 'Pack `~w'' is already installed @~w'-[Pack, AVersion] ].
 2307message(already_installed(Pack)) -->
 2308    [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
 2309message(invalid_name(File)) -->
 2310    [ '~w: A package archive must be named <pack>-<version>.<ext>'-[File] ],
 2311    no_tar_gz(File).
 2312
 2313no_tar_gz(File) -->
 2314    { sub_atom(File, _, _, 0, '.tar.gz') },
 2315    !,
 2316    [ nl,
 2317      'Package archive files must have a single extension.  E.g., \'.tgz\''-[]
 2318    ].
 2319no_tar_gz(_) --> [].
 2320
 2321message(kept_foreign(Pack)) -->
 2322    [ 'Found foreign libraries for target platform.'-[], nl,
 2323      'Use ?- pack_rebuild(~q). to rebuild from sources'-[Pack]
 2324    ].
 2325message(no_pack_installed(Pack)) -->
 2326    [ 'No pack ~q installed.  Use ?- pack_list(Pattern) to search'-[Pack] ].
 2327message(no_packages_installed) -->
 2328    { setting(server, ServerBase) },
 2329    [ 'There are no extra packages installed.', nl,
 2330      'Please visit ~wlist.'-[ServerBase]
 2331    ].
 2332message(remove_with(Pack)) -->
 2333    [ 'The package can be removed using: ?- ~q.'-[pack_remove(Pack)]
 2334    ].
 2335message(unsatisfied(Packs)) -->
 2336    [ 'The following dependencies are not satisfied:', nl ],
 2337    unsatisfied(Packs).
 2338message(depends(Pack, Deps)) -->
 2339    [ 'The following packages depend on `~w\':'-[Pack], nl ],
 2340    pack_list(Deps).
 2341message(remove(PackDir)) -->
 2342    [ 'Removing ~q and contents'-[PackDir] ].
 2343message(remove_existing_pack(PackDir)) -->
 2344    [ 'Remove old installation in ~q'-[PackDir] ].
 2345message(install_from(Pack, Version, git(URL))) -->
 2346    [ 'Install ~w@~w from GIT at ~w'-[Pack, Version, URL] ].
 2347message(install_from(Pack, Version, URL)) -->
 2348    [ 'Install ~w@~w from ~w'-[Pack, Version, URL] ].
 2349message(select_install_from(Pack, Version)) -->
 2350    [ 'Select download location for ~w@~w'-[Pack, Version] ].
 2351message(install_downloaded(File)) -->
 2352    { file_base_name(File, Base),
 2353      size_file(File, Size) },
 2354    [ 'Install "~w" (~D bytes)'-[Base, Size] ].
 2355message(git_post_install(PackDir, Pack)) -->
 2356    (   { is_foreign_pack(PackDir) }
 2357    ->  [ 'Run post installation scripts for pack "~w"'-[Pack] ]
 2358    ;   [ 'Activate pack "~w"'-[Pack] ]
 2359    ).
 2360message(no_meta_data(BaseDir)) -->
 2361    [ 'Cannot find pack.pl inside directory ~q.  Not a package?'-[BaseDir] ].
 2362message(inquiry(Server)) -->
 2363    [ 'Verify package status (anonymously)', nl,
 2364      '\tat "~w"'-[Server]
 2365    ].
 2366message(search_no_matches(Name)) -->
 2367    [ 'Search for "~w", returned no matching packages'-[Name] ].
 2368message(rebuild(Pack)) -->
 2369    [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
 2370message(upgrade(Pack, From, To)) -->
 2371    [ 'Upgrade "~w" from '-[Pack] ],
 2372    msg_version(From), [' to '-[]], msg_version(To).
 2373message(up_to_date(Pack)) -->
 2374    [ 'Package "~w" is up-to-date'-[Pack] ].
 2375message(query_versions(URL)) -->
 2376    [ 'Querying "~w" to find new versions ...'-[URL] ].
 2377message(no_matching_urls(URL)) -->
 2378    [ 'Could not find any matching URL: ~q'-[URL] ].
 2379message(found_versions([Latest-_URL|More])) -->
 2380    { length(More, Len),
 2381      atom_version(VLatest, Latest)
 2382    },
 2383    [ '    Latest version: ~w (~D older)'-[VLatest, Len] ].
 2384message(process_output(Codes)) -->
 2385    { split_lines(Codes, Lines) },
 2386    process_lines(Lines).
 2387message(contacting_server(Server)) -->
 2388    [ 'Contacting server at ~w ...'-[Server], flush ].
 2389message(server_reply(true(_))) -->
 2390    [ at_same_line, ' ok'-[] ].
 2391message(server_reply(false)) -->
 2392    [ at_same_line, ' done'-[] ].
 2393message(server_reply(exception(E))) -->
 2394    [ 'Server reported the following error:'-[], nl ],
 2395    '$messages':translate_message(E).
 2396message(cannot_create_dir(Alias)) -->
 2397    { setof(PackDir,
 2398            absolute_file_name(Alias, PackDir, [solutions(all)]),
 2399            PackDirs)
 2400    },
 2401    [ 'Cannot find a place to create a package directory.'-[],
 2402      'Considered:'-[]
 2403    ],
 2404    candidate_dirs(PackDirs).
 2405message(no_match(Name)) -->
 2406    [ 'No registered pack matches "~w"'-[Name] ].
 2407message(conflict(version, [PackV, FileV])) -->
 2408    ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
 2409    [', file claims version '-[]], msg_version(FileV).
 2410message(conflict(name, [PackInfo, FileInfo])) -->
 2411    ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
 2412    [', file claims ~w: ~p'-[FileInfo]].
 2413message(no_prolog_response(ContentType, String)) -->
 2414    [ 'Expected Prolog response.  Got content of type ~p'-[ContentType], nl,
 2415      '~s'-[String]
 2416    ].
 2417message(pack(no_upgrade_info(Pack))) -->
 2418    [ '~w: pack meta-data does not provide an upgradable URL'-[Pack] ].
 2419
 2420candidate_dirs([]) --> [].
 2421candidate_dirs([H|T]) --> [ nl, '    ~w'-[H] ], candidate_dirs(T).
 2422
 2423message(no_mingw) -->
 2424    [ 'Cannot find MinGW and/or MSYS.'-[] ].
 2425
 2426                                                % Questions
 2427message(resolve_remove) -->
 2428    [ nl, 'Please select an action:', nl, nl ].
 2429message(create_pack_dir) -->
 2430    [ nl, 'Create directory for packages', nl ].
 2431message(menu(item(I, Label))) -->
 2432    [ '~t(~d)~6|   '-[I] ],
 2433    label(Label).
 2434message(menu(default_item(I, Label))) -->
 2435    [ '~t(~d)~6| * '-[I] ],
 2436    label(Label).
 2437message(menu(select)) -->
 2438    [ nl, 'Your choice? ', flush ].
 2439message(confirm(Question, Default)) -->
 2440    message(Question),
 2441    confirm_default(Default),
 2442    [ flush ].
 2443message(menu(reply(Min,Max))) -->
 2444    (  { Max =:= Min+1 }
 2445    -> [ 'Please enter ~w or ~w'-[Min,Max] ]
 2446    ;  [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
 2447    ).
 2448
 2449% Alternate hashes for found for the same file
 2450
 2451message(alt_hashes(URL, _Alts)) -->
 2452    { git_url(URL, _)
 2453    },
 2454    !,
 2455    [ 'GIT repository was updated without updating version' ].
 2456message(alt_hashes(URL, Alts)) -->
 2457    { file_base_name(URL, File)
 2458    },
 2459    [ 'Found multiple versions of "~w".'-[File], nl,
 2460      'This could indicate a compromised or corrupted file', nl
 2461    ],
 2462    alt_hashes(Alts).
 2463message(continue_with_alt_hashes(Count, URL)) -->
 2464    [ 'Continue installation from "~w" (downloaded ~D times)'-[URL, Count] ].
 2465message(continue_with_modified_hash(_URL)) -->
 2466    [ 'Pack may be compromised.  Continue anyway'
 2467    ].
 2468message(modified_hash(_SHA1-URL, _SHA2-[URL])) -->
 2469    [ 'Content of ~q has changed.'-[URL]
 2470    ].
 2471
 2472alt_hashes([]) --> [].
 2473alt_hashes([H|T]) --> alt_hash(H), ( {T == []} -> [] ; [nl], alt_hashes(T) ).
 2474
 2475alt_hash(alt_hash(Count, URLs, Hash)) -->
 2476    [ '~t~d~8| ~w'-[Count, Hash] ],
 2477    alt_urls(URLs).
 2478
 2479alt_urls([]) --> [].
 2480alt_urls([H|T]) -->
 2481    [ nl, '    ~w'-[H] ],
 2482    alt_urls(T).
 2483
 2484% Installation dependencies gathered from inquiry server.
 2485
 2486message(install_dependencies(Resolution)) -->
 2487    [ 'Package depends on the following:' ],
 2488    msg_res_tokens(Resolution, 1).
 2489
 2490msg_res_tokens([], _) --> [].
 2491msg_res_tokens([H|T], L) --> msg_res_token(H, L), msg_res_tokens(T, L).
 2492
 2493msg_res_token(Token-unresolved, L) -->
 2494    res_indent(L),
 2495    [ '"~w" cannot be satisfied'-[Token] ].
 2496msg_res_token(Token-resolve(Pack, Version, [URL|_], SubResolves), L) -->
 2497    !,
 2498    res_indent(L),
 2499    [ '"~w", provided by ~w@~w from ~w'-[Token, Pack, Version, URL] ],
 2500    { L2 is L+1 },
 2501    msg_res_tokens(SubResolves, L2).
 2502msg_res_token(Token-resolved(Pack), L) -->
 2503    !,
 2504    res_indent(L),
 2505    [ '"~w", provided by installed pack ~w'-[Token,Pack] ].
 2506
 2507res_indent(L) -->
 2508    { I is L*2 },
 2509    [ nl, '~*c'-[I,0'\s] ].
 2510
 2511message(resolve_deps) -->
 2512    [ nl, 'What do you wish to do' ].
 2513label(install_deps) -->
 2514    [ 'Install proposed dependencies' ].
 2515label(install_no_deps) -->
 2516    [ 'Only install requested package' ].
 2517
 2518
 2519message(git_fetch(Dir)) -->
 2520    [ 'Running "git fetch" in ~q'-[Dir] ].
 2521
 2522% inquiry is blank
 2523
 2524message(inquiry_ok(Reply, File)) -->
 2525    { memberchk(downloads(Count), Reply),
 2526      memberchk(rating(VoteCount, Rating), Reply),
 2527      !,
 2528      length(Stars, Rating),
 2529      maplist(=(0'*), Stars)
 2530    },
 2531    [ '"~w" was downloaded ~D times.  Package rated ~s (~D votes)'-
 2532      [ File, Count, Stars, VoteCount ]
 2533    ].
 2534message(inquiry_ok(Reply, File)) -->
 2535    { memberchk(downloads(Count), Reply)
 2536    },
 2537    [ '"~w" was downloaded ~D times'-[ File, Count ] ].
 2538
 2539                                                % support predicates
 2540unsatisfied([]) --> [].
 2541unsatisfied([Needed-[By]|T]) -->
 2542    [ '\t`~q\', needed by package `~w\''-[Needed, By] ],
 2543    unsatisfied(T).
 2544unsatisfied([Needed-By|T]) -->
 2545    [ '\t`~q\', needed by packages'-[Needed], nl ],
 2546    pack_list(By),
 2547    unsatisfied(T).
 2548
 2549pack_list([]) --> [].
 2550pack_list([H|T]) -->
 2551    [ '\t\tPackage `~w\''-[H], nl ],
 2552    pack_list(T).
 2553
 2554process_lines([]) --> [].
 2555process_lines([H|T]) -->
 2556    [ '~s'-[H] ],
 2557    (   {T==[]}
 2558    ->  []
 2559    ;   [nl], process_lines(T)
 2560    ).
 2561
 2562split_lines([], []) :- !.
 2563split_lines(All, [Line1|More]) :-
 2564    append(Line1, [0'\n|Rest], All),
 2565    !,
 2566    split_lines(Rest, More).
 2567split_lines(Line, [Line]).
 2568
 2569label(remove_only(Pack)) -->
 2570    [ 'Only remove package ~w (break dependencies)'-[Pack] ].
 2571label(remove_deps(Pack, Deps)) -->
 2572    { length(Deps, Count) },
 2573    [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
 2574label(create_dir(Dir)) -->
 2575    [ '~w'-[Dir] ].
 2576label(install_from(git(URL))) -->
 2577    !,
 2578    [ 'GIT repository at ~w'-[URL] ].
 2579label(install_from(URL)) -->
 2580    [ '~w'-[URL] ].
 2581label(cancel) -->
 2582    [ 'Cancel' ].
 2583
 2584confirm_default(yes) -->
 2585    [ ' Y/n? ' ].
 2586confirm_default(no) -->
 2587    [ ' y/N? ' ].
 2588confirm_default(none) -->
 2589    [ ' y/n? ' ].
 2590
 2591msg_version(Version) -->
 2592    { atom(Version) },
 2593    !,
 2594    [ '~w'-[Version] ].
 2595msg_version(VersionData) -->
 2596    !,
 2597    { atom_version(Atom, VersionData) },
 2598    [ '~w'-[Atom] ]