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

   81:- multifile
   82    environment/2.                          % Name, Value
   83
   84:- dynamic
   85    pack_requires/2,                        % Pack, Requirement
   86    pack_provides_db/2.                     % Pack, Provided
   87
   88
   89                 /*******************************
   90                 *          CONSTANTS           *
   91                 *******************************/
   92
   93:- setting(server, atom, 'https://www.swi-prolog.org/pack/',
   94           'Server to exchange pack information').   95
   96
   97                 /*******************************
   98                 *         PACKAGE INFO         *
   99                 *******************************/

 current_pack(?Pack) is nondet

True if Pack is a currently installed pack.

  105current_pack(Pack) :-
  106    '$pack':pack(Pack, _).

 pack_list_installed is det

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

See also

- Use pack_list/1 to find packages.

  116pack_list_installed :-
  117    findall(Pack, current_pack(Pack), Packages0),
  118    Packages0 \== [],
  119    !,
  120    sort(Packages0, Packages),
  121    length(Packages, Count),
  122    format('Installed packages (~D):~n~n', [Count]),
  123    maplist(pack_info(list), Packages),
  124    validate_dependencies.
  125pack_list_installed :-
  126    print_message(informational, pack(no_packages_installed)).

 pack_info(+Pack)

Print more detailed information about Pack.

  132pack_info(Name) :-
  133    pack_info(info, Name).
  134
  135pack_info(Level, Name) :-
  136    must_be(atom, Name),
  137    findall(Info, pack_info(Name, Level, Info), Infos0),
  138    (   Infos0 == []
  139    ->  print_message(warning, pack(no_pack_installed(Name))),
  140        fail
  141    ;   true
  142    ),
  143    update_dependency_db(Name, Infos0),
  144    findall(Def,  pack_default(Level, Infos, Def), Defs),
  145    append(Infos0, Defs, Infos1),
  146    sort(Infos1, Infos),
  147    show_info(Name, Infos, [info(Level)]).
  148
  149
  150show_info(_Name, _Properties, Options) :-
  151    option(silent(true), Options),
  152    !.
  153show_info(Name, Properties, Options) :-
  154    option(info(list), Options),
  155    !,
  156    memberchk(title(Title), Properties),
  157    memberchk(version(Version), Properties),
  158    format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
  159show_info(Name, Properties, _) :-
  160    !,
  161    print_property_value('Package'-'~w', [Name]),
  162    findall(Term, pack_level_info(info, Term, _, _), Terms),
  163    maplist(print_property(Properties), Terms).
  164
  165print_property(_, nl) :-
  166    !,
  167    format('~n').
  168print_property(Properties, Term) :-
  169    findall(Term, member(Term, Properties), Terms),
  170    Terms \== [],
  171    !,
  172    pack_level_info(_, Term, LabelFmt, _Def),
  173    (   LabelFmt = Label-FmtElem
  174    ->  true
  175    ;   Label = LabelFmt,
  176        FmtElem = '~w'
  177    ),
  178    multi_valued(Terms, FmtElem, FmtList, Values),
  179    atomic_list_concat(FmtList, ', ', Fmt),
  180    print_property_value(Label-Fmt, Values).
  181print_property(_, _).
  182
  183multi_valued([H], LabelFmt, [LabelFmt], Values) :-
  184    !,
  185    H =.. [_|Values].
  186multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
  187    H =.. [_|VH],
  188    append(VH, MoreValues, Values),
  189    multi_valued(T, LabelFmt, LT, MoreValues).
  190
  191
  192pvalue_column(24).
  193print_property_value(Prop-Fmt, Values) :-
  194    !,
  195    pvalue_column(C),
  196    atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
  197    format(Format, [Prop,C|Values]).
  198
  199pack_info(Name, Level, Info) :-
  200    '$pack':pack(Name, BaseDir),
  201    (   Info = directory(BaseDir)
  202    ;   pack_info_term(BaseDir, Info)
  203    ),
  204    pack_level_info(Level, Info, _Format, _Default).
  205
  206:- public pack_level_info/4.                    % used by web-server
  207
  208pack_level_info(_,    title(_),         'Title',                   '<no title>').
  209pack_level_info(_,    version(_),       'Installed version',       '<unknown>').
  210pack_level_info(info, directory(_),     'Installed in directory',  -).
  211pack_level_info(info, author(_, _),     'Author'-'~w <~w>',        -).
  212pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>',    -).
  213pack_level_info(info, packager(_, _),   'Packager'-'~w <~w>',      -).
  214pack_level_info(info, home(_),          'Home page',               -).
  215pack_level_info(info, download(_),      'Download URL',            -).
  216pack_level_info(_,    provides(_),      'Provides',                -).
  217pack_level_info(_,    requires(_),      'Requires',                -).
  218pack_level_info(_,    conflicts(_),     'Conflicts with',          -).
  219pack_level_info(_,    replaces(_),      'Replaces packages',       -).
  220pack_level_info(info, library(_),	'Provided libraries',      -).
  221
  222pack_default(Level, Infos, Def) :-
  223    pack_level_info(Level, ITerm, _Format, Def),
  224    Def \== (-),
  225    \+ memberchk(ITerm, Infos).

 pack_info_term(+PackDir, ?Info) is nondet

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

  231pack_info_term(BaseDir, Info) :-
  232    directory_file_path(BaseDir, 'pack.pl', InfoFile),
  233    catch(
  234        setup_call_cleanup(
  235            open(InfoFile, read, In),
  236            term_in_stream(In, Info),
  237            close(In)),
  238        error(existence_error(source_sink, InfoFile), _),
  239        ( print_message(error, pack(no_meta_data(BaseDir))),
  240          fail
  241        )).
  242pack_info_term(BaseDir, library(Lib)) :-
  243    atom_concat(BaseDir, '/prolog/', LibDir),
  244    atom_concat(LibDir, '*.pl', Pattern),
  245    expand_file_name(Pattern, Files),
  246    maplist(atom_concat(LibDir), Plain, Files),
  247    convlist(base_name, Plain, Libs),
  248    member(Lib, Libs).
  249
  250base_name(File, Base) :-
  251    file_name_extension(Base, pl, File).
  252
  253term_in_stream(In, Term) :-
  254    repeat,
  255        read_term(In, Term0, []),
  256        (   Term0 == end_of_file
  257        ->  !, fail
  258        ;   Term = Term0,
  259            valid_info_term(Term0)
  260        ).
  261
  262valid_info_term(Term) :-
  263    Term =.. [Name|Args],
  264    same_length(Args, Types),
  265    Decl =.. [Name|Types],
  266    (   pack_info_term(Decl)
  267    ->  maplist(valid_info_arg, Types, Args)
  268    ;   print_message(warning, pack(invalid_info(Term))),
  269        fail
  270    ).
  271
  272valid_info_arg(Type, Arg) :-
  273    must_be(Type, Arg).

 pack_info_term(?Term) is nondet

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

  280pack_info_term(name(atom)).                     % Synopsis
  281pack_info_term(title(atom)).
  282pack_info_term(keywords(list(atom))).
  283pack_info_term(description(list(atom))).
  284pack_info_term(version(version)).
  285pack_info_term(author(atom, email_or_url)).     % Persons
  286pack_info_term(maintainer(atom, email_or_url)).
  287pack_info_term(packager(atom, email_or_url)).
  288pack_info_term(home(atom)).                     % Home page
  289pack_info_term(download(atom)).                 % Source
  290pack_info_term(provides(atom)).                 % Dependencies
  291pack_info_term(requires(dependency)).
  292pack_info_term(conflicts(dependency)).          % Conflicts with package
  293pack_info_term(replaces(atom)).                 % Replaces another package
  294pack_info_term(autoload(boolean)).              % Default installation options
  295
  296:- multifile
  297    error:has_type/2.  298
  299error:has_type(version, Version) :-
  300    atom(Version),
  301    version_data(Version, _Data).
  302error:has_type(email_or_url, Address) :-
  303    atom(Address),
  304    (   sub_atom(Address, _, _, _, @)
  305    ->  true
  306    ;   uri_is_global(Address)
  307    ).
  308error:has_type(dependency, Value) :-
  309    is_dependency(Value, _Token, _Version).
  310
  311version_data(Version, version(Data)) :-
  312    atomic_list_concat(Parts, '.', Version),
  313    maplist(atom_number, Parts, Data).
  314
  315is_dependency(Token, Token, *) :-
  316    atom(Token).
  317is_dependency(Term, Token, VersionCmp) :-
  318    Term =.. [Op,Token,Version],
  319    cmp(Op, _),
  320    version_data(Version, _),
  321    VersionCmp =.. [Op,Version].
  322
  323cmp(<,  @<).
  324cmp(=<, @=<).
  325cmp(==, ==).
  326cmp(>=, @>=).
  327cmp(>,  @>).
  328
  329
  330                 /*******************************
  331                 *            SEARCH            *
  332                 *******************************/

 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.

  361pack_list(Query) :-
  362    pack_search(Query).
  363
  364pack_search(Query) :-
  365    query_pack_server(search(Query), Result, []),
  366    (   Result == false
  367    ->  (   local_search(Query, Packs),
  368            Packs \== []
  369        ->  forall(member(pack(Pack, Stat, Title, Version, _), Packs),
  370                   format('~w ~w@~w ~28|- ~w~n',
  371                          [Stat, Pack, Version, Title]))
  372        ;   print_message(warning, pack(search_no_matches(Query)))
  373        )
  374    ;   Result = true(Hits),
  375        local_search(Query, Local),
  376        append(Hits, Local, All),
  377        sort(All, Sorted),
  378        list_hits(Sorted)
  379    ).
  380
  381list_hits([]).
  382list_hits([ pack(Pack, i, Title, Version, _),
  383            pack(Pack, p, Title, Version, _)
  384          | More
  385          ]) :-
  386    !,
  387    format('i ~w@~w ~28|- ~w~n', [Pack, Version, Title]),
  388    list_hits(More).
  389list_hits([ pack(Pack, i, Title, VersionI, _),
  390            pack(Pack, p, _,     VersionS, _)
  391          | More
  392          ]) :-
  393    !,
  394    version_data(VersionI, VDI),
  395    version_data(VersionS, VDS),
  396    (   VDI @< VDS
  397    ->  Tag = ('U')
  398    ;   Tag = ('A')
  399    ),
  400    format('~w ~w@~w(~w) ~28|- ~w~n', [Tag, Pack, VersionI, VersionS, Title]),
  401    list_hits(More).
  402list_hits([ pack(Pack, i, Title, VersionI, _)
  403          | More
  404          ]) :-
  405    !,
  406    format('l ~w@~w ~28|- ~w~n', [Pack, VersionI, Title]),
  407    list_hits(More).
  408list_hits([pack(Pack, Stat, Title, Version, _)|More]) :-
  409    format('~w ~w@~w ~28|- ~w~n', [Stat, Pack, Version, Title]),
  410    list_hits(More).
  411
  412
  413local_search(Query, Packs) :-
  414    findall(Pack, matching_installed_pack(Query, Pack), Packs).
  415
  416matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
  417    current_pack(Pack),
  418    findall(Term,
  419            ( pack_info(Pack, _, Term),
  420              search_info(Term)
  421            ), Info),
  422    (   sub_atom_icasechk(Pack, _, Query)
  423    ->  true
  424    ;   memberchk(title(Title), Info),
  425        sub_atom_icasechk(Title, _, Query)
  426    ),
  427    option(title(Title), Info, '<no title>'),
  428    option(version(Version), Info, '<no version>'),
  429    option(download(URL), Info, '<no download url>').
  430
  431search_info(title(_)).
  432search_info(version(_)).
  433search_info(download(_)).
  434
  435
  436                 /*******************************
  437                 *            INSTALL           *
  438                 *******************************/

 pack_install(+Spec:atom) is det

Install a package. Spec is one of

• 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.
• A package name. This queries the package repository at http://www.swi-prolog.org

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

  456pack_install(Spec) :-
  457    pack_default_options(Spec, Pack, [], Options),
  458    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.

  465pack_default_options(_Spec, Pack, OptsIn, Options) :-
  466    option(already_installed(pack(Pack,_Version)), OptsIn),
  467    !,
  468    Options = OptsIn.
  469pack_default_options(_Spec, Pack, OptsIn, Options) :-
  470    option(url(URL), OptsIn),
  471    !,
  472    (   option(git(_), OptsIn)
  473    ->  Options = OptsIn
  474    ;   git_url(URL, Pack)
  475    ->  Options = [git(true)|OptsIn]
  476    ;   Options = OptsIn
  477    ),
  478    (   nonvar(Pack)
  479    ->  true
  480    ;   option(pack(Pack), Options)
  481    ->  true
  482    ;   pack_version_file(Pack, _Version, URL)
  483    ).
  484pack_default_options(Archive, Pack, _, Options) :-      % Install from archive
  485    must_be(atom, Archive),
  486    \+ uri_is_global(Archive),
  487    expand_file_name(Archive, [File]),
  488    exists_file(File),
  489    !,
  490    pack_version_file(Pack, Version, File),
  491    uri_file_name(FileURL, File),
  492    Options = [url(FileURL), version(Version)].
  493pack_default_options(URL, Pack, _, Options) :-
  494    git_url(URL, Pack),
  495    !,
  496    Options = [git(true), url(URL)].
  497pack_default_options(FileURL, Pack, _, Options) :-      % Install from directory
  498    uri_file_name(FileURL, Dir),
  499    exists_directory(Dir),
  500    pack_info_term(Dir, name(Pack)),
  501    !,
  502    (   pack_info_term(Dir, version(Version))
  503    ->  uri_file_name(DirURL, Dir),
  504        Options = [url(DirURL), version(Version)]
  505    ;   throw(error(existence_error(key, version, Dir),_))
  506    ).
  507pack_default_options(URL, Pack, _, Options) :-          % Install from URL
  508    pack_version_file(Pack, Version, URL),
  509    download_url(URL),
  510    !,
  511    available_download_versions(URL, [URLVersion-LatestURL|_]),
  512    Options = [url(LatestURL)|VersionOptions],
  513    version_options(Version, URLVersion, VersionOptions).
  514pack_default_options(Pack, Pack, OptsIn, Options) :-    % Install from name
  515    \+ uri_is_global(Pack),                             % ignore URLs
  516    query_pack_server(locate(Pack), Reply, OptsIn),
  517    (   Reply = true(Results)
  518    ->  pack_select_candidate(Pack, Results, OptsIn, Options)
  519    ;   print_message(warning, pack(no_match(Pack))),
  520        fail
  521    ).
  522
  523version_options(Version, Version, [version(Version)]) :- !.
  524version_options(Version, _, [version(Version)]) :-
  525    Version = version(List),
  526    maplist(integer, List),
  527    !.
  528version_options(_, _, []).

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

Select from available packages.

  534pack_select_candidate(Pack, [Version-_|_], Options,
  535                      [already_installed(pack(Pack, Installed))|Options]) :-
  536    current_pack(Pack),
  537    pack_info(Pack, _, version(InstalledAtom)),
  538    atom_version(InstalledAtom, Installed),
  539    Installed @>= Version,
  540    !.
  541pack_select_candidate(Pack, Available, Options, OptsOut) :-
  542    option(url(URL), Options),
  543    memberchk(_Version-URLs, Available),
  544    memberchk(URL, URLs),
  545    !,
  546    (   git_url(URL, Pack)
  547    ->  Extra = [git(true)]
  548    ;   Extra = []
  549    ),
  550    OptsOut = [url(URL), inquiry(true) | Extra].
  551pack_select_candidate(Pack, [Version-[URL]|_], Options,
  552                      [url(URL), git(true), inquiry(true)]) :-
  553    git_url(URL, Pack),
  554    !,
  555    confirm(install_from(Pack, Version, git(URL)), yes, Options).
  556pack_select_candidate(Pack, [Version-[URL]|More], Options,
  557                      [url(URL), inquiry(true)]) :-
  558    (   More == []
  559    ->  !
  560    ;   true
  561    ),
  562    confirm(install_from(Pack, Version, URL), yes, Options),
  563    !.
  564pack_select_candidate(Pack, [Version-URLs|_], Options,
  565                      [url(URL), inquiry(true)|Rest]) :-
  566    maplist(url_menu_item, URLs, Tagged),
  567    append(Tagged, [cancel=cancel], Menu),
  568    Menu = [Default=_|_],
  569    menu(pack(select_install_from(Pack, Version)),
  570         Menu, Default, Choice, Options),
  571    (   Choice == cancel
  572    ->  fail
  573    ;   Choice = git(URL)
  574    ->  Rest = [git(true)]
  575    ;   Choice = URL,
  576        Rest = []
  577    ).
  578
  579url_menu_item(URL, git(URL)=install_from(git(URL))) :-
  580    git_url(URL, _),
  581    !.
  582url_menu_item(URL, URL=install_from(URL)).

 pack_install(+Name, +Options) is det

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

url(+URL)

Source for downloading the package

package_directory(+Dir)

Directory into which to install the package

interactive(+Boolean)

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

silent(+Boolean)

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

upgrade(+Boolean)

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

git(+Boolean)

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

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

  613pack_install(Spec, Options) :-
  614    pack_default_options(Spec, Pack, Options, DefOptions),
  615    (   option(already_installed(Installed), DefOptions)
  616    ->  print_message(informational, pack(already_installed(Installed)))
  617    ;   merge_options(Options, DefOptions, PackOptions),
  618        update_dependency_db,
  619        pack_install_dir(PackDir, PackOptions),
  620        pack_install(Pack, PackDir, PackOptions)
  621    ).
  622
  623pack_install_dir(PackDir, Options) :-
  624    option(package_directory(PackDir), Options),
  625    !.
  626pack_install_dir(PackDir, _Options) :-          % TBD: global/user?
  627    absolute_file_name(pack(.), PackDir,
  628                       [ file_type(directory),
  629                         access(write),
  630                         file_errors(fail)
  631                       ]),
  632    !.
  633pack_install_dir(PackDir, Options) :-           % TBD: global/user?
  634    pack_create_install_dir(PackDir, Options).
  635
  636pack_create_install_dir(PackDir, Options) :-
  637    findall(Candidate = create_dir(Candidate),
  638            ( absolute_file_name(pack(.), Candidate, [solutions(all)]),
  639              \+ exists_file(Candidate),
  640              \+ exists_directory(Candidate),
  641              file_directory_name(Candidate, Super),
  642              (   exists_directory(Super)
  643              ->  access_file(Super, write)
  644              ;   true
  645              )
  646            ),
  647            Candidates0),
  648    list_to_set(Candidates0, Candidates),   % keep order
  649    pack_create_install_dir(Candidates, PackDir, Options).
  650
  651pack_create_install_dir(Candidates, PackDir, Options) :-
  652    Candidates = [Default=_|_],
  653    !,
  654    append(Candidates, [cancel=cancel], Menu),
  655    menu(pack(create_pack_dir), Menu, Default, Selected, Options),
  656    Selected \== cancel,
  657    (   catch(make_directory_path(Selected), E,
  658              (print_message(warning, E), fail))
  659    ->  PackDir = Selected
  660    ;   delete(Candidates, PackDir=create_dir(PackDir), Remaining),
  661        pack_create_install_dir(Remaining, PackDir, Options)
  662    ).
  663pack_create_install_dir(_, _, _) :-
  664    print_message(error, pack(cannot_create_dir(pack(.)))),
  665    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.

  680pack_install(Name, _, Options) :-
  681    current_pack(Name),
  682    option(upgrade(false), Options, false),
  683    print_message(error, pack(already_installed(Name))),
  684    pack_info(Name),
  685    print_message(information, pack(remove_with(Name))),
  686    !,
  687    fail.
  688pack_install(Name, PackDir, Options) :-
  689    option(url(URL), Options),
  690    uri_file_name(URL, Source),
  691    !,
  692    pack_install_from_local(Source, PackDir, Name, Options).
  693pack_install(Name, PackDir, Options) :-
  694    option(url(URL), Options),
  695    uri_components(URL, Components),
  696    uri_data(scheme, Components, Scheme),
  697    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).

  706pack_install_from_local(Source, PackTopDir, Name, Options) :-
  707    exists_directory(Source),
  708    !,
  709    directory_file_path(PackTopDir, Name, PackDir),
  710    prepare_pack_dir(PackDir, Options),
  711    copy_directory(Source, PackDir),
  712    pack_post_install(Name, PackDir, Options).
  713pack_install_from_local(Source, PackTopDir, Name, Options) :-
  714    exists_file(Source),
  715    directory_file_path(PackTopDir, Name, PackDir),
  716    prepare_pack_dir(PackDir, Options),
  717    pack_unpack(Source, PackDir, Name, Options),
  718    pack_post_install(Name, PackDir, Options).

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

Unpack an archive to the given package dir.

  725:- if(exists_source(library(archive))).  726pack_unpack(Source, PackDir, Pack, Options) :-
  727    ensure_loaded_archive,
  728    pack_archive_info(Source, Pack, _Info, StripOptions),
  729    prepare_pack_dir(PackDir, Options),
  730    archive_extract(Source, PackDir,
  731                    [ exclude(['._*'])          % MacOS resource forks
  732                    | StripOptions
  733                    ]).
  734:- else.  735pack_unpack(_,_,_,_) :-
  736    existence_error(library, archive).
  737:- endif.  738
  739                 /*******************************
  740                 *             INFO             *
  741                 *******************************/

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

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

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.

  755:- if(exists_source(library(archive))).  756ensure_loaded_archive :-
  757    current_predicate(archive_open/3),
  758    !.
  759ensure_loaded_archive :-
  760    use_module(library(archive)).
  761
  762pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
  763    ensure_loaded_archive,
  764    size_file(Archive, Bytes),
  765    setup_call_cleanup(
  766        archive_open(Archive, Handle, []),
  767        (   repeat,
  768            (   archive_next_header(Handle, InfoFile)
  769            ->  true
  770            ;   !, fail
  771            )
  772        ),
  773        archive_close(Handle)),
  774    file_base_name(InfoFile, 'pack.pl'),
  775    atom_concat(Prefix, 'pack.pl', InfoFile),
  776    strip_option(Prefix, Pack, Strip),
  777    setup_call_cleanup(
  778        archive_open_entry(Handle, Stream),
  779        read_stream_to_terms(Stream, Info),
  780        close(Stream)),
  781    !,
  782    must_be(ground, Info),
  783    maplist(valid_info_term, Info).
  784:- else.  785pack_archive_info(_, _, _, _) :-
  786    existence_error(library, archive).
  787:- endif.  788pack_archive_info(_, _, _, _) :-
  789    existence_error(pack_file, 'pack.pl').
  790
  791strip_option('', _, []) :- !.
  792strip_option('./', _, []) :- !.
  793strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
  794    atom_concat(PrefixDir, /, Prefix),
  795    file_base_name(PrefixDir, Base),
  796    (   Base == Pack
  797    ->  true
  798    ;   pack_version_file(Pack, _, Base)
  799    ->  true
  800    ;   \+ sub_atom(PrefixDir, _, _, _, /)
  801    ).
  802
  803read_stream_to_terms(Stream, Terms) :-
  804    read(Stream, Term0),
  805    read_stream_to_terms(Term0, Stream, Terms).
  806
  807read_stream_to_terms(end_of_file, _, []) :- !.
  808read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
  809    read(Stream, Term1),
  810    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.

  818pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
  819    exists_directory(GitDir),
  820    !,
  821    git_ls_tree(Entries, [directory(GitDir)]),
  822    git_hash(Hash, [directory(GitDir)]),
  823    maplist(arg(4), Entries, Sizes),
  824    sum_list(Sizes, Bytes),
  825    directory_file_path(GitDir, 'pack.pl', InfoFile),
  826    read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
  827    must_be(ground, Info),
  828    maplist(valid_info_term, Info).

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

Perform basic sanity checks on DownloadFile

  834download_file_sanity_check(Archive, Pack, Info) :-
  835    info_field(name(Name), Info),
  836    info_field(version(VersionAtom), Info),
  837    atom_version(VersionAtom, Version),
  838    pack_version_file(PackA, VersionA, Archive),
  839    must_match([Pack, PackA, Name], name),
  840    must_match([Version, VersionA], version).
  841
  842info_field(Field, Info) :-
  843    memberchk(Field, Info),
  844    ground(Field),
  845    !.
  846info_field(Field, _Info) :-
  847    functor(Field, FieldName, _),
  848    print_message(error, pack(missing(FieldName))),
  849    fail.
  850
  851must_match(Values, _Field) :-
  852    sort(Values, [_]),
  853    !.
  854must_match(Values, Field) :-
  855    print_message(error, pack(conflict(Field, Values))),
  856    fail.
  857
  858
  859                 /*******************************
  860                 *         INSTALLATION         *
  861                 *******************************/

 prepare_pack_dir(+Dir, +Options)

Prepare for installing the package into Dir. This should create Dir if it does not exist and warn if the directory already exists, asking to make it empty.

  869prepare_pack_dir(Dir, Options) :-
  870    exists_directory(Dir),
  871    !,
  872    (   empty_directory(Dir)
  873    ->  true
  874    ;   option(upgrade(true), Options)
  875    ->  delete_directory_contents(Dir)
  876    ;   confirm(remove_existing_pack(Dir), yes, Options),
  877        delete_directory_contents(Dir)
  878    ).
  879prepare_pack_dir(Dir, _) :-
  880    make_directory(Dir).

 empty_directory(+Directory) is semidet

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

  886empty_directory(Dir) :-
  887    \+ ( directory_files(Dir, Entries),
  888         member(Entry, Entries),
  889         \+ special(Entry)
  890       ).
  891
  892special(.).
  893special(..).

 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.

  903pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
  904    option(git(true), Options),
  905    !,
  906    directory_file_path(PackTopDir, Pack, PackDir),
  907    prepare_pack_dir(PackDir, Options),
  908    run_process(path(git), [clone, URL, PackDir], []),
  909    pack_git_info(PackDir, Hash, Info),
  910    pack_inquiry(URL, git(Hash), Info, Options),
  911    show_info(Pack, Info, Options),
  912    confirm(git_post_install(PackDir, Pack), yes, Options),
  913    pack_post_install(Pack, PackDir, Options).
  914pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
  915    download_scheme(Scheme),
  916    directory_file_path(PackTopDir, Pack, PackDir),
  917    prepare_pack_dir(PackDir, Options),
  918    pack_download_dir(PackTopDir, DownLoadDir),
  919    download_file(URL, Pack, DownloadBase, Options),
  920    directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
  921    setup_call_cleanup(
  922        http_open(URL, In,
  923                  [ cert_verify_hook(ssl_verify)
  924                  ]),
  925        setup_call_cleanup(
  926            open(DownloadFile, write, Out, [type(binary)]),
  927            copy_stream_data(In, Out),
  928            close(Out)),
  929        close(In)),
  930    pack_archive_info(DownloadFile, Pack, Info, _),
  931    download_file_sanity_check(DownloadFile, Pack, Info),
  932    pack_inquiry(URL, DownloadFile, Info, Options),
  933    show_info(Pack, Info, Options),
  934    confirm(install_downloaded(DownloadFile), yes, Options),
  935    pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).

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

  939download_file(URL, Pack, File, Options) :-
  940    option(version(Version), Options),
  941    !,
  942    atom_version(VersionA, Version),
  943    file_name_extension(_, Ext, URL),
  944    format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
  945download_file(URL, Pack, File, _) :-
  946    file_base_name(URL,Basename),
  947    no_int_file_name_extension(Tag,Ext,Basename),
  948    tag_version(Tag,Version),
  949    !,
  950    atom_version(VersionA,Version),
  951    format(atom(File0), '~w-~w', [Pack, VersionA]),
  952    file_name_extension(File0, Ext, File).
  953download_file(URL, _, File, _) :-
  954    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.

  962pack_url_file(URL, FileID) :-
  963    github_release_url(URL, Pack, Version),
  964    !,
  965    download_file(URL, Pack, FileID, [version(Version)]).
  966pack_url_file(URL, FileID) :-
  967    file_base_name(URL, FileID).
  968
  969
  970:- 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.

  978ssl_verify(_SSL,
  979           _ProblemCertificate, _AllCertificates, _FirstCertificate,
  980           _Error).
  981
  982pack_download_dir(PackTopDir, DownLoadDir) :-
  983    directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
  984    (   exists_directory(DownLoadDir)
  985    ->  true
  986    ;   make_directory(DownLoadDir)
  987    ),
  988    (   access_file(DownLoadDir, write)
  989    ->  true
  990    ;   permission_error(write, directory, DownLoadDir)
  991    ).

 download_url(+URL) is det

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

  997download_url(URL) :-
  998    atom(URL),
  999    uri_components(URL, Components),
 1000    uri_data(scheme, Components, Scheme),
 1001    download_scheme(Scheme).
 1002
 1003download_scheme(http).
 1004download_scheme(https) :-
 1005    catch(use_module(library(http/http_ssl_plugin)),
 1006          E, (print_message(warning, E), fail)).

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

Process post installation work. Steps:

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

 1016pack_post_install(Pack, PackDir, Options) :-
 1017    post_install_foreign(Pack, PackDir,
 1018                         [ build_foreign(if_absent)
 1019                         | Options
 1020                         ]),
 1021    post_install_autoload(PackDir, Options),
 1022    '$pack_attach'(PackDir).

 pack_rebuild(+Pack) is det

Rebuilt possible foreign components of Pack.

 1028pack_rebuild(Pack) :-
 1029    '$pack':pack(Pack, BaseDir),
 1030    !,
 1031    catch(pack_make(BaseDir, [distclean], []), E,
 1032          print_message(warning, E)),
 1033    post_install_foreign(Pack, BaseDir, []).
 1034pack_rebuild(Pack) :-
 1035    existence_error(pack, Pack).

 pack_rebuild is det

Rebuild foreign components of all packages.

 1041pack_rebuild :-
 1042    forall(current_pack(Pack),
 1043           ( print_message(informational, pack(rebuild(Pack))),
 1044             pack_rebuild(Pack)
 1045           )).

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

Install foreign parts of the package.

 1052post_install_foreign(Pack, PackDir, Options) :-
 1053    is_foreign_pack(PackDir),
 1054    !,
 1055    (   option(build_foreign(if_absent), Options),
 1056        foreign_present(PackDir)
 1057    ->  print_message(informational, pack(kept_foreign(Pack)))
 1058    ;   setup_path,
 1059        save_build_environment(PackDir),
 1060        configure_foreign(PackDir, Options),
 1061        make_foreign(PackDir, Options)
 1062    ).
 1063post_install_foreign(_, _, _).
 1064
 1065foreign_present(PackDir) :-
 1066    current_prolog_flag(arch, Arch),
 1067    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
 1068    exists_directory(ForeignBaseDir),
 1069    !,
 1070    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
 1071    exists_directory(ForeignDir),
 1072    current_prolog_flag(shared_object_extension, Ext),
 1073    atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
 1074    expand_file_name(Pattern, Files),
 1075    Files \== [].
 1076
 1077is_foreign_pack(PackDir) :-
 1078    foreign_file(File),
 1079    directory_file_path(PackDir, File, Path),
 1080    exists_file(Path),
 1081    !.
 1082
 1083foreign_file('configure.in').
 1084foreign_file('configure.ac').
 1085foreign_file('configure').
 1086foreign_file('Makefile').
 1087foreign_file('makefile').
 1088foreign_file('CMakeLists.txt').

 configure_foreign(+PackDir, +Options) is det

Run configure if it exists. If configure.ac or configure.in exists, first run autoheader and autoconf

 1096configure_foreign(PackDir, Options) :-
 1097    directory_file_path(PackDir, 'CMakeLists.txt', CMakeFile),
 1098    exists_file(CMakeFile),
 1099    !,
 1100    cmake_configure_foreign(PackDir, Options).
 1101configure_foreign(PackDir, Options) :-
 1102    make_configure(PackDir, Options),
 1103    directory_file_path(PackDir, configure, Configure),
 1104    exists_file(Configure),
 1105    !,
 1106    build_environment(BuildEnv),
 1107    run_process(path(bash), [Configure],
 1108                [ env(BuildEnv),
 1109                  directory(PackDir)
 1110                ]).
 1111configure_foreign(_, _).
 1112
 1113make_configure(PackDir, _Options) :-
 1114    directory_file_path(PackDir, 'configure', Configure),
 1115    exists_file(Configure),
 1116    !.
 1117make_configure(PackDir, _Options) :-
 1118    autoconf_master(ConfigMaster),
 1119    directory_file_path(PackDir, ConfigMaster, ConfigureIn),
 1120    exists_file(ConfigureIn),
 1121    !,
 1122    run_process(path(autoheader), [], [directory(PackDir)]),
 1123    run_process(path(autoconf),   [], [directory(PackDir)]).
 1124make_configure(_, _).
 1125
 1126autoconf_master('configure.ac').
 1127autoconf_master('configure.in').

 cmake_configure_foreign(+PackDir, +Options) is det

Create a build directory in PackDir and run `cmake ..`

 1133cmake_configure_foreign(PackDir, _Options) :-
 1134    directory_file_path(PackDir, build, BuildDir),
 1135    make_directory_path(BuildDir),
 1136    current_prolog_flag(executable, Exe),
 1137    format(atom(CDEF), '-DSWIPL=~w', [Exe]),
 1138    run_process(path(cmake), [CDEF, '..'],
 1139                [directory(BuildDir)]).

 make_foreign(+PackDir, +Options) is det

Generate the foreign executable.

 1146make_foreign(PackDir, Options) :-
 1147    pack_make(PackDir, [all, check, install], Options).
 1148
 1149pack_make(PackDir, Targets, _Options) :-
 1150    directory_file_path(PackDir, 'Makefile', Makefile),
 1151    exists_file(Makefile),
 1152    !,
 1153    build_environment(BuildEnv),
 1154    ProcessOptions = [ directory(PackDir), env(BuildEnv) ],
 1155    forall(member(Target, Targets),
 1156           run_process(path(make), [Target], ProcessOptions)).
 1157pack_make(PackDir, Targets, _Options) :-
 1158    directory_file_path(PackDir, 'CMakeLists.txt', CMakefile),
 1159    exists_file(CMakefile),
 1160    directory_file_path(PackDir, 'build', BuildDir),
 1161    exists_directory(BuildDir),
 1162    !,
 1163    (   Targets == [distclean]
 1164    ->  delete_directory_contents(BuildDir)
 1165    ;   build_environment(BuildEnv),
 1166        ProcessOptions = [ directory(BuildDir), env(BuildEnv) ],
 1167        forall(member(Target, Targets),
 1168               run_cmake_target(Target, BuildDir, ProcessOptions))
 1169    ).
 1170pack_make(_, _, _).
 1171
 1172run_cmake_target(check, BuildDir, ProcessOptions) :-
 1173    !,
 1174    (   directory_file_path(BuildDir, 'CTestTestfile.cmake', TestFile),
 1175        exists_file(TestFile)
 1176    ->  run_process(path(ctest), [], ProcessOptions)
 1177    ;   true
 1178    ).
 1179run_cmake_target(Target, _, ProcessOptions) :-
 1180    run_process(path(make), [Target], ProcessOptions).

 save_build_environment(+PackDir)

Create a shell-script build.env that contains the build environment.

 1187save_build_environment(PackDir) :-
 1188    directory_file_path(PackDir, 'buildenv.sh', EnvFile),
 1189    build_environment(Env),
 1190    setup_call_cleanup(
 1191        open(EnvFile, write, Out),
 1192        write_env_script(Out, Env),
 1193        close(Out)).
 1194
 1195write_env_script(Out, Env) :-
 1196    format(Out,
 1197           '# This file contains the environment that can be used to\n\c
 1198                # build the foreign pack outside Prolog.  This file must\n\c
 1199                # be loaded into a bourne-compatible shell using\n\c
 1200                #\n\c
 1201                #   $ source buildenv.sh\n\n',
 1202           []),
 1203    forall(member(Var=Value, Env),
 1204           format(Out, '~w=\'~w\'\n', [Var, Value])),
 1205    format(Out, '\nexport ', []),
 1206    forall(member(Var=_, Env),
 1207           format(Out, ' ~w', [Var])),
 1208    format(Out, '\n', []).
 1209
 1210build_environment(Env) :-
 1211    findall(Name=Value, environment(Name, Value), UserEnv),
 1212    findall(Name=Value,
 1213            ( def_environment(Name, Value),
 1214              \+ memberchk(Name=_, UserEnv)
 1215            ),
 1216            DefEnv),
 1217    append(UserEnv, DefEnv, Env).

 environment(-Name, -Value) is nondet

Hook to define the environment for building packs. This Multifile hook extends the process environment for building foreign extensions. A value provided by this hook overrules defaults provided by def_environment/2. In addition to changing the environment, this may be used to pass additional values to the environment, as in:

prolog_pack:environment('USER', User) :-
    getenv('USER', User).

Arguments:

Name	- is an atom denoting a valid variable name
Value	- is either an atom or number representing the value of the variable.

 def_environment(-Name, -Value) is nondet

True if Name=Value must appear in the environment for building foreign extensions.

 1244def_environment('PATH', Value) :-
 1245    getenv('PATH', PATH),
 1246    current_prolog_flag(executable, Exe),
 1247    file_directory_name(Exe, ExeDir),
 1248    prolog_to_os_filename(ExeDir, OsExeDir),
 1249    (   current_prolog_flag(windows, true)
 1250    ->  Sep = (;)
 1251    ;   Sep = (:)
 1252    ),
 1253    atomic_list_concat([OsExeDir, Sep, PATH], Value).
 1254def_environment('SWIPL', Value) :-
 1255    current_prolog_flag(executable, Value).
 1256def_environment('SWIPLVERSION', Value) :-
 1257    current_prolog_flag(version, Value).
 1258def_environment('SWIHOME', Value) :-
 1259    current_prolog_flag(home, Value).
 1260def_environment('SWIARCH', Value) :-
 1261    current_prolog_flag(arch, Value).
 1262def_environment('PACKSODIR', Value) :-
 1263    current_prolog_flag(arch, Arch),
 1264    atom_concat('lib/', Arch, Value).
 1265def_environment('SWISOLIB', Value) :-
 1266    current_prolog_flag(c_libplso, Value).
 1267def_environment('SWILIB', '-lswipl').
 1268def_environment('CC', Value) :-
 1269    (   getenv('CC', Value)
 1270    ->  true
 1271    ;   default_c_compiler(Value)
 1272    ->  true
 1273    ;   current_prolog_flag(c_cc, Value)
 1274    ).
 1275def_environment('LD', Value) :-
 1276    (   getenv('LD', Value)
 1277    ->  true
 1278    ;   current_prolog_flag(c_cc, Value)
 1279    ).
 1280def_environment('CFLAGS', Value) :-
 1281    (   getenv('CFLAGS', SystemFlags)
 1282    ->  Extra = [' ', SystemFlags]
 1283    ;   Extra = []
 1284    ),
 1285    current_prolog_flag(c_cflags, Value0),
 1286    current_prolog_flag(home, Home),
 1287    atomic_list_concat([Value0, ' -I"', Home, '/include"' | Extra], Value).
 1288def_environment('LDSOFLAGS', Value) :-
 1289    (   getenv('LDFLAGS', SystemFlags)
 1290    ->  Extra = [SystemFlags|System]
 1291    ;   Extra = System
 1292    ),
 1293    (   current_prolog_flag(windows, true)
 1294    ->  current_prolog_flag(home, Home),
 1295        atomic_list_concat(['-L"', Home, '/bin"'], SystemLib),
 1296        System = [SystemLib]
 1297    ;   apple_bundle_libdir(LibDir)
 1298    ->  atomic_list_concat(['-L"', LibDir, '"'], SystemLib),
 1299        System = [SystemLib]
 1300    ;   current_prolog_flag(c_libplso, '')
 1301    ->  System = []                 % ELF systems do not need this
 1302    ;   prolog_library_dir(SystemLibDir),
 1303        atomic_list_concat(['-L"',SystemLibDir,'"'], SystemLib),
 1304        System = [SystemLib]
 1305    ),
 1306    current_prolog_flag(c_ldflags, LDFlags),
 1307    atomic_list_concat([LDFlags, '-shared' | Extra], ' ', Value).
 1308def_environment('SOEXT', Value) :-
 1309    current_prolog_flag(shared_object_extension, Value).
 1310def_environment(Pass, Value) :-
 1311    pass_env(Pass),
 1312    getenv(Pass, Value).
 1313
 1314pass_env('TMP').
 1315pass_env('TEMP').
 1316pass_env('USER').
 1317pass_env('HOME').
 1318
 1319:- multifile
 1320    prolog:runtime_config/2. 1321
 1322prolog_library_dir(Dir) :-
 1323    prolog:runtime_config(c_libdir, Dir),
 1324    !.
 1325prolog_library_dir(Dir) :-
 1326    current_prolog_flag(home, Home),
 1327    (   current_prolog_flag(c_libdir, Rel)
 1328    ->  atomic_list_concat([Home, Rel], /, Dir)
 1329    ;   current_prolog_flag(arch, Arch)
 1330    ->  atomic_list_concat([Home, lib, Arch], /, Dir)
 1331    ).

 default_c_compiler(-CC) is semidet

Try to find a suitable C compiler for compiling packages with foreign code.

To be done

- Needs proper defaults for Windows. Find MinGW? Find MSVC?

 1340default_c_compiler(CC) :-
 1341    preferred_c_compiler(CC),
 1342    has_program(path(CC), _),
 1343    !.
 1344
 1345preferred_c_compiler(gcc).
 1346preferred_c_compiler(clang).
 1347preferred_c_compiler(cc).
 1348
 1349
 1350                 /*******************************
 1351                 *             PATHS            *
 1352                 *******************************/
 1353
 1354setup_path :-
 1355    has_program(path(make), _),
 1356    has_program(path(gcc), _),
 1357    !.
 1358setup_path :-
 1359    current_prolog_flag(windows, true),
 1360    !,
 1361    (   mingw_extend_path
 1362    ->  true
 1363    ;   print_message(error, pack(no_mingw))
 1364    ).
 1365setup_path.
 1366
 1367has_program(Program, Path) :-
 1368    exe_options(ExeOptions),
 1369    absolute_file_name(Program, Path,
 1370                       [ file_errors(fail)
 1371                       | ExeOptions
 1372                       ]).
 1373
 1374exe_options(Options) :-
 1375    current_prolog_flag(windows, true),
 1376    !,
 1377    Options = [ extensions(['',exe,com]), access(read) ].
 1378exe_options(Options) :-
 1379    Options = [ access(execute) ].
 1380
 1381mingw_extend_path :-
 1382    mingw_root(MinGW),
 1383    directory_file_path(MinGW, bin, MinGWBinDir),
 1384    atom_concat(MinGW, '/msys/*/bin', Pattern),
 1385    expand_file_name(Pattern, MsysDirs),
 1386    last(MsysDirs, MSysBinDir),
 1387    prolog_to_os_filename(MinGWBinDir, WinDirMinGW),
 1388    prolog_to_os_filename(MSysBinDir, WinDirMSYS),
 1389    getenv('PATH', Path0),
 1390    atomic_list_concat([WinDirMSYS, WinDirMinGW, Path0], ';', Path),
 1391    setenv('PATH', Path).
 1392
 1393mingw_root(MinGwRoot) :-
 1394    current_prolog_flag(executable, Exe),
 1395    sub_atom(Exe, 1, _, _, :),
 1396    sub_atom(Exe, 0, 1, _, PlDrive),
 1397    Drives = [PlDrive,c,d],
 1398    member(Drive, Drives),
 1399    format(atom(MinGwRoot), '~a:/MinGW', [Drive]),
 1400    exists_directory(MinGwRoot),
 1401    !.
 1402
 1403
 1404                 /*******************************
 1405                 *           AUTOLOAD           *
 1406                 *******************************/

 post_install_autoload(+PackDir, +Options)

Create an autoload index if the package demands such.

 1412post_install_autoload(PackDir, Options) :-
 1413    option(autoload(true), Options, true),
 1414    pack_info_term(PackDir, autoload(true)),
 1415    !,
 1416    directory_file_path(PackDir, prolog, PrologLibDir),
 1417    make_library_index(PrologLibDir).
 1418post_install_autoload(_, _).
 1419
 1420
 1421                 /*******************************
 1422                 *            UPGRADE           *
 1423                 *******************************/

 pack_upgrade(+Pack) is semidet

Try to upgrade the package Pack.

To be done

- Update dependencies when updating a pack from git?

 1431pack_upgrade(Pack) :-
 1432    pack_info(Pack, _, directory(Dir)),
 1433    directory_file_path(Dir, '.git', GitDir),
 1434    exists_directory(GitDir),
 1435    !,
 1436    print_message(informational, pack(git_fetch(Dir))),
 1437    git([fetch], [ directory(Dir) ]),
 1438    git_describe(V0, [ directory(Dir) ]),
 1439    git_describe(V1, [ directory(Dir), commit('origin/master') ]),
 1440    (   V0 == V1
 1441    ->  print_message(informational, pack(up_to_date(Pack)))
 1442    ;   confirm(upgrade(Pack, V0, V1), yes, []),
 1443        git([merge, 'origin/master'], [ directory(Dir) ]),
 1444        pack_rebuild(Pack)
 1445    ).
 1446pack_upgrade(Pack) :-
 1447    once(pack_info(Pack, _, version(VersionAtom))),
 1448    atom_version(VersionAtom, Version),
 1449    pack_info(Pack, _, download(URL)),
 1450    (   wildcard_pattern(URL)
 1451    ->  true
 1452    ;   github_url(URL, _User, _Repo)
 1453    ),
 1454    !,
 1455    available_download_versions(URL, [Latest-LatestURL|_Versions]),
 1456    (   Latest @> Version
 1457    ->  confirm(upgrade(Pack, Version, Latest), yes, []),
 1458        pack_install(Pack,
 1459                     [ url(LatestURL),
 1460                       upgrade(true),
 1461                       pack(Pack)
 1462                     ])
 1463    ;   print_message(informational, pack(up_to_date(Pack)))
 1464    ).
 1465pack_upgrade(Pack) :-
 1466    print_message(warning, pack(no_upgrade_info(Pack))).
 1467
 1468
 1469                 /*******************************
 1470                 *            REMOVE            *
 1471                 *******************************/

 pack_remove(+Name) is det

Remove the indicated package.

 1477pack_remove(Pack) :-
 1478    update_dependency_db,
 1479    (   setof(Dep, pack_depends_on(Dep, Pack), Deps)
 1480    ->  confirm_remove(Pack, Deps, Delete),
 1481        forall(member(P, Delete), pack_remove_forced(P))
 1482    ;   pack_remove_forced(Pack)
 1483    ).
 1484
 1485pack_remove_forced(Pack) :-
 1486    catch('$pack_detach'(Pack, BaseDir),
 1487          error(existence_error(pack, Pack), _),
 1488          fail),
 1489    !,
 1490    print_message(informational, pack(remove(BaseDir))),
 1491    delete_directory_and_contents(BaseDir).
 1492pack_remove_forced(Pack) :-
 1493    directory_file_path(Pack, 'pack.pl', PackFile),
 1494    absolute_file_name(pack(PackFile), PackPath,
 1495                       [ access(read),
 1496                         file_errors(fail)
 1497                       ]),
 1498    !,
 1499    file_directory_name(PackPath, BaseDir),
 1500    delete_directory_and_contents(BaseDir).
 1501pack_remove_forced(Pack) :-
 1502    print_message(informational, error(existence_error(pack, Pack),_)).
 1503
 1504confirm_remove(Pack, Deps, Delete) :-
 1505    print_message(warning, pack(depends(Pack, Deps))),
 1506    menu(pack(resolve_remove),
 1507         [ [Pack]      = remove_only(Pack),
 1508           [Pack|Deps] = remove_deps(Pack, Deps),
 1509           []          = cancel
 1510         ], [], Delete, []),
 1511    Delete \== [].
 1512
 1513
 1514                 /*******************************
 1515                 *           PROPERTIES         *
 1516                 *******************************/

 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)

 1539pack_property(Pack, Property) :-
 1540    findall(Pack-Property, pack_property_(Pack, Property), List),
 1541    member(Pack-Property, List).            % make det if applicable
 1542
 1543pack_property_(Pack, Property) :-
 1544    pack_info(Pack, _, Property).
 1545pack_property_(Pack, Property) :-
 1546    \+ \+ info_file(Property, _),
 1547    '$pack':pack(Pack, BaseDir),
 1548    access_file(BaseDir, read),
 1549    directory_files(BaseDir, Files),
 1550    member(File, Files),
 1551    info_file(Property, Pattern),
 1552    downcase_atom(File, Pattern),
 1553    directory_file_path(BaseDir, File, InfoFile),
 1554    arg(1, Property, InfoFile).
 1555
 1556info_file(readme(_), 'readme.txt').
 1557info_file(readme(_), 'readme').
 1558info_file(todo(_),   'todo.txt').
 1559info_file(todo(_),   'todo').
 1560
 1561
 1562                 /*******************************
 1563                 *             GIT              *
 1564                 *******************************/

 git_url(+URL, -Pack) is semidet

True if URL describes a git url for Pack

 1570git_url(URL, Pack) :-
 1571    uri_components(URL, Components),
 1572    uri_data(scheme, Components, Scheme),
 1573    uri_data(path, Components, Path),
 1574    (   Scheme == git
 1575    ->  true
 1576    ;   git_download_scheme(Scheme),
 1577        file_name_extension(_, git, Path)
 1578    ),
 1579    file_base_name(Path, PackExt),
 1580    (   file_name_extension(Pack, git, PackExt)
 1581    ->  true
 1582    ;   Pack = PackExt
 1583    ),
 1584    (   safe_pack_name(Pack)
 1585    ->  true
 1586    ;   domain_error(pack_name, Pack)
 1587    ).
 1588
 1589git_download_scheme(http).
 1590git_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.

 1597safe_pack_name(Name) :-
 1598    atom_length(Name, Len),
 1599    Len >= 3,                               % demand at least three length
 1600    atom_codes(Name, Codes),
 1601    maplist(safe_pack_char, Codes),
 1602    !.
 1603
 1604safe_pack_char(C) :- between(0'a, 0'z, C), !.
 1605safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 1606safe_pack_char(C) :- between(0'0, 0'9, C), !.
 1607safe_pack_char(0'_).
 1608
 1609
 1610                 /*******************************
 1611                 *         VERSION LOGIC        *
 1612                 *******************************/

 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.

 1621pack_version_file(Pack, Version, GitHubRelease) :-
 1622    atomic(GitHubRelease),
 1623    github_release_url(GitHubRelease, Pack, Version),
 1624    !.
 1625pack_version_file(Pack, Version, Path) :-
 1626    atomic(Path),
 1627    file_base_name(Path, File),
 1628    no_int_file_name_extension(Base, _Ext, File),
 1629    atom_codes(Base, Codes),
 1630    (   phrase(pack_version(Pack, Version), Codes),
 1631        safe_pack_name(Pack)
 1632    ->  true
 1633    ).
 1634
 1635no_int_file_name_extension(Base, Ext, File) :-
 1636    file_name_extension(Base0, Ext0, File),
 1637    \+ atom_number(Ext0, _),
 1638    !,
 1639    Base = Base0,
 1640    Ext = Ext0.
 1641no_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'

 1654github_release_url(URL, Pack, Version) :-
 1655    uri_components(URL, Components),
 1656    uri_data(authority, Components, 'github.com'),
 1657    uri_data(scheme, Components, Scheme),
 1658    download_scheme(Scheme),
 1659    uri_data(path, Components, Path),
 1660    atomic_list_concat(['',_Project,Pack,archive,File], /, Path),
 1661    file_name_extension(Tag, Ext, File),
 1662    github_archive_extension(Ext),
 1663    tag_version(Tag, Version),
 1664    !.
 1665
 1666github_archive_extension(tgz).
 1667github_archive_extension(zip).
 1668
 1669tag_version(Tag, Version) :-
 1670    version_tag_prefix(Prefix),
 1671    atom_concat(Prefix, AtomVersion, Tag),
 1672    atom_version(AtomVersion, Version).
 1673
 1674version_tag_prefix(v).
 1675version_tag_prefix('V').
 1676version_tag_prefix('').
 1677
 1678
 1679:- public
 1680    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 @>

 1688atom_version(Atom, version(Parts)) :-
 1689    (   atom(Atom)
 1690    ->  atom_codes(Atom, Codes),
 1691        phrase(version(Parts), Codes)
 1692    ;   atomic_list_concat(Parts, '.', Atom)
 1693    ).
 1694
 1695pack_version(Pack, version(Parts)) -->
 1696    string(Codes), "-",
 1697    version(Parts),
 1698    !,
 1699    { atom_codes(Pack, Codes)
 1700    }.
 1701
 1702version([_|T]) -->
 1703    "*",
 1704    !,
 1705    (   "."
 1706    ->  version(T)
 1707    ;   []
 1708    ).
 1709version([H|T]) -->
 1710    integer(H),
 1711    (   "."
 1712    ->  version(T)
 1713    ;   { T = [] }
 1714    ).
 1715
 1716integer(H)    --> digit(D0), digits(L), { number_codes(H, [D0|L]) }.
 1717digit(D)      --> [D], { code_type(D, digit) }.
 1718digits([H|T]) --> digit(H), !, digits(T).
 1719digits([])    --> [].
 1720
 1721
 1722                 /*******************************
 1723                 *       QUERY CENTRAL DB       *
 1724                 *******************************/