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

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

 current_pack(?Pack) is nondet

True if Pack is a currently installed pack.

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

 pack_list_installed is det

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

See also

- Use pack_list/1 to find packages.

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

 pack_info(+Pack)

Print more detailed information about Pack.

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

 pack_info_term(+PackDir, ?Info) is nondet

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

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

 pack_info_term(?Term) is nondet

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

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

 pack_search(+Query) is det

 pack_list(+Query) is det

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

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

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

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

See also

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

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

 pack_install(+Spec:atom) is det

Install a package. Spec is one of

• Archive file name
• HTTP URL of an archive file name. This URL may contain a star (*) for the version. In this case pack_install asks for the directory content and selects the latest version.
• GIT URL (not well supported yet)
• A local directory name given as file:// URL.
• A package name. This queries the package repository at http://www.swi-prolog.org

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

  456pack_install(Spec) :-
  457    pack_default_options(Spec, Pack, [], Options),
  458    pack_install(Pack, [pack(Pack)|Options]).

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

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

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

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

Select from available packages.

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

 pack_install(+Name, +Options) is det

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

url(+URL)

Source for downloading the package

package_directory(+Dir)

Directory into which to install the package

interactive(+Boolean)

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

silent(+Boolean)

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

upgrade(+Boolean)

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

git(+Boolean)

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

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

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

 pack_install(+Pack, +PackDir, +Options)

Install package Pack into PackDir. Options:

url(URL)

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

upgrade(Boolean)

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

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

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

Install a package from a local media.

To be done

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

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

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

Unpack an archive to the given package dir.

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

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

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

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

Errors

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

- Syntax errors if pack.pl cannot be parsed.

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

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

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

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

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

Perform basic sanity checks on DownloadFile

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

 prepare_pack_dir(+Dir, +Options)

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

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

 empty_directory(+Directory) is semidet

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

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

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

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

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

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

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

 pack_url_file(+URL, -File) is det

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

  962pack_url_file(URL, FileID) :-
  963    github_release_url(URL, Pack, Version),
  964    !,
  965    download_file(URL, Pack, FileID, [version(Version)]).
  966pack_url_file(URL, FileID) :-
  967    file_base_name(URL, FileID).
  968
  969
  970:- public ssl_verify/5.

 ssl_verify(+SSL, +ProblemCert, +AllCerts, +FirstCert, +Error)

Currently we accept all certificates. We organise our own security using SHA1 signatures, so we do not care about the source of the data.

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

 download_url(+URL) is det

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

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

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

Process post installation work. Steps:

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

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

 pack_rebuild(+Pack) is det

Rebuilt possible foreign components of Pack.

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

 pack_rebuild is det

Rebuild foreign components of all packages.

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

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

Install foreign parts of the package.

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

 configure_foreign(+PackDir, +Options) is det

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

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

 make_foreign(+PackDir, +Options) is det

Generate the foreign executable.

 1128make_foreign(PackDir, Options) :-
 1129    pack_make(PackDir, [all, check, install], Options).
 1130
 1131pack_make(PackDir, Targets, _Options) :-
 1132    directory_file_path(PackDir, 'Makefile', Makefile),
 1133    exists_file(Makefile),
 1134    !,
 1135    build_environment(BuildEnv),
 1136    ProcessOptions = [ directory(PackDir), env(BuildEnv) ],
 1137    forall(member(Target, Targets),
 1138           run_process(path(make), [Target], ProcessOptions)).
 1139pack_make(_, _, _).

 save_build_environment(+PackDir)

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

 1146save_build_environment(PackDir) :-
 1147    directory_file_path(PackDir, 'buildenv.sh', EnvFile),
 1148    build_environment(Env),
 1149    setup_call_cleanup(
 1150        open(EnvFile, write, Out),
 1151        write_env_script(Out, Env),
 1152        close(Out)).
 1153
 1154write_env_script(Out, Env) :-
 1155    format(Out,
 1156           '# This file contains the environment that can be used to\n\c
 1157                # build the foreign pack outside Prolog.  This file must\n\c
 1158                # be loaded into a bourne-compatible shell using\n\c
 1159                #\n\c
 1160                #   $ source buildenv.sh\n\n',
 1161           []),
 1162    forall(member(Var=Value, Env),
 1163           format(Out, '~w=\'~w\'\n', [Var, Value])),
 1164    format(Out, '\nexport ', []),
 1165    forall(member(Var=_, Env),
 1166           format(Out, ' ~w', [Var])),
 1167    format(Out, '\n', []).
 1168
 1169build_environment(Env) :-
 1170    findall(Name=Value, environment(Name, Value), UserEnv),
 1171    findall(Name=Value,
 1172            ( def_environment(Name, Value),
 1173              \+ memberchk(Name=_, UserEnv)
 1174            ),
 1175            DefEnv),
 1176    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.

 1203def_environment('PATH', Value) :-
 1204    getenv('PATH', PATH),
 1205    current_prolog_flag(executable, Exe),
 1206    file_directory_name(Exe, ExeDir),
 1207    prolog_to_os_filename(ExeDir, OsExeDir),
 1208    (   current_prolog_flag(windows, true)
 1209    ->  Sep = (;)
 1210    ;   Sep = (:)
 1211    ),
 1212    atomic_list_concat([OsExeDir, Sep, PATH], Value).
 1213def_environment('SWIPL', Value) :-
 1214    current_prolog_flag(executable, Value).
 1215def_environment('SWIPLVERSION', Value) :-
 1216    current_prolog_flag(version, Value).
 1217def_environment('SWIHOME', Value) :-
 1218    current_prolog_flag(home, Value).
 1219def_environment('SWIARCH', Value) :-
 1220    current_prolog_flag(arch, Value).
 1221def_environment('PACKSODIR', Value) :-
 1222    current_prolog_flag(arch, Arch),
 1223    atom_concat('lib/', Arch, Value).
 1224def_environment('SWISOLIB', Value) :-
 1225    current_prolog_flag(c_libplso, Value).
 1226def_environment('SWILIB', '-lswipl').
 1227def_environment('CC', Value) :-
 1228    (   getenv('CC', Value)
 1229    ->  true
 1230    ;   default_c_compiler(Value)
 1231    ->  true
 1232    ;   current_prolog_flag(c_cc, Value)
 1233    ).
 1234def_environment('LD', Value) :-
 1235    (   getenv('LD', Value)
 1236    ->  true
 1237    ;   current_prolog_flag(c_cc, Value)
 1238    ).
 1239def_environment('CFLAGS', Value) :-
 1240    (   getenv('CFLAGS', SystemFlags)
 1241    ->  Extra = [' ', SystemFlags]
 1242    ;   Extra = []
 1243    ),
 1244    current_prolog_flag(c_cflags, Value0),
 1245    current_prolog_flag(home, Home),
 1246    atomic_list_concat([Value0, ' -I"', Home, '/include"' | Extra], Value).
 1247def_environment('LDSOFLAGS', Value) :-
 1248    (   getenv('LDFLAGS', SystemFlags)
 1249    ->  Extra = [SystemFlags|System]
 1250    ;   Extra = System
 1251    ),
 1252    (   current_prolog_flag(windows, true)
 1253    ->  current_prolog_flag(home, Home),
 1254        atomic_list_concat(['-L"', Home, '/bin"'], SystemLib),
 1255        System = [SystemLib]
 1256    ;   apple_bundle_libdir(LibDir)
 1257    ->  atomic_list_concat(['-L"', LibDir, '"'], SystemLib),
 1258        System = [SystemLib]
 1259    ;   current_prolog_flag(c_libplso, '')
 1260    ->  System = []                 % ELF systems do not need this
 1261    ;   prolog_library_dir(SystemLibDir),
 1262        atomic_list_concat(['-L"',SystemLibDir,'"'], SystemLib),
 1263        System = [SystemLib]
 1264    ),
 1265    current_prolog_flag(c_ldflags, LDFlags),
 1266    atomic_list_concat([LDFlags, '-shared' | Extra], ' ', Value).
 1267def_environment('SOEXT', Value) :-
 1268    current_prolog_flag(shared_object_extension, Value).
 1269def_environment(Pass, Value) :-
 1270    pass_env(Pass),
 1271    getenv(Pass, Value).
 1272
 1273pass_env('TMP').
 1274pass_env('TEMP').
 1275pass_env('USER').
 1276pass_env('HOME').
 1277
 1278:- multifile
 1279    prolog:runtime_config/2. 1280
 1281prolog_library_dir(Dir) :-
 1282    prolog:runtime_config(c_libdir, Dir),
 1283    !.
 1284prolog_library_dir(Dir) :-
 1285    current_prolog_flag(home, Home),
 1286    (   current_prolog_flag(c_libdir, Rel)
 1287    ->  atomic_list_concat([Home, Rel], /, Dir)
 1288    ;   current_prolog_flag(arch, Arch)
 1289    ->  atomic_list_concat([Home, lib, Arch], /, Dir)
 1290    ).

 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?

 1299default_c_compiler(CC) :-
 1300    preferred_c_compiler(CC),
 1301    has_program(path(CC), _),
 1302    !.
 1303
 1304preferred_c_compiler(gcc).
 1305preferred_c_compiler(clang).
 1306preferred_c_compiler(cc).
 1307
 1308
 1309                 /*******************************
 1310                 *             PATHS            *
 1311                 *******************************/
 1312
 1313setup_path :-
 1314    has_program(path(make), _),
 1315    has_program(path(gcc), _),
 1316    !.
 1317setup_path :-
 1318    current_prolog_flag(windows, true),
 1319    !,
 1320    (   mingw_extend_path
 1321    ->  true
 1322    ;   print_message(error, pack(no_mingw))
 1323    ).
 1324setup_path.
 1325
 1326has_program(Program, Path) :-
 1327    exe_options(ExeOptions),
 1328    absolute_file_name(Program, Path,
 1329                       [ file_errors(fail)
 1330                       | ExeOptions
 1331                       ]).
 1332
 1333exe_options(Options) :-
 1334    current_prolog_flag(windows, true),
 1335    !,
 1336    Options = [ extensions(['',exe,com]), access(read) ].
 1337exe_options(Options) :-
 1338    Options = [ access(execute) ].
 1339
 1340mingw_extend_path :-
 1341    mingw_root(MinGW),
 1342    directory_file_path(MinGW, bin, MinGWBinDir),
 1343    atom_concat(MinGW, '/msys/*/bin', Pattern),
 1344    expand_file_name(Pattern, MsysDirs),
 1345    last(MsysDirs, MSysBinDir),
 1346    prolog_to_os_filename(MinGWBinDir, WinDirMinGW),
 1347    prolog_to_os_filename(MSysBinDir, WinDirMSYS),
 1348    getenv('PATH', Path0),
 1349    atomic_list_concat([WinDirMSYS, WinDirMinGW, Path0], ';', Path),
 1350    setenv('PATH', Path).
 1351
 1352mingw_root(MinGwRoot) :-
 1353    current_prolog_flag(executable, Exe),
 1354    sub_atom(Exe, 1, _, _, :),
 1355    sub_atom(Exe, 0, 1, _, PlDrive),
 1356    Drives = [PlDrive,c,d],
 1357    member(Drive, Drives),
 1358    format(atom(MinGwRoot), '~a:/MinGW', [Drive]),
 1359    exists_directory(MinGwRoot),
 1360    !.
 1361
 1362
 1363                 /*******************************
 1364                 *           AUTOLOAD           *
 1365                 *******************************/

 post_install_autoload(+PackDir, +Options)

Create an autoload index if the package demands such.

 1371post_install_autoload(PackDir, Options) :-
 1372    option(autoload(true), Options, true),
 1373    pack_info_term(PackDir, autoload(true)),
 1374    !,
 1375    directory_file_path(PackDir, prolog, PrologLibDir),
 1376    make_library_index(PrologLibDir).
 1377post_install_autoload(_, _).
 1378
 1379
 1380                 /*******************************
 1381                 *            UPGRADE           *
 1382                 *******************************/

 pack_upgrade(+Pack) is semidet

Try to upgrade the package Pack.

To be done

- Update dependencies when updating a pack from git?

 1390pack_upgrade(Pack) :-
 1391    pack_info(Pack, _, directory(Dir)),
 1392    directory_file_path(Dir, '.git', GitDir),
 1393    exists_directory(GitDir),
 1394    !,
 1395    print_message(informational, pack(git_fetch(Dir))),
 1396    git([fetch], [ directory(Dir) ]),
 1397    git_describe(V0, [ directory(Dir) ]),
 1398    git_describe(V1, [ directory(Dir), commit('origin/master') ]),
 1399    (   V0 == V1
 1400    ->  print_message(informational, pack(up_to_date(Pack)))
 1401    ;   confirm(upgrade(Pack, V0, V1), yes, []),
 1402        git([merge, 'origin/master'], [ directory(Dir) ]),
 1403        pack_rebuild(Pack)
 1404    ).
 1405pack_upgrade(Pack) :-
 1406    once(pack_info(Pack, _, version(VersionAtom))),
 1407    atom_version(VersionAtom, Version),
 1408    pack_info(Pack, _, download(URL)),
 1409    (   wildcard_pattern(URL)
 1410    ->  true
 1411    ;   github_url(URL, _User, _Repo)
 1412    ),
 1413    !,
 1414    available_download_versions(URL, [Latest-LatestURL|_Versions]),
 1415    (   Latest @> Version
 1416    ->  confirm(upgrade(Pack, Version, Latest), yes, []),
 1417        pack_install(Pack,
 1418                     [ url(LatestURL),
 1419                       upgrade(true),
 1420                       pack(Pack)
 1421                     ])
 1422    ;   print_message(informational, pack(up_to_date(Pack)))
 1423    ).
 1424pack_upgrade(Pack) :-
 1425    print_message(warning, pack(no_upgrade_info(Pack))).
 1426
 1427
 1428                 /*******************************
 1429                 *            REMOVE            *
 1430                 *******************************/

 pack_remove(+Name) is det

Remove the indicated package.

 1436pack_remove(Pack) :-
 1437    update_dependency_db,
 1438    (   setof(Dep, pack_depends_on(Dep, Pack), Deps)
 1439    ->  confirm_remove(Pack, Deps, Delete),
 1440        forall(member(P, Delete), pack_remove_forced(P))
 1441    ;   pack_remove_forced(Pack)
 1442    ).
 1443
 1444pack_remove_forced(Pack) :-
 1445    catch('$pack_detach'(Pack, BaseDir),
 1446          error(existence_error(pack, Pack), _),
 1447          fail),
 1448    !,
 1449    print_message(informational, pack(remove(BaseDir))),
 1450    delete_directory_and_contents(BaseDir).
 1451pack_remove_forced(Pack) :-
 1452    directory_file_path(Pack, 'pack.pl', PackFile),
 1453    absolute_file_name(pack(PackFile), PackPath,
 1454                       [ access(read),
 1455                         file_errors(fail)
 1456                       ]),
 1457    !,
 1458    file_directory_name(PackPath, BaseDir),
 1459    delete_directory_and_contents(BaseDir).
 1460pack_remove_forced(Pack) :-
 1461    print_message(informational, error(existence_error(pack, Pack),_)).
 1462
 1463confirm_remove(Pack, Deps, Delete) :-
 1464    print_message(warning, pack(depends(Pack, Deps))),
 1465    menu(pack(resolve_remove),
 1466         [ [Pack]      = remove_only(Pack),
 1467           [Pack|Deps] = remove_deps(Pack, Deps),
 1468           []          = cancel
 1469         ], [], Delete, []),
 1470    Delete \== [].
 1471
 1472
 1473                 /*******************************
 1474                 *           PROPERTIES         *
 1475                 *******************************/

 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)

 1498pack_property(Pack, Property) :-
 1499    findall(Pack-Property, pack_property_(Pack, Property), List),
 1500    member(Pack-Property, List).            % make det if applicable
 1501
 1502pack_property_(Pack, Property) :-
 1503    pack_info(Pack, _, Property).
 1504pack_property_(Pack, Property) :-
 1505    \+ \+ info_file(Property, _),
 1506    '$pack':pack(Pack, BaseDir),
 1507    access_file(BaseDir, read),
 1508    directory_files(BaseDir, Files),
 1509    member(File, Files),
 1510    info_file(Property, Pattern),
 1511    downcase_atom(File, Pattern),
 1512    directory_file_path(BaseDir, File, InfoFile),
 1513    arg(1, Property, InfoFile).
 1514
 1515info_file(readme(_), 'readme.txt').
 1516info_file(readme(_), 'readme').
 1517info_file(todo(_),   'todo.txt').
 1518info_file(todo(_),   'todo').
 1519
 1520
 1521                 /*******************************
 1522                 *             GIT              *
 1523                 *******************************/

 git_url(+URL, -Pack) is semidet

True if URL describes a git url for Pack

 1529git_url(URL, Pack) :-
 1530    uri_components(URL, Components),
 1531    uri_data(scheme, Components, Scheme),
 1532    uri_data(path, Components, Path),
 1533    (   Scheme == git
 1534    ->  true
 1535    ;   git_download_scheme(Scheme),
 1536        file_name_extension(_, git, Path)
 1537    ),
 1538    file_base_name(Path, PackExt),
 1539    (   file_name_extension(Pack, git, PackExt)
 1540    ->  true
 1541    ;   Pack = PackExt
 1542    ),
 1543    (   safe_pack_name(Pack)
 1544    ->  true
 1545    ;   domain_error(pack_name, Pack)
 1546    ).
 1547
 1548git_download_scheme(http).
 1549git_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.

 1556safe_pack_name(Name) :-
 1557    atom_length(Name, Len),
 1558    Len >= 3,                               % demand at least three length
 1559    atom_codes(Name, Codes),
 1560    maplist(safe_pack_char, Codes),
 1561    !.
 1562
 1563safe_pack_char(C) :- between(0'a, 0'z, C), !.
 1564safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 1565safe_pack_char(C) :- between(0'0, 0'9, C), !.
 1566safe_pack_char(0'_).
 1567
 1568
 1569                 /*******************************
 1570                 *         VERSION LOGIC        *
 1571                 *******************************/

 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.

 1580pack_version_file(Pack, Version, GitHubRelease) :-
 1581    atomic(GitHubRelease),
 1582    github_release_url(GitHubRelease, Pack, Version),
 1583    !.
 1584pack_version_file(Pack, Version, Path) :-
 1585    atomic(Path),
 1586    file_base_name(Path, File),
 1587    no_int_file_name_extension(Base, _Ext, File),
 1588    atom_codes(Base, Codes),
 1589    (   phrase(pack_version(Pack, Version), Codes),
 1590        safe_pack_name(Pack)
 1591    ->  true
 1592    ).
 1593
 1594no_int_file_name_extension(Base, Ext, File) :-
 1595    file_name_extension(Base0, Ext0, File),
 1596    \+ atom_number(Ext0, _),
 1597    !,
 1598    Base = Base0,
 1599    Ext = Ext0.
 1600no_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'

 1613github_release_url(URL, Pack, Version) :-
 1614    uri_components(URL, Components),
 1615    uri_data(authority, Components, 'github.com'),
 1616    uri_data(scheme, Components, Scheme),
 1617    download_scheme(Scheme),
 1618    uri_data(path, Components, Path),
 1619    atomic_list_concat(['',_Project,Pack,archive,File], /, Path),
 1620    file_name_extension(Tag, Ext, File),
 1621    github_archive_extension(Ext),
 1622    tag_version(Tag, Version),
 1623    !.
 1624
 1625github_archive_extension(tgz).
 1626github_archive_extension(zip).
 1627
 1628tag_version(Tag, Version) :-
 1629    version_tag_prefix(Prefix),
 1630    atom_concat(Prefix, AtomVersion, Tag),
 1631    atom_version(AtomVersion, Version).
 1632
 1633version_tag_prefix(v).
 1634version_tag_prefix('V').
 1635version_tag_prefix('').
 1636
 1637
 1638:- public
 1639    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 @>

 1647atom_version(Atom, version(Parts)) :-
 1648    (   atom(Atom)
 1649    ->  atom_codes(Atom, Codes),
 1650        phrase(version(Parts), Codes)
 1651    ;   atomic_list_concat(Parts, '.', Atom)
 1652    ).
 1653
 1654pack_version(Pack, version(Parts)) -->
 1655    string(Codes), "-",
 1656    version(Parts),
 1657    !,
 1658    { atom_codes(Pack, Codes)
 1659    }.
 1660
 1661version([_|T]) -->
 1662    "*",
 1663    !,
 1664    (   "."
 1665    ->  version(T)
 1666    ;   []
 1667    ).
 1668version([H|T]) -->
 1669    integer(H),
 1670    (   "."
 1671    ->  version(T)
 1672    ;   { T = [] }
 1673    ).
 1674
 1675integer(H)    --> digit(D0), digits(L), { number_codes(H, [D0|L]) }.
 1676digit(D)      --> [D], { code_type(D, digit) }.
 1677digits([H|T]) --> digit(H), !, digits(T).
 1678digits([])    --> [].
 1679
 1680
 1681                 /*******************************
 1682                 *       QUERY CENTRAL DB       *
 1683                 *******************************/

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

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

alt_hash(Count, URLs, Hash)

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

downloads(Count)

Number of times a file with this hash was downloaded.

rating(VoteCount, Rating)

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

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

Required tokens can be provided by the given provides.

 1703pack_inquiry(_, _, _, Options) :-
 1704    option(inquiry(false), Options),
 1705    !.
 1706pack_inquiry(URL, DownloadFile, Info, Options) :-
 1707    setting(server, ServerBase),
 1708    ServerBase \== '',
 1709    atom_concat(ServerBase, query, Server),
 1710    (   option(inquiry(true), Options)
 1711    ->  true
 1712    ;   confirm(inquiry(Server), yes, Options)
 1713    ),
 1714    !,
 1715    (   DownloadFile = git(SHA1)
 1716    ->  true
 1717    ;   file_sha1(DownloadFile, SHA1)
 1718    ),
 1719    query_pack_server(install(URL, SHA1, Info), Reply, Options),
 1720    inquiry_result(Reply, URL, Options).
 1721pack_inquiry(_, _, _, _).