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

  110:- multifile
  111    environment/2.                          % Name, Value
  112
  113:- dynamic
  114    pack_requires/2,                        % Pack, Requirement
  115    pack_provides_db/2.                     % Pack, Provided
  116
  117
  118                 /*******************************
  119                 *          CONSTANTS           *
  120                 *******************************/
  121
  122:- setting(server, atom, 'https://www.swi-prolog.org/pack/',
  123           'Server to exchange pack information').  124
  125
  126                 /*******************************
  127                 *         PACKAGE INFO         *
  128                 *******************************/

 current_pack(?Pack) is nondet

 current_pack(?Pack, ?Dir) is nondet

True if Pack is a currently installed pack.

  135current_pack(Pack) :-
  136    current_pack(Pack, _).
  137
  138current_pack(Pack, Dir) :-
  139    '$pack':pack(Pack, Dir).

 pack_list_installed is det

List currently installed packages. Unlike pack_list/1, only locally installed packages are displayed and no connection is made to the internet.

See also

- Use pack_list/1 to find packages.

  149pack_list_installed :-
  150    findall(Pack, current_pack(Pack), Packages0),
  151    Packages0 \== [],
  152    !,
  153    sort(Packages0, Packages),
  154    length(Packages, Count),
  155    format('Installed packages (~D):~n~n', [Count]),
  156    maplist(pack_info(list), Packages),
  157    validate_dependencies.
  158pack_list_installed :-
  159    print_message(informational, pack(no_packages_installed)).

 pack_info(+Pack)

Print more detailed information about Pack.

  165pack_info(Name) :-
  166    pack_info(info, Name).
  167
  168pack_info(Level, Name) :-
  169    must_be(atom, Name),
  170    findall(Info, pack_info(Name, Level, Info), Infos0),
  171    (   Infos0 == []
  172    ->  print_message(warning, pack(no_pack_installed(Name))),
  173        fail
  174    ;   true
  175    ),
  176    update_dependency_db(Name, Infos0),
  177    findall(Def,  pack_default(Level, Infos, Def), Defs),
  178    append(Infos0, Defs, Infos1),
  179    sort(Infos1, Infos),
  180    show_info(Name, Infos, [info(Level)]).
  181
  182
  183show_info(_Name, _Properties, Options) :-
  184    option(silent(true), Options),
  185    !.
  186show_info(Name, Properties, Options) :-
  187    option(info(list), Options),
  188    !,
  189    memberchk(title(Title), Properties),
  190    memberchk(version(Version), Properties),
  191    format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
  192show_info(Name, Properties, _) :-
  193    !,
  194    print_property_value('Package'-'~w', [Name]),
  195    findall(Term, pack_level_info(info, Term, _, _), Terms),
  196    maplist(print_property(Properties), Terms).
  197
  198print_property(_, nl) :-
  199    !,
  200    format('~n').
  201print_property(Properties, Term) :-
  202    findall(Term, member(Term, Properties), Terms),
  203    Terms \== [],
  204    !,
  205    pack_level_info(_, Term, LabelFmt, _Def),
  206    (   LabelFmt = Label-FmtElem
  207    ->  true
  208    ;   Label = LabelFmt,
  209        FmtElem = '~w'
  210    ),
  211    multi_valued(Terms, FmtElem, FmtList, Values),
  212    atomic_list_concat(FmtList, ', ', Fmt),
  213    print_property_value(Label-Fmt, Values).
  214print_property(_, _).
  215
  216multi_valued([H], LabelFmt, [LabelFmt], Values) :-
  217    !,
  218    H =.. [_|Values].
  219multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
  220    H =.. [_|VH],
  221    append(VH, MoreValues, Values),
  222    multi_valued(T, LabelFmt, LT, MoreValues).
  223
  224
  225pvalue_column(24).
  226print_property_value(Prop-Fmt, Values) :-
  227    !,
  228    pvalue_column(C),
  229    atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
  230    format(Format, [Prop,C|Values]).
  231
  232pack_info(Name, Level, Info) :-
  233    '$pack':pack(Name, BaseDir),
  234    (   Info = directory(BaseDir)
  235    ;   pack_info_term(BaseDir, Info)
  236    ),
  237    pack_level_info(Level, Info, _Format, _Default).
  238
  239:- public pack_level_info/4.                    % used by web-server
  240
  241pack_level_info(_,    title(_),         'Title',                   '<no title>').
  242pack_level_info(_,    version(_),       'Installed version',       '<unknown>').
  243pack_level_info(info, directory(_),     'Installed in directory',  -).
  244pack_level_info(info, author(_, _),     'Author'-'~w <~w>',        -).
  245pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>',    -).
  246pack_level_info(info, packager(_, _),   'Packager'-'~w <~w>',      -).
  247pack_level_info(info, home(_),          'Home page',               -).
  248pack_level_info(info, download(_),      'Download URL',            -).
  249pack_level_info(_,    provides(_),      'Provides',                -).
  250pack_level_info(_,    requires(_),      'Requires',                -).
  251pack_level_info(_,    conflicts(_),     'Conflicts with',          -).
  252pack_level_info(_,    replaces(_),      'Replaces packages',       -).
  253pack_level_info(info, library(_),	'Provided libraries',      -).
  254
  255pack_default(Level, Infos, Def) :-
  256    pack_level_info(Level, ITerm, _Format, Def),
  257    Def \== (-),
  258    \+ memberchk(ITerm, Infos).

 pack_info_term(+PackDir, ?Info) is nondet

True when Info is meta-data for the package PackName.

  264pack_info_term(BaseDir, Info) :-
  265    directory_file_path(BaseDir, 'pack.pl', InfoFile),
  266    catch(
  267        setup_call_cleanup(
  268            open(InfoFile, read, In),
  269            term_in_stream(In, Info),
  270            close(In)),
  271        error(existence_error(source_sink, InfoFile), _),
  272        ( print_message(error, pack(no_meta_data(BaseDir))),
  273          fail
  274        )).
  275pack_info_term(BaseDir, library(Lib)) :-
  276    atom_concat(BaseDir, '/prolog/', LibDir),
  277    atom_concat(LibDir, '*.pl', Pattern),
  278    expand_file_name(Pattern, Files),
  279    maplist(atom_concat(LibDir), Plain, Files),
  280    convlist(base_name, Plain, Libs),
  281    member(Lib, Libs).
  282
  283base_name(File, Base) :-
  284    file_name_extension(Base, pl, File).
  285
  286term_in_stream(In, Term) :-
  287    repeat,
  288        read_term(In, Term0, []),
  289        (   Term0 == end_of_file
  290        ->  !, fail
  291        ;   Term = Term0,
  292            valid_info_term(Term0)
  293        ).
  294
  295valid_info_term(Term) :-
  296    Term =.. [Name|Args],
  297    same_length(Args, Types),
  298    Decl =.. [Name|Types],
  299    (   pack_info_term(Decl)
  300    ->  maplist(valid_info_arg, Types, Args)
  301    ;   print_message(warning, pack(invalid_info(Term))),
  302        fail
  303    ).
  304
  305valid_info_arg(Type, Arg) :-
  306    must_be(Type, Arg).

 pack_info_term(?Term) is nondet

True when Term describes name and arguments of a valid package info term.

  313pack_info_term(name(atom)).                     % Synopsis
  314pack_info_term(title(atom)).
  315pack_info_term(keywords(list(atom))).
  316pack_info_term(description(list(atom))).
  317pack_info_term(version(version)).
  318pack_info_term(author(atom, email_or_url_or_empty)).     % Persons
  319pack_info_term(maintainer(atom, email_or_url)).
  320pack_info_term(packager(atom, email_or_url)).
  321pack_info_term(pack_version(nonneg)).           % Package convention version
  322pack_info_term(home(atom)).                     % Home page
  323pack_info_term(download(atom)).                 % Source
  324pack_info_term(provides(atom)).                 % Dependencies
  325pack_info_term(requires(dependency)).
  326pack_info_term(conflicts(dependency)).          % Conflicts with package
  327pack_info_term(replaces(atom)).                 % Replaces another package
  328pack_info_term(autoload(boolean)).              % Default installation options
  329
  330:- multifile
  331    error:has_type/2.  332
  333error:has_type(version, Version) :-
  334    atom(Version),
  335    version_data(Version, _Data).
  336error:has_type(email_or_url, Address) :-
  337    atom(Address),
  338    (   sub_atom(Address, _, _, _, @)
  339    ->  true
  340    ;   uri_is_global(Address)
  341    ).
  342error:has_type(email_or_url_or_empty, Address) :-
  343    (   Address == ''
  344    ->  true
  345    ;   error:has_type(email_or_url, Address)
  346    ).
  347error:has_type(dependency, Value) :-
  348    is_dependency(Value, _Token, _Version).
  349
  350version_data(Version, version(Data)) :-
  351    atomic_list_concat(Parts, '.', Version),
  352    maplist(atom_number, Parts, Data).
  353
  354is_dependency(Token, Token, *) :-
  355    atom(Token).
  356is_dependency(Term, Token, VersionCmp) :-
  357    Term =.. [Op,Token,Version],
  358    cmp(Op, _),
  359    version_data(Version, _),
  360    VersionCmp =.. [Op,Version].
  361
  362cmp(<,  @<).
  363cmp(=<, @=<).
  364cmp(==, ==).
  365cmp(>=, @>=).
  366cmp(>,  @>).
  367
  368
  369                 /*******************************
  370                 *            SEARCH            *
  371                 *******************************/

 pack_search(+Query) is det

 pack_list(+Query) is det

Query package server and installed packages and display results. Query is matches case-insensitively against the name and title of known and installed packages. For each matching package, a single line is displayed that provides:

• Installation status
  • p: package, not installed
  • i: installed package; up-to-date with public version
  • U: installed package; can be upgraded
  • A: installed package; newer than publically available
  • l: installed package; not on server
• Name@Version
• Name@Version(ServerVersion)
• Title

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

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

See also

- pack_list_installed/0 to list installed packages without contacting the server.

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

 pack_install(+Spec:atom) is det

Install a package. Spec is one of

• A package name. This queries the package repository at http://www.swi-prolog.org
• Archive file name
• HTTP URL of an archive file name. This URL may contain a star (*) for the version. In this case pack_install asks for the directory content and selects the latest version.
• GIT URL (not well supported yet)
• A local directory name given as file:// URL
• '.', in which case a relative symlink is created to the current directory (all other options for Spec make a copy of the files).

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

  498pack_install(Spec) :-
  499    pack_default_options(Spec, Pack, [], Options),
  500    pack_install(Pack, [pack(Pack)|Options]).

 pack_default_options(+Spec, -Pack, +OptionsIn, -Options) is det

Establish the pack name (Pack) and install options from a specification and options (OptionsIn) provided by the user.

  507pack_default_options(_Spec, Pack, OptsIn, Options) :-
  508    option(already_installed(pack(Pack,_Version)), OptsIn),
  509    !,
  510    Options = OptsIn.
  511pack_default_options(_Spec, Pack, OptsIn, Options) :-
  512    option(url(URL), OptsIn),
  513    !,
  514    (   option(git(_), OptsIn)
  515    ->  Options = OptsIn
  516    ;   git_url(URL, Pack)
  517    ->  Options = [git(true)|OptsIn]
  518    ;   Options = OptsIn
  519    ),
  520    (   nonvar(Pack)
  521    ->  true
  522    ;   option(pack(Pack), Options)
  523    ->  true
  524    ;   pack_version_file(Pack, _Version, URL)
  525    ).
  526pack_default_options(Archive, Pack, _, Options) :-      % Install from archive
  527    must_be(atom, Archive),
  528    \+ uri_is_global(Archive),
  529    expand_file_name(Archive, [File]),
  530    exists_file(File),
  531    !,
  532    pack_version_file(Pack, Version, File),
  533    uri_file_name(FileURL, File),
  534    Options = [url(FileURL), version(Version)].
  535pack_default_options(URL, Pack, _, Options) :-
  536    git_url(URL, Pack),
  537    !,
  538    Options = [git(true), url(URL)].
  539pack_default_options(FileURL, Pack, _, Options) :-      % Install from directory
  540    uri_file_name(FileURL, Dir),
  541    exists_directory(Dir),
  542    pack_info_term(Dir, name(Pack)),
  543    !,
  544    (   pack_info_term(Dir, version(Version))
  545    ->  uri_file_name(DirURL, Dir),
  546        Options = [url(DirURL), version(Version)]
  547    ;   throw(error(existence_error(key, version, Dir),_))
  548    ).
  549pack_default_options('.', Pack, _, Options) :-          % Install from CWD
  550    pack_info_term('.', name(Pack)),
  551    !,
  552    working_directory(Dir, Dir),
  553    (   pack_info_term(Dir, version(Version))
  554    ->  uri_file_name(DirURL, Dir),
  555        Options = [url(DirURL), version(Version) | Options1],
  556        (   current_prolog_flag(windows, true)
  557        ->  Options1 = []
  558        ;   Options1 = [link(true), rebuild(make)]
  559        )
  560    ;   throw(error(existence_error(key, version, Dir),_))
  561    ).
  562pack_default_options(URL, Pack, _, Options) :-          % Install from URL
  563    pack_version_file(Pack, Version, URL),
  564    download_url(URL),
  565    !,
  566    available_download_versions(URL, [URLVersion-LatestURL|_]),
  567    Options = [url(LatestURL)|VersionOptions],
  568    version_options(Version, URLVersion, VersionOptions).
  569pack_default_options(Pack, Pack, OptsIn, Options) :-    % Install from name
  570    \+ uri_is_global(Pack),                             % ignore URLs
  571    query_pack_server(locate(Pack), Reply, OptsIn),
  572    (   Reply = true(Results)
  573    ->  pack_select_candidate(Pack, Results, OptsIn, Options)
  574    ;   print_message(warning, pack(no_match(Pack))),
  575        fail
  576    ).
  577
  578version_options(Version, Version, [version(Version)]) :- !.
  579version_options(Version, _, [version(Version)]) :-
  580    Version = version(List),
  581    maplist(integer, List),
  582    !.
  583version_options(_, _, []).

 pack_select_candidate(+Pack, +AvailableVersions, +OptionsIn, -Options)

Select from available packages.

  589pack_select_candidate(Pack, [AtomVersion-_|_], Options,
  590                      [already_installed(pack(Pack, Installed))|Options]) :-
  591    current_pack(Pack),
  592    pack_info(Pack, _, version(InstalledAtom)),
  593    atom_version(InstalledAtom, Installed),
  594    atom_version(AtomVersion, Version),
  595    Installed @>= Version,
  596    in_explicit_pack_dir(Pack, Options),
  597    !.
  598pack_select_candidate(Pack, Available, Options, OptsOut) :-
  599    option(url(URL), Options),
  600    memberchk(_Version-URLs, Available),
  601    memberchk(URL, URLs),
  602    !,
  603    (   git_url(URL, Pack)
  604    ->  Extra = [git(true)]
  605    ;   Extra = []
  606    ),
  607    OptsOut = [url(URL), inquiry(true) | Extra].
  608pack_select_candidate(Pack, [Version-[URL]|_], Options,
  609                      [url(URL), git(true), inquiry(true)]) :-
  610    git_url(URL, Pack),
  611    !,
  612    confirm(install_from(Pack, Version, git(URL)), yes, Options).
  613pack_select_candidate(Pack, [Version-[URL]|More], Options,
  614                      [url(URL), inquiry(true) | Upgrade]) :-
  615    (   More == []
  616    ->  !
  617    ;   true
  618    ),
  619    confirm(install_from(Pack, Version, URL), yes, Options),
  620    !,
  621    add_upgrade(Pack, Upgrade).
  622pack_select_candidate(Pack, [Version-URLs|_], Options,
  623                      [url(URL), inquiry(true)|Rest]) :-
  624    maplist(url_menu_item, URLs, Tagged),
  625    append(Tagged, [cancel=cancel], Menu),
  626    Menu = [Default=_|_],
  627    menu(pack(select_install_from(Pack, Version)),
  628         Menu, Default, Choice, Options),
  629    (   Choice == cancel
  630    ->  fail
  631    ;   Choice = git(URL)
  632    ->  Rest = [git(true)|Upgrade]
  633    ;   Choice = URL,
  634        Rest = Upgrade
  635    ),
  636    add_upgrade(Pack, Upgrade).
  637
  638add_upgrade(Pack, Options) :-
  639    current_pack(Pack),
  640    !,
  641    Options = [upgrade(true)].
  642add_upgrade(_, []).
  643
  644url_menu_item(URL, git(URL)=install_from(git(URL))) :-
  645    git_url(URL, _),
  646    !.
  647url_menu_item(URL, URL=install_from(URL)).

 in_explicit_pack_dir(+Pack, +Options) is semidet

True when Pack is installed in the explicit target directory.

  653in_explicit_pack_dir(Pack, Options) :-
  654    option(package_directory(Root), Options),
  655    current_pack(Pack, PackDir),
  656    file_directory_name(PackDir, Parent),
  657    same_file(Parent, Root).

 pack_install(+Name, +Options) is det

Install package Name. Processes the options below. Default options as would be used by pack_install/1 are used to complete the provided Options.

url(+URL)

Source for downloading the package

package_directory(+Dir)

Directory into which to install the package.

global(+Boolean)

If true, install in the XDG common application data path, making the pack accessible to everyone. If false, install in the XDG user application data path, making the pack accessible for the current user only. If the option is absent, use the first existing and writable directory. If that doesn't exist find locations where it can be created and prompt the user to do so.

insecure(+Boolean)

When true (default false), do not perform any checks on SSL certificates when downloading using https.

interactive(+Boolean)

Use default answer without asking the user if there is a default action.

silent(+Boolean)

If true (default false), suppress informational progress messages.

upgrade(+Boolean)

If true (default false), upgrade package if it is already installed.

rebuild(Condition)

Rebuild the foreign components. Condition is one of if_absent (default, do nothing if the directory with foreign resources exists), make (run make) or true (run `make distclean` followed by the default configure and build steps).

test(Boolean)

If true (default), run the pack tests.

git(+Boolean)

If true (default false unless URL ends with =.git=), assume the URL is a GIT repository.

link(+Boolean)

Can be used if the installation source is a local directory and the file system supports symbolic links. In this case the system adds the current directory to the pack registration using a symbolic link and performs the local installation steps.

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

  710pack_install(Spec, Options) :-
  711    pack_default_options(Spec, Pack, Options, DefOptions),
  712    (   option(already_installed(Installed), DefOptions)
  713    ->  print_message(informational, pack(already_installed(Installed)))
  714    ;   merge_options(Options, DefOptions, PackOptions),
  715        update_dependency_db,
  716        pack_install_dir(PackDir, PackOptions),
  717        pack_install(Pack, PackDir, PackOptions)
  718    ).
  719
  720pack_install_dir(PackDir, Options) :-
  721    option(package_directory(PackDir), Options),
  722    !.
  723pack_install_dir(PackDir, Options) :-
  724    base_alias(Alias, Options),
  725    absolute_file_name(Alias, PackDir,
  726                       [ file_type(directory),
  727                         access(write),
  728                         file_errors(fail)
  729                       ]),
  730    !.
  731pack_install_dir(PackDir, Options) :-
  732    pack_create_install_dir(PackDir, Options).
  733
  734base_alias(Alias, Options) :-
  735    option(global(true), Options),
  736    !,
  737    Alias = common_app_data(pack).
  738base_alias(Alias, Options) :-
  739    option(global(false), Options),
  740    !,
  741    Alias = user_app_data(pack).
  742base_alias(Alias, _Options) :-
  743    Alias = pack('.').
  744
  745pack_create_install_dir(PackDir, Options) :-
  746    base_alias(Alias, Options),
  747    findall(Candidate = create_dir(Candidate),
  748            ( absolute_file_name(Alias, Candidate, [solutions(all)]),
  749              \+ exists_file(Candidate),
  750              \+ exists_directory(Candidate),
  751              file_directory_name(Candidate, Super),
  752              (   exists_directory(Super)
  753              ->  access_file(Super, write)
  754              ;   true
  755              )
  756            ),
  757            Candidates0),
  758    list_to_set(Candidates0, Candidates),   % keep order
  759    pack_create_install_dir(Candidates, PackDir, Options).
  760
  761pack_create_install_dir(Candidates, PackDir, Options) :-
  762    Candidates = [Default=_|_],
  763    !,
  764    append(Candidates, [cancel=cancel], Menu),
  765    menu(pack(create_pack_dir), Menu, Default, Selected, Options),
  766    Selected \== cancel,
  767    (   catch(make_directory_path(Selected), E,
  768              (print_message(warning, E), fail))
  769    ->  PackDir = Selected
  770    ;   delete(Candidates, PackDir=create_dir(PackDir), Remaining),
  771        pack_create_install_dir(Remaining, PackDir, Options)
  772    ).
  773pack_create_install_dir(_, _, _) :-
  774    print_message(error, pack(cannot_create_dir(pack(.)))),
  775    fail.

 pack_install(+Pack, +PackDir, +Options)

Install package Pack into PackDir. Options:

url(URL)

Install from the given URL, URL is either a file://, a git URL or a download URL.

upgrade(Boolean)

If Pack is already installed and Boolean is true, update the package to the latest version. If Boolean is false print an error and fail.

  790pack_install(Name, _, Options) :-
  791    current_pack(Name, Dir),
  792    option(upgrade(false), Options, false),
  793    \+ pack_is_in_local_dir(Name, Dir, Options),
  794    (   option(package_directory(_), Options)
  795    ->  in_explicit_pack_dir(Name, Options)
  796    ;   true
  797    ),
  798    print_message(error, pack(already_installed(Name))),
  799    pack_info(Name),
  800    print_message(information, pack(remove_with(Name))),
  801    !,
  802    fail.
  803pack_install(Name, PackDir, Options) :-
  804    option(url(URL), Options),
  805    uri_file_name(URL, Source),
  806    !,
  807    pack_install_from_local(Source, PackDir, Name, Options).
  808pack_install(Name, PackDir, Options) :-
  809    option(url(URL), Options),
  810    uri_components(URL, Components),
  811    uri_data(scheme, Components, Scheme),
  812    pack_install_from_url(Scheme, URL, PackDir, Name, Options).

 pack_install_from_local(+Source, +PackTopDir, +Name, +Options)

Install a package from a local media.

To be done

- Provide an option to install directories using a link (or file-links).

  821pack_install_from_local(Source, PackTopDir, Name, Options) :-
  822    exists_directory(Source),
  823    !,
  824    directory_file_path(PackTopDir, Name, PackDir),
  825    (   option(link(true), Options)
  826    ->  (   same_file(Source, PackDir)
  827        ->  true
  828        ;   atom_concat(PackTopDir, '/', PackTopDirS),
  829            relative_file_name(Source, PackTopDirS, RelPath),
  830            link_file(RelPath, PackDir, symbolic),
  831            assertion(same_file(Source, PackDir))
  832        )
  833    ;   prepare_pack_dir(PackDir, Options),
  834        copy_directory(Source, PackDir)
  835    ),
  836    pack_post_install(Name, PackDir, Options).
  837pack_install_from_local(Source, PackTopDir, Name, Options) :-
  838    exists_file(Source),
  839    directory_file_path(PackTopDir, Name, PackDir),
  840    prepare_pack_dir(PackDir, Options),
  841    pack_unpack(Source, PackDir, Name, Options),
  842    pack_post_install(Name, PackDir, Options).
  843
  844pack_is_in_local_dir(_Pack, PackDir, Options) :-
  845    option(url(DirURL), Options),
  846    uri_file_name(DirURL, Dir),
  847    same_file(PackDir, Dir).

 pack_unpack(+SourceFile, +PackDir, +Pack, +Options)

Unpack an archive to the given package dir.

  854:- if(exists_source(library(archive))).  855pack_unpack(Source, PackDir, Pack, Options) :-
  856    ensure_loaded_archive,
  857    pack_archive_info(Source, Pack, _Info, StripOptions),
  858    prepare_pack_dir(PackDir, Options),
  859    archive_extract(Source, PackDir,
  860                    [ exclude(['._*'])          % MacOS resource forks
  861                    | StripOptions
  862                    ]).
  863:- else.  864pack_unpack(_,_,_,_) :-
  865    existence_error(library, archive).
  866:- endif.  867
  868                 /*******************************
  869                 *             INFO             *
  870                 *******************************/

 pack_archive_info(+Archive, +Pack, -Info, -Strip)

True when Archive archives Pack. Info is unified with the terms from pack.pl in the pack and Strip is the strip-option for archive_extract/3.

Requires library(archive), which is lazily loaded when needed.

Errors

- existence_error(pack_file, 'pack.pl') if the archive doesn't contain pack.pl

- Syntax errors if pack.pl cannot be parsed.

  884:- if(exists_source(library(archive))).  885ensure_loaded_archive :-
  886    current_predicate(archive_open/3),
  887    !.
  888ensure_loaded_archive :-
  889    use_module(library(archive)).
  890
  891pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
  892    ensure_loaded_archive,
  893    size_file(Archive, Bytes),
  894    setup_call_cleanup(
  895        archive_open(Archive, Handle, []),
  896        (   repeat,
  897            (   archive_next_header(Handle, InfoFile)
  898            ->  true
  899            ;   !, fail
  900            )
  901        ),
  902        archive_close(Handle)),
  903    file_base_name(InfoFile, 'pack.pl'),
  904    atom_concat(Prefix, 'pack.pl', InfoFile),
  905    strip_option(Prefix, Pack, Strip),
  906    setup_call_cleanup(
  907        archive_open_entry(Handle, Stream),
  908        read_stream_to_terms(Stream, Info),
  909        close(Stream)),
  910    !,
  911    must_be(ground, Info),
  912    maplist(valid_info_term, Info).
  913:- else.  914pack_archive_info(_, _, _, _) :-
  915    existence_error(library, archive).
  916:- endif.  917pack_archive_info(_, _, _, _) :-
  918    existence_error(pack_file, 'pack.pl').
  919
  920strip_option('', _, []) :- !.
  921strip_option('./', _, []) :- !.
  922strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
  923    atom_concat(PrefixDir, /, Prefix),
  924    file_base_name(PrefixDir, Base),
  925    (   Base == Pack
  926    ->  true
  927    ;   pack_version_file(Pack, _, Base)
  928    ->  true
  929    ;   \+ sub_atom(PrefixDir, _, _, _, /)
  930    ).
  931
  932read_stream_to_terms(Stream, Terms) :-
  933    read(Stream, Term0),
  934    read_stream_to_terms(Term0, Stream, Terms).
  935
  936read_stream_to_terms(end_of_file, _, []) :- !.
  937read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
  938    read(Stream, Term1),
  939    read_stream_to_terms(Term1, Stream, Terms).

 pack_git_info(+GitDir, -Hash, -Info) is det

Retrieve info from a cloned git repository that is compatible with pack_archive_info/4.

  947pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
  948    exists_directory(GitDir),
  949    !,
  950    git_ls_tree(Entries, [directory(GitDir)]),
  951    git_hash(Hash, [directory(GitDir)]),
  952    maplist(arg(4), Entries, Sizes),
  953    sum_list(Sizes, Bytes),
  954    directory_file_path(GitDir, 'pack.pl', InfoFile),
  955    read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
  956    must_be(ground, Info),
  957    maplist(valid_info_term, Info).

 download_file_sanity_check(+Archive, +Pack, +Info) is semidet

Perform basic sanity checks on DownloadFile

  963download_file_sanity_check(Archive, Pack, Info) :-
  964    info_field(name(Name), Info),
  965    info_field(version(VersionAtom), Info),
  966    atom_version(VersionAtom, Version),
  967    pack_version_file(PackA, VersionA, Archive),
  968    must_match([Pack, PackA, Name], name),
  969    must_match([Version, VersionA], version).
  970
  971info_field(Field, Info) :-
  972    memberchk(Field, Info),
  973    ground(Field),
  974    !.
  975info_field(Field, _Info) :-
  976    functor(Field, FieldName, _),
  977    print_message(error, pack(missing(FieldName))),
  978    fail.
  979
  980must_match(Values, _Field) :-
  981    sort(Values, [_]),
  982    !.
  983must_match(Values, Field) :-
  984    print_message(error, pack(conflict(Field, Values))),
  985    fail.
  986
  987
  988                 /*******************************
  989                 *         INSTALLATION         *
  990                 *******************************/

 prepare_pack_dir(+Dir, +Options)

Prepare for installing the package into Dir. This

• If the directory exist and is empty, done.
• Else if the directory exists, remove the directory and recreate it. Note that if the directory is a symlink this just deletes the link.
• Else create the directory.

 1002prepare_pack_dir(Dir, Options) :-
 1003    exists_directory(Dir),
 1004    !,
 1005    (   empty_directory(Dir)
 1006    ->  true
 1007    ;   (   option(upgrade(true), Options)
 1008        ;   confirm(remove_existing_pack(Dir), yes, Options)
 1009        )
 1010    ->  delete_directory_and_contents(Dir),
 1011        make_directory(Dir)
 1012    ).
 1013prepare_pack_dir(Dir, _) :-
 1014    make_directory(Dir).

 empty_directory(+Directory) is semidet

True if Directory is empty (holds no files or sub-directories).

 1020empty_directory(Dir) :-
 1021    \+ ( directory_files(Dir, Entries),
 1022         member(Entry, Entries),
 1023         \+ special(Entry)
 1024       ).
 1025
 1026special(.).
 1027special(..).

 pack_install_from_url(+Scheme, +URL, +PackDir, +Pack, +Options)

Install a package from a remote source. For git repositories, we simply clone. Archives are downloaded. We currently use the built-in HTTP client. For complete coverage, we should consider using an external (e.g., curl) if available.

 1037pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
 1038    option(git(true), Options),
 1039    !,
 1040    directory_file_path(PackTopDir, Pack, PackDir),
 1041    prepare_pack_dir(PackDir, Options),
 1042    run_process(path(git), [clone, URL, PackDir], []),
 1043    pack_git_info(PackDir, Hash, Info),
 1044    pack_inquiry(URL, git(Hash), Info, Options),
 1045    show_info(Pack, Info, Options),
 1046    confirm(git_post_install(PackDir, Pack), yes, Options),
 1047    pack_post_install(Pack, PackDir, Options).
 1048pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
 1049    download_scheme(Scheme),
 1050    directory_file_path(PackTopDir, Pack, PackDir),
 1051    prepare_pack_dir(PackDir, Options),
 1052    pack_download_dir(PackTopDir, DownLoadDir),
 1053    download_file(URL, Pack, DownloadBase, Options),
 1054    directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
 1055    (   option(insecure(true), Options, false)
 1056    ->  TLSOptions = [cert_verify_hook(ssl_verify)]
 1057    ;   TLSOptions = []
 1058    ),
 1059    setup_call_cleanup(
 1060        http_open(URL, In, TLSOptions),
 1061        setup_call_cleanup(
 1062            open(DownloadFile, write, Out, [type(binary)]),
 1063            copy_stream_data(In, Out),
 1064            close(Out)),
 1065        close(In)),
 1066    pack_archive_info(DownloadFile, Pack, Info, _),
 1067    download_file_sanity_check(DownloadFile, Pack, Info),
 1068    pack_inquiry(URL, DownloadFile, Info, Options),
 1069    show_info(Pack, Info, Options),
 1070    confirm(install_downloaded(DownloadFile), yes, Options),
 1071    pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).

 download_file(+URL, +Pack, -File, +Options) is det

 1075download_file(URL, Pack, File, Options) :-
 1076    option(version(Version), Options),
 1077    !,
 1078    atom_version(VersionA, Version),
 1079    file_name_extension(_, Ext, URL),
 1080    format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
 1081download_file(URL, Pack, File, _) :-
 1082    file_base_name(URL,Basename),
 1083    no_int_file_name_extension(Tag,Ext,Basename),
 1084    tag_version(Tag,Version),
 1085    !,
 1086    atom_version(VersionA,Version),
 1087    format(atom(File0), '~w-~w', [Pack, VersionA]),
 1088    file_name_extension(File0, Ext, File).
 1089download_file(URL, _, File, _) :-
 1090    file_base_name(URL, File).

 pack_url_file(+URL, -File) is det

True if File is a unique id for the referenced pack and version. Normally, that is simply the base name, but GitHub archives destroy this picture. Needed by the pack manager.

 1098pack_url_file(URL, FileID) :-
 1099    github_release_url(URL, Pack, Version),
 1100    !,
 1101    download_file(URL, Pack, FileID, [version(Version)]).
 1102pack_url_file(URL, FileID) :-
 1103    file_base_name(URL, FileID).
 1104
 1105
 1106:- public ssl_verify/5. 1107
 1108%   ssl_verify(+SSL, +ProblemCert, +AllCerts, +FirstCert, +Error)
 1109%
 1110%   Currently we accept  all  certificates.   We  organise  our  own
 1111%   security using SHA1 signatures, so  we   do  not  care about the
 1112%   source of the data.
 1113
 1114ssl_verify(_SSL,
 1115           _ProblemCertificate, _AllCertificates, _FirstCertificate,
 1116           _Error).
 1117
 1118pack_download_dir(PackTopDir, DownLoadDir) :-
 1119    directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
 1120    (   exists_directory(DownLoadDir)
 1121    ->  true
 1122    ;   make_directory(DownLoadDir)
 1123    ),
 1124    (   access_file(DownLoadDir, write)
 1125    ->  true
 1126    ;   permission_error(write, directory, DownLoadDir)
 1127    ).

 download_url(+URL) is det

True if URL looks like a URL we can download from.

 1133download_url(URL) :-
 1134    atom(URL),
 1135    uri_components(URL, Components),
 1136    uri_data(scheme, Components, Scheme),
 1137    download_scheme(Scheme).
 1138
 1139download_scheme(http).
 1140download_scheme(https) :-
 1141    catch(use_module(library(http/http_ssl_plugin)),
 1142          E, (print_message(warning, E), fail)).

 pack_post_install(+Pack, +PackDir, +Options) is det

Process post installation work. Steps:

• Create foreign resources
• Register directory as autoload library
• Attach the package

 1152pack_post_install(Pack, PackDir, Options) :-
 1153    post_install_foreign(Pack, PackDir, Options),
 1154    post_install_autoload(PackDir, Options),
 1155    attach_packs(PackDir, [duplicate(warning)]).

 pack_rebuild(+Pack) is det

Rebuild possible foreign components of Pack.

 1161pack_rebuild(Pack) :-
 1162    current_pack(Pack, PackDir),
 1163    !,
 1164    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 1165pack_rebuild(Pack) :-
 1166    unattached_pacth(Pack, PackDir),
 1167    !,
 1168    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 1169pack_rebuild(Pack) :-
 1170    existence_error(pack, Pack).
 1171
 1172unattached_pacth(Pack, BaseDir) :-
 1173    directory_file_path(Pack, 'pack.pl', PackFile),
 1174    absolute_file_name(pack(PackFile), PackPath,
 1175                       [ access(read),
 1176                         file_errors(fail)
 1177                       ]),
 1178    file_directory_name(PackPath, BaseDir).

 pack_rebuild is det

Rebuild foreign components of all packages.

 1184pack_rebuild :-
 1185    forall(current_pack(Pack),
 1186           ( print_message(informational, pack(rebuild(Pack))),
 1187             pack_rebuild(Pack)
 1188           )).

 post_install_foreign(+Pack, +PackDir, +Options) is det

Install foreign parts of the package.

 1195post_install_foreign(Pack, PackDir, Options) :-
 1196    is_foreign_pack(PackDir, _),
 1197    !,
 1198    (   pack_info_term(PackDir, pack_version(Version))
 1199    ->  true
 1200    ;   Version = 1
 1201    ),
 1202    option(rebuild(Rebuild), Options, if_absent),
 1203    (   Rebuild == if_absent,
 1204        foreign_present(PackDir)
 1205    ->  print_message(informational, pack(kept_foreign(Pack)))
 1206    ;   BuildSteps0 = [[dependencies], [configure], build, [test], install],
 1207        (   Rebuild == true
 1208        ->  BuildSteps1 = [distclean|BuildSteps0]
 1209        ;   BuildSteps1 = BuildSteps0
 1210        ),
 1211        (   option(test(false), Options)
 1212        ->  delete(BuildSteps1, [test], BuildSteps)
 1213        ;   BuildSteps = BuildSteps1
 1214        ),
 1215        build_steps(BuildSteps, PackDir, [pack_version(Version)|Options])
 1216    ).
 1217post_install_foreign(_, _, _).

 foreign_present(+PackDir) is semidet

True if we find one or more modules in the pack lib directory for the current architecture. Does not check that these can be loaded, nor whether all required modules are present.

 1226foreign_present(PackDir) :-
 1227    current_prolog_flag(arch, Arch),
 1228    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
 1229    exists_directory(ForeignBaseDir),
 1230    !,
 1231    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
 1232    exists_directory(ForeignDir),
 1233    current_prolog_flag(shared_object_extension, Ext),
 1234    atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
 1235    expand_file_name(Pattern, Files),
 1236    Files \== [].

 is_foreign_pack(+PackDir, -Type) is nondet

True when PackDir contains files that indicate the need for a specific class of build tools indicated by Type.

 1243is_foreign_pack(PackDir, Type) :-
 1244    foreign_file(File, Type),
 1245    directory_file_path(PackDir, File, Path),
 1246    exists_file(Path).
 1247
 1248foreign_file('CMakeLists.txt', cmake).
 1249foreign_file('configure',      configure).
 1250foreign_file('configure.in',   autoconf).
 1251foreign_file('configure.ac',   autoconf).
 1252foreign_file('Makefile.am',    automake).
 1253foreign_file('Makefile',       make).
 1254foreign_file('makefile',       make).
 1255foreign_file('conanfile.txt',  conan).
 1256foreign_file('conanfile.py',   conan).
 1257
 1258
 1259                 /*******************************
 1260                 *           AUTOLOAD           *
 1261                 *******************************/

 post_install_autoload(+PackDir, +Options)

Create an autoload index if the package demands such.

 1267post_install_autoload(PackDir, Options) :-
 1268    option(autoload(true), Options, true),
 1269    pack_info_term(PackDir, autoload(true)),
 1270    !,
 1271    directory_file_path(PackDir, prolog, PrologLibDir),
 1272    make_library_index(PrologLibDir).
 1273post_install_autoload(_, _).
 1274
 1275
 1276                 /*******************************
 1277                 *            UPGRADE           *
 1278                 *******************************/

 pack_upgrade(+Pack) is semidet

Try to upgrade the package Pack.

To be done

- Update dependencies when updating a pack from git?

 1286pack_upgrade(Pack) :-
 1287    pack_info(Pack, _, directory(Dir)),
 1288    directory_file_path(Dir, '.git', GitDir),
 1289    exists_directory(GitDir),
 1290    !,
 1291    print_message(informational, pack(git_fetch(Dir))),
 1292    git([fetch], [ directory(Dir) ]),
 1293    git_describe(V0, [ directory(Dir) ]),
 1294    git_describe(V1, [ directory(Dir), commit('origin/master') ]),
 1295    (   V0 == V1
 1296    ->  print_message(informational, pack(up_to_date(Pack)))
 1297    ;   confirm(upgrade(Pack, V0, V1), yes, []),
 1298        git([merge, 'origin/master'], [ directory(Dir) ]),
 1299        pack_rebuild(Pack)
 1300    ).
 1301pack_upgrade(Pack) :-
 1302    once(pack_info(Pack, _, version(VersionAtom))),
 1303    atom_version(VersionAtom, Version),
 1304    pack_info(Pack, _, download(URL)),
 1305    (   wildcard_pattern(URL)
 1306    ->  true
 1307    ;   github_url(URL, _User, _Repo)
 1308    ),
 1309    !,
 1310    available_download_versions(URL, [Latest-LatestURL|_Versions]),
 1311    (   Latest @> Version
 1312    ->  confirm(upgrade(Pack, Version, Latest), yes, []),
 1313        pack_install(Pack,
 1314                     [ url(LatestURL),
 1315                       upgrade(true),
 1316                       pack(Pack)
 1317                     ])
 1318    ;   print_message(informational, pack(up_to_date(Pack)))
 1319    ).
 1320pack_upgrade(Pack) :-
 1321    print_message(warning, pack(no_upgrade_info(Pack))).
 1322
 1323
 1324                 /*******************************
 1325                 *            REMOVE            *
 1326                 *******************************/

 pack_remove(+Name) is det

Remove the indicated package.

 1332pack_remove(Pack) :-
 1333    update_dependency_db,
 1334    (   setof(Dep, pack_depends_on(Dep, Pack), Deps)
 1335    ->  confirm_remove(Pack, Deps, Delete),
 1336        forall(member(P, Delete), pack_remove_forced(P))
 1337    ;   pack_remove_forced(Pack)
 1338    ).
 1339
 1340pack_remove_forced(Pack) :-
 1341    catch('$pack_detach'(Pack, BaseDir),
 1342          error(existence_error(pack, Pack), _),
 1343          fail),
 1344    !,
 1345    print_message(informational, pack(remove(BaseDir))),
 1346    delete_directory_and_contents(BaseDir).
 1347pack_remove_forced(Pack) :-
 1348    unattached_pacth(Pack, BaseDir),
 1349    !,
 1350    delete_directory_and_contents(BaseDir).
 1351pack_remove_forced(Pack) :-
 1352    print_message(informational, error(existence_error(pack, Pack),_)).
 1353
 1354confirm_remove(Pack, Deps, Delete) :-
 1355    print_message(warning, pack(depends(Pack, Deps))),
 1356    menu(pack(resolve_remove),
 1357         [ [Pack]      = remove_only(Pack),
 1358           [Pack|Deps] = remove_deps(Pack, Deps),
 1359           []          = cancel
 1360         ], [], Delete, []),
 1361    Delete \== [].
 1362
 1363
 1364                 /*******************************
 1365                 *           PROPERTIES         *
 1366                 *******************************/

 pack_property(?Pack, ?Property) is nondet

True when Property is a property of an installed Pack. This interface is intended for programs that wish to interact with the package manager. Defined properties are:

directory(Directory)

Directory into which the package is installed

version(Version)

Installed version

title(Title)

Full title of the package

author(Author)

Registered author

download(URL)

Official download URL

readme(File)

Package README file (if present)

todo(File)

Package TODO file (if present)

 1389pack_property(Pack, Property) :-
 1390    findall(Pack-Property, pack_property_(Pack, Property), List),
 1391    member(Pack-Property, List).            % make det if applicable
 1392
 1393pack_property_(Pack, Property) :-
 1394    pack_info(Pack, _, Property).
 1395pack_property_(Pack, Property) :-
 1396    \+ \+ info_file(Property, _),
 1397    '$pack':pack(Pack, BaseDir),
 1398    access_file(BaseDir, read),
 1399    directory_files(BaseDir, Files),
 1400    member(File, Files),
 1401    info_file(Property, Pattern),
 1402    downcase_atom(File, Pattern),
 1403    directory_file_path(BaseDir, File, InfoFile),
 1404    arg(1, Property, InfoFile).
 1405
 1406info_file(readme(_), 'readme.txt').
 1407info_file(readme(_), 'readme').
 1408info_file(todo(_),   'todo.txt').
 1409info_file(todo(_),   'todo').
 1410
 1411
 1412                 /*******************************
 1413                 *             GIT              *
 1414                 *******************************/

 git_url(+URL, -Pack) is semidet

True if URL describes a git url for Pack

 1420git_url(URL, Pack) :-
 1421    uri_components(URL, Components),
 1422    uri_data(scheme, Components, Scheme),
 1423    nonvar(Scheme),                         % must be full URL
 1424    uri_data(path, Components, Path),
 1425    (   Scheme == git
 1426    ->  true
 1427    ;   git_download_scheme(Scheme),
 1428        file_name_extension(_, git, Path)
 1429    ;   git_download_scheme(Scheme),
 1430        catch(git_ls_remote(URL, _, [refs(['HEAD']), error(_)]), _, fail)
 1431    ->  true
 1432    ),
 1433    file_base_name(Path, PackExt),
 1434    (   file_name_extension(Pack, git, PackExt)
 1435    ->  true
 1436    ;   Pack = PackExt
 1437    ),
 1438    (   safe_pack_name(Pack)
 1439    ->  true
 1440    ;   domain_error(pack_name, Pack)
 1441    ).
 1442
 1443git_download_scheme(http).
 1444git_download_scheme(https).

 safe_pack_name(+Name:atom) is semidet

Verifies that Name is a valid pack name. This avoids trickery with pack file names to make shell commands behave unexpectly.

 1451safe_pack_name(Name) :-
 1452    atom_length(Name, Len),
 1453    Len >= 3,                               % demand at least three length
 1454    atom_codes(Name, Codes),
 1455    maplist(safe_pack_char, Codes),
 1456    !.
 1457
 1458safe_pack_char(C) :- between(0'a, 0'z, C), !.
 1459safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 1460safe_pack_char(C) :- between(0'0, 0'9, C), !.
 1461safe_pack_char(0'_).
 1462
 1463
 1464                 /*******************************
 1465                 *         VERSION LOGIC        *
 1466                 *******************************/

 pack_version_file(-Pack, -Version, +File) is semidet

True if File is the name of a file or URL of a file that contains Pack at Version. File must have an extension and the basename must be of the form <pack>-<n>{.<m>}*. E.g., mypack-1.5.

 1475pack_version_file(Pack, Version, GitHubRelease) :-
 1476    atomic(GitHubRelease),
 1477    github_release_url(GitHubRelease, Pack, Version),
 1478    !.
 1479pack_version_file(Pack, Version, Path) :-
 1480    atomic(Path),
 1481    file_base_name(Path, File),
 1482    no_int_file_name_extension(Base, _Ext, File),
 1483    atom_codes(Base, Codes),
 1484    (   phrase(pack_version(Pack, Version), Codes),
 1485        safe_pack_name(Pack)
 1486    ->  true
 1487    ).
 1488
 1489no_int_file_name_extension(Base, Ext, File) :-
 1490    file_name_extension(Base0, Ext0, File),
 1491    \+ atom_number(Ext0, _),
 1492    !,
 1493    Base = Base0,
 1494    Ext = Ext0.
 1495no_int_file_name_extension(File, '', File).

 github_release_url(+URL, -Pack, -Version) is semidet

True when URL is the URL of a GitHub release. Such releases are accessible as

https:/github.com/<owner>/<pack>/archive/[vV]?<version>.zip'

 1508github_release_url(URL, Pack, Version) :-
 1509    uri_components(URL, Components),
 1510    uri_data(authority, Components, 'github.com'),
 1511    uri_data(scheme, Components, Scheme),
 1512    download_scheme(Scheme),
 1513    uri_data(path, Components, Path),
 1514    github_archive_path(Archive,Pack,File),
 1515    atomic_list_concat(Archive, /, Path),
 1516    file_name_extension(Tag, Ext, File),
 1517    github_archive_extension(Ext),
 1518    tag_version(Tag, Version),
 1519    !.
 1520
 1521github_archive_path(['',_User,Pack,archive,File],Pack,File).
 1522github_archive_path(['',_User,Pack,archive,refs,tags,File],Pack,File).
 1523
 1524github_archive_extension(tgz).
 1525github_archive_extension(zip).
 1526
 1527tag_version(Tag, Version) :-
 1528    version_tag_prefix(Prefix),
 1529    atom_concat(Prefix, AtomVersion, Tag),
 1530    atom_version(AtomVersion, Version).
 1531
 1532version_tag_prefix(v).
 1533version_tag_prefix('V').
 1534version_tag_prefix('').
 1535
 1536
 1537:- public
 1538    atom_version/2. 1539
 1540%   atom_version(?Atom, ?Version)
 1541%
 1542%   Translate   between   atomic   version   representation   and   term
 1543%   representation.  The  term  representation  is  a  list  of  version
 1544%   components as integers and can be compared using `@>`
 1545
 1546atom_version(Atom, version(Parts)) :-
 1547    (   atom(Atom)
 1548    ->  atom_codes(Atom, Codes),
 1549        phrase(version(Parts), Codes)
 1550    ;   atomic_list_concat(Parts, '.', Atom)
 1551    ).
 1552
 1553pack_version(Pack, version(Parts)) -->
 1554    string(Codes), "-",
 1555    version(Parts),
 1556    !,
 1557    { atom_codes(Pack, Codes)
 1558    }.
 1559
 1560version([_|T]) -->
 1561    "*",
 1562    !,
 1563    (   "."
 1564    ->  version(T)
 1565    ;   []
 1566    ).
 1567version([H|T]) -->
 1568    integer(H),
 1569    (   "."
 1570    ->  version(T)
 1571    ;   { T = [] }
 1572    ).
 1573
 1574                 /*******************************
 1575                 *       QUERY CENTRAL DB       *
 1576                 *******************************/

 pack_inquiry(+URL, +DownloadFile, +Info, +Options) is semidet

Query the status of a package with the central repository. To do this, we POST a Prolog document containing the URL, info and the SHA1 hash to http://www.swi-prolog.org/pack/eval. The server replies using a list of Prolog terms, described below. The only member that is always included is downloads (with default value 0).

alt_hash(Count, URLs, Hash)

A file with the same base-name, but a different hash was found at URLs and downloaded Count times.

downloads(Count)

Number of times a file with this hash was downloaded.

rating(VoteCount, Rating)

User rating (1..5), provided based on VoteCount votes.

dependency(Token, Pack, Version, URLs, SubDeps)

Required tokens can be provided by the given provides.

 1596pack_inquiry(_, _, _, Options) :-
 1597    option(inquiry(false), Options),
 1598    !.
 1599pack_inquiry(URL, DownloadFile, Info, Options) :-
 1600    setting(server, ServerBase),
 1601    ServerBase \== '',
 1602    atom_concat(ServerBase, query, Server),
 1603    (   option(inquiry(true), Options)
 1604    ->  true
 1605    ;   confirm(inquiry(Server), yes, Options)
 1606    ),
 1607    !,
 1608    (   DownloadFile = git(SHA1)
 1609    ->  true
 1610    ;   file_sha1(DownloadFile, SHA1)
 1611    ),
 1612    query_pack_server(install(URL, SHA1, Info), Reply, Options),
 1613    inquiry_result(Reply, URL, Options).
 1614pack_inquiry(_, _, _, _).

 query_pack_server(+Query, -Result, +Options)

Send a Prolog query to the package server and process its results.

 1622query_pack_server(Query, Result, Options) :-
 1623    setting(server, ServerBase),
 1624    ServerBase \== '',
 1625    atom_concat(ServerBase, query, Server),
 1626    format(codes(Data), '~q.~n', Query),
 1627    info_level(Informational, Options),
 1628    print_message(Informational, pack(contacting_server(Server))),
 1629    setup_call_cleanup(
 1630        http_open(Server, In,
 1631                  [ post(codes(application/'x-prolog', Data)),
 1632                    header(content_type, ContentType)
 1633                  ]),
 1634        read_reply(ContentType, In, Result),
 1635        close(In)),
 1636    message_severity(Result, Level, Informational),
 1637    print_message(Level, pack(server_reply(Result))).
 1638
 1639read_reply(ContentType, In, Result) :-
 1640    sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
 1641    !,
 1642    set_stream(In, encoding(utf8)),
 1643    read(In, Result).
 1644read_reply(ContentType, In, _Result) :-
 1645    read_string(In, 500, String),
 1646    print_message(error, pack(no_prolog_response(ContentType, String))),
 1647    fail.
 1648
 1649info_level(Level, Options) :-
 1650    option(silent(true), Options),
 1651    !,
 1652    Level = silent.
 1653info_level(informational, _).
 1654
 1655message_severity(true(_), Informational, Informational).
 1656message_severity(false, warning, _).
 1657message_severity(exception(_), error, _).

 inquiry_result(+Reply, +File, +Options) is semidet

Analyse the results of the inquiry and decide whether to continue or not.

 1665inquiry_result(Reply, File, Options) :-
 1666    findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation),
 1667    \+ member(cancel, Evaluation),
 1668    select_option(git(_), Options, Options1, _),
 1669    forall(member(install_dependencies(Resolution), Evaluation),
 1670           maplist(install_dependency(Options1), Resolution)).
 1671
 1672eval_inquiry(true(Reply), URL, Eval, _) :-
 1673    include(alt_hash, Reply, Alts),
 1674    Alts \== [],
 1675    print_message(warning, pack(alt_hashes(URL, Alts))),
 1676    (   memberchk(downloads(Count), Reply),
 1677        (   git_url(URL, _)
 1678        ->  Default = yes,
 1679            Eval = with_git_commits_in_same_version
 1680        ;   Default = no,
 1681            Eval = with_alt_hashes
 1682        ),
 1683        confirm(continue_with_alt_hashes(Count, URL), Default, [])
 1684    ->  true
 1685    ;   !,                          % Stop other rules
 1686        Eval = cancel
 1687    ).
 1688eval_inquiry(true(Reply), _, Eval, Options) :-
 1689    include(dependency, Reply, Deps),
 1690    Deps \== [],
 1691    select_dependency_resolution(Deps, Eval, Options),
 1692    (   Eval == cancel
 1693    ->  !
 1694    ;   true
 1695    ).
 1696eval_inquiry(true(Reply), URL, true, Options) :-
 1697    file_base_name(URL, File),
 1698    info_level(Informational, Options),
 1699    print_message(Informational, pack(inquiry_ok(Reply, File))).
 1700eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))),
 1701             URL, Eval, Options) :-
 1702    (   confirm(continue_with_modified_hash(URL), no, Options)
 1703    ->  Eval = true
 1704    ;   Eval = cancel
 1705    ).
 1706
 1707alt_hash(alt_hash(_,_,_)).
 1708dependency(dependency(_,_,_,_,_)).

 select_dependency_resolution(+Deps, -Eval, +Options)

Select a resolution.

To be done

- Exploit backtracking over resolve_dependencies/2.