1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: jan@swi-prolog.org 5 WWW: https://www.swi-prolog.org 6 Copyright (c) 2012-2024, VU University Amsterdam 7 CWI, Amsterdam 8 SWI-Prolog Solutions b.v. 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(prolog_pack, 38 [ pack_list_installed/0, 39 pack_info/1, % +Name 40 pack_list/1, % +Keyword 41 pack_list/2, % +Query, +Options 42 pack_search/1, % +Keyword 43 pack_install/1, % +Name 44 pack_install/2, % +Name, +Options 45 pack_install_local/3, % :Spec, +Dir, +Options 46 pack_upgrade/1, % +Name 47 pack_rebuild/1, % +Name 48 pack_rebuild/0, % All packages 49 pack_remove/1, % +Name 50 pack_remove/2, % +Name, +Options 51 pack_publish/2, % +URL, +Options 52 pack_property/2 % ?Name, ?Property 53 ]). 54:- use_module(library(apply)). 55:- use_module(library(error)). 56:- use_module(library(option)). 57:- use_module(library(readutil)). 58:- use_module(library(lists)). 59:- use_module(library(filesex)). 60:- use_module(library(xpath)). 61:- use_module(library(settings)). 62:- use_module(library(uri)). 63:- use_module(library(dcg/basics)). 64:- use_module(library(dcg/high_order)). 65:- use_module(library(http/http_open)). 66:- use_module(library(http/json)). 67:- use_module(library(http/http_client), []). 68:- use_module(library(debug), [assertion/1]). 69:- use_module(library(pairs), 70 [pairs_keys/2, map_list_to_pairs/3, pairs_values/2]). 71:- autoload(library(git)). 72:- autoload(library(sgml)). 73:- autoload(library(sha)). 74:- autoload(library(build/tools)). 75:- autoload(library(ansi_term), [ansi_format/3]). 76:- autoload(library(pprint), [print_term/2]). 77:- autoload(library(prolog_versions), [require_version/3, cmp_versions/3]). 78:- autoload(library(ugraphs), [vertices_edges_to_ugraph/3, ugraph_layers/2]). 79:- autoload(library(process), [process_which/2]). 80:- autoload(library(aggregate), [aggregate_all/3]). 81 82:- meta_predicate 83 pack_install_local( , , ).
98 /******************************* 99 * CONSTANTS * 100 *******************************/ 101 102:- setting(server, atom, 'https://www.swi-prolog.org/pack/', 103 'Server to exchange pack information'). 104 105 106 /******************************* 107 * LOCAL DECLARATIONS * 108 *******************************/ 109 110:- op(900, xfx, @). % Token@Version 111 112:- meta_predicate det_if( , ). 113 114 /******************************* 115 * PACKAGE INFO * 116 *******************************/
123current_pack(Pack) :- 124 current_pack(Pack, _). 125 126current_pack(Pack, Dir) :- 127 '$pack':pack(Pack, Dir).
134pack_list_installed :-
135 pack_list('', [installed(true)]),
136 validate_dependencies.
142pack_info(Name) :- 143 pack_info(info, Name). 144 145pack_info(Level, Name) :- 146 must_be(atom, Name), 147 findall(Info, pack_info(Name, Level, Info), Infos0), 148 ( Infos0 == [] 149 -> print_message(warning, pack(no_pack_installed(Name))), 150 fail 151 ; true 152 ), 153 findall(Def, pack_default(Level, Infos, Def), Defs), 154 append(Infos0, Defs, Infos1), 155 sort(Infos1, Infos), 156 show_info(Name, Infos, [info(Level)]). 157 158 159show_info(_Name, _Properties, Options) :- 160 option(silent(true), Options), 161 !. 162show_info(_Name, _Properties, Options) :- 163 option(show_info(false), Options), 164 !. 165show_info(Name, Properties, Options) :- 166 option(info(list), Options), 167 !, 168 memberchk(title(Title), Properties), 169 memberchk(version(Version), Properties), 170 format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]). 171show_info(Name, Properties, _) :- 172 !, 173 print_property_value('Package'-'~w', [Name]), 174 findall(Term, pack_level_info(info, Term, _, _), Terms), 175 maplist(print_property(Properties), Terms). 176 177print_property(_, nl) :- 178 !, 179 format('~n'). 180print_property(Properties, Term) :- 181 findall(Term, member(Term, Properties), Terms), 182 Terms \== [], 183 !, 184 pack_level_info(_, Term, LabelFmt, _Def), 185 ( LabelFmt = Label-FmtElem 186 -> true 187 ; Label = LabelFmt, 188 FmtElem = '~w' 189 ), 190 multi_valued(Terms, FmtElem, FmtList, Values), 191 atomic_list_concat(FmtList, ', ', Fmt), 192 print_property_value(Label-Fmt, Values). 193print_property(_, _). 194 195multi_valued([H], LabelFmt, [LabelFmt], Values) :- 196 !, 197 H =.. [_|Values]. 198multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :- 199 H =.. [_|VH], 200 append(VH, MoreValues, Values), 201 multi_valued(T, LabelFmt, LT, MoreValues). 202 203 204pvalue_column(31). 205print_property_value(Prop-Fmt, Values) :- 206 !, 207 pvalue_column(C), 208 ansi_format(comment, '% ~w:~t~*|', [Prop, C]), 209 ansi_format(code, Fmt, Values), 210 ansi_format([], '~n', []). 211 212pack_info(Name, Level, Info) :- 213 '$pack':pack(Name, BaseDir), 214 pack_dir_info(BaseDir, Level, Info). 215 216pack_dir_info(BaseDir, Level, Info) :- 217 ( Info = directory(BaseDir) 218 ; pack_info_term(BaseDir, Info) 219 ), 220 pack_level_info(Level, Info, _Format, _Default). 221 222:- public pack_level_info/4. % used by web-server 223 224pack_level_info(_, title(_), 'Title', '<no title>'). 225pack_level_info(_, version(_), 'Installed version', '<unknown>'). 226pack_level_info(info, automatic(_), 'Automatic (dependency only)', -). 227pack_level_info(info, directory(_), 'Installed in directory', -). 228pack_level_info(info, link(_), 'Installed as link to'-'~w', -). 229pack_level_info(info, built(_,_), 'Built on'-'~w for SWI-Prolog ~w', -). 230pack_level_info(info, author(_, _), 'Author'-'~w <~w>', -). 231pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>', -). 232pack_level_info(info, packager(_, _), 'Packager'-'~w <~w>', -). 233pack_level_info(info, home(_), 'Home page', -). 234pack_level_info(info, download(_), 'Download URL', -). 235pack_level_info(_, provides(_), 'Provides', -). 236pack_level_info(_, requires(_), 'Requires', -). 237pack_level_info(_, conflicts(_), 'Conflicts with', -). 238pack_level_info(_, replaces(_), 'Replaces packages', -). 239pack_level_info(info, library(_), 'Provided libraries', -). 240pack_level_info(info, autoload(_), 'Autoload', -). 241 242pack_default(Level, Infos, Def) :- 243 pack_level_info(Level, ITerm, _Format, Def), 244 Def \== (-), 245 \+ memberchk(ITerm, Infos).
251pack_info_term(BaseDir, Info) :- 252 directory_file_path(BaseDir, 'pack.pl', InfoFile), 253 catch( 254 term_in_file(valid_term(pack_info_term), InfoFile, Info), 255 error(existence_error(source_sink, InfoFile), _), 256 ( print_message(error, pack(no_meta_data(BaseDir))), 257 fail 258 )). 259pack_info_term(BaseDir, library(Lib)) :- 260 atom_concat(BaseDir, '/prolog/', LibDir), 261 atom_concat(LibDir, '*.pl', Pattern), 262 expand_file_name(Pattern, Files), 263 maplist(atom_concat(LibDir), Plain, Files), 264 convlist(base_name, Plain, Libs), 265 member(Lib, Libs), 266 Lib \== 'INDEX'. 267pack_info_term(BaseDir, autoload(true)) :- 268 atom_concat(BaseDir, '/prolog/INDEX.pl', IndexFile), 269 exists_file(IndexFile). 270pack_info_term(BaseDir, automatic(Boolean)) :- 271 once(pack_status_dir(BaseDir, automatic(Boolean))). 272pack_info_term(BaseDir, built(Arch, Prolog)) :- 273 pack_status_dir(BaseDir, built(Arch, Prolog, _How)). 274pack_info_term(BaseDir, link(Dest)) :- 275 read_link(BaseDir, _, Dest). 276 277base_name(File, Base) :- 278 file_name_extension(Base, pl, File).
call(Valid, Term)
is true.284:- meta_predicate 285 term_in_file( , , ). 286 287term_in_file(Valid, File, Term) :- 288 exists_file(File), 289 setup_call_cleanup( 290 open(File, read, In, [encoding(utf8)]), 291 term_in_stream(Valid, In, Term), 292 close(In)). 293 294term_in_stream(Valid, In, Term) :- 295 repeat, 296 read_term(In, Term0, []), 297 ( Term0 == end_of_file 298 -> !, fail 299 ; Term = Term0, 300 call(Valid, Term0) 301 ). 302 303:- meta_predicate 304 valid_term( , ). 305 306valid_term(Type, Term) :- 307 Term =.. [Name|Args], 308 same_length(Args, Types), 309 Decl =.. [Name|Types], 310 ( call(Type, Decl) 311 -> maplist(valid_info_arg, Types, Args) 312 ; print_message(warning, pack(invalid_term(Type, Term))), 313 fail 314 ). 315 316valid_info_arg(Type, Arg) :- 317 must_be(Type, Arg).
324pack_info_term(name(atom)). % Synopsis 325pack_info_term(title(atom)). 326pack_info_term(keywords(list(atom))). 327pack_info_term(description(list(atom))). 328pack_info_term(version(version)). 329pack_info_term(author(atom, email_or_url_or_empty)). % Persons 330pack_info_term(maintainer(atom, email_or_url)). 331pack_info_term(packager(atom, email_or_url)). 332pack_info_term(pack_version(nonneg)). % Package convention version 333pack_info_term(home(atom)). % Home page 334pack_info_term(download(atom)). % Source 335pack_info_term(provides(atom)). % Dependencies 336pack_info_term(requires(dependency)). 337pack_info_term(conflicts(dependency)). % Conflicts with package 338pack_info_term(replaces(atom)). % Replaces another package 339pack_info_term(autoload(boolean)). % Default installation options 340 341:- multifile 342 error:has_type/2. 343 344errorhas_type(version, Version) :- 345 atom(Version), 346 is_version(Version). 347errorhas_type(email_or_url, Address) :- 348 atom(Address), 349 ( sub_atom(Address, _, _, _, @) 350 -> true 351 ; uri_is_global(Address) 352 ). 353errorhas_type(email_or_url_or_empty, Address) :- 354 ( Address == '' 355 -> true 356 ; error:has_type(email_or_url, Address) 357 ). 358errorhas_type(dependency, Value) :- 359 is_dependency(Value). 360 361is_version(Version) :- 362 split_string(Version, ".", "", Parts), 363 maplist(number_string, _, Parts). 364 365is_dependency(Var) :- 366 var(Var), 367 !, 368 fail. 369is_dependency(Token) :- 370 atom(Token), 371 !. 372is_dependency(Term) :- 373 compound(Term), 374 compound_name_arguments(Term, Op, [Token,Version]), 375 atom(Token), 376 cmp(Op, _), 377 is_version(Version), 378 !. 379is_dependency(PrologToken) :- 380 is_prolog_token(PrologToken). 381 382cmp(<, @<). 383cmp(=<, @=<). 384cmp(==, ==). 385cmp(>=, @>=). 386cmp(>, @>). 387 388 389 /******************************* 390 * SEARCH * 391 *******************************/
Options processed:
installed(true)
.false
, do not contact the server. This implies
installed(true)
. Otherwise, use the given pack server.
Hint: ?- pack_list('').
lists all known packages.
The predicates pack_list/1 and pack_search/1 are synonyms. Both
contact the package server at https://www.swi-prolog.org to find
available packages. Contacting the server can be avoided using the
server(false)
option.
433pack_list(Query) :- 434 pack_list(Query, []). 435 436pack_search(Query) :- 437 pack_list(Query, []). 438 439pack_list(Query, Options) :- 440 ( option(installed(true), Options) 441 ; option(outdated(true), Options) 442 ; option(server(false), Options) 443 ), 444 !, 445 local_search(Query, Local), 446 maplist(arg(1), Local, Packs), 447 ( option(server(false), Options) 448 -> Hits = [] 449 ; query_pack_server(info(Packs), true(Hits), Options) 450 ), 451 list_hits(Hits, Local, Options). 452pack_list(Query, Options) :- 453 query_pack_server(search(Query), Result, Options), 454 ( Result == false 455 -> ( local_search(Query, Packs), 456 Packs \== [] 457 -> forall(member(pack(Pack, Stat, Title, Version, _), Packs), 458 format('~w ~w@~w ~28|- ~w~n', 459 [Stat, Pack, Version, Title])) 460 ; print_message(warning, pack(search_no_matches(Query))) 461 ) 462 ; Result = true(Hits), % Hits = list(pack(Name, p, Title, Version, URL)) 463 local_search(Query, Local), 464 list_hits(Hits, Local, []) 465 ). 466 467list_hits(Hits, Local, Options) :- 468 append(Hits, Local, All), 469 sort(All, Sorted), 470 join_status(Sorted, Packs0), 471 include(filtered(Options), Packs0, Packs), 472 maplist(list_hit(Options), Packs). 473 474filtered(Options, pack(_,Tag,_,_,_)) :- 475 option(outdated(true), Options), 476 !, 477 Tag == 'U'. 478filtered(_, _). 479 480list_hit(_Options, pack(Pack, Tag, Title, Version, _URL)) => 481 list_tag(Tag), 482 ansi_format(code, '~w', [Pack]), 483 format('@'), 484 list_version(Tag, Version), 485 format('~35|- ', []), 486 ansi_format(comment, '~w~n', [Title]). 487 488list_tag(Tag) :- 489 tag_color(Tag, Color), 490 ansi_format(Color, '~w ', [Tag]). 491 492list_version(Tag, VersionI-VersionS) => 493 tag_color(Tag, Color), 494 ansi_format(Color, '~w', [VersionI]), 495 ansi_format(bold, '(~w)', [VersionS]). 496list_version(_Tag, Version) => 497 ansi_format([], '~w', [Version]). 498 499tag_color('U', warning) :- !. 500tag_color('A', comment) :- !. 501tag_color(_, []).
pack(Name, Status, Version, URL)
. If
the versions do not match, Version is
VersionInstalled-VersionRemote
and similar for thee URL.510join_status([], []). 511join_status([ pack(Pack, i, Title, Version, URL), 512 pack(Pack, p, Title, Version, _) 513 | T0 514 ], 515 [ pack(Pack, Tag, Title, Version, URL) 516 | T 517 ]) :- 518 !, 519 ( pack_status(Pack, automatic(true)) 520 -> Tag = a 521 ; Tag = i 522 ), 523 join_status(T0, T). 524join_status([ pack(Pack, i, Title, VersionI, URLI), 525 pack(Pack, p, _, VersionS, URLS) 526 | T0 527 ], 528 [ pack(Pack, Tag, Title, VersionI-VersionS, URLI-URLS) 529 | T 530 ]) :- 531 !, 532 version_sort_key(VersionI, VDI), 533 version_sort_key(VersionS, VDS), 534 ( VDI @< VDS 535 -> Tag = 'U' 536 ; Tag = 'A' 537 ), 538 join_status(T0, T). 539join_status([ pack(Pack, i, Title, VersionI, URL) 540 | T0 541 ], 542 [ pack(Pack, l, Title, VersionI, URL) 543 | T 544 ]) :- 545 !, 546 join_status(T0, T). 547join_status([H|T0], [H|T]) :- 548 join_status(T0, T).
554local_search(Query, Packs) :- 555 findall(Pack, matching_installed_pack(Query, Pack), Packs). 556 557matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :- 558 current_pack(Pack), 559 findall(Term, 560 ( pack_info(Pack, _, Term), 561 search_info(Term) 562 ), Info), 563 ( sub_atom_icasechk(Pack, _, Query) 564 -> true 565 ; memberchk(title(Title), Info), 566 sub_atom_icasechk(Title, _, Query) 567 ), 568 option(title(Title), Info, '<no title>'), 569 option(version(Version), Info, '<no version>'), 570 option(download(URL), Info, '<no download url>'). 571 572search_info(title(_)). 573search_info(version(_)). 574search_info(download(_)). 575 576 577 /******************************* 578 * INSTALL * 579 *******************************/
http(s)
URL of an archive file name. This URL may contain a
star (*) for the version. In this case pack_install/1 asks
for the directory content and selects the latest version.file://
URL'.'
, in which case a relative symlink is created to the
current directory (all other options for Spec make a copy
of the files). Installation using a symlink is normally
used during development of a pack.
Processes the options below. Default options as would be used by
pack_install/1 are used to complete the provided Options. Note that
pack_install/2 can be used through the SWI-Prolog command line app
pack
as below. Most of the options of this predicate are available
as command line options.
swipl pack install <name>
Options:
true
, install in the XDG common application data path,
making the pack accessible to everyone. If false
, install in
the XDG user application data path, making the pack accessible
for the current user only. If the option is absent, use the
first existing and writable directory. If that doesn't exist
find locations where it can be created and prompt the user to do
so.true
(default false
), do not perform any checks on SSL
certificates when downloading using https
.true
(default false), suppress informational progress
messages.true
(default false
), upgrade package if it is already
installed.if_absent
(default, do nothing if the directory with foreign
resources exists), make
(run make
) or true
(run `make
distclean` followed by the default configure and build steps).true
(default), run the pack tests.true
(default false
unless URL ends with .git
),
assume the URL is a GIT repository.'1.5'
is the
same as >=('1.5')
.'HEAD'
.-DCMAKE_BUILD_TYPE=Type
.
Default is the build type of Prolog or Release
.true
(default), register packages as downloaded after
performing the download. This contacts the server with the
meta-data of each pack that was downloaded. The server will
either register the location as a new version or increment
the download count. The server stores the IP address of the
client. Subsequent downloads of the same version from the
same IP address are ignored.prolog_pack:server
, by default set to
https://www.swi-prolog.org/pack/
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.
679pack_install(Spec) :- 680 pack_default_options(Spec, Pack, [], Options), 681 pack_install(Pack, [pack(Pack)|Options]). 682 683pack_install(Specs, Options) :- 684 is_list(Specs), 685 !, 686 maplist(pack_options(Options), Specs, Pairs), 687 pack_install_dir(PackTopDir, Options), 688 pack_install_set(Pairs, PackTopDir, Options). 689pack_install(Spec, Options) :- 690 pack_default_options(Spec, Pack, Options, DefOptions), 691 ( option(already_installed(Installed), DefOptions) 692 -> print_message(informational, pack(already_installed(Installed))) 693 ; merge_options(Options, DefOptions, PackOptions), 694 pack_install_dir(PackTopDir, PackOptions), 695 pack_install_set([Pack-PackOptions], PackTopDir, Options) 696 ). 697 698pack_options(Options, Spec, Pack-PackOptions) :- 699 pack_default_options(Spec, Pack, Options, DefOptions), 700 merge_options(Options, DefOptions, PackOptions).
url(URL)
option. Determine whether
the URL is a GIT repository, get the version and pack from the
URL.git(true)
and adds the URL as option.packs.pl
file.'.'
. Create a symlink to make the current dir
accessible as a pack.726pack_default_options(_Spec, Pack, OptsIn, Options) :- % (1) 727 option(already_installed(pack(Pack,_Version)), OptsIn), 728 !, 729 Options = OptsIn. 730pack_default_options(_Spec, Pack, OptsIn, Options) :- % (2) 731 option(url(URL), OptsIn), 732 !, 733 ( option(git(_), OptsIn) 734 -> Options = OptsIn 735 ; git_url(URL, Pack) 736 -> Options = [git(true)|OptsIn] 737 ; Options = OptsIn 738 ), 739 ( nonvar(Pack) 740 -> true 741 ; option(pack(Pack), Options) 742 -> true 743 ; pack_version_file(Pack, _Version, URL) 744 ). 745pack_default_options(Archive, Pack, OptsIn, Options) :- % (3) 746 must_be(atom, Archive), 747 \+ uri_is_global(Archive), 748 expand_file_name(Archive, [File]), 749 exists_file(File), 750 !, 751 ( pack_version_file(Pack, Version, File) 752 -> uri_file_name(FileURL, File), 753 merge_options([url(FileURL), version(Version)], OptsIn, Options) 754 ; domain_error(pack_file_name, Archive) 755 ). 756pack_default_options(URL, Pack, OptsIn, Options) :- % (4) 757 git_url(URL, Pack), 758 !, 759 merge_options([git(true), url(URL)], OptsIn, Options). 760pack_default_options(FileURL, Pack, _, Options) :- % (5) 761 uri_file_name(FileURL, Dir), 762 exists_directory(Dir), 763 pack_info_term(Dir, name(Pack)), 764 !, 765 ( pack_info_term(Dir, version(Version)) 766 -> uri_file_name(DirURL, Dir), 767 Options = [url(DirURL), version(Version)] 768 ; throw(error(existence_error(key, version, Dir),_)) 769 ). 770pack_default_options('.', Pack, OptsIn, Options) :- % (6) 771 pack_info_term('.', name(Pack)), 772 !, 773 working_directory(Dir, Dir), 774 ( pack_info_term(Dir, version(Version)) 775 -> uri_file_name(DirURL, Dir), 776 NewOptions = [url(DirURL), version(Version) | Options1], 777 ( current_prolog_flag(windows, true) 778 -> Options1 = [] 779 ; Options1 = [link(true), rebuild(make)] 780 ), 781 merge_options(NewOptions, OptsIn, Options) 782 ; throw(error(existence_error(key, version, Dir),_)) 783 ). 784pack_default_options(URL, Pack, OptsIn, Options) :- % (7) 785 pack_version_file(Pack, Version, URL), 786 download_url(URL), 787 !, 788 available_download_versions(URL, Available, Options), 789 Available = [URLVersion-LatestURL|_], 790 NewOptions = [url(LatestURL)|VersionOptions], 791 version_options(Version, URLVersion, Available, VersionOptions), 792 merge_options(NewOptions, OptsIn, Options). 793pack_default_options(Pack, Pack, Options, Options) :- % (8) 794 \+ uri_is_global(Pack). 795 796version_options(Version, Version, _, [version(Version)]) :- !. 797version_options(Version, _, Available, [versions(Available)]) :- 798 sub_atom(Version, _, _, _, *), 799 !. 800version_options(_, _, _, []).
pack_directory(+PackDir)
Use PackDir. PackDir is created if it does not exist.global(+Boolean)
If true
, find a writeable global directory based on the
file search path common_app_data
. If false
, find a
user-specific writeable directory based on user_app_data
pack
.If no writeable directory is found, generate possible location where this directory can be created and ask the user to create one of them.
820pack_install_dir(PackDir, Options) :- 821 option(pack_directory(PackDir), Options), 822 ensure_directory(PackDir), 823 !. 824pack_install_dir(PackDir, Options) :- 825 base_alias(Alias, Options), 826 absolute_file_name(Alias, PackDir, 827 [ file_type(directory), 828 access(write), 829 file_errors(fail) 830 ]), 831 !. 832pack_install_dir(PackDir, Options) :- 833 pack_create_install_dir(PackDir, Options). 834 835base_alias(Alias, Options) :- 836 option(global(true), Options), 837 !, 838 Alias = common_app_data(pack). 839base_alias(Alias, Options) :- 840 option(global(false), Options), 841 !, 842 Alias = user_app_data(pack). 843base_alias(Alias, _Options) :- 844 Alias = pack('.'). 845 846pack_create_install_dir(PackDir, Options) :- 847 base_alias(Alias, Options), 848 findall(Candidate = create_dir(Candidate), 849 ( absolute_file_name(Alias, Candidate, [solutions(all)]), 850 \+ exists_file(Candidate), 851 \+ exists_directory(Candidate), 852 file_directory_name(Candidate, Super), 853 ( exists_directory(Super) 854 -> access_file(Super, write) 855 ; true 856 ) 857 ), 858 Candidates0), 859 list_to_set(Candidates0, Candidates), % keep order 860 pack_create_install_dir(Candidates, PackDir, Options). 861 862pack_create_install_dir(Candidates, PackDir, Options) :- 863 Candidates = [Default=_|_], 864 !, 865 append(Candidates, [cancel=cancel], Menu), 866 menu(pack(create_pack_dir), Menu, Default, Selected, Options), 867 Selected \== cancel, 868 ( catch(make_directory_path(Selected), E, 869 (print_message(warning, E), fail)) 870 -> PackDir = Selected 871 ; delete(Candidates, PackDir=create_dir(PackDir), Remaining), 872 pack_create_install_dir(Remaining, PackDir, Options) 873 ). 874pack_create_install_dir(_, _, _) :- 875 print_message(error, pack(cannot_create_dir(pack(.)))), 876 fail.
890pack_unpack_from_local(Source0, PackTopDir, Name, PackDir, Options) :- 891 exists_directory(Source0), 892 remove_slash(Source0, Source), 893 !, 894 directory_file_path(PackTopDir, Name, PackDir), 895 ( option(link(true), Options) 896 -> ( same_file(Source, PackDir) 897 -> true 898 ; remove_existing_pack(PackDir, Options), 899 atom_concat(PackTopDir, '/', PackTopDirS), 900 relative_file_name(Source, PackTopDirS, RelPath), 901 link_file(RelPath, PackDir, symbolic), 902 assertion(same_file(Source, PackDir)) 903 ) 904 ; \+ option(git(false), Options), 905 is_git_directory(Source) 906 -> remove_existing_pack(PackDir, Options), 907 run_process(path(git), [clone, Source, PackDir], []) 908 ; prepare_pack_dir(PackDir, Options), 909 copy_directory(Source, PackDir) 910 ). 911pack_unpack_from_local(Source, PackTopDir, Name, PackDir, Options) :- 912 exists_file(Source), 913 directory_file_path(PackTopDir, Name, PackDir), 914 prepare_pack_dir(PackDir, Options), 915 pack_unpack(Source, PackDir, Name, Options).
924:- if(exists_source(library(archive))). 925pack_unpack(Source, PackDir, Pack, Options) :- 926 ensure_loaded_archive, 927 pack_archive_info(Source, Pack, _Info, StripOptions), 928 prepare_pack_dir(PackDir, Options), 929 archive_extract(Source, PackDir, 930 [ exclude(['._*']) % MacOS resource forks 931 | StripOptions 932 ]). 933:- else. 934pack_unpack(_,_,_,_) :- 935 existence_error(library, archive). 936:- endif.
944pack_install_local(M:Gen, Dir, Options) :- 945 findall(Pack-PackOptions, call(M:Gen, Pack, PackOptions), Pairs), 946 pack_install_set(Pairs, Dir, Options). 947 948pack_install_set(Pairs, Dir, Options) :- 949 must_be(list(pair), Pairs), 950 ensure_directory(Dir), 951 partition(known_media, Pairs, Local, Remote), 952 maplist(pack_options_to_versions, Local, LocalVersions), 953 ( Remote == [] 954 -> AllVersions = LocalVersions 955 ; pairs_keys(Remote, Packs), 956 prolog_description(Properties), 957 query_pack_server(versions(Packs, Properties), Result, Options), 958 ( Result = true(RemoteVersions) 959 -> append(LocalVersions, RemoteVersions, AllVersions) 960 ; print_message(error, pack(query_failed(Result))), 961 fail 962 ) 963 ), 964 local_packs(Dir, Existing), 965 pack_resolve(Pairs, Existing, AllVersions, Plan0, Options), 966 !, % for now, only first plan 967 maplist(hsts_info(Options), Plan0, Plan), 968 Options1 = [pack_directory(Dir)|Options], 969 download_plan(Pairs, Plan, PlanB, Options1), 970 register_downloads(PlanB, Options), 971 maplist(update_automatic, PlanB), 972 build_plan(PlanB, Built, Options1), 973 publish_download(PlanB, Options), 974 work_done(Pairs, Plan, PlanB, Built, Options). 975 976hsts_info(Options, Info0, Info) :- 977 hsts(Info0.get(url), URL, Options), 978 !, 979 Info = Info0.put(url, URL). 980hsts_info(_Options, Info, Info).
989known_media(_-Options) :-
990 option(url(_), Options).
pack(Pack, i, Title, Version, URL)
terms that represents the already
installed packages. Versions is obtained from the server. See
pack.pl
from the web server for details. On success, this results
in a Plan to satisfies the requirements. The plan is a list of
packages to install with their location. The steps satisfy the
partial ordering of dependencies, such that dependencies are
installed before the dependents. Options:
1008pack_resolve(Pairs, Existing, Versions, Plan, Options) :-
1009 insert_existing(Existing, Versions, AllVersions, Options),
1010 phrase(select_version(Pairs, AllVersions,
1011 [ plan(PlanA), % access to plan
1012 dependency_for([]) % dependencies
1013 | Options
1014 ]),
1015 PlanA),
1016 mark_installed(PlanA, Existing, Plan).
upgrade(true)
is specified, the existing is merged into the set of
Available versions. Otherwise Existing is prepended to Available, so
it is selected as first.1027:- det(insert_existing/4). 1028insert_existing(Existing, [], Versions, _Options) => 1029 maplist(existing_to_versions, Existing, Versions). 1030insert_existing(Existing, [Pack-Versions|T0], AllPackVersions, Options), 1031 select(Installed, Existing, Existing2), 1032 Installed.pack == Pack => 1033 can_upgrade(Installed, Versions, Installed2), 1034 insert_existing_(Installed2, Versions, AllVersions, Options), 1035 AllPackVersions = [Pack-AllVersions|T], 1036 insert_existing(Existing2, T0, T, Options). 1037insert_existing(Existing, [H|T0], AllVersions, Options) => 1038 AllVersions = [H|T], 1039 insert_existing(Existing, T0, T, Options). 1040 1041existing_to_versions(Installed, Pack-[Version-[Installed]]) :- 1042 Pack = Installed.pack, 1043 Version = Installed.version. 1044 1045insert_existing_(Installed, Versions, AllVersions, Options) :- 1046 option(upgrade(true), Options), 1047 !, 1048 insert_existing_(Installed, Versions, AllVersions). 1049insert_existing_(Installed, Versions, AllVersions, _) :- 1050 AllVersions = [Installed.version-[Installed]|Versions]. 1051 1052insert_existing_(Installed, [H|T0], [H|T]) :- 1053 H = V0-_Infos, 1054 cmp_versions(>, V0, Installed.version), 1055 !, 1056 insert_existing_(Installed, T0, T). 1057insert_existing_(Installed, [H0|T], [H|T]) :- 1058 H0 = V0-Infos, 1059 V0 == Installed.version, 1060 !, 1061 H = V0-[Installed|Infos]. 1062insert_existing_(Installed, Versions, All) :- 1063 All = [Installed.version-[Installed]|Versions].
latest_version
key to Installed if its version is older than
the latest available version.1070can_upgrade(Info, [Version-_|_], Info2) :- 1071 cmp_versions(>, Version, Info.version), 1072 !, 1073 Info2 = Info.put(latest_version, Version). 1074can_upgrade(Info, _, Info).
upgrade:true
to elements of PlanA in Existing that are not the
same.1082mark_installed([], _, []). 1083mark_installed([Info|T], Existing, Plan) :- 1084 ( member(Installed, Existing), 1085 Installed.pack == Info.pack 1086 -> ( ( Installed.git == true 1087 -> Info.git == true, 1088 Installed.hash == Info.hash 1089 ; Version = Info.get(version) 1090 -> Installed.version == Version 1091 ) 1092 -> Plan = [Info.put(keep, true)|PlanT] % up-to-date 1093 ; Plan = [Info.put(upgrade, Installed)|PlanT] % needs upgrade 1094 ) 1095 ; Plan = [Info|PlanT] % new install 1096 ), 1097 mark_installed(T, Existing, PlanT).
1105select_version([], _, _) --> 1106 []. 1107select_version([Pack-PackOptions|More], Versions, Options) --> 1108 { memberchk(Pack-PackVersions, Versions), 1109 member(Version-Infos, PackVersions), 1110 compatible_version(Pack, Version, PackOptions), 1111 member(Info, Infos), 1112 pack_options_compatible_with_info(Info, PackOptions), 1113 pack_satisfies(Pack, Version, Info, Info2, PackOptions), 1114 all_downloads(PackVersions, Downloads) 1115 }, 1116 add_to_plan(Info2.put(_{version: Version, all_downloads:Downloads}), 1117 Versions, Options), 1118 select_version(More, Versions, Options). 1119select_version([Pack-_PackOptions|_More], _Versions, _Options) --> 1120 { existence_error(pack, Pack) }. % or warn and continue? 1121 1122all_downloads(PackVersions, AllDownloads) :- 1123 aggregate_all(sum(Downloads), 1124 ( member(_Version-Infos, PackVersions), 1125 member(Info, Infos), 1126 get_dict(downloads, Info, Downloads) 1127 ), 1128 AllDownloads). 1129 1130add_requirements([], _, _) --> 1131 []. 1132add_requirements([H|T], Versions, Options) --> 1133 { is_prolog_token(H), 1134 !, 1135 prolog_satisfies(H) 1136 }, 1137 add_requirements(T, Versions, Options). 1138add_requirements([H|T], Versions, Options) --> 1139 { member(Pack-PackVersions, Versions), 1140 member(Version-Infos, PackVersions), 1141 member(Info, Infos), 1142 ( Provides = @(Pack,Version) 1143 ; member(Provides, Info.get(provides)) 1144 ), 1145 satisfies_req(Provides, H), 1146 all_downloads(PackVersions, Downloads) 1147 }, 1148 add_to_plan(Info.put(_{version: Version, all_downloads:Downloads}), 1149 Versions, Options), 1150 add_requirements(T, Versions, Options).
1158add_to_plan(Info, _Versions, Options) --> 1159 { option(plan(Plan), Options), 1160 member_nonvar(Planned, Plan), 1161 Planned.pack == Info.pack, 1162 !, 1163 same_version(Planned, Info) % same pack, different version 1164 }. 1165add_to_plan(Info, _Versions, _Options) --> 1166 { member(Conflict, Info.get(conflicts)), 1167 is_prolog_token(Conflict), 1168 prolog_satisfies(Conflict), 1169 !, 1170 fail % incompatible with this Prolog 1171 }. 1172add_to_plan(Info, _Versions, Options) --> 1173 { option(plan(Plan), Options), 1174 member_nonvar(Planned, Plan), 1175 info_conflicts(Info, Planned), % Conflicts with a planned pack 1176 !, 1177 fail 1178 }. 1179add_to_plan(Info, Versions, Options) --> 1180 { select_option(dependency_for(Dep0), Options, Options1), 1181 Options2 = [dependency_for([Info.pack|Dep0])|Options1], 1182 ( Dep0 = [DepFor|_] 1183 -> add_dependency_for(DepFor, Info, Info1) 1184 ; Info1 = Info 1185 ) 1186 }, 1187 [Info1], 1188 add_requirements(Info.get(requires,[]), Versions, Options2). 1189 1190add_dependency_for(Pack, Info, Info) :- 1191 Old = Info.get(dependency_for), 1192 !, 1193 b_set_dict(dependency_for, Info, [Pack|Old]). 1194add_dependency_for(Pack, Info0, Info) :- 1195 Info = Info0.put(dependency_for, [Pack]). 1196 1197same_version(Info, Info) :- 1198 !. 1199same_version(Planned, Info) :- 1200 Hash = Planned.get(hash), 1201 Hash \== (-), 1202 !, 1203 Hash == Info.get(hash). 1204same_version(Planned, Info) :- 1205 Planned.get(version) == Info.get(version).
1211info_conflicts(Info, Planned) :- 1212 info_conflicts_(Info, Planned), 1213 !. 1214info_conflicts(Info, Planned) :- 1215 info_conflicts_(Planned, Info), 1216 !. 1217 1218info_conflicts_(Info, Planned) :- 1219 member(Conflict, Info.get(conflicts)), 1220 \+ is_prolog_token(Conflict), 1221 info_provides(Planned, Provides), 1222 satisfies_req(Provides, Conflict), 1223 !. 1224 1225info_provides(Info, Provides) :- 1226 ( Provides = Info.pack@Info.version 1227 ; member(Provides, Info.get(provides)) 1228 ).
1235pack_satisfies(_Pack, _Version, Info0, Info, Options) :- 1236 option(commit('HEAD'), Options), 1237 !, 1238 Info0.get(git) == true, 1239 Info = Info0.put(commit, 'HEAD'). 1240pack_satisfies(_Pack, _Version, Info, Info, Options) :- 1241 option(commit(Commit), Options), 1242 !, 1243 Commit == Info.get(hash). 1244pack_satisfies(Pack, Version, Info, Info, Options) :- 1245 option(version(ReqVersion), Options), 1246 !, 1247 satisfies_version(Pack, Version, ReqVersion). 1248pack_satisfies(_Pack, _Version, Info, Info, _Options).
1252satisfies_version(Pack, Version, ReqVersion) :-
1253 catch(require_version(pack(Pack), Version, ReqVersion),
1254 error(version_error(pack(Pack), Version, ReqVersion),_),
1255 fail).
1261satisfies_req(Token, Token) => true. 1262satisfies_req(@(Token,_), Token) => true. 1263satisfies_req(@(Token,PrvVersion), Req), cmp(Req, Token, Cmp, ReqVersion) => 1264 cmp_versions(Cmp, PrvVersion, ReqVersion). 1265satisfies_req(_,_) => fail. 1266 1267cmp(Token < Version, Token, <, Version). 1268cmp(Token =< Version, Token, =<, Version). 1269cmp(Token = Version, Token, =, Version). 1270cmp(Token == Version, Token, ==, Version). 1271cmp(Token >= Version, Token, >=, Version). 1272cmp(Token > Version, Token, >, Version).
url(URL)
option. This allows installing packages that are
not known to the server. In most cases, the URL will be a git URL or
the URL to download an archive. It can also be a file://
url to
install from a local archive.
The first clause deals with a wildcard URL. See pack_default_options/4, case (7).
1285:- det(pack_options_to_versions/2). 1286pack_options_to_versions(Pack-PackOptions, Pack-Versions) :- 1287 option(versions(Available), PackOptions), !, 1288 maplist(version_url_info(Pack, PackOptions), Available, Versions). 1289pack_options_to_versions(Pack-PackOptions, Pack-[Version-[Info]]) :- 1290 option(url(URL), PackOptions), 1291 findall(Prop, option_info_prop(PackOptions, Prop), Pairs), 1292 dict_create(Info, #, 1293 [ pack-Pack, 1294 url-URL 1295 | Pairs 1296 ]), 1297 Version = Info.get(version, '0.0.0'). 1298 1299version_url_info(Pack, PackOptions, Version-URL, Version-[Info]) :- 1300 findall(Prop, 1301 ( option_info_prop(PackOptions, Prop), 1302 Prop \= version-_ 1303 ), 1304 Pairs), 1305 dict_create(Info, #, 1306 [ pack-Pack, 1307 url-URL, 1308 version-Version 1309 | Pairs 1310 ]). 1311 1312option_info_prop(PackOptions, Prop-Value) :- 1313 option_info(Prop), 1314 Opt =.. [Prop,Value], 1315 option(Opt, PackOptions). 1316 1317option_info(git). 1318option_info(hash). 1319option_info(version). 1320option_info(branch). 1321option_info(link).
1328compatible_version(Pack, Version, PackOptions) :- 1329 option(version(ReqVersion), PackOptions), 1330 !, 1331 satisfies_version(Pack, Version, ReqVersion). 1332compatible_version(_, _, _).
1339pack_options_compatible_with_info(Info, PackOptions) :-
1340 findall(Prop, option_info_prop(PackOptions, Prop), Pairs),
1341 dict_create(Dict, _, Pairs),
1342 Dict >:< Info.
1352download_plan(_Targets, Plan, Plan, _Options) :- 1353 exclude(installed, Plan, []), 1354 !. 1355download_plan(Targets, Plan0, Plan, Options) :- 1356 confirm(download_plan(Plan0), yes, Options), 1357 maplist(download_from_info(Options), Plan0, Plan1), 1358 plan_unsatisfied_dependencies(Plan1, Deps), 1359 ( Deps == [] 1360 -> Plan = Plan1 1361 ; print_message(informational, pack(new_dependencies(Deps))), 1362 prolog_description(Properties), 1363 query_pack_server(versions(Deps, Properties), Result, []), 1364 ( Result = true(Versions) 1365 -> pack_resolve(Targets, Plan1, Versions, Plan2, Options), 1366 !, 1367 download_plan(Targets, Plan2, Plan, Options) 1368 ; print_message(error, pack(query_failed(Result))), 1369 fail 1370 ) 1371 ).
1378plan_unsatisfied_dependencies(Plan, Deps) :- 1379 phrase(plan_unsatisfied_dependencies(Plan, Plan), Deps). 1380 1381plan_unsatisfied_dependencies([], _) --> 1382 []. 1383plan_unsatisfied_dependencies([Info|Infos], Plan) --> 1384 { Deps = Info.get(requires) }, 1385 plan_unsatisfied_requirements(Deps, Plan), 1386 plan_unsatisfied_dependencies(Infos, Plan). 1387 1388plan_unsatisfied_requirements([], _) --> 1389 []. 1390plan_unsatisfied_requirements([H|T], Plan) --> 1391 { is_prolog_token(H), % Can this fail? 1392 prolog_satisfies(H) 1393 }, 1394 !, 1395 plan_unsatisfied_requirements(T, Plan). 1396plan_unsatisfied_requirements([H|T], Plan) --> 1397 { member(Info, Plan), 1398 ( ( Version = Info.get(version) 1399 -> Provides = @(Info.get(pack), Version) 1400 ; Provides = Info.get(pack) 1401 ) 1402 ; member(Provides, Info.get(provides)) 1403 ), 1404 satisfies_req(Provides, H) 1405 }, !, 1406 plan_unsatisfied_requirements(T, Plan). 1407plan_unsatisfied_requirements([H|T], Plan) --> 1408 [H], 1409 plan_unsatisfied_requirements(T, Plan).
1418build_plan(Plan, Ordered, Options) :-
1419 maplist(decide_autoload_pack(Options), Plan, Plan1),
1420 partition(needs_rebuild_from_info(Options), Plan1, ToBuild, NoBuild),
1421 maplist(attach_from_info(Options), NoBuild),
1422 ( ToBuild == []
1423 -> post_install_autoload(NoBuild),
1424 Ordered = []
1425 ; order_builds(ToBuild, Ordered),
1426 confirm(build_plan(Ordered), yes, Options),
1427 maplist(exec_plan_rebuild_step(Options), Ordered)
1428 ).
1434needs_rebuild_from_info(Options, Info) :-
1435 PackDir = Info.installed,
1436 is_foreign_pack(PackDir, _),
1437 \+ is_built(PackDir, Options).
1446is_built(PackDir, _Options) :-
1447 current_prolog_flag(arch, Arch),
1448 prolog_version_dotted(Version), % Major.Minor.Patch
1449 pack_status_dir(PackDir, built(Arch, Version, _)).
1456order_builds(ToBuild, Ordered) :-
1457 findall(Pack-Dependent, dep_edge(ToBuild, Pack, Dependent), Edges),
1458 maplist(get_dict(pack), ToBuild, Packs),
1459 vertices_edges_to_ugraph(Packs, Edges, Graph),
1460 ugraph_layers(Graph, Layers),
1461 append(Layers, PackNames),
1462 maplist(pack_info_from_name(ToBuild), PackNames, Ordered).
1470dep_edge(Infos, Pack, Dependent) :- 1471 member(Info, Infos), 1472 Pack = Info.pack, 1473 member(Dependent, Info.get(dependency_for)), 1474 ( member(DepInfo, Infos), 1475 DepInfo.pack == Dependent 1476 -> true 1477 ). 1478 1479:- det(pack_info_from_name/3). 1480pack_info_from_name(Infos, Pack, Info) :- 1481 member(Info, Infos), 1482 Info.pack == Pack, 1483 !.
1489exec_plan_rebuild_step(Options, Info) :-
1490 print_message(informational, pack(build(Info.pack, Info.installed))),
1491 pack_post_install(Info, Options),
1492 attach_from_info(Options, Info).
1498attach_from_info(_Options, Info) :- 1499 Info.get(keep) == true, 1500 !. 1501attach_from_info(Options, Info) :- 1502 ( option(pack_directory(_Parent), Options) 1503 -> pack_attach(Info.installed, [duplicate(replace)]) 1504 ; pack_attach(Info.installed, []) 1505 ).
1515download_from_info(Options, Info0, Info), option(dryrun(true), Options) => 1516 print_term(Info0, [nl(true)]), 1517 Info = Info0. 1518download_from_info(_Options, Info0, Info), installed(Info0) => 1519 Info = Info0. 1520download_from_info(_Options, Info0, Info), 1521 _{upgrade:OldInfo, git:true} :< Info0, 1522 is_git_directory(OldInfo.installed) => 1523 PackDir = OldInfo.installed, 1524 git_checkout_version(PackDir, [commit(Info0.hash)]), 1525 reload_info(PackDir, Info0, Info). 1526download_from_info(Options, Info0, Info), 1527 _{upgrade:OldInfo} :< Info0 => 1528 PackDir = OldInfo.installed, 1529 detach_pack(OldInfo.pack, PackDir), 1530 delete_directory_and_contents(PackDir), 1531 del_dict(upgrade, Info0, _, Info1), 1532 download_from_info(Options, Info1, Info). 1533download_from_info(Options, Info0, Info), 1534 _{url:URL, git:true} :< Info0, \+ have_git => 1535 git_archive_url(URL, Archive, Options), 1536 download_from_info([git_url(URL)|Options], 1537 Info0.put(_{ url:Archive, 1538 git:false, 1539 git_url:URL 1540 }), 1541 Info1), 1542 % restore the hash to register the download. 1543 ( Info1.get(version) == Info0.get(version), 1544 Hash = Info0.get(hash) 1545 -> Info = Info1.put(hash, Hash) 1546 ; Info = Info1 1547 ). 1548download_from_info(Options, Info0, Info), 1549 _{url:URL} :< Info0 => 1550 select_option(pack_directory(Dir), Options, Options1), 1551 select_option(version(_), Options1, Options2, _), 1552 download_info_extra(Info0, InstallOptions, Options2), 1553 pack_download_from_url(URL, Dir, Info0.pack, 1554 [ interactive(false), 1555 pack_dir(PackDir) 1556 | InstallOptions 1557 ]), 1558 reload_info(PackDir, Info0, Info). 1559 1560download_info_extra(Info, [git(true),commit(Hash)|Options], Options) :- 1561 Info.get(git) == true, 1562 !, 1563 Hash = Info.get(commit, 'HEAD'). 1564download_info_extra(Info, [link(true)|Options], Options) :- 1565 Info.get(link) == true, 1566 !. 1567download_info_extra(_, Options, Options). 1568 1569installed(Info) :- 1570 _ = Info.get(installed). 1571 1572detach_pack(Pack, PackDir) :- 1573 ( current_pack(Pack, PackDir) 1574 -> '$pack_detach'(Pack, PackDir) 1575 ; true 1576 ).
1585reload_info(_PackDir, Info, Info) :- 1586 _ = Info.get(installed), % we read it from the package 1587 !. 1588reload_info(PackDir, Info0, Info) :- 1589 local_pack_info(PackDir, Info1), 1590 Info = Info0.put(installed, PackDir) 1591 .put(downloaded, Info0.url) 1592 .put(Info1).
1599work_done(_, _, _, _, Options), 1600 option(silent(true), Options) => 1601 true. 1602work_done(Targets, Plan, Plan, [], _Options) => 1603 convlist(can_upgrade_target(Plan), Targets, CanUpgrade), 1604 ( CanUpgrade == [] 1605 -> pairs_keys(Targets, Packs), 1606 print_message(informational, pack(up_to_date(Packs))) 1607 ; print_message(informational, pack(installed_can_upgrade(CanUpgrade))) 1608 ). 1609work_done(_, _, _, _, _) => 1610 true. 1611 1612can_upgrade_target(Plan, Pack-_, Info) => 1613 member(Info, Plan), 1614 Info.pack == Pack, 1615 !, 1616 _ = Info.get(latest_version).
1623local_packs(Dir, Packs) :- 1624 findall(Pack, pack_in_subdir(Dir, Pack), Packs). 1625 1626pack_in_subdir(Dir, Info) :- 1627 directory_member(Dir, PackDir, 1628 [ file_type(directory), 1629 hidden(false) 1630 ]), 1631 local_pack_info(PackDir, Info). 1632 1633local_pack_info(PackDir, 1634 #{ pack: Pack, 1635 version: Version, 1636 title: Title, 1637 hash: Hash, 1638 url: URL, 1639 git: IsGit, 1640 requires: Requires, 1641 provides: Provides, 1642 conflicts: Conflicts, 1643 installed: PackDir 1644 }) :- 1645 directory_file_path(PackDir, 'pack.pl', MetaFile), 1646 exists_file(MetaFile), 1647 file_base_name(PackDir, DirName), 1648 findall(Term, pack_dir_info(PackDir, _, Term), Info), 1649 option(pack(Pack), Info, DirName), 1650 option(title(Title), Info, '<no title>'), 1651 option(version(Version), Info, '<no version>'), 1652 option(download(URL), Info, '<no download url>'), 1653 findall(Req, member(requires(Req), Info), Requires), 1654 findall(Prv, member(provides(Prv), Info), Provides), 1655 findall(Cfl, member(conflicts(Cfl), Info), Conflicts), 1656 ( have_git, 1657 is_git_directory(PackDir) 1658 -> git_hash(Hash, [directory(PackDir)]), 1659 IsGit = true 1660 ; Hash = '-', 1661 IsGit = false 1662 ). 1663 1664 1665 /******************************* 1666 * PROLOG VERSIONS * 1667 *******************************/
prolog(Dialect, Version)
1678prolog_description([prolog(swi(Version))]) :- 1679 prolog_version(Version). 1680 1681prolog_version(Version) :- 1682 current_prolog_flag(version_git, Version), 1683 !. 1684prolog_version(Version) :- 1685 prolog_version_dotted(Version). 1686 1687prolog_version_dotted(Version) :- 1688 current_prolog_flag(version_data, swi(Major, Minor, Patch, _)), 1689 VNumbers = [Major, Minor, Patch], 1690 atomic_list_concat(VNumbers, '.', Version).
1697is_prolog_token(Token), cmp(Token, prolog, _Cmp, _Version) => true. 1698is_prolog_token(prolog:Feature), atom(Feature) => true. 1699is_prolog_token(prolog:Feature), flag_value_feature(Feature, _Flag, _Value) => 1700 true. 1701is_prolog_token(_) => fail.
requires(Token)
terms for
library(Lib)
1716prolog_satisfies(Token), cmp(Token, prolog, Cmp, ReqVersion) => 1717 prolog_version(CurrentVersion), 1718 cmp_versions(Cmp, CurrentVersion, ReqVersion). 1719prolog_satisfies(prolog:library(Lib)), atom(Lib) => 1720 exists_source(library(Lib)). 1721prolog_satisfies(prolog:Feature), atom(Feature) => 1722 current_prolog_flag(Feature, true). 1723prolog_satisfies(prolog:Feature), flag_value_feature(Feature, Flag, Value) => 1724 current_prolog_flag(Flag, Value). 1725 1726flag_value_feature(Feature, Flag, Value) :- 1727 compound(Feature), 1728 compound_name_arguments(Feature, Flag, [Value]), 1729 atom(Flag). 1730 1731 1732 /******************************* 1733 * INFO * 1734 *******************************/
pack.pl
in the pack and Strip is the strip-option for
archive_extract/3.
Requires library(archive), which is lazily loaded when needed.
1748:- if(exists_source(library(archive))). 1749ensure_loaded_archive :- 1750 current_predicate(archive_open/3), 1751 !. 1752ensure_loaded_archive :- 1753 use_module(library(archive)). 1754 1755pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :- 1756 ensure_loaded_archive, 1757 size_file(Archive, Bytes), 1758 setup_call_cleanup( 1759 archive_open(Archive, Handle, []), 1760 ( repeat, 1761 ( archive_next_header(Handle, InfoFile) 1762 -> true 1763 ; !, fail 1764 ) 1765 ), 1766 archive_close(Handle)), 1767 file_base_name(InfoFile, 'pack.pl'), 1768 atom_concat(Prefix, 'pack.pl', InfoFile), 1769 strip_option(Prefix, Pack, Strip), 1770 setup_call_cleanup( 1771 archive_open_entry(Handle, Stream), 1772 read_stream_to_terms(Stream, Info), 1773 close(Stream)), 1774 !, 1775 must_be(ground, Info), 1776 maplist(valid_term(pack_info_term), Info). 1777:- else. 1778pack_archive_info(_, _, _, _) :- 1779 existence_error(library, archive). 1780:- endif. 1781pack_archive_info(_, _, _, _) :- 1782 existence_error(pack_file, 'pack.pl'). 1783 1784strip_option('', _, []) :- !. 1785strip_option('./', _, []) :- !. 1786strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :- 1787 atom_concat(PrefixDir, /, Prefix), 1788 file_base_name(PrefixDir, Base), 1789 ( Base == Pack 1790 -> true 1791 ; pack_version_file(Pack, _, Base) 1792 -> true 1793 ; \+ sub_atom(PrefixDir, _, _, _, /) 1794 ). 1795 1796read_stream_to_terms(Stream, Terms) :- 1797 read(Stream, Term0), 1798 read_stream_to_terms(Term0, Stream, Terms). 1799 1800read_stream_to_terms(end_of_file, _, []) :- !. 1801read_stream_to_terms(Term0, Stream, [Term0|Terms]) :- 1802 read(Stream, Term1), 1803 read_stream_to_terms(Term1, Stream, Terms).
1811pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :- 1812 exists_directory(GitDir), 1813 !, 1814 git_ls_tree(Entries, [directory(GitDir)]), 1815 git_hash(Hash, [directory(GitDir)]), 1816 maplist(arg(4), Entries, Sizes), 1817 sum_list(Sizes, Bytes), 1818 dir_metadata(GitDir, Info). 1819 1820dir_metadata(GitDir, Info) :- 1821 directory_file_path(GitDir, 'pack.pl', InfoFile), 1822 read_file_to_terms(InfoFile, Info, [encoding(utf8)]), 1823 maplist(valid_term(pack_info_term), Info).
1829download_file_sanity_check(Archive, Pack, Info) :- 1830 info_field(name(PackName), Info), 1831 info_field(version(PackVersion), Info), 1832 pack_version_file(PackFile, FileVersion, Archive), 1833 must_match([Pack, PackName, PackFile], name), 1834 must_match([PackVersion, FileVersion], version). 1835 1836info_field(Field, Info) :- 1837 memberchk(Field, Info), 1838 ground(Field), 1839 !. 1840info_field(Field, _Info) :- 1841 functor(Field, FieldName, _), 1842 print_message(error, pack(missing(FieldName))), 1843 fail. 1844 1845must_match(Values, _Field) :- 1846 sort(Values, [_]), 1847 !. 1848must_match(Values, Field) :- 1849 print_message(error, pack(conflict(Field, Values))), 1850 fail. 1851 1852 1853 /******************************* 1854 * INSTALLATION * 1855 *******************************/
1869prepare_pack_dir(Dir, Options) :- 1870 exists_directory(Dir), 1871 !, 1872 ( empty_directory(Dir) 1873 -> true 1874 ; remove_existing_pack(Dir, Options) 1875 -> make_directory(Dir) 1876 ). 1877prepare_pack_dir(Dir, _) :- 1878 ( read_link(Dir, _, _) 1879 ; access_file(Dir, exist) 1880 ), 1881 !, 1882 delete_file(Dir), 1883 make_directory(Dir). 1884prepare_pack_dir(Dir, _) :- 1885 make_directory(Dir).
1891empty_directory(Dir) :- 1892 \+ ( directory_files(Dir, Entries), 1893 member(Entry, Entries), 1894 \+ special(Entry) 1895 ). 1896 1897special(.). 1898special(..).
upgrade(true)
is present. This is used to remove an old installation
before unpacking a new archive, copy or link a directory with the
new contents.1907remove_existing_pack(PackDir, Options) :- 1908 exists_directory(PackDir), 1909 !, 1910 ( ( option(upgrade(true), Options) 1911 ; confirm(remove_existing_pack(PackDir), yes, Options) 1912 ) 1913 -> delete_directory_and_contents(PackDir) 1914 ; print_message(error, pack(directory_exists(PackDir))), 1915 fail 1916 ). 1917remove_existing_pack(_, _).
1933pack_download_from_url(URL, PackTopDir, Pack, Options) :- 1934 option(git(true), Options), 1935 !, 1936 directory_file_path(PackTopDir, Pack, PackDir), 1937 prepare_pack_dir(PackDir, Options), 1938 ( option(branch(Branch), Options) 1939 -> Extra = ['--branch', Branch] 1940 ; Extra = [] 1941 ), 1942 run_process(path(git), [clone, URL, PackDir|Extra], []), 1943 git_checkout_version(PackDir, [update(false)|Options]), 1944 option(pack_dir(PackDir), Options, _). 1945pack_download_from_url(URL0, PackTopDir, Pack, Options) :- 1946 download_url(URL0), 1947 !, 1948 hsts(URL0, URL, Options), 1949 directory_file_path(PackTopDir, Pack, PackDir), 1950 prepare_pack_dir(PackDir, Options), 1951 pack_download_dir(PackTopDir, DownLoadDir), 1952 download_file(URL, Pack, DownloadBase, Options), 1953 directory_file_path(DownLoadDir, DownloadBase, DownloadFile), 1954 ( option(insecure(true), Options, false) 1955 -> TLSOptions = [cert_verify_hook(ssl_verify)] 1956 ; TLSOptions = [] 1957 ), 1958 print_message(informational, pack(download(begin, Pack, URL, DownloadFile))), 1959 setup_call_cleanup( 1960 http_open(URL, In, TLSOptions), 1961 setup_call_cleanup( 1962 open(DownloadFile, write, Out, [type(binary)]), 1963 copy_stream_data(In, Out), 1964 close(Out)), 1965 close(In)), 1966 print_message(informational, pack(download(end, Pack, URL, DownloadFile))), 1967 pack_archive_info(DownloadFile, Pack, Info, _), 1968 ( option(git_url(GitURL), Options) 1969 -> Origin = GitURL % implicit download from git. 1970 ; download_file_sanity_check(DownloadFile, Pack, Info), 1971 Origin = URL 1972 ), 1973 pack_unpack_from_local(DownloadFile, PackTopDir, Pack, PackDir, Options), 1974 pack_assert(PackDir, archive(DownloadFile, Origin)), 1975 option(pack_dir(PackDir), Options, _). 1976pack_download_from_url(URL, PackTopDir, Pack, Options) :- 1977 local_uri_file_name(URL, File), 1978 !, 1979 pack_unpack_from_local(File, PackTopDir, Pack, PackDir, Options), 1980 pack_assert(PackDir, archive(File, URL)), 1981 option(pack_dir(PackDir), Options, _). 1982pack_download_from_url(URL, _PackTopDir, _Pack, _Options) :- 1983 domain_error(url, URL).
'HEAD'
. If 'HEAD'
, get the HEAD of the
explicit (option branch(Branch)
), current or default branch. If
the commit is a hash and it is the tip of a branch, checkout
this branch. Else simply checkout the hash.commit('HEAD')
.2007git_checkout_version(PackDir, Options) :- 2008 option(commit('HEAD'), Options), 2009 option(branch(Branch), Options), 2010 !, 2011 git_ensure_on_branch(PackDir, Branch), 2012 run_process(path(git), ['-C', PackDir, pull], []). 2013git_checkout_version(PackDir, Options) :- 2014 option(commit('HEAD'), Options), 2015 git_current_branch(_, [directory(PackDir)]), 2016 !, 2017 run_process(path(git), ['-C', PackDir, pull], []). 2018git_checkout_version(PackDir, Options) :- 2019 option(commit('HEAD'), Options), 2020 !, 2021 git_default_branch(Branch, [directory(PackDir)]), 2022 git_ensure_on_branch(PackDir, Branch), 2023 run_process(path(git), ['-C', PackDir, pull], []). 2024git_checkout_version(PackDir, Options) :- 2025 option(commit(Hash), Options), 2026 run_process(path(git), ['-C', PackDir, fetch], []), 2027 git_branches(Branches, [contains(Hash), directory(PackDir)]), 2028 git_process_output(['-C', PackDir, 'rev-parse' | Branches], 2029 read_lines_to_atoms(Commits), 2030 []), 2031 nth1(I, Commits, Hash), 2032 nth1(I, Branches, Branch), 2033 !, 2034 git_ensure_on_branch(PackDir, Branch). 2035git_checkout_version(PackDir, Options) :- 2036 option(commit(Hash), Options), 2037 !, 2038 run_process(path(git), ['-C', PackDir, checkout, '--quiet', Hash], []). 2039git_checkout_version(PackDir, Options) :- 2040 option(version(Version), Options), 2041 !, 2042 git_tags(Tags, [directory(PackDir)]), 2043 ( memberchk(Version, Tags) 2044 -> Tag = Version 2045 ; member(Tag, Tags), 2046 sub_atom(Tag, B, _, 0, Version), 2047 sub_atom(Tag, 0, B, _, Prefix), 2048 version_prefix(Prefix) 2049 -> true 2050 ; existence_error(version_tag, Version) 2051 ), 2052 run_process(path(git), ['-C', PackDir, checkout, Tag], []). 2053git_checkout_version(_PackDir, Options) :- 2054 option(fresh(true), Options), 2055 !. 2056git_checkout_version(PackDir, _Options) :- 2057 git_current_branch(_, [directory(PackDir)]), 2058 !, 2059 run_process(path(git), ['-C', PackDir, pull], []). 2060git_checkout_version(PackDir, _Options) :- 2061 git_default_branch(Branch, [directory(PackDir)]), 2062 git_ensure_on_branch(PackDir, Branch), 2063 run_process(path(git), ['-C', PackDir, pull], []).
2069git_ensure_on_branch(PackDir, Branch) :- 2070 git_current_branch(Branch, [directory(PackDir)]), 2071 !. 2072git_ensure_on_branch(PackDir, Branch) :- 2073 run_process(path(git), ['-C', PackDir, checkout, Branch], []). 2074 2075read_lines_to_atoms(Atoms, In) :- 2076 read_line_to_string(In, Line), 2077 ( Line == end_of_file 2078 -> Atoms = [] 2079 ; atom_string(Atom, Line), 2080 Atoms = [Atom|T], 2081 read_lines_to_atoms(T, In) 2082 ). 2083 2084version_prefix(Prefix) :- 2085 atom_codes(Prefix, Codes), 2086 phrase(version_prefix, Codes). 2087 2088version_prefix --> 2089 [C], 2090 { code_type(C, alpha) }, 2091 !, 2092 version_prefix. 2093version_prefix --> 2094 "-". 2095version_prefix --> 2096 "_". 2097version_prefix --> 2098 "".
2105download_file(URL, Pack, File, Options) :- 2106 option(version(Version), Options), 2107 !, 2108 file_name_extension(_, Ext, URL), 2109 format(atom(File), '~w-~w.~w', [Pack, Version, Ext]). 2110download_file(URL, Pack, File, _) :- 2111 file_base_name(URL,Basename), 2112 no_int_file_name_extension(Tag,Ext,Basename), 2113 tag_version(Tag,Version), 2114 !, 2115 format(atom(File0), '~w-~w', [Pack, Version]), 2116 file_name_extension(File0, Ext, File). 2117download_file(URL, _, File, _) :- 2118 file_base_name(URL, File).
2126:- public pack_url_file/2. 2127pack_url_file(URL, FileID) :- 2128 github_release_url(URL, Pack, Version), 2129 !, 2130 download_file(URL, Pack, FileID, [version(Version)]). 2131pack_url_file(URL, FileID) :- 2132 file_base_name(URL, FileID). 2133 2134% ssl_verify(+SSL, +ProblemCert, +AllCerts, +FirstCert, +Error) 2135% 2136% Used if insecure(true) is given to pack_install/2. Accepts any 2137% certificate. 2138 2139:- public ssl_verify/5. 2140ssl_verify(_SSL, 2141 _ProblemCertificate, _AllCertificates, _FirstCertificate, 2142 _Error). 2143 2144pack_download_dir(PackTopDir, DownLoadDir) :- 2145 directory_file_path(PackTopDir, 'Downloads', DownLoadDir), 2146 ( exists_directory(DownLoadDir) 2147 -> true 2148 ; make_directory(DownLoadDir) 2149 ), 2150 ( access_file(DownLoadDir, write) 2151 -> true 2152 ; permission_error(write, directory, DownLoadDir) 2153 ).
ftp://
are also download URLs, but we cannot download
from them.2161download_url(URL) :- 2162 url_scheme(URL, Scheme), 2163 download_scheme(Scheme). 2164 2165url_scheme(URL, Scheme) :- 2166 atom(URL), 2167 uri_components(URL, Components), 2168 uri_data(scheme, Components, Scheme0), 2169 atom(Scheme0), 2170 Scheme = Scheme0. 2171 2172download_scheme(http). 2173download_scheme(https).
insecure(true)
, which may also be used to disable TLS
certificate checking. Note that the pack integrity is still
protected by its SHA1 hash.2184hsts(URL0, URL, Options) :- 2185 option(insecure(true), Options, false), 2186 !, 2187 URL = URL0. 2188hsts(URL0, URL, _Options) :- 2189 url_scheme(URL0, http), 2190 !, 2191 uri_edit(scheme(https), URL0, URL). 2192hsts(URL, URL, _Options).
2203pack_post_install(Info, Options) :-
2204 Pack = Info.pack,
2205 PackDir = Info.installed,
2206 post_install_foreign(Pack, PackDir, Options),
2207 post_install_autoload(Info),
2208 pack_attach(PackDir, [duplicate(warning)]).
2216pack_rebuild :- 2217 forall(current_pack(Pack), 2218 ( print_message(informational, pack(rebuild(Pack))), 2219 pack_rebuild(Pack) 2220 )). 2221 2222pack_rebuild(Pack) :- 2223 current_pack(Pack, PackDir), 2224 !, 2225 post_install_foreign(Pack, PackDir, [rebuild(true)]). 2226pack_rebuild(Pack) :- 2227 unattached_pack(Pack, PackDir), 2228 !, 2229 post_install_foreign(Pack, PackDir, [rebuild(true)]). 2230pack_rebuild(Pack) :- 2231 existence_error(pack, Pack). 2232 2233unattached_pack(Pack, BaseDir) :- 2234 directory_file_path(Pack, 'pack.pl', PackFile), 2235 absolute_file_name(pack(PackFile), PackPath, 2236 [ access(read), 2237 file_errors(fail) 2238 ]), 2239 file_directory_name(PackPath, BaseDir).
2255post_install_foreign(Pack, PackDir, Options) :- 2256 is_foreign_pack(PackDir, _), 2257 !, 2258 ( pack_info_term(PackDir, pack_version(Version)) 2259 -> true 2260 ; Version = 1 2261 ), 2262 option(rebuild(Rebuild), Options, if_absent), 2263 current_prolog_flag(arch, Arch), 2264 prolog_version_dotted(PrologVersion), 2265 ( Rebuild == if_absent, 2266 foreign_present(PackDir, Arch) 2267 -> print_message(informational, pack(kept_foreign(Pack, Arch))), 2268 ( pack_status_dir(PackDir, built(Arch, _, _)) 2269 -> true 2270 ; pack_assert(PackDir, built(Arch, PrologVersion, downloaded)) 2271 ) 2272 ; BuildSteps0 = [[dependencies], [configure], build, install, [test]], 2273 ( Rebuild == true 2274 -> BuildSteps1 = [distclean|BuildSteps0] 2275 ; BuildSteps1 = BuildSteps0 2276 ), 2277 ( option(test(false), Options) 2278 -> delete(BuildSteps1, [test], BuildSteps2) 2279 ; BuildSteps2 = BuildSteps1 2280 ), 2281 ( option(clean(true), Options) 2282 -> append(BuildSteps2, [[clean]], BuildSteps) 2283 ; BuildSteps = BuildSteps2 2284 ), 2285 build_steps(BuildSteps, PackDir, [pack_version(Version)|Options]), 2286 pack_assert(PackDir, built(Arch, PrologVersion, built)) 2287 ). 2288post_install_foreign(_, _, _).
lib
directory for
the current architecture.
2299foreign_present(PackDir, Arch) :-
2300 atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
2301 exists_directory(ForeignBaseDir),
2302 !,
2303 atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
2304 exists_directory(ForeignDir),
2305 current_prolog_flag(shared_object_extension, Ext),
2306 atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
2307 expand_file_name(Pattern, Files),
2308 Files \== [].
2315is_foreign_pack(PackDir, Type) :- 2316 foreign_file(File, Type), 2317 directory_file_path(PackDir, File, Path), 2318 exists_file(Path). 2319 2320foreign_file('CMakeLists.txt', cmake). 2321foreign_file('configure', configure). 2322foreign_file('configure.in', autoconf). 2323foreign_file('configure.ac', autoconf). 2324foreign_file('Makefile.am', automake). 2325foreign_file('Makefile', make). 2326foreign_file('makefile', make). 2327foreign_file('conanfile.txt', conan). 2328foreign_file('conanfile.py', conan). 2329 2330 2331 /******************************* 2332 * AUTOLOAD * 2333 *******************************/
2339post_install_autoload(List), is_list(List) => 2340 maplist(post_install_autoload, List). 2341post_install_autoload(Info), 2342 _{installed:PackDir, autoload:true} :< Info => 2343 directory_file_path(PackDir, prolog, PrologLibDir), 2344 make_library_index(PrologLibDir). 2345post_install_autoload(Info) => 2346 directory_file_path(Info.installed, 'prolog/INDEX.pl', IndexFile), 2347 ( exists_file(IndexFile) 2348 -> E = error(_,_), 2349 print_message(warning, pack(delete_autoload_index(Info.pack, IndexFile))), 2350 catch(delete_file(IndexFile), E, 2351 print_message(warning, E)) 2352 ; true 2353 ).
2360decide_autoload_pack(Options, Info0, Info) :- 2361 is_autoload_pack(Info0.pack, Info0.installed, Options), 2362 !, 2363 Info = Info0.put(autoload, true). 2364decide_autoload_pack(_, Info, Info). 2365 2366is_autoload_pack(_Pack, _PackDir, Options) :- 2367 option(autoload(true), Options), 2368 !. 2369is_autoload_pack(Pack, PackDir, Options) :- 2370 pack_info_term(PackDir, autoload(true)), 2371 confirm(autoload(Pack), no, Options). 2372 2373 2374 /******************************* 2375 * UPGRADE * 2376 *******************************/
pack_install(Pack, [upgrade(true)])
.2382pack_upgrade(Pack) :- 2383 pack_install(Pack, [upgrade(true)]). 2384 2385 2386 /******************************* 2387 * REMOVE * 2388 *******************************/
true
delete dependencies without asking.2401pack_remove(Pack) :- 2402 pack_remove(Pack, []). 2403 2404pack_remove(Pack, Options) :- 2405 option(dependencies(false), Options), 2406 !, 2407 pack_remove_forced(Pack). 2408pack_remove(Pack, Options) :- 2409 ( dependents(Pack, Deps) 2410 -> ( option(dependencies(true), Options) 2411 -> true 2412 ; confirm_remove(Pack, Deps, Delete, Options) 2413 ), 2414 forall(member(P, Delete), pack_remove_forced(P)) 2415 ; pack_remove_forced(Pack) 2416 ). 2417 2418pack_remove_forced(Pack) :- 2419 catch('$pack_detach'(Pack, BaseDir), 2420 error(existence_error(pack, Pack), _), 2421 fail), 2422 !, 2423 ( read_link(BaseDir, _, Target) 2424 -> What = link(Target) 2425 ; What = directory 2426 ), 2427 print_message(informational, pack(remove(What, BaseDir))), 2428 delete_directory_and_contents(BaseDir). 2429pack_remove_forced(Pack) :- 2430 unattached_pack(Pack, BaseDir), 2431 !, 2432 delete_directory_and_contents(BaseDir). 2433pack_remove_forced(Pack) :- 2434 print_message(informational, error(existence_error(pack, Pack),_)). 2435 2436confirm_remove(Pack, Deps, Delete, Options) :- 2437 print_message(warning, pack(depends(Pack, Deps))), 2438 menu(pack(resolve_remove), 2439 [ [Pack] = remove_only(Pack), 2440 [Pack|Deps] = remove_deps(Pack, Deps), 2441 [] = cancel 2442 ], [], Delete, Options), 2443 Delete \== []. 2444 2445 2446 /******************************* 2447 * PUBLISH * 2448 *******************************/
?- pack_publish('.', []).
Alternatively, an archive file has been uploaded to a public location. In this scenario we can publish the pack using
?- pack_publish(URL, [])
In both scenarios, pack_publish/2 by default creates an isolated environment and installs the package in this directory from the public URL. On success it triggers the pack server to register the URL as a new pack or a new release of a pack.
Packs may also be published using the app pack
, e.g.
swipl pack publish .
Options:
true
, and Spec is a git managed directory, install using
the remote repo.git tag -s <tag>
.git tag -f <tag>
.false
(default true
), perform the installation, but do
not upload to the server. This can be used for testing.true
(default), install and build all packages in an
isolated package directory. If false
, use other packages
installed for the environment. The latter may be used to
speedup debugging.true
(default), clean the destination directory first2501pack_publish(Dir, Options) :- 2502 \+ download_url(Dir), 2503 is_git_directory(Dir), !, 2504 pack_git_info(Dir, _Hash, Metadata), 2505 prepare_repository(Dir, Metadata, Options), 2506 ( memberchk(download(URL), Metadata), 2507 git_url(URL, _) 2508 -> true 2509 ; option(remote(Remote), Options, origin), 2510 git_remote_url(Remote, RemoteURL, [directory(Dir)]), 2511 git_to_https_url(RemoteURL, URL) 2512 ), 2513 memberchk(version(Version), Metadata), 2514 pack_publish_(URL, 2515 [ version(Version) 2516 | Options 2517 ]). 2518pack_publish(Spec, Options) :- 2519 pack_publish_(Spec, Options). 2520 2521pack_publish_(Spec, Options) :- 2522 pack_default_options(Spec, Pack, Options, DefOptions), 2523 option(url(URL), DefOptions), 2524 valid_publish_url(URL, Options), 2525 prepare_build_location(Pack, Dir, Clean, Options), 2526 ( option(register(false), Options) 2527 -> InstallOptions = DefOptions 2528 ; InstallOptions = [publish(Pack)|DefOptions] 2529 ), 2530 call_cleanup(pack_install(Pack, 2531 [ pack(Pack) 2532 | InstallOptions 2533 ]), 2534 cleanup_publish(Clean, Dir)). 2535 2536cleanup_publish(true, Dir) :- 2537 !, 2538 delete_directory_and_contents(Dir). 2539cleanup_publish(_, _). 2540 2541valid_publish_url(URL, Options) :- 2542 option(register(Register), Options, true), 2543 ( Register == false 2544 -> true 2545 ; download_url(URL) 2546 -> true 2547 ; permission_error(publish, pack, URL) 2548 ). 2549 2550prepare_build_location(Pack, Dir, Clean, Options) :- 2551 ( option(pack_directory(Dir), Options) 2552 -> ensure_directory(Dir), 2553 ( option(clean(true), Options, true) 2554 -> delete_directory_contents(Dir) 2555 ; true 2556 ) 2557 ; tmp_file(pack, Dir), 2558 make_directory(Dir), 2559 Clean = true 2560 ), 2561 ( option(isolated(false), Options) 2562 -> detach_pack(Pack, _), 2563 attach_packs(Dir, [search(first)]) 2564 ; attach_packs(Dir, [replace(true)]) 2565 ).
register(false)
is provided, this is
a test run and therefore we do not need this. Otherwise we demand
the working directory to be clean, we tag the current commit and
push the current branch.2576prepare_repository(_Dir, _Metadata, Options) :- 2577 option(register(false), Options), 2578 !. 2579prepare_repository(Dir, Metadata, Options) :- 2580 git_dir_must_be_clean(Dir), 2581 git_must_be_on_default_branch(Dir, Options), 2582 tag_git_dir(Dir, Metadata, Action, Options), 2583 confirm(git_push, yes, Options), 2584 run_process(path(git), ['-C', file(Dir), push ], []), 2585 ( Action = push_tag(Tag) 2586 -> run_process(path(git), ['-C', file(Dir), push, origin, Tag ], []) 2587 ; true 2588 ). 2589 2590git_dir_must_be_clean(Dir) :- 2591 git_describe(Description, [directory(Dir)]), 2592 ( sub_atom(Description, _, _, 0, '-DIRTY') 2593 -> print_message(error, pack(git_not_clean(Dir))), 2594 fail 2595 ; true 2596 ). 2597 2598git_must_be_on_default_branch(Dir, Options) :- 2599 ( option(branch(Default), Options) 2600 -> true 2601 ; git_default_branch(Default, [directory(Dir)]) 2602 ), 2603 git_current_branch(Current, [directory(Dir)]), 2604 ( Default == Current 2605 -> true 2606 ; print_message(error, 2607 pack(git_branch_not_default(Dir, Default, Current))), 2608 fail 2609 ).
2618tag_git_dir(Dir, Metadata, Action, Options) :- 2619 memberchk(version(Version), Metadata), 2620 atom_concat('V', Version, Tag), 2621 git_tags(Tags, [directory(Dir)]), 2622 ( memberchk(Tag, Tags) 2623 -> git_tag_is_consistent(Dir, Tag, Action, Options) 2624 ; format(string(Message), 'Release ~w', [Version]), 2625 findall(Opt, git_tag_option(Opt, Options), Argv, 2626 [ '-m', Message, Tag ]), 2627 confirm(git_tag(Tag), yes, Options), 2628 run_process(path(git), ['-C', file(Dir), tag | Argv ], []), 2629 Action = push_tag(Tag) 2630 ). 2631 2632git_tag_option('-s', Options) :- option(sign(true), Options, true). 2633git_tag_option('-f', Options) :- option(force(true), Options, true). 2634 2635git_tag_is_consistent(Dir, Tag, Action, Options) :- 2636 format(atom(TagRef), 'refs/tags/~w', [Tag]), 2637 format(atom(CommitRef), 'refs/tags/~w^{}', [Tag]), 2638 option(remote(Remote), Options, origin), 2639 git_ls_remote(Dir, LocalTags, [tags(true)]), 2640 memberchk(CommitHash-CommitRef, LocalTags), 2641 ( git_hash(CommitHash, [directory(Dir)]) 2642 -> true 2643 ; print_message(error, pack(git_release_tag_not_at_head(Tag))), 2644 fail 2645 ), 2646 memberchk(TagHash-TagRef, LocalTags), 2647 git_ls_remote(Remote, RemoteTags, [tags(true)]), 2648 ( memberchk(RemoteCommitHash-CommitRef, RemoteTags), 2649 memberchk(RemoteTagHash-TagRef, RemoteTags) 2650 -> ( RemoteCommitHash == CommitHash, 2651 RemoteTagHash == TagHash 2652 -> Action = none 2653 ; print_message(error, pack(git_tag_out_of_sync(Tag))), 2654 fail 2655 ) 2656 ; Action = push_tag(Tag) 2657 ).
2665git_to_https_url(URL, URL) :- 2666 download_url(URL), 2667 !. 2668git_to_https_url(GitURL, URL) :- 2669 atom_concat('git@github.com:', Repo, GitURL), 2670 !, 2671 atom_concat('https://github.com/', Repo, URL). 2672git_to_https_url(GitURL, _) :- 2673 print_message(error, pack(git_no_https(GitURL))), 2674 fail. 2675 2676 2677 /******************************* 2678 * PROPERTIES * 2679 *******************************/
README
file (if present)TODO
file (if present)2702pack_property(Pack, Property) :- 2703 findall(Pack-Property, pack_property_(Pack, Property), List), 2704 member(Pack-Property, List). % make det if applicable 2705 2706pack_property_(Pack, Property) :- 2707 pack_info(Pack, _, Property). 2708pack_property_(Pack, Property) :- 2709 \+ \+ info_file(Property, _), 2710 '$pack':pack(Pack, BaseDir), 2711 access_file(BaseDir, read), 2712 directory_files(BaseDir, Files), 2713 member(File, Files), 2714 info_file(Property, Pattern), 2715 downcase_atom(File, Pattern), 2716 directory_file_path(BaseDir, File, InfoFile), 2717 arg(1, Property, InfoFile). 2718 2719info_file(readme(_), 'readme.txt'). 2720info_file(readme(_), 'readme'). 2721info_file(todo(_), 'todo.txt'). 2722info_file(todo(_), 'todo'). 2723 2724 2725 /******************************* 2726 * VERSION LOGIC * 2727 *******************************/
mypack-1.5
.2736pack_version_file(Pack, Version, GitHubRelease) :- 2737 atomic(GitHubRelease), 2738 github_release_url(GitHubRelease, Pack, Version), 2739 !. 2740pack_version_file(Pack, Version, Path) :- 2741 atomic(Path), 2742 file_base_name(Path, File), 2743 no_int_file_name_extension(Base, _Ext, File), 2744 atom_codes(Base, Codes), 2745 ( phrase(pack_version(Pack, Version), Codes), 2746 safe_pack_name(Pack) 2747 -> true 2748 ). 2749 2750no_int_file_name_extension(Base, Ext, File) :- 2751 file_name_extension(Base0, Ext0, File), 2752 \+ atom_number(Ext0, _), 2753 !, 2754 Base = Base0, 2755 Ext = Ext0. 2756no_int_file_name_extension(File, '', File).
2763safe_pack_name(Name) :- 2764 atom_length(Name, Len), 2765 Len >= 3, % demand at least three length 2766 atom_codes(Name, Codes), 2767 maplist(safe_pack_char, Codes), 2768 !. 2769 2770safe_pack_char(C) :- between(0'a, 0'z, C), !. 2771safe_pack_char(C) :- between(0'A, 0'Z, C), !. 2772safe_pack_char(C) :- between(0'0, 0'9, C), !. 2773safe_pack_char(0'_).
2779pack_version(Pack, Version) --> 2780 string(Codes), "-", 2781 version(Parts), 2782 !, 2783 { atom_codes(Pack, Codes), 2784 atomic_list_concat(Parts, '.', Version) 2785 }. 2786 2787version([H|T]) --> 2788 version_part(H), 2789 ( "." 2790 -> version(T) 2791 ; {T=[]} 2792 ). 2793 2794version_part(*) --> "*", !. 2795version_part(Int) --> integer(Int). 2796 2797 2798 /******************************* 2799 * GIT LOGIC * 2800 *******************************/ 2801 2802have_git :- 2803 process_which(path(git), _).
2810git_url(URL, Pack) :- 2811 uri_components(URL, Components), 2812 uri_data(scheme, Components, Scheme), 2813 nonvar(Scheme), % must be full URL 2814 uri_data(path, Components, Path), 2815 ( Scheme == git 2816 -> true 2817 ; git_download_scheme(Scheme), 2818 file_name_extension(_, git, Path) 2819 ; git_download_scheme(Scheme), 2820 catch(git_ls_remote(URL, _, [refs(['HEAD']), error(_)]), _, fail) 2821 -> true 2822 ), 2823 file_base_name(Path, PackExt), 2824 ( file_name_extension(Pack, git, PackExt) 2825 -> true 2826 ; Pack = PackExt 2827 ), 2828 ( safe_pack_name(Pack) 2829 -> true 2830 ; domain_error(pack_name, Pack) 2831 ). 2832 2833git_download_scheme(http). 2834git_download_scheme(https).
https:/github.com/<owner>/<pack>/archive/[vV]?<version>.zip'
2843github_release_url(URL, Pack, Version) :- 2844 uri_components(URL, Components), 2845 uri_data(authority, Components, 'github.com'), 2846 uri_data(scheme, Components, Scheme), 2847 download_scheme(Scheme), 2848 uri_data(path, Components, Path), 2849 github_archive_path(Archive,Pack,File), 2850 atomic_list_concat(Archive, /, Path), 2851 file_name_extension(Tag, Ext, File), 2852 github_archive_extension(Ext), 2853 tag_version(Tag, Version), 2854 !. 2855 2856github_archive_path(['',_User,Pack,archive,File],Pack,File). 2857github_archive_path(['',_User,Pack,archive,refs,tags,File],Pack,File). 2858 2859github_archive_extension(tgz). 2860github_archive_extension(zip).
[vV]?int(\.int)*
.2867tag_version(Tag, Version) :- 2868 version_tag_prefix(Prefix), 2869 atom_concat(Prefix, Version, Tag), 2870 is_version(Version). 2871 2872version_tag_prefix(v). 2873version_tag_prefix('V'). 2874version_tag_prefix('').
2883git_archive_url(URL, Archive, Options) :- 2884 uri_components(URL, Components), 2885 uri_data(authority, Components, 'github.com'), 2886 uri_data(path, Components, Path), 2887 atomic_list_concat(['', User, RepoGit], /, Path), 2888 $, 2889 remove_git_ext(RepoGit, Repo), 2890 git_archive_version(Version, Options), 2891 atomic_list_concat(['', User, Repo, zip, Version], /, ArchivePath), 2892 uri_edit([ path(ArchivePath), 2893 host('codeload.github.com') 2894 ], 2895 URL, Archive). 2896git_archive_url(URL, _, _) :- 2897 print_message(error, pack(no_git(URL))), 2898 fail. 2899 2900remove_git_ext(RepoGit, Repo) :- 2901 file_name_extension(Repo, git, RepoGit), 2902 !. 2903remove_git_ext(Repo, Repo). 2904 2905git_archive_version(Version, Options) :- 2906 option(commit(Version), Options), 2907 !. 2908git_archive_version(Version, Options) :- 2909 option(branch(Version), Options), 2910 !. 2911git_archive_version(Version, Options) :- 2912 option(version(Version), Options), 2913 !. 2914git_archive_version('HEAD', _). 2915 2916 /******************************* 2917 * QUERY CENTRAL DB * 2918 *******************************/
publish(Pack)
that must be
a no-op.publish(Pack)
by do_publish(Pack)
.2933register_downloads(_, Options) :- 2934 option(register(false), Options), 2935 !. 2936register_downloads(_, Options) :- 2937 option(publish(_), Options), 2938 !. 2939register_downloads(Infos, Options) :- 2940 convlist(download_data, Infos, Data), 2941 ( Data == [] 2942 -> true 2943 ; query_pack_server(downloaded(Data), Reply, Options), 2944 ( option(do_publish(Pack), Options) 2945 -> ( member(Info, Infos), 2946 Info.pack == Pack 2947 -> true 2948 ), 2949 ( Reply = true(Actions), 2950 memberchk(Pack-Result, Actions) 2951 -> ( registered(Result) 2952 -> print_message(informational, pack(published(Info, Result))) 2953 ; print_message(error, pack(publish_failed(Info, Result))), 2954 fail 2955 ) 2956 ; print_message(error, pack(publish_failed(Info, false))) 2957 ) 2958 ; true 2959 ) 2960 ). 2961 2962registered(git(_URL)). 2963registered(file(_URL)). 2964 2965publish_download(Infos, Options) :- 2966 select_option(publish(Pack), Options, Options1), 2967 !, 2968 register_downloads(Infos, [do_publish(Pack)|Options1]). 2969publish_download(_Infos, _Options).
download(URL, Hash, Metadata).
Where URL is location of the GIT repository or URL of the download archive. Hash is either the GIT commit hash or the SHA1 of the archive file.
2982download_data(Info, Data), 2983 Info.get(git) == true => % Git clone 2984 Data = download(URL, Hash, Metadata), 2985 URL = Info.get(downloaded), 2986 pack_git_info(Info.installed, Hash, Metadata). 2987download_data(Info, Data), 2988 _{git_url:URL,hash:Hash} :< Info, Hash \== (-) => 2989 Data = download(URL, Hash, Metadata), % Git downloaded as zip 2990 dir_metadata(Info.installed, Metadata). 2991download_data(Info, Data) => % Archive download. 2992 Data = download(URL, Hash, Metadata), 2993 URL = Info.get(downloaded), 2994 download_url(URL), 2995 pack_status_dir(Info.installed, archive(Archive, URL)), 2996 file_sha1(Archive, Hash), 2997 pack_archive_info(Archive, _Pack, Metadata, _).
3004query_pack_server(Query, Result, Options) :- 3005 ( option(server(ServerOpt), Options) 3006 -> server_url(ServerOpt, ServerBase) 3007 ; setting(server, ServerBase), 3008 ServerBase \== '' 3009 ), 3010 atom_concat(ServerBase, query, Server), 3011 format(codes(Data), '~q.~n', Query), 3012 info_level(Informational, Options), 3013 print_message(Informational, pack(contacting_server(Server))), 3014 setup_call_cleanup( 3015 http_open(Server, In, 3016 [ post(codes(application/'x-prolog', Data)), 3017 header(content_type, ContentType) 3018 ]), 3019 read_reply(ContentType, In, Result), 3020 close(In)), 3021 message_severity(Result, Level, Informational), 3022 print_message(Level, pack(server_reply(Result))). 3023 3024server_url(URL0, URL) :- 3025 uri_components(URL0, Components), 3026 uri_data(scheme, Components, Scheme), 3027 var(Scheme), 3028 !, 3029 atom_concat('https://', URL0, URL1), 3030 server_url(URL1, URL). 3031server_url(URL0, URL) :- 3032 uri_components(URL0, Components), 3033 uri_data(path, Components, ''), 3034 !, 3035 uri_edit([path('/pack/')], URL0, URL). 3036server_url(URL, URL). 3037 3038read_reply(ContentType, In, Result) :- 3039 sub_atom(ContentType, 0, _, _, 'application/x-prolog'), 3040 !, 3041 set_stream(In, encoding(utf8)), 3042 read(In, Result). 3043read_reply(ContentType, In, _Result) :- 3044 read_string(In, 500, String), 3045 print_message(error, pack(no_prolog_response(ContentType, String))), 3046 fail. 3047 3048info_level(Level, Options) :- 3049 option(silent(true), Options), 3050 !, 3051 Level = silent. 3052info_level(informational, _). 3053 3054message_severity(true(_), Informational, Informational). 3055message_severity(false, warning, _). 3056message_severity(exception(_), error, _). 3057 3058 3059 /******************************* 3060 * WILDCARD URIs * 3061 *******************************/
3070available_download_versions(URL, Versions, _Options) :- 3071 wildcard_pattern(URL), 3072 github_url(URL, User, Repo), % demands https 3073 !, 3074 findall(Version-VersionURL, 3075 github_version(User, Repo, Version, VersionURL), 3076 Versions). 3077available_download_versions(URL0, Versions, Options) :- 3078 wildcard_pattern(URL0), 3079 !, 3080 hsts(URL0, URL, Options), 3081 file_directory_name(URL, DirURL0), 3082 ensure_slash(DirURL0, DirURL), 3083 print_message(informational, pack(query_versions(DirURL))), 3084 setup_call_cleanup( 3085 http_open(DirURL, In, []), 3086 load_html(stream(In), DOM, 3087 [ syntax_errors(quiet) 3088 ]), 3089 close(In)), 3090 findall(MatchingURL, 3091 absolute_matching_href(DOM, URL, MatchingURL), 3092 MatchingURLs), 3093 ( MatchingURLs == [] 3094 -> print_message(warning, pack(no_matching_urls(URL))) 3095 ; true 3096 ), 3097 versioned_urls(MatchingURLs, VersionedURLs), 3098 sort_version_pairs(VersionedURLs, Versions), 3099 print_message(informational, pack(found_versions(Versions))). 3100available_download_versions(URL, [Version-URL], _Options) :- 3101 ( pack_version_file(_Pack, Version0, URL) 3102 -> Version = Version0 3103 ; Version = '0.0.0' 3104 ).
3110sort_version_pairs(Pairs, Sorted) :- 3111 map_list_to_pairs(version_pair_sort_key_, Pairs, Keyed), 3112 sort(1, @>=, Keyed, SortedKeyed), 3113 pairs_values(SortedKeyed, Sorted). 3114 3115version_pair_sort_key_(Version-_Data, Key) :- 3116 version_sort_key(Version, Key). 3117 3118version_sort_key(Version, Key) :- 3119 split_string(Version, ".", "", Parts), 3120 maplist(number_string, Key, Parts), 3121 !. 3122version_sort_key(Version, _) :- 3123 domain_error(version, Version).
3129github_url(URL, User, Repo) :-
3130 uri_components(URL, uri_components(https,'github.com',Path,_,_)),
3131 atomic_list_concat(['',User,Repo|_], /, Path).
3139github_version(User, Repo, Version, VersionURI) :- 3140 atomic_list_concat(['',repos,User,Repo,tags], /, Path1), 3141 uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)), 3142 setup_call_cleanup( 3143 http_open(ApiUri, In, 3144 [ request_header('Accept'='application/vnd.github.v3+json') 3145 ]), 3146 json_read_dict(In, Dicts), 3147 close(In)), 3148 member(Dict, Dicts), 3149 atom_string(Tag, Dict.name), 3150 tag_version(Tag, Version), 3151 atom_string(VersionURI, Dict.zipball_url). 3152 3153wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *). 3154wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?). 3155 3156ensure_slash(Dir, DirS) :- 3157 ( sub_atom(Dir, _, _, 0, /) 3158 -> DirS = Dir 3159 ; atom_concat(Dir, /, DirS) 3160 ). 3161 3162remove_slash(Dir0, Dir) :- 3163 Dir0 \== '/', 3164 atom_concat(Dir1, /, Dir0), 3165 !, 3166 remove_slash(Dir1, Dir). 3167remove_slash(Dir, Dir). 3168 3169absolute_matching_href(DOM, Pattern, Match) :- 3170 xpath(DOM, //a(@href), HREF), 3171 uri_normalized(HREF, Pattern, Match), 3172 wildcard_match(Pattern, Match). 3173 3174versioned_urls([], []). 3175versioned_urls([H|T0], List) :- 3176 file_base_name(H, File), 3177 ( pack_version_file(_Pack, Version, File) 3178 -> List = [Version-H|T] 3179 ; List = T 3180 ), 3181 versioned_urls(T0, T). 3182 3183 3184 /******************************* 3185 * DEPENDENCIES * 3186 *******************************/
3194pack_provides(Pack, Pack@Version) :- 3195 current_pack(Pack), 3196 once(pack_info(Pack, version, version(Version))). 3197pack_provides(Pack, Provides) :- 3198 findall(Prv, pack_info(Pack, dependency, provides(Prv)), PrvList), 3199 member(Provides, PrvList). 3200 3201pack_requires(Pack, Requires) :- 3202 current_pack(Pack), 3203 findall(Req, pack_info(Pack, dependency, requires(Req)), ReqList), 3204 member(Requires, ReqList). 3205 3206pack_conflicts(Pack, Conflicts) :- 3207 current_pack(Pack), 3208 findall(Cfl, pack_info(Pack, dependency, conflicts(Cfl)), CflList), 3209 member(Conflicts, CflList).
3216pack_depends_on(Pack, Dependency) :- 3217 ground(Pack), 3218 !, 3219 pack_requires(Pack, Requires), 3220 \+ is_prolog_token(Requires), 3221 pack_provides(Dependency, Provides), 3222 satisfies_req(Provides, Requires). 3223pack_depends_on(Pack, Dependency) :- 3224 ground(Dependency), 3225 !, 3226 pack_provides(Dependency, Provides), 3227 pack_requires(Pack, Requires), 3228 satisfies_req(Provides, Requires). 3229pack_depends_on(Pack, Dependency) :- 3230 current_pack(Pack), 3231 pack_depends_on(Pack, Dependency).
3238dependents(Pack, Deps) :- 3239 setof(Dep, dependent(Pack, Dep, []), Deps). 3240 3241dependent(Pack, Dep, Seen) :- 3242 pack_depends_on(Dep0, Pack), 3243 \+ memberchk(Dep0, Seen), 3244 ( Dep = Dep0 3245 ; dependent(Dep0, Dep, [Dep0|Seen]) 3246 ).
3252validate_dependencies :- 3253 setof(Issue, pack_dependency_issue(_, Issue), Issues), 3254 !, 3255 print_message(warning, pack(dependency_issues(Issues))). 3256validate_dependencies.
3268pack_dependency_issue(Pack, Issue) :- 3269 current_pack(Pack), 3270 pack_dependency_issue_(Pack, Issue). 3271 3272pack_dependency_issue_(Pack, unsatisfied(Pack, Requires)) :- 3273 pack_requires(Pack, Requires), 3274 ( is_prolog_token(Requires) 3275 -> \+ prolog_satisfies(Requires) 3276 ; \+ ( pack_provides(_, Provides), 3277 satisfies_req(Provides, Requires) ) 3278 ). 3279pack_dependency_issue_(Pack, conflicts(Pack, Conflicts)) :- 3280 pack_conflicts(Pack, Conflicts), 3281 ( is_prolog_token(Conflicts) 3282 -> prolog_satisfies(Conflicts) 3283 ; pack_provides(_, Provides), 3284 satisfies_req(Provides, Conflicts) 3285 ). 3286 3287 3288 /******************************* 3289 * RECORD PACK FACTS * 3290 *******************************/
built
if we built it or downloaded
if it was downloaded.true
, pack was installed as dependency.3306pack_assert(PackDir, Fact) :- 3307 must_be(ground, Fact), 3308 findall(Term, pack_status_dir(PackDir, Term), Facts0), 3309 update_facts(Facts0, Fact, Facts), 3310 OpenOptions = [encoding(utf8), lock(exclusive)], 3311 status_file(PackDir, StatusFile), 3312 ( Facts == Facts0 3313 -> true 3314 ; Facts0 \== [], 3315 append(Facts0, New, Facts) 3316 -> setup_call_cleanup( 3317 open(StatusFile, append, Out, OpenOptions), 3318 maplist(write_fact(Out), New), 3319 close(Out)) 3320 ; setup_call_cleanup( 3321 open(StatusFile, write, Out, OpenOptions), 3322 ( write_facts_header(Out), 3323 maplist(write_fact(Out), Facts) 3324 ), 3325 close(Out)) 3326 ). 3327 3328update_facts([], Fact, [Fact]) :- 3329 !. 3330update_facts([H|T], Fact, [Fact|T]) :- 3331 general_pack_fact(Fact, GenFact), 3332 general_pack_fact(H, GenTerm), 3333 GenFact =@= GenTerm, 3334 !. 3335update_facts([H|T0], Fact, [H|T]) :- 3336 update_facts(T0, Fact, T). 3337 3338general_pack_fact(built(Arch, _Version, _How), General) => 3339 General = built(Arch, _, _). 3340general_pack_fact(Term, General), compound(Term) => 3341 compound_name_arity(Term, Name, Arity), 3342 compound_name_arity(General, Name, Arity). 3343general_pack_fact(Term, General) => 3344 General = Term. 3345 3346write_facts_header(Out) :- 3347 format(Out, '% Fact status file. Managed by package manager.~n', []). 3348 3349write_fact(Out, Term) :- 3350 format(Out, '~q.~n', [Term]).
status.db
.3358pack_status(Pack, Fact) :- 3359 current_pack(Pack, PackDir), 3360 pack_status_dir(PackDir, Fact). 3361 3362pack_status_dir(PackDir, Fact) :- 3363 det_if(ground(Fact), pack_status_(PackDir, Fact)). 3364 3365pack_status_(PackDir, Fact) :- 3366 status_file(PackDir, StatusFile), 3367 catch(term_in_file(valid_term(pack_status_term), StatusFile, Fact), 3368 error(existence_error(source_sink, StatusFile), _), 3369 fail). 3370 3371pack_status_term(built(atom, version, oneof([built,downloaded]))). 3372pack_status_term(automatic(boolean)). 3373pack_status_term(archive(atom, atom)).
3383update_automatic(Info) :- 3384 _ = Info.get(dependency_for), 3385 \+ pack_status(Info.installed, automatic(_)), 3386 !, 3387 pack_assert(Info.installed, automatic(true)). 3388update_automatic(Info) :- 3389 pack_assert(Info.installed, automatic(false)). 3390 3391status_file(PackDir, StatusFile) :- 3392 directory_file_path(PackDir, 'status.db', StatusFile). 3393 3394 /******************************* 3395 * USER INTERACTION * 3396 *******************************/ 3397 3398:- multifile prolog:message//1.
3402menu(_Question, _Alternatives, Default, Selection, Options) :- 3403 option(interactive(false), Options), 3404 !, 3405 Selection = Default. 3406menu(Question, Alternatives, Default, Selection, _) :- 3407 length(Alternatives, N), 3408 between(1, 5, _), 3409 print_message(query, Question), 3410 print_menu(Alternatives, Default, 1), 3411 print_message(query, pack(menu(select))), 3412 read_selection(N, Choice), 3413 !, 3414 ( Choice == default 3415 -> Selection = Default 3416 ; nth1(Choice, Alternatives, Selection=_) 3417 -> true 3418 ). 3419 [], _, _) (. 3421print_menu([Value=Label|T], Default, I) :- 3422 ( Value == Default 3423 -> print_message(query, pack(menu(default_item(I, Label)))) 3424 ; print_message(query, pack(menu(item(I, Label)))) 3425 ), 3426 I2 is I + 1, 3427 print_menu(T, Default, I2). 3428 3429read_selection(Max, Choice) :- 3430 get_single_char(Code), 3431 ( answered_default(Code) 3432 -> Choice = default 3433 ; code_type(Code, digit(Choice)), 3434 between(1, Max, Choice) 3435 -> true 3436 ; print_message(warning, pack(menu(reply(1,Max)))), 3437 fail 3438 ).
3446confirm(_Question, Default, Options) :- 3447 Default \== none, 3448 option(interactive(false), Options, true), 3449 !, 3450 Default == yes. 3451confirm(Question, Default, _) :- 3452 between(1, 5, _), 3453 print_message(query, pack(confirm(Question, Default))), 3454 read_yes_no(YesNo, Default), 3455 !, 3456 format(user_error, '~N', []), 3457 YesNo == yes. 3458 3459read_yes_no(YesNo, Default) :- 3460 get_single_char(Code), 3461 code_yes_no(Code, Default, YesNo), 3462 !. 3463 3464code_yes_no(0'y, _, yes). 3465code_yes_no(0'Y, _, yes). 3466code_yes_no(0'n, _, no). 3467code_yes_no(0'N, _, no). 3468code_yes_no(_, none, _) :- !, fail. 3469code_yes_no(C, Default, Default) :- 3470 answered_default(C). 3471 3472answered_default(0'\r). 3473answered_default(0'\n). 3474answered_default(0'\s). 3475 3476 3477 /******************************* 3478 * MESSAGES * 3479 *******************************/ 3480 3481:- multifile prolog:message//1. 3482 3483prologmessage(pack(Message)) --> 3484 message(Message). 3485 3486:- discontiguous 3487 message//1, 3488 label//1. 3489 3490message(invalid_term(pack_info_term, Term)) --> 3491 [ 'Invalid package meta data: ~q'-[Term] ]. 3492message(invalid_term(pack_status_term, Term)) --> 3493 [ 'Invalid package status data: ~q'-[Term] ]. 3494message(directory_exists(Dir)) --> 3495 [ 'Package target directory exists and is not empty:', nl, 3496 '\t~q'-[Dir] 3497 ]. 3498message(already_installed(pack(Pack, Version))) --> 3499 [ 'Pack `~w'' is already installed @~w'-[Pack, Version] ]. 3500message(already_installed(Pack)) --> 3501 [ 'Pack `~w'' is already installed. Package info:'-[Pack] ]. 3502message(kept_foreign(Pack, Arch)) --> 3503 [ 'Found foreign libraries for architecture '-[], 3504 ansi(code, '~q', [Arch]), nl, 3505 'Use ', ansi(code, '?- pack_rebuild(~q).', [Pack]), 3506 ' to rebuild from sources'-[] 3507 ]. 3508message(no_pack_installed(Pack)) --> 3509 [ 'No pack ~q installed. Use ?- pack_list(Pattern) to search'-[Pack] ]. 3510message(dependency_issues(Issues)) --> 3511 [ 'The current set of packs has dependency issues:', nl ], 3512 dep_issues(Issues). 3513message(depends(Pack, Deps)) --> 3514 [ 'The following packs depend on `~w\':'-[Pack], nl ], 3515 pack_list(Deps). 3516message(remove(link(To), PackDir)) --> 3517 [ 'Removing ', url(PackDir), nl, ' as link to ', url(To) ]. 3518message(remove(directory, PackDir)) --> 3519 [ 'Removing ~q and contents'-[PackDir] ]. 3520message(remove_existing_pack(PackDir)) --> 3521 [ 'Remove old installation in ~q'-[PackDir] ]. 3522message(delete_autoload_index(Pack, Index)) --> 3523 [ 'Pack ' ], msg_pack(Pack), [ ': deleting autoload index ', url(Index) ]. 3524message(download_plan(Plan)) --> 3525 [ ansi(bold, 'Installation plan:', []), nl ], 3526 install_plan(Plan, Actions), 3527 install_label(Actions). 3528message(build_plan(Plan)) --> 3529 [ ansi(bold, 'The following packs have post install scripts:', []), nl ], 3530 msg_build_plan(Plan), 3531 [ nl, ansi(bold, 'Run scripts?', []) ]. 3532message(autoload(Pack)) --> 3533 [ 'Pack ' ], msg_pack(Pack), 3534 [ ' prefers to be added as autoload library', 3535 nl, ansi(bold, 'Allow?', []) 3536 ]. 3537message(no_meta_data(BaseDir)) --> 3538 [ 'Cannot find pack.pl inside directory ~q. Not a package?'-[BaseDir] ]. 3539message(search_no_matches(Name)) --> 3540 [ 'Search for "~w", returned no matching packages'-[Name] ]. 3541message(rebuild(Pack)) --> 3542 [ 'Checking pack "~w" for rebuild ...'-[Pack] ]. 3543message(up_to_date([Pack])) --> 3544 !, 3545 [ 'Pack ' ], msg_pack(Pack), [' is up-to-date' ]. 3546message(up_to_date(Packs)) --> 3547 [ 'Packs ' ], sequence(msg_pack, [', '], Packs), [' are up-to-date' ]. 3548message(installed_can_upgrade(List)) --> 3549 sequence(msg_can_upgrade_target, [nl], List). 3550message(new_dependencies(Deps)) --> 3551 [ 'Found new dependencies after downloading (~p).'-[Deps], nl ]. 3552message(query_versions(URL)) --> 3553 [ 'Querying "~w" to find new versions ...'-[URL] ]. 3554message(no_matching_urls(URL)) --> 3555 [ 'Could not find any matching URL: ~q'-[URL] ]. 3556message(found_versions([Latest-_URL|More])) --> 3557 { length(More, Len) }, 3558 [ ' Latest version: ~w (~D older)'-[Latest, Len] ]. 3559message(build(Pack, PackDir)) --> 3560 [ ansi(bold, 'Building pack ~w in directory ~w', [Pack, PackDir]) ]. 3561message(contacting_server(Server)) --> 3562 [ 'Contacting server at ~w ...'-[Server], flush ]. 3563message(server_reply(true(_))) --> 3564 [ at_same_line, ' ok'-[] ]. 3565message(server_reply(false)) --> 3566 [ at_same_line, ' done'-[] ]. 3567message(server_reply(exception(E))) --> 3568 [ 'Server reported the following error:'-[], nl ], 3569 '$messages':translate_message(E). 3570message(cannot_create_dir(Alias)) --> 3571 { findall(PackDir, 3572 absolute_file_name(Alias, PackDir, [solutions(all)]), 3573 PackDirs0), 3574 sort(PackDirs0, PackDirs) 3575 }, 3576 [ 'Cannot find a place to create a package directory.'-[], 3577 'Considered:'-[] 3578 ], 3579 candidate_dirs(PackDirs). 3580message(conflict(version, [PackV, FileV])) --> 3581 ['Version mismatch: pack.pl: '-[]], msg_version(PackV), 3582 [', file claims version '-[]], msg_version(FileV). 3583message(conflict(name, [PackInfo, FileInfo])) --> 3584 ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]], 3585 [', file claims ~w: ~p'-[FileInfo]]. 3586message(no_prolog_response(ContentType, String)) --> 3587 [ 'Expected Prolog response. Got content of type ~p'-[ContentType], nl, 3588 '~s'-[String] 3589 ]. 3590message(download(begin, Pack, _URL, _DownloadFile)) --> 3591 [ 'Downloading ' ], msg_pack(Pack), [ ' ... ', flush ]. 3592message(download(end, _, _, File)) --> 3593 { size_file(File, Bytes) }, 3594 [ at_same_line, '~D bytes'-[Bytes] ]. 3595message(no_git(URL)) --> 3596 [ 'Cannot install from git repository ', url(URL), '.', nl, 3597 'Cannot find git program and do not know how to download the code', nl, 3598 'from this git service. Please install git and retry.' 3599 ]. 3600message(git_no_https(GitURL)) --> 3601 [ 'Do not know how to get an HTTP(s) URL for ', url(GitURL) ]. 3602message(git_branch_not_default(Dir, Default, Current)) --> 3603 [ 'GIT current branch on ', url(Dir), ' is not default.', nl, 3604 ' Current branch: ', ansi(code, '~w', [Current]), 3605 ' default: ', ansi(code, '~w', [Default]) 3606 ]. 3607message(git_not_clean(Dir)) --> 3608 [ 'GIT working directory is dirty: ', url(Dir), nl, 3609 'Your repository must be clean before publishing.' 3610 ]. 3611message(git_push) --> 3612 [ 'Push release to GIT origin?' ]. 3613message(git_tag(Tag)) --> 3614 [ 'Tag repository with release tag ', ansi(code, '~w', [Tag]) ]. 3615message(git_release_tag_not_at_head(Tag)) --> 3616 [ 'Release tag ', ansi(code, '~w', [Tag]), ' is not at HEAD.', nl, 3617 'If you want to update the tag, please run ', 3618 ansi(code, 'git tag -d ~w', [Tag]) 3619 ]. 3620message(git_tag_out_of_sync(Tag)) --> 3621 [ 'Release tag ', ansi(code, '~w', [Tag]), 3622 ' differs from this tag at the origin' 3623 ]. 3624 3625message(published(Info, At)) --> 3626 [ 'Published pack ' ], msg_pack(Info), msg_info_version(Info), 3627 [' to be installed from '], 3628 msg_published_address(At). 3629message(publish_failed(Info, Reason)) --> 3630 [ 'Pack ' ], msg_pack(Info), [ ' at version ~w'-[Info.version] ], 3631 msg_publish_failed(Reason). 3632 3633msg_publish_failed(throw(error(permission_error(register, 3634 pack(_),_URL),_))) --> 3635 [ ' is already registered with a different URL']. 3636msg_publish_failed(download) --> 3637 [' was already published?']. 3638msg_publish_failed(Status) --> 3639 [ ' failed for unknown reason (~p)'-[Status] ]. 3640 3641msg_published_address(git(URL)) --> 3642 msg_url(URL, _). 3643msg_published_address(file(URL)) --> 3644 msg_url(URL, _). 3645 3646candidate_dirs([]) --> []. 3647candidate_dirs([H|T]) --> [ nl, ' ~w'-[H] ], candidate_dirs(T). 3648 % Questions 3649message(resolve_remove) --> 3650 [ nl, 'Please select an action:', nl, nl ]. 3651message(create_pack_dir) --> 3652 [ nl, 'Create directory for packages', nl ]. 3653message(menu(item(I, Label))) --> 3654 [ '~t(~d)~6| '-[I] ], 3655 label(Label). 3656message(menu(default_item(I, Label))) --> 3657 [ '~t(~d)~6| * '-[I] ], 3658 label(Label). 3659message(menu(select)) --> 3660 [ nl, 'Your choice? ', flush ]. 3661message(confirm(Question, Default)) --> 3662 message(Question), 3663 confirm_default(Default), 3664 [ flush ]. 3665message(menu(reply(Min,Max))) --> 3666 ( { Max =:= Min+1 } 3667 -> [ 'Please enter ~w or ~w'-[Min,Max] ] 3668 ; [ 'Please enter a number between ~w and ~w'-[Min,Max] ] 3669 ). 3670 3671 % support predicates 3672dep_issues(Issues) --> 3673 sequence(dep_issue, [nl], Issues). 3674 3675dep_issue(unsatisfied(Pack, Requires)) --> 3676 [ ' - Pack ' ], msg_pack(Pack), [' requires ~p'-[Requires]]. 3677dep_issue(conflicts(Pack, Conflict)) --> 3678 [ ' - Pack ' ], msg_pack(Pack), [' conflicts with ~p'-[Conflict]].
3685install_label([link]) --> 3686 !, 3687 [ ansi(bold, 'Activate pack?', []) ]. 3688install_label([unpack]) --> 3689 !, 3690 [ ansi(bold, 'Unpack archive?', []) ]. 3691install_label(_) --> 3692 [ ansi(bold, 'Download packs?', []) ]. 3693 3694 3695install_plan(Plan, Actions) --> 3696 install_plan(Plan, Actions, Sec), 3697 sec_warning(Sec). 3698 3699install_plan([], [], _) --> 3700 []. 3701install_plan([H|T], [AH|AT], Sec) --> 3702 install_step(H, AH, Sec), [nl], 3703 install_plan(T, AT, Sec). 3704 3705install_step(Info, keep, _Sec) --> 3706 { Info.get(keep) == true }, 3707 !, 3708 [ ' Keep ' ], msg_pack(Info), [ ' at version ~w'-[Info.version] ], 3709 msg_can_upgrade(Info). 3710install_step(Info, Action, Sec) --> 3711 { From = Info.get(upgrade), 3712 VFrom = From.version, 3713 VTo = Info.get(version), 3714 ( cmp_versions(>=, VTo, VFrom) 3715 -> Label = ansi(bold, ' Upgrade ', []) 3716 ; Label = ansi(warning, ' Downgrade ', []) 3717 ) 3718 }, 3719 [ Label ], msg_pack(Info), 3720 [ ' from version ~w to ~w'- [From.version, Info.get(version)] ], 3721 install_from(Info, Action, Sec). 3722install_step(Info, Action, Sec) --> 3723 { _From = Info.get(upgrade) }, 3724 [ ' Upgrade ' ], msg_pack(Info), 3725 install_from(Info, Action, Sec). 3726install_step(Info, Action, Sec) --> 3727 { Dep = Info.get(dependency_for) }, 3728 [ ' Install ' ], msg_pack(Info), 3729 [ ' at version ~w as dependency for '-[Info.version], 3730 ansi(code, '~w', [Dep]) 3731 ], 3732 install_from(Info, Action, Sec), 3733 msg_downloads(Info). 3734install_step(Info, Action, Sec) --> 3735 { Info.get(commit) == 'HEAD' }, 3736 !, 3737 [ ' Install ' ], msg_pack(Info), [ ' at current GIT HEAD'-[] ], 3738 install_from(Info, Action, Sec), 3739 msg_downloads(Info). 3740install_step(Info, link, _Sec) --> 3741 { Info.get(link) == true, 3742 uri_file_name(Info.get(url), Dir) 3743 }, 3744 !, 3745 [ ' Install ' ], msg_pack(Info), [ ' as symlink to ', url(Dir) ]. 3746install_step(Info, Action, Sec) --> 3747 [ ' Install ' ], msg_pack(Info), [ ' at version ~w'-[Info.get(version)] ], 3748 install_from(Info, Action, Sec), 3749 msg_downloads(Info). 3750install_step(Info, Action, Sec) --> 3751 [ ' Install ' ], msg_pack(Info), 3752 install_from(Info, Action, Sec), 3753 msg_downloads(Info). 3754 3755install_from(Info, download, Sec) --> 3756 { download_url(Info.url) }, 3757 !, 3758 [ ' from ' ], msg_url(Info.url, Sec). 3759install_from(Info, unpack, Sec) --> 3760 [ ' from ' ], msg_url(Info.url, Sec). 3761 3762msg_url(URL, unsafe) --> 3763 { atomic(URL), 3764 atom_concat('http://', Rest, URL) 3765 }, 3766 [ ansi(error, '~w', ['http://']), '~w'-[Rest] ]. 3767msg_url(URL, _) --> 3768 [ url(URL) ]. 3769 3770sec_warning(Sec) --> 3771 { var(Sec) }, 3772 !. 3773sec_warning(unsafe) --> 3774 [ ansi(warning, ' WARNING: The installation plan includes downloads \c 3775 from insecure HTTP servers.', []), nl 3776 ]. 3777 3778msg_downloads(Info) --> 3779 { Downloads = Info.get(all_downloads), 3780 Downloads > 0 3781 }, 3782 [ ansi(comment, ' (downloaded ~D times)', [Downloads]) ], 3783 !. 3784msg_downloads(_) --> 3785 []. 3786 3787msg_pack(Pack) --> 3788 { atom(Pack) }, 3789 !, 3790 [ ansi(code, '~w', [Pack]) ]. 3791msg_pack(Info) --> 3792 msg_pack(Info.pack). 3793 3794msg_info_version(Info) --> 3795 [ ansi(code, '@~w', [Info.get(version)]) ], 3796 !. 3797msg_info_version(_Info) --> 3798 [].
3804msg_build_plan(Plan) --> 3805 sequence(build_step, [nl], Plan). 3806 3807build_step(Info) --> 3808 [ ' Build ' ], msg_pack(Info), [' in directory ', url(Info.installed) ]. 3809 3810msg_can_upgrade_target(Info) --> 3811 [ ' Pack ' ], msg_pack(Info), 3812 [ ' is installed at version ~w'-[Info.version] ], 3813 msg_can_upgrade(Info). 3814 3815pack_list([]) --> []. 3816pack_list([H|T]) --> 3817 [ ' - Pack ' ], msg_pack(H), [nl], 3818 pack_list(T). 3819 3820label(remove_only(Pack)) --> 3821 [ 'Only remove package ~w (break dependencies)'-[Pack] ]. 3822label(remove_deps(Pack, Deps)) --> 3823 { length(Deps, Count) }, 3824 [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ]. 3825label(create_dir(Dir)) --> 3826 [ '~w'-[Dir] ]. 3827label(install_from(git(URL))) --> 3828 !, 3829 [ 'GIT repository at ~w'-[URL] ]. 3830label(install_from(URL)) --> 3831 [ '~w'-[URL] ]. 3832label(cancel) --> 3833 [ 'Cancel' ]. 3834 3835confirm_default(yes) --> 3836 [ ' Y/n? ' ]. 3837confirm_default(no) --> 3838 [ ' y/N? ' ]. 3839confirm_default(none) --> 3840 [ ' y/n? ' ]. 3841 3842msg_version(Version) --> 3843 [ '~w'-[Version] ]. 3844 3845msg_can_upgrade(Info) --> 3846 { Latest = Info.get(latest_version) }, 3847 [ ansi(warning, ' (can be upgraded to ~w)', [Latest]) ]. 3848msg_can_upgrade(_) --> 3849 []. 3850 3851 3852 /******************************* 3853 * MISC * 3854 *******************************/ 3855 3856local_uri_file_name(URL, FileName) :- 3857 uri_file_name(URL, FileName), 3858 !. 3859local_uri_file_name(URL, FileName) :- 3860 uri_components(URL, Components), 3861 uri_data(scheme, Components, File), File == file, 3862 uri_data(authority, Components, FileNameEnc), 3863 uri_data(path, Components, ''), 3864 uri_encoded(path, FileName, FileNameEnc). 3865 3866det_if(Cond, Goal) :- 3867 ( 3868 -> , 3869 ! 3870 ; 3871 ). 3872 3873member_nonvar(_, Var) :- 3874 var(Var), 3875 !, 3876 fail. 3877member_nonvar(E, [E|_]). 3878member_nonvar(E, [_|T]) :- 3879 member_nonvar(E, T)
A package manager for Prolog
The library(prolog_pack) provides the SWI-Prolog package manager. This library lets you inspect installed packages, install packages, remove packages, etc. This library complemented by the built-in predicates such as attach_packs/2 that makes installed packages available as libraries.
The important functionality of this library is encapsulated in the app
pack
. For help, run*/