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

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