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)).     % 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(dependency, Value) :-
  310    is_dependency(Value, _Token, _Version).
  311
  312version_data(Version, version(Data)) :-
  313    atomic_list_concat(Parts, '.', Version),
  314    maplist(atom_number, Parts, Data).
  315
  316is_dependency(Token, Token, *) :-
  317    atom(Token).
  318is_dependency(Term, Token, VersionCmp) :-
  319    Term =.. [Op,Token,Version],
  320    cmp(Op, _),
  321    version_data(Version, _),
  322    VersionCmp =.. [Op,Version].
  323
  324cmp(<,  @<).
  325cmp(=<, @=<).
  326cmp(==, ==).
  327cmp(>=, @>=).
  328cmp(>,  @>).
  329
  330
  331                 /*******************************
  332                 *            SEARCH            *
  333                 *******************************/

 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.

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

 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.

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

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

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

Select from available packages.

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

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

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

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

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

Unpack an archive to the given package dir.

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

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

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

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.

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

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

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

Perform basic sanity checks on DownloadFile

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

 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.

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

 empty_directory(+Directory) is semidet

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

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

 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.

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

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

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

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

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

 download_url(+URL) is det

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

  998download_url(URL) :-
  999    atom(URL),
 1000    uri_components(URL, Components),
 1001    uri_data(scheme, Components, Scheme),
 1002    download_scheme(Scheme).
 1003
 1004download_scheme(http).
 1005download_scheme(https) :-
 1006    catch(use_module(library(http/http_ssl_plugin)),
 1007          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

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

 pack_rebuild(+Pack) is det

Rebuilt possible foreign components of Pack.

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

 pack_rebuild is det

Rebuild foreign components of all packages.

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

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

Install foreign parts of the package.

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

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

 cmake_configure_foreign(+PackDir, +Options) is det

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

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

 make_foreign(+PackDir, +Options) is det

Generate the foreign executable.

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

 save_build_environment(+PackDir)

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

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

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

 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?

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

 post_install_autoload(+PackDir, +Options)

Create an autoload index if the package demands such.

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

 pack_upgrade(+Pack) is semidet

Try to upgrade the package Pack.

To be done

- Update dependencies when updating a pack from git?

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

 pack_remove(+Name) is det

Remove the indicated package.

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

 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)

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

 git_url(+URL, -Pack) is semidet

True if URL describes a git url for Pack

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

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

 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.

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

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

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