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

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

 pack_install(+Name, +Options) is det

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

url(+URL)

Source for downloading the package

package_directory(+Dir)

Directory into which to install the package.

global(+Boolean)

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

interactive(+Boolean)

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

silent(+Boolean)

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

upgrade(+Boolean)

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

rebuild(Condition)

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

test(Boolean)

If true (default), run the pack tests.

git(+Boolean)

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

link(+Boolean)

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

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

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

  777pack_install(Name, _, Options) :-
  778    current_pack(Name, Dir),
  779    option(upgrade(false), Options, false),
  780    \+ pack_is_in_local_dir(Name, Dir, Options),
  781    print_message(error, pack(already_installed(Name))),
  782    pack_info(Name),
  783    print_message(information, pack(remove_with(Name))),
  784    !,
  785    fail.
  786pack_install(Name, PackDir, Options) :-
  787    option(url(URL), Options),
  788    uri_file_name(URL, Source),
  789    !,
  790    pack_install_from_local(Source, PackDir, Name, Options).
  791pack_install(Name, PackDir, Options) :-
  792    option(url(URL), Options),
  793    uri_components(URL, Components),
  794    uri_data(scheme, Components, Scheme),
  795    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).

  804pack_install_from_local(Source, PackTopDir, Name, Options) :-
  805    exists_directory(Source),
  806    !,
  807    directory_file_path(PackTopDir, Name, PackDir),
  808    (   option(link(true), Options)
  809    ->  (   same_file(Source, PackDir)
  810        ->  true
  811        ;   atom_concat(PackTopDir, '/', PackTopDirS),
  812            relative_file_name(Source, PackTopDirS, RelPath),
  813            link_file(RelPath, PackDir, symbolic),
  814            assertion(same_file(Source, PackDir))
  815        )
  816    ;   prepare_pack_dir(PackDir, Options),
  817        copy_directory(Source, PackDir)
  818    ),
  819    pack_post_install(Name, PackDir, Options).
  820pack_install_from_local(Source, PackTopDir, Name, Options) :-
  821    exists_file(Source),
  822    directory_file_path(PackTopDir, Name, PackDir),
  823    prepare_pack_dir(PackDir, Options),
  824    pack_unpack(Source, PackDir, Name, Options),
  825    pack_post_install(Name, PackDir, Options).
  826
  827pack_is_in_local_dir(_Pack, PackDir, Options) :-
  828    option(url(DirURL), Options),
  829    uri_file_name(DirURL, Dir),
  830    same_file(PackDir, Dir).

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

Unpack an archive to the given package dir.

  837:- if(exists_source(library(archive))).  838pack_unpack(Source, PackDir, Pack, Options) :-
  839    ensure_loaded_archive,
  840    pack_archive_info(Source, Pack, _Info, StripOptions),
  841    prepare_pack_dir(PackDir, Options),
  842    archive_extract(Source, PackDir,
  843                    [ exclude(['._*'])          % MacOS resource forks
  844                    | StripOptions
  845                    ]).
  846:- else.  847pack_unpack(_,_,_,_) :-
  848    existence_error(library, archive).
  849:- endif.  850
  851                 /*******************************
  852                 *             INFO             *
  853                 *******************************/

 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.

  867:- if(exists_source(library(archive))).  868ensure_loaded_archive :-
  869    current_predicate(archive_open/3),
  870    !.
  871ensure_loaded_archive :-
  872    use_module(library(archive)).
  873
  874pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
  875    ensure_loaded_archive,
  876    size_file(Archive, Bytes),
  877    setup_call_cleanup(
  878        archive_open(Archive, Handle, []),
  879        (   repeat,
  880            (   archive_next_header(Handle, InfoFile)
  881            ->  true
  882            ;   !, fail
  883            )
  884        ),
  885        archive_close(Handle)),
  886    file_base_name(InfoFile, 'pack.pl'),
  887    atom_concat(Prefix, 'pack.pl', InfoFile),
  888    strip_option(Prefix, Pack, Strip),
  889    setup_call_cleanup(
  890        archive_open_entry(Handle, Stream),
  891        read_stream_to_terms(Stream, Info),
  892        close(Stream)),
  893    !,
  894    must_be(ground, Info),
  895    maplist(valid_info_term, Info).
  896:- else.  897pack_archive_info(_, _, _, _) :-
  898    existence_error(library, archive).
  899:- endif.  900pack_archive_info(_, _, _, _) :-
  901    existence_error(pack_file, 'pack.pl').
  902
  903strip_option('', _, []) :- !.
  904strip_option('./', _, []) :- !.
  905strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
  906    atom_concat(PrefixDir, /, Prefix),
  907    file_base_name(PrefixDir, Base),
  908    (   Base == Pack
  909    ->  true
  910    ;   pack_version_file(Pack, _, Base)
  911    ->  true
  912    ;   \+ sub_atom(PrefixDir, _, _, _, /)
  913    ).
  914
  915read_stream_to_terms(Stream, Terms) :-
  916    read(Stream, Term0),
  917    read_stream_to_terms(Term0, Stream, Terms).
  918
  919read_stream_to_terms(end_of_file, _, []) :- !.
  920read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
  921    read(Stream, Term1),
  922    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.

  930pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
  931    exists_directory(GitDir),
  932    !,
  933    git_ls_tree(Entries, [directory(GitDir)]),
  934    git_hash(Hash, [directory(GitDir)]),
  935    maplist(arg(4), Entries, Sizes),
  936    sum_list(Sizes, Bytes),
  937    directory_file_path(GitDir, 'pack.pl', InfoFile),
  938    read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
  939    must_be(ground, Info),
  940    maplist(valid_info_term, Info).

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

Perform basic sanity checks on DownloadFile

  946download_file_sanity_check(Archive, Pack, Info) :-
  947    info_field(name(Name), Info),
  948    info_field(version(VersionAtom), Info),
  949    atom_version(VersionAtom, Version),
  950    pack_version_file(PackA, VersionA, Archive),
  951    must_match([Pack, PackA, Name], name),
  952    must_match([Version, VersionA], version).
  953
  954info_field(Field, Info) :-
  955    memberchk(Field, Info),
  956    ground(Field),
  957    !.
  958info_field(Field, _Info) :-
  959    functor(Field, FieldName, _),
  960    print_message(error, pack(missing(FieldName))),
  961    fail.
  962
  963must_match(Values, _Field) :-
  964    sort(Values, [_]),
  965    !.
  966must_match(Values, Field) :-
  967    print_message(error, pack(conflict(Field, Values))),
  968    fail.
  969
  970
  971                 /*******************************
  972                 *         INSTALLATION         *
  973                 *******************************/

 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.

  985prepare_pack_dir(Dir, Options) :-
  986    exists_directory(Dir),
  987    !,
  988    (   empty_directory(Dir)
  989    ->  true
  990    ;   (   option(upgrade(true), Options)
  991        ;   confirm(remove_existing_pack(Dir), yes, Options)
  992        )
  993    ->  delete_directory_and_contents(Dir),
  994        make_directory(Dir)
  995    ).
  996prepare_pack_dir(Dir, _) :-
  997    make_directory(Dir).

 empty_directory(+Directory) is semidet

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

 1003empty_directory(Dir) :-
 1004    \+ ( directory_files(Dir, Entries),
 1005         member(Entry, Entries),
 1006         \+ special(Entry)
 1007       ).
 1008
 1009special(.).
 1010special(..).

 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.

 1020pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
 1021    option(git(true), Options),
 1022    !,
 1023    directory_file_path(PackTopDir, Pack, PackDir),
 1024    prepare_pack_dir(PackDir, Options),
 1025    run_process(path(git), [clone, URL, PackDir], []),
 1026    pack_git_info(PackDir, Hash, Info),
 1027    pack_inquiry(URL, git(Hash), Info, Options),
 1028    show_info(Pack, Info, Options),
 1029    confirm(git_post_install(PackDir, Pack), yes, Options),
 1030    pack_post_install(Pack, PackDir, Options).
 1031pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
 1032    download_scheme(Scheme),
 1033    directory_file_path(PackTopDir, Pack, PackDir),
 1034    prepare_pack_dir(PackDir, Options),
 1035    pack_download_dir(PackTopDir, DownLoadDir),
 1036    download_file(URL, Pack, DownloadBase, Options),
 1037    directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
 1038    setup_call_cleanup(
 1039        http_open(URL, In,
 1040                  [ cert_verify_hook(ssl_verify)
 1041                  ]),
 1042        setup_call_cleanup(
 1043            open(DownloadFile, write, Out, [type(binary)]),
 1044            copy_stream_data(In, Out),
 1045            close(Out)),
 1046        close(In)),
 1047    pack_archive_info(DownloadFile, Pack, Info, _),
 1048    download_file_sanity_check(DownloadFile, Pack, Info),
 1049    pack_inquiry(URL, DownloadFile, Info, Options),
 1050    show_info(Pack, Info, Options),
 1051    confirm(install_downloaded(DownloadFile), yes, Options),
 1052    pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).

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

 1056download_file(URL, Pack, File, Options) :-
 1057    option(version(Version), Options),
 1058    !,
 1059    atom_version(VersionA, Version),
 1060    file_name_extension(_, Ext, URL),
 1061    format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
 1062download_file(URL, Pack, File, _) :-
 1063    file_base_name(URL,Basename),
 1064    no_int_file_name_extension(Tag,Ext,Basename),
 1065    tag_version(Tag,Version),
 1066    !,
 1067    atom_version(VersionA,Version),
 1068    format(atom(File0), '~w-~w', [Pack, VersionA]),
 1069    file_name_extension(File0, Ext, File).
 1070download_file(URL, _, File, _) :-
 1071    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.

 1079pack_url_file(URL, FileID) :-
 1080    github_release_url(URL, Pack, Version),
 1081    !,
 1082    download_file(URL, Pack, FileID, [version(Version)]).
 1083pack_url_file(URL, FileID) :-
 1084    file_base_name(URL, FileID).
 1085
 1086
 1087:- 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.

 1095ssl_verify(_SSL,
 1096           _ProblemCertificate, _AllCertificates, _FirstCertificate,
 1097           _Error).
 1098
 1099pack_download_dir(PackTopDir, DownLoadDir) :-
 1100    directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
 1101    (   exists_directory(DownLoadDir)
 1102    ->  true
 1103    ;   make_directory(DownLoadDir)
 1104    ),
 1105    (   access_file(DownLoadDir, write)
 1106    ->  true
 1107    ;   permission_error(write, directory, DownLoadDir)
 1108    ).

 download_url(+URL) is det

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

 1114download_url(URL) :-
 1115    atom(URL),
 1116    uri_components(URL, Components),
 1117    uri_data(scheme, Components, Scheme),
 1118    download_scheme(Scheme).
 1119
 1120download_scheme(http).
 1121download_scheme(https) :-
 1122    catch(use_module(library(http/http_ssl_plugin)),
 1123          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

 1133pack_post_install(Pack, PackDir, Options) :-
 1134    post_install_foreign(Pack, PackDir, Options),
 1135    post_install_autoload(PackDir, Options),
 1136    '$pack_attach'(PackDir).

 pack_rebuild(+Pack) is det

Rebuild possible foreign components of Pack.

 1142pack_rebuild(Pack) :-
 1143    current_pack(Pack, PackDir),
 1144    !,
 1145    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 1146pack_rebuild(Pack) :-
 1147    unattached_pacth(Pack, PackDir),
 1148    !,
 1149    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 1150pack_rebuild(Pack) :-
 1151    existence_error(pack, Pack).
 1152
 1153unattached_pacth(Pack, BaseDir) :-
 1154    directory_file_path(Pack, 'pack.pl', PackFile),
 1155    absolute_file_name(pack(PackFile), PackPath,
 1156                       [ access(read),
 1157                         file_errors(fail)
 1158                       ]),
 1159    file_directory_name(PackPath, BaseDir).

 pack_rebuild is det

Rebuild foreign components of all packages.

 1165pack_rebuild :-
 1166    forall(current_pack(Pack),
 1167           ( print_message(informational, pack(rebuild(Pack))),
 1168             pack_rebuild(Pack)
 1169           )).

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

Install foreign parts of the package.

 1176post_install_foreign(Pack, PackDir, Options) :-
 1177    is_foreign_pack(PackDir, _),
 1178    !,
 1179    (   pack_info_term(PackDir, pack_version(Version))
 1180    ->  true
 1181    ;   Version = 1
 1182    ),
 1183    option(rebuild(Rebuild), Options, if_absent),
 1184    (   Rebuild == if_absent,
 1185        foreign_present(PackDir)
 1186    ->  print_message(informational, pack(kept_foreign(Pack)))
 1187    ;   BuildSteps0 = [[dependencies], [configure], build, [test], install],
 1188        (   Rebuild == true
 1189        ->  BuildSteps1 = [distclean|BuildSteps0]
 1190        ;   BuildSteps1 = BuildSteps0
 1191        ),
 1192        (   option(test(false), Options)
 1193        ->  delete(BuildSteps1, [test], BuildSteps)
 1194        ;   BuildSteps = BuildSteps1
 1195        ),
 1196        build_steps(BuildSteps, PackDir, [pack_version(Version)|Options])
 1197    ).
 1198post_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.

 1207foreign_present(PackDir) :-
 1208    current_prolog_flag(arch, Arch),
 1209    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
 1210    exists_directory(ForeignBaseDir),
 1211    !,
 1212    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
 1213    exists_directory(ForeignDir),
 1214    current_prolog_flag(shared_object_extension, Ext),
 1215    atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
 1216    expand_file_name(Pattern, Files),
 1217    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.

 1224is_foreign_pack(PackDir, Type) :-
 1225    foreign_file(File, Type),
 1226    directory_file_path(PackDir, File, Path),
 1227    exists_file(Path).
 1228
 1229foreign_file('CMakeLists.txt', cmake).
 1230foreign_file('configure',      configure).
 1231foreign_file('configure.in',   autoconf).
 1232foreign_file('configure.ac',   autoconf).
 1233foreign_file('Makefile.am',    automake).
 1234foreign_file('Makefile',       make).
 1235foreign_file('makefile',       make).
 1236foreign_file('conanfile.txt',  conan).
 1237foreign_file('conanfile.py',   conan).
 1238
 1239
 1240                 /*******************************
 1241                 *           AUTOLOAD           *
 1242                 *******************************/

 post_install_autoload(+PackDir, +Options)

Create an autoload index if the package demands such.

 1248post_install_autoload(PackDir, Options) :-
 1249    option(autoload(true), Options, true),
 1250    pack_info_term(PackDir, autoload(true)),
 1251    !,
 1252    directory_file_path(PackDir, prolog, PrologLibDir),
 1253    make_library_index(PrologLibDir).
 1254post_install_autoload(_, _).
 1255
 1256
 1257                 /*******************************
 1258                 *            UPGRADE           *
 1259                 *******************************/

 pack_upgrade(+Pack) is semidet

Try to upgrade the package Pack.

To be done

- Update dependencies when updating a pack from git?

 1267pack_upgrade(Pack) :-
 1268    pack_info(Pack, _, directory(Dir)),
 1269    directory_file_path(Dir, '.git', GitDir),
 1270    exists_directory(GitDir),
 1271    !,
 1272    print_message(informational, pack(git_fetch(Dir))),
 1273    git([fetch], [ directory(Dir) ]),
 1274    git_describe(V0, [ directory(Dir) ]),
 1275    git_describe(V1, [ directory(Dir), commit('origin/master') ]),
 1276    (   V0 == V1
 1277    ->  print_message(informational, pack(up_to_date(Pack)))
 1278    ;   confirm(upgrade(Pack, V0, V1), yes, []),
 1279        git([merge, 'origin/master'], [ directory(Dir) ]),
 1280        pack_rebuild(Pack)
 1281    ).
 1282pack_upgrade(Pack) :-
 1283    once(pack_info(Pack, _, version(VersionAtom))),
 1284    atom_version(VersionAtom, Version),
 1285    pack_info(Pack, _, download(URL)),
 1286    (   wildcard_pattern(URL)
 1287    ->  true
 1288    ;   github_url(URL, _User, _Repo)
 1289    ),
 1290    !,
 1291    available_download_versions(URL, [Latest-LatestURL|_Versions]),
 1292    (   Latest @> Version
 1293    ->  confirm(upgrade(Pack, Version, Latest), yes, []),
 1294        pack_install(Pack,
 1295                     [ url(LatestURL),
 1296                       upgrade(true),
 1297                       pack(Pack)
 1298                     ])
 1299    ;   print_message(informational, pack(up_to_date(Pack)))
 1300    ).
 1301pack_upgrade(Pack) :-
 1302    print_message(warning, pack(no_upgrade_info(Pack))).
 1303
 1304
 1305                 /*******************************
 1306                 *            REMOVE            *
 1307                 *******************************/

 pack_remove(+Name) is det

Remove the indicated package.

 1313pack_remove(Pack) :-
 1314    update_dependency_db,
 1315    (   setof(Dep, pack_depends_on(Dep, Pack), Deps)
 1316    ->  confirm_remove(Pack, Deps, Delete),
 1317        forall(member(P, Delete), pack_remove_forced(P))
 1318    ;   pack_remove_forced(Pack)
 1319    ).
 1320
 1321pack_remove_forced(Pack) :-
 1322    catch('$pack_detach'(Pack, BaseDir),
 1323          error(existence_error(pack, Pack), _),
 1324          fail),
 1325    !,
 1326    print_message(informational, pack(remove(BaseDir))),
 1327    delete_directory_and_contents(BaseDir).
 1328pack_remove_forced(Pack) :-
 1329    unattached_pacth(Pack, BaseDir),
 1330    !,
 1331    delete_directory_and_contents(BaseDir).
 1332pack_remove_forced(Pack) :-
 1333    print_message(informational, error(existence_error(pack, Pack),_)).
 1334
 1335confirm_remove(Pack, Deps, Delete) :-
 1336    print_message(warning, pack(depends(Pack, Deps))),
 1337    menu(pack(resolve_remove),
 1338         [ [Pack]      = remove_only(Pack),
 1339           [Pack|Deps] = remove_deps(Pack, Deps),
 1340           []          = cancel
 1341         ], [], Delete, []),
 1342    Delete \== [].
 1343
 1344
 1345                 /*******************************
 1346                 *           PROPERTIES         *
 1347                 *******************************/

 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)

 1370pack_property(Pack, Property) :-
 1371    findall(Pack-Property, pack_property_(Pack, Property), List),
 1372    member(Pack-Property, List).            % make det if applicable
 1373
 1374pack_property_(Pack, Property) :-
 1375    pack_info(Pack, _, Property).
 1376pack_property_(Pack, Property) :-
 1377    \+ \+ info_file(Property, _),
 1378    '$pack':pack(Pack, BaseDir),
 1379    access_file(BaseDir, read),
 1380    directory_files(BaseDir, Files),
 1381    member(File, Files),
 1382    info_file(Property, Pattern),
 1383    downcase_atom(File, Pattern),
 1384    directory_file_path(BaseDir, File, InfoFile),
 1385    arg(1, Property, InfoFile).
 1386
 1387info_file(readme(_), 'readme.txt').
 1388info_file(readme(_), 'readme').
 1389info_file(todo(_),   'todo.txt').
 1390info_file(todo(_),   'todo').
 1391
 1392
 1393                 /*******************************
 1394                 *             GIT              *
 1395                 *******************************/

 git_url(+URL, -Pack) is semidet

True if URL describes a git url for Pack

 1401git_url(URL, Pack) :-
 1402    uri_components(URL, Components),
 1403    uri_data(scheme, Components, Scheme),
 1404    nonvar(Scheme),                         % must be full URL
 1405    uri_data(path, Components, Path),
 1406    (   Scheme == git
 1407    ->  true
 1408    ;   git_download_scheme(Scheme),
 1409        file_name_extension(_, git, Path)
 1410    ;   git_download_scheme(Scheme),
 1411        catch(git_ls_remote(URL, _, [refs(['HEAD']), error(_)]), _, fail)
 1412    ->  true
 1413    ),
 1414    file_base_name(Path, PackExt),
 1415    (   file_name_extension(Pack, git, PackExt)
 1416    ->  true
 1417    ;   Pack = PackExt
 1418    ),
 1419    (   safe_pack_name(Pack)
 1420    ->  true
 1421    ;   domain_error(pack_name, Pack)
 1422    ).
 1423
 1424git_download_scheme(http).
 1425git_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.

 1432safe_pack_name(Name) :-
 1433    atom_length(Name, Len),
 1434    Len >= 3,                               % demand at least three length
 1435    atom_codes(Name, Codes),
 1436    maplist(safe_pack_char, Codes),
 1437    !.
 1438
 1439safe_pack_char(C) :- between(0'a, 0'z, C), !.
 1440safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 1441safe_pack_char(C) :- between(0'0, 0'9, C), !.
 1442safe_pack_char(0'_).
 1443
 1444
 1445                 /*******************************
 1446                 *         VERSION LOGIC        *
 1447                 *******************************/

 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.

 1456pack_version_file(Pack, Version, GitHubRelease) :-
 1457    atomic(GitHubRelease),
 1458    github_release_url(GitHubRelease, Pack, Version),
 1459    !.
 1460pack_version_file(Pack, Version, Path) :-
 1461    atomic(Path),
 1462    file_base_name(Path, File),
 1463    no_int_file_name_extension(Base, _Ext, File),
 1464    atom_codes(Base, Codes),
 1465    (   phrase(pack_version(Pack, Version), Codes),
 1466        safe_pack_name(Pack)
 1467    ->  true
 1468    ).
 1469
 1470no_int_file_name_extension(Base, Ext, File) :-
 1471    file_name_extension(Base0, Ext0, File),
 1472    \+ atom_number(Ext0, _),
 1473    !,
 1474    Base = Base0,
 1475    Ext = Ext0.
 1476no_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'

 1489github_release_url(URL, Pack, Version) :-
 1490    uri_components(URL, Components),
 1491    uri_data(authority, Components, 'github.com'),
 1492    uri_data(scheme, Components, Scheme),
 1493    download_scheme(Scheme),
 1494    uri_data(path, Components, Path),
 1495    github_archive_path(Archive,Pack,File),
 1496    atomic_list_concat(Archive, /, Path),
 1497    file_name_extension(Tag, Ext, File),
 1498    github_archive_extension(Ext),
 1499    tag_version(Tag, Version),
 1500    !.
 1501
 1502github_archive_path(['',_User,Pack,archive,File],Pack,File).
 1503github_archive_path(['',_User,Pack,archive,refs,tags,File],Pack,File).
 1504
 1505github_archive_extension(tgz).
 1506github_archive_extension(zip).
 1507
 1508tag_version(Tag, Version) :-
 1509    version_tag_prefix(Prefix),
 1510    atom_concat(Prefix, AtomVersion, Tag),
 1511    atom_version(AtomVersion, Version).
 1512
 1513version_tag_prefix(v).
 1514version_tag_prefix('V').
 1515version_tag_prefix('').
 1516
 1517
 1518:- public
 1519    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 @>

 1527atom_version(Atom, version(Parts)) :-
 1528    (   atom(Atom)
 1529    ->  atom_codes(Atom, Codes),
 1530        phrase(version(Parts), Codes)
 1531    ;   atomic_list_concat(Parts, '.', Atom)
 1532    ).
 1533
 1534pack_version(Pack, version(Parts)) -->
 1535    string(Codes), "-",
 1536    version(Parts),
 1537    !,
 1538    { atom_codes(Pack, Codes)
 1539    }.
 1540
 1541version([_|T]) -->
 1542    "*",
 1543    !,
 1544    (   "."
 1545    ->  version(T)
 1546    ;   []
 1547    ).
 1548version([H|T]) -->
 1549    integer(H),
 1550    (   "."
 1551    ->  version(T)
 1552    ;   { T = [] }
 1553    ).
 1554
 1555                 /*******************************
 1556                 *       QUERY CENTRAL DB       *
 1557                 *******************************/

 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.

 1577pack_inquiry(_, _, _, Options) :-
 1578    option(inquiry(false), Options),
 1579    !.
 1580pack_inquiry(URL, DownloadFile, Info, Options) :-
 1581    setting(server, ServerBase),
 1582    ServerBase \== '',
 1583    atom_concat(ServerBase, query, Server),
 1584    (   option(inquiry(true), Options)
 1585    ->  true
 1586    ;   confirm(inquiry(Server), yes, Options)
 1587    ),
 1588    !,
 1589    (   DownloadFile = git(SHA1)
 1590    ->  true
 1591    ;   file_sha1(DownloadFile, SHA1)
 1592    ),
 1593    query_pack_server(install(URL, SHA1, Info), Reply, Options),
 1594    inquiry_result(Reply, URL, Options).
 1595pack_inquiry(_, _, _, _).

 query_pack_server(+Query, -Result, +Options)

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

 1603query_pack_server(Query, Result, Options) :-
 1604    setting(server, ServerBase),
 1605    ServerBase \== '',
 1606    atom_concat(ServerBase, query, Server),
 1607    format(codes(Data), '~q.~n', Query),
 1608    info_level(Informational, Options),
 1609    print_message(Informational, pack(contacting_server(Server))),
 1610    setup_call_cleanup(
 1611        http_open(Server, In,
 1612                  [ post(codes(application/'x-prolog', Data)),
 1613                    header(content_type, ContentType)
 1614                  ]),
 1615        read_reply(ContentType, In, Result),
 1616        close(In)),
 1617    message_severity(Result, Level, Informational),
 1618    print_message(Level, pack(server_reply(Result))).
 1619
 1620read_reply(ContentType, In, Result) :-
 1621    sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
 1622    !,
 1623    set_stream(In, encoding(utf8)),
 1624    read(In, Result).
 1625read_reply(ContentType, In, _Result) :-
 1626    read_string(In, 500, String),
 1627    print_message(error, pack(no_prolog_response(ContentType, String))),
 1628    fail.
 1629
 1630info_level(Level, Options) :-
 1631    option(silent(true), Options),
 1632    !,
 1633    Level = silent.
 1634info_level(informational, _).
 1635
 1636message_severity(true(_), Informational, Informational).
 1637message_severity(false, warning, _).
 1638message_severity(exception(_), error, _).

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

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

 1646inquiry_result(Reply, File, Options) :-
 1647    findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation),
 1648    \+ member(cancel, Evaluation),
 1649    select_option(git(_), Options, Options1, _),
 1650    forall(member(install_dependencies(Resolution), Evaluation),
 1651           maplist(install_dependency(Options1), Resolution)).
 1652
 1653eval_inquiry(true(Reply), URL, Eval, _) :-
 1654    include(alt_hash, Reply, Alts),
 1655    Alts \== [],
 1656    print_message(warning, pack(alt_hashes(URL, Alts))),
 1657    (   memberchk(downloads(Count), Reply),
 1658        (   git_url(URL, _)
 1659        ->  Default = yes,
 1660            Eval = with_git_commits_in_same_version
 1661        ;   Default = no,
 1662            Eval = with_alt_hashes
 1663        ),
 1664        confirm(continue_with_alt_hashes(Count, URL), Default, [])
 1665    ->  true
 1666    ;   !,                          % Stop other rules
 1667        Eval = cancel
 1668    ).
 1669eval_inquiry(true(Reply), _, Eval, Options) :-
 1670    include(dependency, Reply, Deps),
 1671    Deps \== [],
 1672    select_dependency_resolution(Deps, Eval, Options),
 1673    (   Eval == cancel
 1674    ->  !
 1675    ;   true
 1676    ).
 1677eval_inquiry(true(Reply), URL, true, Options) :-
 1678    file_base_name(URL, File),
 1679    info_level(Informational, Options),
 1680    print_message(Informational, pack(inquiry_ok(Reply, File))).
 1681eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))),
 1682             URL, Eval, Options) :-
 1683    (   confirm(continue_with_modified_hash(URL), no, Options)
 1684    ->  Eval = true
 1685    ;   Eval = cancel
 1686    ).
 1687
 1688alt_hash(alt_hash(_,_,_)).
 1689dependency(dependency(_,_,_,_,_)).

 select_dependency_resolution(+Deps, -Eval, +Options)

Select a resolution.

To be done

- Exploit backtracking over resolve_dependencies/2.

 1698select_dependency_resolution(Deps, Eval, Options) :-
 1699    resolve_dependencies(Deps, Resolution),
 1700    exclude(local_dep, Resolution, ToBeDone),
 1701    (   ToBeDone == []
 1702    ->  !, Eval = true
 1703    ;   print_message(warning, pack(install_dependencies(Resolution))),
 1704        (   memberchk(_-unresolved, Resolution)
 1705        ->  Default = cancel
 1706        ;   Default = install_deps
 1707        ),
 1708        menu(pack(resolve_deps),
 1709             [ install_deps    = install_deps,
 1710               install_no_deps = install_no_deps,
 1711               cancel          = cancel
 1712             ], Default, Choice, Options),
 1713        (   Choice == cancel
 1714        ->  !, Eval = cancel
 1715        ;   Choice == install_no_deps
 1716        ->  !, Eval = install_no_deps
 1717        ;   !, Eval = install_dependencies(Resolution)
 1718        )
 1719    ).
 1720
 1721local_dep(_-resolved(_)).