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').
 1076foreign_file('Makefile').
 1077foreign_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

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

 make_foreign(+PackDir, +Options) is det

Generate the foreign executable.

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

 save_build_environment(+PackDir)

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

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

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

 post_install_autoload(+PackDir, +Options)

Create an autoload index if the package demands such.

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

 pack_upgrade(+Pack) is semidet

Try to upgrade the package Pack.

To be done

- Update dependencies when updating a pack from git?

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

 pack_remove(+Name) is det

Remove the indicated package.

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

 pack_property(?Pack, ?Property) is nondet

True when Property is a property of 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)

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

 git_url(+URL, -Pack) is semidet

True if URL describes a git url for Pack

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

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

 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.

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

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

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

 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.

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

 query_pack_server(+Query, -Result, +Options)

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

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