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            pack_attach/2,              % +Dir, +Options
   49
   50            pack_url_file/2             % +URL, -File
   51          ]).   52:- use_module(library(apply)).   53:- use_module(library(error)).   54:- use_module(library(process)).   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(http/http_open)).   63:- use_module(library(http/json)).   64:- use_module(library(http/http_client), []).   % plugin for POST support
   65:- use_module(library(prolog_config)).

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

 current_pack(?Pack) is nondet

True if Pack is a currently installed pack.

  106current_pack(Pack) :-
  107    '$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.

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

 pack_info(+Pack)

Print more detailed information about Pack.

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

 pack_info_term(+PackDir, ?Info) is nondet

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

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

 pack_info_term(?Term) is nondet

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

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

 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.

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

 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.

  462pack_install(Spec) :-
  463    pack_default_options(Spec, Pack, [], Options),
  464    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.

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

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

Select from available packages.

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

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

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

  712pack_install_from_local(Source, PackTopDir, Name, Options) :-
  713    exists_directory(Source),
  714    !,
  715    directory_file_path(PackTopDir, Name, PackDir),
  716    prepare_pack_dir(PackDir, Options),
  717    copy_directory(Source, PackDir),
  718    pack_post_install(Name, PackDir, Options).
  719pack_install_from_local(Source, PackTopDir, Name, Options) :-
  720    exists_file(Source),
  721    directory_file_path(PackTopDir, Name, PackDir),
  722    prepare_pack_dir(PackDir, Options),
  723    pack_unpack(Source, PackDir, Name, Options),
  724    pack_post_install(Name, PackDir, Options).

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

Unpack an archive to the given package dir.

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

 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.

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

  824pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
  825    exists_directory(GitDir),
  826    !,
  827    git_ls_tree(Entries, [directory(GitDir)]),
  828    git_hash(Hash, [directory(GitDir)]),
  829    maplist(arg(4), Entries, Sizes),
  830    sum_list(Sizes, Bytes),
  831    directory_file_path(GitDir, 'pack.pl', InfoFile),
  832    read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
  833    must_be(ground, Info),
  834    maplist(valid_info_term, Info).

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

Perform basic sanity checks on DownloadFile

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

 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.

  875prepare_pack_dir(Dir, Options) :-
  876    exists_directory(Dir),
  877    !,
  878    (   empty_directory(Dir)
  879    ->  true
  880    ;   option(upgrade(true), Options)
  881    ->  delete_directory_contents(Dir)
  882    ;   confirm(remove_existing_pack(Dir), yes, Options),
  883        delete_directory_contents(Dir)
  884    ).
  885prepare_pack_dir(Dir, _) :-
  886    make_directory(Dir).

 empty_directory(+Directory) is semidet

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

  892empty_directory(Dir) :-
  893    \+ ( directory_files(Dir, Entries),
  894         member(Entry, Entries),
  895         \+ special(Entry)
  896       ).
  897
  898special(.).
  899special(..).

 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.

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

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

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

  968pack_url_file(URL, FileID) :-
  969    github_release_url(URL, Pack, Version),
  970    !,
  971    download_file(URL, Pack, FileID, [version(Version)]).
  972pack_url_file(URL, FileID) :-
  973    file_base_name(URL, FileID).
  974
  975
  976:- 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.

  984ssl_verify(_SSL,
  985           _ProblemCertificate, _AllCertificates, _FirstCertificate,
  986           _Error).
  987
  988pack_download_dir(PackTopDir, DownLoadDir) :-
  989    directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
  990    (   exists_directory(DownLoadDir)
  991    ->  true
  992    ;   make_directory(DownLoadDir)
  993    ),
  994    (   access_file(DownLoadDir, write)
  995    ->  true
  996    ;   permission_error(write, directory, DownLoadDir)
  997    ).

 download_url(+URL) is det

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

 1003download_url(URL) :-
 1004    atom(URL),
 1005    uri_components(URL, Components),
 1006    uri_data(scheme, Components, Scheme),
 1007    download_scheme(Scheme).
 1008
 1009download_scheme(http).
 1010download_scheme(https) :-
 1011    catch(use_module(library(http/http_ssl_plugin)),
 1012          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

 1022pack_post_install(Pack, PackDir, Options) :-
 1023    post_install_foreign(Pack, PackDir,
 1024                         [ build_foreign(if_absent)
 1025                         | Options
 1026                         ]),
 1027    post_install_autoload(PackDir, Options),
 1028    '$pack_attach'(PackDir).

 pack_rebuild(+Pack) is det

Rebuilt possible foreign components of Pack.

 1034pack_rebuild(Pack) :-
 1035    '$pack':pack(Pack, BaseDir),
 1036    !,
 1037    catch(pack_make(BaseDir, [distclean], []), E,
 1038          print_message(warning, E)),
 1039    post_install_foreign(Pack, BaseDir, []).
 1040pack_rebuild(Pack) :-
 1041    existence_error(pack, Pack).

 pack_rebuild is det

Rebuild foreign components of all packages.

 1047pack_rebuild :-
 1048    forall(current_pack(Pack),
 1049           ( print_message(informational, pack(rebuild(Pack))),
 1050             pack_rebuild(Pack)
 1051           )).

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

Install foreign parts of the package.

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

 1102configure_foreign(PackDir, Options) :-
 1103    directory_file_path(PackDir, 'CMakeLists.txt', CMakeFile),
 1104    exists_file(CMakeFile),
 1105    !,
 1106    cmake_configure_foreign(PackDir, Options).
 1107configure_foreign(PackDir, Options) :-
 1108    make_configure(PackDir, Options),
 1109    directory_file_path(PackDir, configure, Configure),
 1110    exists_file(Configure),
 1111    !,
 1112    build_environment(BuildEnv),
 1113    findall(Opt, configure_option(Opt), Opts),
 1114    run_process(path(bash), [Configure|Opts],
 1115                [ env(BuildEnv),
 1116                  directory(PackDir)
 1117                ]).
 1118configure_foreign(_, _).
 1119
 1120configure_option(Opt) :-
 1121    prolog_prefix(Prefix),
 1122    format(atom(Opt), '--prefix=~w', [Prefix]).
 1123
 1124make_configure(PackDir, _Options) :-
 1125    directory_file_path(PackDir, 'configure', Configure),
 1126    exists_file(Configure),
 1127    !.
 1128make_configure(PackDir, _Options) :-
 1129    autoconf_master(ConfigMaster),
 1130    directory_file_path(PackDir, ConfigMaster, ConfigureIn),
 1131    exists_file(ConfigureIn),
 1132    !,
 1133    run_process(path(autoheader), [], [directory(PackDir)]),
 1134    run_process(path(autoconf),   [], [directory(PackDir)]).
 1135make_configure(_, _).
 1136
 1137autoconf_master('configure.ac').
 1138autoconf_master('configure.in').

 cmake_configure_foreign(+PackDir, +Options) is det

Create a build directory in PackDir and run `cmake [options] ..`

 1144cmake_configure_foreign(PackDir, _Options) :-
 1145    directory_file_path(PackDir, build, BuildDir),
 1146    make_directory_path(BuildDir),
 1147    findall(Opt, cmake_option(Opt), Argv, [..]),
 1148    run_process(path(cmake), Argv,
 1149                [directory(BuildDir)]).
 1150
 1151cmake_option(CDEF) :-
 1152    current_prolog_flag(executable, Exe),
 1153    format(atom(CDEF), '-DSWIPL=~w', [Exe]).
 1154cmake_option(CDEF) :-
 1155    prolog_prefix(Prefix),
 1156    format(atom(CDEF), '-DCMAKE_INSTALL_PREFIX=~w', [Prefix]).

 make_foreign(+PackDir, +Options) is det

Generate the foreign executable.

 1162make_foreign(PackDir, Options) :-
 1163    pack_make(PackDir, [all, check, install], Options).
 1164
 1165pack_make(PackDir, Targets, _Options) :-
 1166    directory_file_path(PackDir, 'Makefile', Makefile),
 1167    exists_file(Makefile),
 1168    !,
 1169    build_environment(BuildEnv),
 1170    ProcessOptions = [ directory(PackDir), env(BuildEnv) ],
 1171    forall(member(Target, Targets),
 1172           run_process(path(make), [Target], ProcessOptions)).
 1173pack_make(PackDir, Targets, _Options) :-
 1174    directory_file_path(PackDir, 'CMakeLists.txt', CMakefile),
 1175    exists_file(CMakefile),
 1176    directory_file_path(PackDir, 'build', BuildDir),
 1177    exists_directory(BuildDir),
 1178    !,
 1179    (   Targets == [distclean]
 1180    ->  delete_directory_contents(BuildDir)
 1181    ;   build_environment(BuildEnv),
 1182        ProcessOptions = [ directory(BuildDir), env(BuildEnv) ],
 1183        forall(member(Target, Targets),
 1184               run_cmake_target(Target, BuildDir, ProcessOptions))
 1185    ).
 1186pack_make(_, _, _).
 1187
 1188run_cmake_target(check, BuildDir, ProcessOptions) :-
 1189    !,
 1190    (   directory_file_path(BuildDir, 'CTestTestfile.cmake', TestFile),
 1191        exists_file(TestFile)
 1192    ->  run_process(path(ctest), [], ProcessOptions)
 1193    ;   true
 1194    ).
 1195run_cmake_target(Target, _, ProcessOptions) :-
 1196    run_process(path(make), [Target], ProcessOptions).

 save_build_environment(+PackDir)

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

 1203save_build_environment(PackDir) :-
 1204    directory_file_path(PackDir, 'buildenv.sh', EnvFile),
 1205    build_environment(Env),
 1206    setup_call_cleanup(
 1207        open(EnvFile, write, Out),
 1208        write_env_script(Out, Env),
 1209        close(Out)).
 1210
 1211write_env_script(Out, Env) :-
 1212    format(Out,
 1213           '# This file contains the environment that can be used to\n\c
 1214                # build the foreign pack outside Prolog.  This file must\n\c
 1215                # be loaded into a bourne-compatible shell using\n\c
 1216                #\n\c
 1217                #   $ source buildenv.sh\n\n',
 1218           []),
 1219    forall(member(Var=Value, Env),
 1220           format(Out, '~w=\'~w\'\n', [Var, Value])),
 1221    format(Out, '\nexport ', []),
 1222    forall(member(Var=_, Env),
 1223           format(Out, ' ~w', [Var])),
 1224    format(Out, '\n', []).
 1225
 1226build_environment(Env) :-
 1227    findall(Name=Value, environment(Name, Value), UserEnv),
 1228    findall(Name=Value,
 1229            ( def_environment(Name, Value),
 1230              \+ memberchk(Name=_, UserEnv)
 1231            ),
 1232            DefEnv),
 1233    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.

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

 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?

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

 prolog_prefix(-Prefix) is semidet

Return the directory that can be passed into configure or cmake to install executables and other related resources in a similar location as SWI-Prolog itself. Tries these rules:

1. If the Prolog flag pack_prefix at a writable directory, use this.
2. If the current executable can be found on $PATH and the parent of the directory of the executable is writable, use this.
3. If the user has a writable ~/bin directory, use ~.

 1431prolog_prefix(Prefix) :-
 1432    current_prolog_flag(pack_prefix, Prefix),
 1433    access_file(Prefix, write),
 1434    !.
 1435prolog_prefix(Prefix) :-
 1436    current_prolog_flag(os_argv, [Name|_]),
 1437    has_program(path(Name), EXE),
 1438    file_directory_name(EXE, Bin),
 1439    file_directory_name(Bin, Prefix0),
 1440    (   local_prefix(Prefix0, Prefix1)
 1441    ->  Prefix = Prefix1
 1442    ;   Prefix = Prefix0
 1443    ),
 1444    access_file(Prefix, write),
 1445    !.
 1446prolog_prefix(Prefix) :-
 1447    expand_file_name(~, UserHome),
 1448    directory_file_path(UserHome, bin, BinDir),
 1449    exists_directory(BinDir),
 1450    access_file(BinDir, write),
 1451    !,
 1452    Prefix = UserHome.
 1453
 1454local_prefix('/usr', '/usr/local').
 1455
 1456
 1457                 /*******************************
 1458                 *           AUTOLOAD           *
 1459                 *******************************/

 post_install_autoload(+PackDir, +Options)

Create an autoload index if the package demands such.

 1465post_install_autoload(PackDir, Options) :-
 1466    option(autoload(true), Options, true),
 1467    pack_info_term(PackDir, autoload(true)),
 1468    !,
 1469    directory_file_path(PackDir, prolog, PrologLibDir),
 1470    make_library_index(PrologLibDir).
 1471post_install_autoload(_, _).
 1472
 1473
 1474                 /*******************************
 1475                 *            UPGRADE           *
 1476                 *******************************/

 pack_upgrade(+Pack) is semidet

Try to upgrade the package Pack.

To be done

- Update dependencies when updating a pack from git?

 1484pack_upgrade(Pack) :-
 1485    pack_info(Pack, _, directory(Dir)),
 1486    directory_file_path(Dir, '.git', GitDir),
 1487    exists_directory(GitDir),
 1488    !,
 1489    print_message(informational, pack(git_fetch(Dir))),
 1490    git([fetch], [ directory(Dir) ]),
 1491    git_describe(V0, [ directory(Dir) ]),
 1492    git_describe(V1, [ directory(Dir), commit('origin/master') ]),
 1493    (   V0 == V1
 1494    ->  print_message(informational, pack(up_to_date(Pack)))
 1495    ;   confirm(upgrade(Pack, V0, V1), yes, []),
 1496        git([merge, 'origin/master'], [ directory(Dir) ]),
 1497        pack_rebuild(Pack)
 1498    ).
 1499pack_upgrade(Pack) :-
 1500    once(pack_info(Pack, _, version(VersionAtom))),
 1501    atom_version(VersionAtom, Version),
 1502    pack_info(Pack, _, download(URL)),
 1503    (   wildcard_pattern(URL)
 1504    ->  true
 1505    ;   github_url(URL, _User, _Repo)
 1506    ),
 1507    !,
 1508    available_download_versions(URL, [Latest-LatestURL|_Versions]),
 1509    (   Latest @> Version
 1510    ->  confirm(upgrade(Pack, Version, Latest), yes, []),
 1511        pack_install(Pack,
 1512                     [ url(LatestURL),
 1513                       upgrade(true),
 1514                       pack(Pack)
 1515                     ])
 1516    ;   print_message(informational, pack(up_to_date(Pack)))
 1517    ).
 1518pack_upgrade(Pack) :-
 1519    print_message(warning, pack(no_upgrade_info(Pack))).
 1520
 1521
 1522                 /*******************************
 1523                 *            REMOVE            *
 1524                 *******************************/

 pack_remove(+Name) is det

Remove the indicated package.

 1530pack_remove(Pack) :-
 1531    update_dependency_db,
 1532    (   setof(Dep, pack_depends_on(Dep, Pack), Deps)
 1533    ->  confirm_remove(Pack, Deps, Delete),
 1534        forall(member(P, Delete), pack_remove_forced(P))
 1535    ;   pack_remove_forced(Pack)
 1536    ).
 1537
 1538pack_remove_forced(Pack) :-
 1539    catch('$pack_detach'(Pack, BaseDir),
 1540          error(existence_error(pack, Pack), _),
 1541          fail),
 1542    !,
 1543    print_message(informational, pack(remove(BaseDir))),
 1544    delete_directory_and_contents(BaseDir).
 1545pack_remove_forced(Pack) :-
 1546    directory_file_path(Pack, 'pack.pl', PackFile),
 1547    absolute_file_name(pack(PackFile), PackPath,
 1548                       [ access(read),
 1549                         file_errors(fail)
 1550                       ]),
 1551    !,
 1552    file_directory_name(PackPath, BaseDir),
 1553    delete_directory_and_contents(BaseDir).
 1554pack_remove_forced(Pack) :-
 1555    print_message(informational, error(existence_error(pack, Pack),_)).
 1556
 1557confirm_remove(Pack, Deps, Delete) :-
 1558    print_message(warning, pack(depends(Pack, Deps))),
 1559    menu(pack(resolve_remove),
 1560         [ [Pack]      = remove_only(Pack),
 1561           [Pack|Deps] = remove_deps(Pack, Deps),
 1562           []          = cancel
 1563         ], [], Delete, []),
 1564    Delete \== [].
 1565
 1566
 1567                 /*******************************
 1568                 *           PROPERTIES         *
 1569                 *******************************/

 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)

 1592pack_property(Pack, Property) :-
 1593    findall(Pack-Property, pack_property_(Pack, Property), List),
 1594    member(Pack-Property, List).            % make det if applicable
 1595
 1596pack_property_(Pack, Property) :-
 1597    pack_info(Pack, _, Property).
 1598pack_property_(Pack, Property) :-
 1599    \+ \+ info_file(Property, _),
 1600    '$pack':pack(Pack, BaseDir),
 1601    access_file(BaseDir, read),
 1602    directory_files(BaseDir, Files),
 1603    member(File, Files),
 1604    info_file(Property, Pattern),
 1605    downcase_atom(File, Pattern),
 1606    directory_file_path(BaseDir, File, InfoFile),
 1607    arg(1, Property, InfoFile).
 1608
 1609info_file(readme(_), 'readme.txt').
 1610info_file(readme(_), 'readme').
 1611info_file(todo(_),   'todo.txt').
 1612info_file(todo(_),   'todo').
 1613
 1614
 1615                 /*******************************
 1616                 *             GIT              *
 1617                 *******************************/

 git_url(+URL, -Pack) is semidet

True if URL describes a git url for Pack

 1623git_url(URL, Pack) :-
 1624    uri_components(URL, Components),
 1625    uri_data(scheme, Components, Scheme),
 1626    uri_data(path, Components, Path),
 1627    (   Scheme == git
 1628    ->  true
 1629    ;   git_download_scheme(Scheme),
 1630        file_name_extension(_, git, Path)
 1631    ),
 1632    file_base_name(Path, PackExt),
 1633    (   file_name_extension(Pack, git, PackExt)
 1634    ->  true
 1635    ;   Pack = PackExt
 1636    ),
 1637    (   safe_pack_name(Pack)
 1638    ->  true
 1639    ;   domain_error(pack_name, Pack)
 1640    ).
 1641
 1642git_download_scheme(http).
 1643git_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.

 1650safe_pack_name(Name) :-
 1651    atom_length(Name, Len),
 1652    Len >= 3,                               % demand at least three length
 1653    atom_codes(Name, Codes),
 1654    maplist(safe_pack_char, Codes),
 1655    !.
 1656
 1657safe_pack_char(C) :- between(0'a, 0'z, C), !.
 1658safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 1659safe_pack_char(C) :- between(0'0, 0'9, C), !.
 1660safe_pack_char(0'_).
 1661
 1662
 1663                 /*******************************
 1664                 *         VERSION LOGIC        *
 1665                 *******************************/

 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.

 1674pack_version_file(Pack, Version, GitHubRelease) :-
 1675    atomic(GitHubRelease),
 1676    github_release_url(GitHubRelease, Pack, Version),
 1677    !.
 1678pack_version_file(Pack, Version, Path) :-
 1679    atomic(Path),
 1680    file_base_name(Path, File),
 1681    no_int_file_name_extension(Base, _Ext, File),
 1682    atom_codes(Base, Codes),
 1683    (   phrase(pack_version(Pack, Version), Codes),
 1684        safe_pack_name(Pack)
 1685    ->  true
 1686    ).
 1687
 1688no_int_file_name_extension(Base, Ext, File) :-
 1689    file_name_extension(Base0, Ext0, File),
 1690    \+ atom_number(Ext0, _),
 1691    !,
 1692    Base = Base0,
 1693    Ext = Ext0.
 1694no_int_file_name_extension(File, '', File).