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

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

 current_pack(?Pack) is nondet

True if Pack is a currently installed pack.

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

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

 pack_info(+Pack)

Print more detailed information about Pack.

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

 pack_info_term(+PackDir, ?Info) is nondet

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

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

 pack_info_term(?Term) is nondet

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

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

 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.

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

 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 deirectory 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.

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

  467pack_default_options(_Spec, Pack, OptsIn, Options) :-
  468    option(already_installed(pack(Pack,_Version)), OptsIn),
  469    !,
  470    Options = OptsIn.
  471pack_default_options(_Spec, Pack, OptsIn, Options) :-
  472    option(url(URL), OptsIn),
  473    !,
  474    (   option(git(_), OptsIn)
  475    ->  Options = OptsIn
  476    ;   git_url(URL, Pack)
  477    ->  Options = [git(true)|OptsIn]
  478    ;   Options = OptsIn
  479    ),
  480    (   nonvar(Pack)
  481    ->  true
  482    ;   option(pack(Pack), Options)
  483    ->  true
  484    ;   pack_version_file(Pack, _Version, URL)
  485    ).
  486pack_default_options(Archive, Pack, _, Options) :-      % Install from archive
  487    must_be(atom, 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(current_predicate(archive_extract/3)).  727pack_unpack(Source, PackDir, Pack, Options) :-
  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.

Errors

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

- Syntax errors if pack.pl cannot be parsed.

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

  809pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
  810    exists_directory(GitDir),
  811    !,
  812    git_ls_tree(Entries, [directory(GitDir)]),
  813    git_hash(Hash, [directory(GitDir)]),
  814    maplist(arg(4), Entries, Sizes),
  815    sum_list(Sizes, Bytes),
  816    directory_file_path(GitDir, 'pack.pl', InfoFile),
  817    read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
  818    must_be(ground, Info),
  819    maplist(valid_info_term, Info).

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

Perform basic sanity checks on DownloadFile

  825download_file_sanity_check(Archive, Pack, Info) :-
  826    info_field(name(Name), Info),
  827    info_field(version(VersionAtom), Info),
  828    atom_version(VersionAtom, Version),
  829    pack_version_file(PackA, VersionA, Archive),
  830    must_match([Pack, PackA, Name], name),
  831    must_match([Version, VersionA], version).
  832
  833info_field(Field, Info) :-
  834    memberchk(Field, Info),
  835    ground(Field),
  836    !.
  837info_field(Field, _Info) :-
  838    functor(Field, FieldName, _),
  839    print_message(error, pack(missing(FieldName))),
  840    fail.
  841
  842must_match(Values, _Field) :-
  843    sort(Values, [_]),
  844    !.
  845must_match(Values, Field) :-
  846    print_message(error, pack(conflict(Field, Values))),
  847    fail.
  848
  849
  850                 /*******************************
  851                 *         INSTALLATION         *
  852                 *******************************/

 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.

  860prepare_pack_dir(Dir, Options) :-
  861    exists_directory(Dir),
  862    !,
  863    (   empty_directory(Dir)
  864    ->  true
  865    ;   option(upgrade(true), Options)
  866    ->  delete_directory_contents(Dir)
  867    ;   confirm(remove_existing_pack(Dir), yes, Options),
  868        delete_directory_contents(Dir)
  869    ).
  870prepare_pack_dir(Dir, _) :-
  871    make_directory(Dir).

 empty_directory(+Directory) is semidet

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

  877empty_directory(Dir) :-
  878    \+ ( directory_files(Dir, Entries),
  879         member(Entry, Entries),
  880         \+ special(Entry)
  881       ).
  882
  883special(.).
  884special(..).

 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.

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

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

  930download_file(URL, Pack, File, Options) :-
  931    option(version(Version), Options),
  932    !,
  933    atom_version(VersionA, Version),
  934    file_name_extension(_, Ext, URL),
  935    format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
  936download_file(URL, Pack, File, _) :-
  937    file_base_name(URL,Basename),
  938    no_int_file_name_extension(Tag,Ext,Basename),
  939    tag_version(Tag,Version),
  940    !,
  941    atom_version(VersionA,Version),
  942    format(atom(File0), '~w-~w', [Pack, VersionA]),
  943    file_name_extension(File0, Ext, File).
  944download_file(URL, _, File, _) :-
  945    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.

  953pack_url_file(URL, FileID) :-
  954    github_release_url(URL, Pack, Version),
  955    !,
  956    download_file(URL, Pack, FileID, [version(Version)]).
  957pack_url_file(URL, FileID) :-
  958    file_base_name(URL, FileID).
  959
  960
  961:- 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.

  969ssl_verify(_SSL,
  970           _ProblemCertificate, _AllCertificates, _FirstCertificate,
  971           _Error).
  972
  973pack_download_dir(PackTopDir, DownLoadDir) :-
  974    directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
  975    (   exists_directory(DownLoadDir)
  976    ->  true
  977    ;   make_directory(DownLoadDir)
  978    ),
  979    (   access_file(DownLoadDir, write)
  980    ->  true
  981    ;   permission_error(write, directory, DownLoadDir)
  982    ).

 download_url(+URL) is det

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

  988download_url(URL) :-
  989    atom(URL),
  990    uri_components(URL, Components),
  991    uri_data(scheme, Components, Scheme),
  992    download_scheme(Scheme).
  993
  994download_scheme(http).
  995download_scheme(https) :-
  996    catch(use_module(library(http/http_ssl_plugin)),
  997          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

 1007pack_post_install(Pack, PackDir, Options) :-
 1008    post_install_foreign(Pack, PackDir,
 1009                         [ build_foreign(if_absent)
 1010                         | Options
 1011                         ]),
 1012    post_install_autoload(PackDir, Options),
 1013    '$pack_attach'(PackDir).

 pack_rebuild(+Pack) is det

Rebuilt possible foreign components of Pack.

 1019pack_rebuild(Pack) :-
 1020    '$pack':pack(Pack, BaseDir),
 1021    !,
 1022    catch(pack_make(BaseDir, [distclean], []), E,
 1023          print_message(warning, E)),
 1024    post_install_foreign(Pack, BaseDir, []).
 1025pack_rebuild(Pack) :-
 1026    existence_error(pack, Pack).

 pack_rebuild is det

Rebuild foreign components of all packages.

 1032pack_rebuild :-
 1033    forall(current_pack(Pack),
 1034           ( print_message(informational, pack(rebuild(Pack))),
 1035             pack_rebuild(Pack)
 1036           )).

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

Install foreign parts of the package.

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

 1086configure_foreign(PackDir, Options) :-
 1087    make_configure(PackDir, Options),
 1088    directory_file_path(PackDir, configure, Configure),
 1089    exists_file(Configure),
 1090    !,
 1091    build_environment(BuildEnv),
 1092    run_process(path(bash), [Configure],
 1093                [ env(BuildEnv),
 1094                  directory(PackDir)
 1095                ]).
 1096configure_foreign(_, _).
 1097
 1098make_configure(PackDir, _Options) :-
 1099    directory_file_path(PackDir, 'configure', Configure),
 1100    exists_file(Configure),
 1101    !.
 1102make_configure(PackDir, _Options) :-
 1103    autoconf_master(ConfigMaster),
 1104    directory_file_path(PackDir, ConfigMaster, ConfigureIn),
 1105    exists_file(ConfigureIn),
 1106    !,
 1107    run_process(path(autoheader), [], [directory(PackDir)]),
 1108    run_process(path(autoconf),   [], [directory(PackDir)]).
 1109make_configure(_, _).
 1110
 1111autoconf_master('configure.ac').
 1112autoconf_master('configure.in').

 make_foreign(+PackDir, +Options) is det

Generate the foreign executable.

 1119make_foreign(PackDir, Options) :-
 1120    pack_make(PackDir, [all, check, install], Options).
 1121
 1122pack_make(PackDir, Targets, _Options) :-
 1123    directory_file_path(PackDir, 'Makefile', Makefile),
 1124    exists_file(Makefile),
 1125    !,
 1126    build_environment(BuildEnv),
 1127    ProcessOptions = [ directory(PackDir), env(BuildEnv) ],
 1128    forall(member(Target, Targets),
 1129           run_process(path(make), [Target], ProcessOptions)).
 1130pack_make(_, _, _).

 save_build_environment(+PackDir)

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

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

 1194def_environment('PATH', Value) :-
 1195    getenv('PATH', PATH),
 1196    current_prolog_flag(executable, Exe),
 1197    file_directory_name(Exe, ExeDir),
 1198    prolog_to_os_filename(ExeDir, OsExeDir),
 1199    (   current_prolog_flag(windows, true)
 1200    ->  Sep = (;)
 1201    ;   Sep = (:)
 1202    ),
 1203    atomic_list_concat([OsExeDir, Sep, PATH], Value).
 1204def_environment('SWIPL', Value) :-
 1205    current_prolog_flag(executable, Value).
 1206def_environment('SWIPLVERSION', Value) :-
 1207    current_prolog_flag(version, Value).
 1208def_environment('SWIHOME', Value) :-
 1209    current_prolog_flag(home, Value).
 1210def_environment('SWIARCH', Value) :-
 1211    current_prolog_flag(arch, Value).
 1212def_environment('PACKSODIR', Value) :-
 1213    current_prolog_flag(arch, Arch),
 1214    atom_concat('lib/', Arch, Value).
 1215def_environment('SWISOLIB', Value) :-
 1216    current_prolog_flag(c_libplso, Value).
 1217def_environment('SWILIB', '-lswipl').
 1218def_environment('CC', Value) :-
 1219    (   getenv('CC', value)
 1220    ->  true
 1221    ;   current_prolog_flag(c_cc, Value)
 1222    ).
 1223def_environment('LD', Value) :-
 1224    (   getenv('LD', Value)
 1225    ->  true
 1226    ;   current_prolog_flag(c_cc, Value)
 1227    ).
 1228def_environment('CFLAGS', Value) :-
 1229    (   getenv('CFLAGS', SystemFlags)
 1230    ->  Extra = [' ', SystemFlags]
 1231    ;   Extra = []
 1232    ),
 1233    current_prolog_flag(c_cflags, Value0),
 1234    current_prolog_flag(home, Home),
 1235    atomic_list_concat([Value0, ' -I"', Home, '/include"' | Extra], Value).
 1236def_environment('LDSOFLAGS', Value) :-
 1237    (   getenv('LDFLAGS', SystemFlags)
 1238    ->  Extra = [' ', SystemFlags|System]
 1239    ;   Extra = System
 1240    ),
 1241    (   current_prolog_flag(windows, true)
 1242    ->  current_prolog_flag(home, Home),
 1243        atomic_list_concat([' -L"', Home, '/bin"'], SystemLib),
 1244        System = [SystemLib]
 1245    ;   current_prolog_flag(shared_object_extension, so)
 1246    ->  System = []                 % ELF systems do not need this
 1247    ;   current_prolog_flag(home, Home),
 1248        current_prolog_flag(arch, Arch),
 1249        atomic_list_concat([' -L"', Home, '/lib/', Arch, '"'], SystemLib),
 1250        System = [SystemLib]
 1251    ),
 1252    current_prolog_flag(c_ldflags, LDFlags),
 1253    atomic_list_concat([LDFlags, ' -shared' | Extra], Value).
 1254def_environment('SOEXT', Value) :-
 1255    current_prolog_flag(shared_object_extension, Value).
 1256def_environment(Pass, Value) :-
 1257    pass_env(Pass),
 1258    getenv(Pass, Value).
 1259
 1260pass_env('TMP').
 1261pass_env('TEMP').
 1262pass_env('USER').
 1263pass_env('HOME').
 1264
 1265                 /*******************************
 1266                 *             PATHS            *
 1267                 *******************************/
 1268
 1269setup_path :-
 1270    has_program(path(make), _),
 1271    has_program(path(gcc), _),
 1272    !.
 1273setup_path :-
 1274    current_prolog_flag(windows, true),
 1275    !,
 1276    (   mingw_extend_path
 1277    ->  true
 1278    ;   print_message(error, pack(no_mingw))
 1279    ).
 1280setup_path.
 1281
 1282has_program(Program, Path) :-
 1283    exe_options(ExeOptions),
 1284    absolute_file_name(Program, Path,
 1285                       [ file_errors(fail)
 1286                       | ExeOptions
 1287                       ]).
 1288
 1289exe_options(Options) :-
 1290    current_prolog_flag(windows, true),
 1291    !,
 1292    Options = [ extensions(['',exe,com]), access(read) ].
 1293exe_options(Options) :-
 1294    Options = [ access(execute) ].
 1295
 1296mingw_extend_path :-
 1297    mingw_root(MinGW),
 1298    directory_file_path(MinGW, bin, MinGWBinDir),
 1299    atom_concat(MinGW, '/msys/*/bin', Pattern),
 1300    expand_file_name(Pattern, MsysDirs),
 1301    last(MsysDirs, MSysBinDir),
 1302    prolog_to_os_filename(MinGWBinDir, WinDirMinGW),
 1303    prolog_to_os_filename(MSysBinDir, WinDirMSYS),
 1304    getenv('PATH', Path0),
 1305    atomic_list_concat([WinDirMSYS, WinDirMinGW, Path0], ';', Path),
 1306    setenv('PATH', Path).
 1307
 1308mingw_root(MinGwRoot) :-
 1309    current_prolog_flag(executable, Exe),
 1310    sub_atom(Exe, 1, _, _, :),
 1311    sub_atom(Exe, 0, 1, _, PlDrive),
 1312    Drives = [PlDrive,c,d],
 1313    member(Drive, Drives),
 1314    format(atom(MinGwRoot), '~a:/MinGW', [Drive]),
 1315    exists_directory(MinGwRoot),
 1316    !.
 1317
 1318
 1319                 /*******************************
 1320                 *           AUTOLOAD           *
 1321                 *******************************/

 post_install_autoload(+PackDir, +Options)

Create an autoload index if the package demands such.

 1327post_install_autoload(PackDir, Options) :-
 1328    option(autoload(true), Options, true),
 1329    pack_info_term(PackDir, autoload(true)),
 1330    !,
 1331    directory_file_path(PackDir, prolog, PrologLibDir),
 1332    make_library_index(PrologLibDir).
 1333post_install_autoload(_, _).
 1334
 1335
 1336                 /*******************************
 1337                 *            UPGRADE           *
 1338                 *******************************/

 pack_upgrade(+Pack) is semidet

Try to upgrade the package Pack.

To be done

- Update dependencies when updating a pack from git?

 1346pack_upgrade(Pack) :-
 1347    pack_info(Pack, _, directory(Dir)),
 1348    directory_file_path(Dir, '.git', GitDir),
 1349    exists_directory(GitDir),
 1350    !,
 1351    print_message(informational, pack(git_fetch(Dir))),
 1352    git([fetch], [ directory(Dir) ]),
 1353    git_describe(V0, [ directory(Dir) ]),
 1354    git_describe(V1, [ directory(Dir), commit('origin/master') ]),
 1355    (   V0 == V1
 1356    ->  print_message(informational, pack(up_to_date(Pack)))
 1357    ;   confirm(upgrade(Pack, V0, V1), yes, []),
 1358        git([merge, 'origin/master'], [ directory(Dir) ]),
 1359        pack_rebuild(Pack)
 1360    ).
 1361pack_upgrade(Pack) :-
 1362    once(pack_info(Pack, _, version(VersionAtom))),
 1363    atom_version(VersionAtom, Version),
 1364    pack_info(Pack, _, download(URL)),
 1365    (   wildcard_pattern(URL)
 1366    ->  true
 1367    ;   github_url(URL, _User, _Repo)
 1368    ),
 1369    !,
 1370    available_download_versions(URL, [Latest-LatestURL|_Versions]),
 1371    (   Latest @> Version
 1372    ->  confirm(upgrade(Pack, Version, Latest), yes, []),
 1373        pack_install(Pack,
 1374                     [ url(LatestURL),
 1375                       upgrade(true),
 1376                       pack(Pack)
 1377                     ])
 1378    ;   print_message(informational, pack(up_to_date(Pack)))
 1379    ).
 1380pack_upgrade(Pack) :-
 1381    print_message(warning, pack(no_upgrade_info(Pack))).
 1382
 1383
 1384                 /*******************************
 1385                 *            REMOVE            *
 1386                 *******************************/

 pack_remove(+Name) is det

Remove the indicated package.

 1392pack_remove(Pack) :-
 1393    update_dependency_db,
 1394    (   setof(Dep, pack_depends_on(Dep, Pack), Deps)
 1395    ->  confirm_remove(Pack, Deps, Delete),
 1396        forall(member(P, Delete), pack_remove_forced(P))
 1397    ;   pack_remove_forced(Pack)
 1398    ).
 1399
 1400pack_remove_forced(Pack) :-
 1401    '$pack_detach'(Pack, BaseDir),
 1402    print_message(informational, pack(remove(BaseDir))),
 1403    delete_directory_and_contents(BaseDir).
 1404
 1405confirm_remove(Pack, Deps, Delete) :-
 1406    print_message(warning, pack(depends(Pack, Deps))),
 1407    menu(pack(resolve_remove),
 1408         [ [Pack]      = remove_only(Pack),
 1409           [Pack|Deps] = remove_deps(Pack, Deps),
 1410           []          = cancel
 1411         ], [], Delete, []),
 1412    Delete \== [].
 1413
 1414
 1415                 /*******************************
 1416                 *           PROPERTIES         *
 1417                 *******************************/

 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)

 1440pack_property(Pack, Property) :-
 1441    findall(Pack-Property, pack_property_(Pack, Property), List),
 1442    member(Pack-Property, List).            % make det if applicable
 1443
 1444pack_property_(Pack, Property) :-
 1445    pack_info(Pack, _, Property).
 1446pack_property_(Pack, Property) :-
 1447    \+ \+ info_file(Property, _),
 1448    '$pack':pack(Pack, BaseDir),
 1449    access_file(BaseDir, read),
 1450    directory_files(BaseDir, Files),
 1451    member(File, Files),
 1452    info_file(Property, Pattern),
 1453    downcase_atom(File, Pattern),
 1454    directory_file_path(BaseDir, File, InfoFile),
 1455    arg(1, Property, InfoFile).
 1456
 1457info_file(readme(_), 'readme.txt').
 1458info_file(readme(_), 'readme').
 1459info_file(todo(_),   'todo.txt').
 1460info_file(todo(_),   'todo').
 1461
 1462
 1463                 /*******************************
 1464                 *             GIT              *
 1465                 *******************************/

 git_url(+URL, -Pack) is semidet

True if URL describes a git url for Pack

 1471git_url(URL, Pack) :-
 1472    uri_components(URL, Components),
 1473    uri_data(scheme, Components, Scheme),
 1474    uri_data(path, Components, Path),
 1475    (   Scheme == git
 1476    ->  true
 1477    ;   git_download_scheme(Scheme),
 1478        file_name_extension(_, git, Path)
 1479    ),
 1480    file_base_name(Path, PackExt),
 1481    (   file_name_extension(Pack, git, PackExt)
 1482    ->  true
 1483    ;   Pack = PackExt
 1484    ),
 1485    (   safe_pack_name(Pack)
 1486    ->  true
 1487    ;   domain_error(pack_name, Pack)
 1488    ).
 1489
 1490git_download_scheme(http).
 1491git_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.

 1498safe_pack_name(Name) :-
 1499    atom_length(Name, Len),
 1500    Len >= 3,                               % demand at least three length
 1501    atom_codes(Name, Codes),
 1502    maplist(safe_pack_char, Codes),
 1503    !.
 1504
 1505safe_pack_char(C) :- between(0'a, 0'z, C), !.
 1506safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 1507safe_pack_char(C) :- between(0'0, 0'9, C), !.
 1508safe_pack_char(0'_).
 1509
 1510
 1511                 /*******************************
 1512                 *         VERSION LOGIC        *
 1513                 *******************************/

 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.

 1522pack_version_file(Pack, Version, GitHubRelease) :-
 1523    atomic(GitHubRelease),
 1524    github_release_url(GitHubRelease, Pack, Version),
 1525    !.
 1526pack_version_file(Pack, Version, Path) :-
 1527    atomic(Path),
 1528    file_base_name(Path, File),
 1529    no_int_file_name_extension(Base, _Ext, File),
 1530    atom_codes(Base, Codes),
 1531    (   phrase(pack_version(Pack, Version), Codes),
 1532        safe_pack_name(Pack)
 1533    ->  true
 1534    ).
 1535
 1536no_int_file_name_extension(Base, Ext, File) :-
 1537    file_name_extension(Base0, Ext0, File),
 1538    \+ atom_number(Ext0, _),
 1539    !,
 1540    Base = Base0,
 1541    Ext = Ext0.
 1542no_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'

 1555github_release_url(URL, Pack, Version) :-
 1556    uri_components(URL, Components),
 1557    uri_data(authority, Components, 'github.com'),
 1558    uri_data(scheme, Components, Scheme),
 1559    download_scheme(Scheme),
 1560    uri_data(path, Components, Path),
 1561    atomic_list_concat(['',_Project,Pack,archive,File], /, Path),
 1562    file_name_extension(Tag, Ext, File),
 1563    github_archive_extension(Ext),
 1564    tag_version(Tag, Version),
 1565    !.
 1566
 1567github_archive_extension(tgz).
 1568github_archive_extension(zip).
 1569
 1570tag_version(Tag, Version) :-
 1571    version_tag_prefix(Prefix),
 1572    atom_concat(Prefix, AtomVersion, Tag),
 1573    atom_version(AtomVersion, Version).
 1574
 1575version_tag_prefix(v).
 1576version_tag_prefix('V').
 1577version_tag_prefix('').
 1578
 1579
 1580:- public
 1581    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 @>

 1589atom_version(Atom, version(Parts)) :-
 1590    (   atom(Atom)
 1591    ->  atom_codes(Atom, Codes),
 1592        phrase(version(Parts), Codes)
 1593    ;   atomic_list_concat(Parts, '.', Atom)
 1594    ).
 1595
 1596pack_version(Pack, version(Parts)) -->
 1597    string(Codes), "-",
 1598    version(Parts),
 1599    !,
 1600    { atom_codes(Pack, Codes)
 1601    }.
 1602
 1603version([_|T]) -->
 1604    "*",
 1605    !,
 1606    (   "."
 1607    ->  version(T)
 1608    ;   []
 1609    ).
 1610version([H|T]) -->
 1611    integer(H),
 1612    (   "."
 1613    ->  version(T)
 1614    ;   { T = [] }
 1615    ).
 1616
 1617integer(H)    --> digit(D0), digits(L), { number_codes(H, [D0|L]) }.
 1618digit(D)      --> [D], { code_type(D, digit) }.
 1619digits([H|T]) --> digit(H), !, digits(T).
 1620digits([])    --> [].
 1621
 1622
 1623                 /*******************************
 1624                 *       QUERY CENTRAL DB       *
 1625                 *******************************/

 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 is downloads (which may be 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.

 1645pack_inquiry(_, _, _, Options) :-
 1646    option(inquiry(false), Options),
 1647    !.
 1648pack_inquiry(URL, DownloadFile, Info, Options) :-
 1649    setting(server, ServerBase),
 1650    ServerBase \== '',
 1651    atom_concat(ServerBase, query, Server),
 1652    (   option(inquiry(true), Options)
 1653    ->  true
 1654    ;   confirm(inquiry(Server), yes, Options)
 1655    ),
 1656    !,
 1657    (   DownloadFile = git(SHA1)
 1658    ->  true
 1659    ;   file_sha1(DownloadFile, SHA1)
 1660    ),
 1661    query_pack_server(install(URL, SHA1, Info), Reply, Options),
 1662    inquiry_result(Reply, URL, Options).
 1663pack_inquiry(_, _, _, _).

 query_pack_server(+Query, -Result, +Options)

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

 1671query_pack_server(Query, Result, Options) :-
 1672    setting(server, ServerBase),
 1673    ServerBase \== '',
 1674    atom_concat(ServerBase, query, Server),
 1675    format(codes(Data), '~q.~n', Query),
 1676    info_level(Informational, Options),
 1677    print_message(Informational, pack(contacting_server(Server))),
 1678    setup_call_cleanup(
 1679        http_open(Server, In,
 1680                  [ post(codes(application/'x-prolog', Data)),
 1681                    header(content_type, ContentType)
 1682                  ]),
 1683        read_reply(ContentType, In, Result),
 1684        close(In)),
 1685    message_severity(Result, Level, Informational),
 1686    print_message(Level, pack(server_reply(Result))).
 1687
 1688read_reply(ContentType, In, Result) :-
 1689    sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
 1690    !,
 1691    set_stream(In, encoding(utf8)),
 1692    read(In, Result).
 1693read_reply(ContentType, In, _Result) :-
 1694    read_string(In, 500, String),
 1695    print_message(error, pack(no_prolog_response(ContentType, String))),
 1696    fail.
 1697
 1698info_level(Level, Options) :-
 1699    option(silent(true), Options),
 1700    !,
 1701    Level = silent.
 1702info_level(informational, _).
 1703
 1704message_severity(true(_), Informational, Informational).
 1705message_severity(false, warning, _).
 1706message_severity(exception(_), error, _).