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), [pairs_keys/2]). 70:- autoload(library(git)). 71:- autoload(library(sgml)). 72:- autoload(library(sha)). 73:- autoload(library(build/tools)). 74:- autoload(library(ansi_term), [ansi_format/3]). 75:- autoload(library(pprint), [print_term/2]). 76:- autoload(library(prolog_versions), [require_version/3, cmp_versions/3]). 77:- autoload(library(ugraphs), [vertices_edges_to_ugraph/3, ugraph_layers/2]). 78:- autoload(library(process), [process_which/2]). 79 80:- meta_predicate 81 pack_install_local( , , ).
96 /******************************* 97 * CONSTANTS * 98 *******************************/ 99 100:- setting(server, atom, 'https://www.swi-prolog.org/pack/', 101 'Server to exchange pack information'). 102 103 104 /******************************* 105 * LOCAL DECLARATIONS * 106 *******************************/ 107 108:- op(900, xfx, @). % Token@Version 109 110:- meta_predicate det_if( , ). 111 112 /******************************* 113 * PACKAGE INFO * 114 *******************************/
121current_pack(Pack) :- 122 current_pack(Pack, _). 123 124current_pack(Pack, Dir) :- 125 '$pack':pack(Pack, Dir).
132pack_list_installed :-
133 pack_list('', [installed(true)]),
134 validate_dependencies.
140pack_info(Name) :- 141 pack_info(info, Name). 142 143pack_info(Level, Name) :- 144 must_be(atom, Name), 145 findall(Info, pack_info(Name, Level, Info), Infos0), 146 ( Infos0 == [] 147 -> print_message(warning, pack(no_pack_installed(Name))), 148 fail 149 ; true 150 ), 151 findall(Def, pack_default(Level, Infos, Def), Defs), 152 append(Infos0, Defs, Infos1), 153 sort(Infos1, Infos), 154 show_info(Name, Infos, [info(Level)]). 155 156 157show_info(_Name, _Properties, Options) :- 158 option(silent(true), Options), 159 !. 160show_info(_Name, _Properties, Options) :- 161 option(show_info(false), Options), 162 !. 163show_info(Name, Properties, Options) :- 164 option(info(list), Options), 165 !, 166 memberchk(title(Title), Properties), 167 memberchk(version(Version), Properties), 168 format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]). 169show_info(Name, Properties, _) :- 170 !, 171 print_property_value('Package'-'~w', [Name]), 172 findall(Term, pack_level_info(info, Term, _, _), Terms), 173 maplist(print_property(Properties), Terms). 174 175print_property(_, nl) :- 176 !, 177 format('~n'). 178print_property(Properties, Term) :- 179 findall(Term, member(Term, Properties), Terms), 180 Terms \== [], 181 !, 182 pack_level_info(_, Term, LabelFmt, _Def), 183 ( LabelFmt = Label-FmtElem 184 -> true 185 ; Label = LabelFmt, 186 FmtElem = '~w' 187 ), 188 multi_valued(Terms, FmtElem, FmtList, Values), 189 atomic_list_concat(FmtList, ', ', Fmt), 190 print_property_value(Label-Fmt, Values). 191print_property(_, _). 192 193multi_valued([H], LabelFmt, [LabelFmt], Values) :- 194 !, 195 H =.. [_|Values]. 196multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :- 197 H =.. [_|VH], 198 append(VH, MoreValues, Values), 199 multi_valued(T, LabelFmt, LT, MoreValues). 200 201 202pvalue_column(29). 203print_property_value(Prop-Fmt, Values) :- 204 !, 205 pvalue_column(C), 206 atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format), 207 format(Format, [Prop,C|Values]). 208 209pack_info(Name, Level, Info) :- 210 '$pack':pack(Name, BaseDir), 211 pack_dir_info(BaseDir, Level, Info). 212 213pack_dir_info(BaseDir, Level, Info) :- 214 ( Info = directory(BaseDir) 215 ; pack_info_term(BaseDir, Info) 216 ), 217 pack_level_info(Level, Info, _Format, _Default). 218 219:- public pack_level_info/4. % used by web-server 220 221pack_level_info(_, title(_), 'Title', '<no title>'). 222pack_level_info(_, version(_), 'Installed version', '<unknown>'). 223pack_level_info(info, automatic(_), 'Automatic (dependency only)', -). 224pack_level_info(info, directory(_), 'Installed in directory', -). 225pack_level_info(info, link(_), 'Installed as link to'-'~w', -). 226pack_level_info(info, built(_,_), 'Built on'-'~w for SWI-Prolog ~w', -). 227pack_level_info(info, author(_, _), 'Author'-'~w <~w>', -). 228pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>', -). 229pack_level_info(info, packager(_, _), 'Packager'-'~w <~w>', -). 230pack_level_info(info, home(_), 'Home page', -). 231pack_level_info(info, download(_), 'Download URL', -). 232pack_level_info(_, provides(_), 'Provides', -). 233pack_level_info(_, requires(_), 'Requires', -). 234pack_level_info(_, conflicts(_), 'Conflicts with', -). 235pack_level_info(_, replaces(_), 'Replaces packages', -). 236pack_level_info(info, library(_), 'Provided libraries', -). 237 238pack_default(Level, Infos, Def) :- 239 pack_level_info(Level, ITerm, _Format, Def), 240 Def \== (-), 241 \+ memberchk(ITerm, Infos).
247pack_info_term(BaseDir, Info) :- 248 directory_file_path(BaseDir, 'pack.pl', InfoFile), 249 catch( 250 term_in_file(valid_term(pack_info_term), InfoFile, Info), 251 error(existence_error(source_sink, InfoFile), _), 252 ( print_message(error, pack(no_meta_data(BaseDir))), 253 fail 254 )). 255pack_info_term(BaseDir, library(Lib)) :- 256 atom_concat(BaseDir, '/prolog/', LibDir), 257 atom_concat(LibDir, '*.pl', Pattern), 258 expand_file_name(Pattern, Files), 259 maplist(atom_concat(LibDir), Plain, Files), 260 convlist(base_name, Plain, Libs), 261 member(Lib, Libs). 262pack_info_term(BaseDir, automatic(Boolean)) :- 263 once(pack_status_dir(BaseDir, automatic(Boolean))). 264pack_info_term(BaseDir, built(Arch, Prolog)) :- 265 pack_status_dir(BaseDir, built(Arch, Prolog, _How)). 266pack_info_term(BaseDir, link(Dest)) :- 267 read_link(BaseDir, _, Dest). 268 269base_name(File, Base) :- 270 file_name_extension(Base, pl, File).
call(Valid, Term)
is true.276:- meta_predicate 277 term_in_file( , , ). 278 279term_in_file(Valid, File, Term) :- 280 exists_file(File), 281 setup_call_cleanup( 282 open(File, read, In, [encoding(utf8)]), 283 term_in_stream(Valid, In, Term), 284 close(In)). 285 286term_in_stream(Valid, In, Term) :- 287 repeat, 288 read_term(In, Term0, []), 289 ( Term0 == end_of_file 290 -> !, fail 291 ; Term = Term0, 292 call(Valid, Term0) 293 ). 294 295:- meta_predicate 296 valid_term( , ). 297 298valid_term(Type, Term) :- 299 Term =.. [Name|Args], 300 same_length(Args, Types), 301 Decl =.. [Name|Types], 302 ( call(Type, Decl) 303 -> maplist(valid_info_arg, Types, Args) 304 ; print_message(warning, pack(invalid_term(Type, Term))), 305 fail 306 ). 307 308valid_info_arg(Type, Arg) :- 309 must_be(Type, Arg).
316pack_info_term(name(atom)). % Synopsis 317pack_info_term(title(atom)). 318pack_info_term(keywords(list(atom))). 319pack_info_term(description(list(atom))). 320pack_info_term(version(version)). 321pack_info_term(author(atom, email_or_url_or_empty)). % Persons 322pack_info_term(maintainer(atom, email_or_url)). 323pack_info_term(packager(atom, email_or_url)). 324pack_info_term(pack_version(nonneg)). % Package convention version 325pack_info_term(home(atom)). % Home page 326pack_info_term(download(atom)). % Source 327pack_info_term(provides(atom)). % Dependencies 328pack_info_term(requires(dependency)). 329pack_info_term(conflicts(dependency)). % Conflicts with package 330pack_info_term(replaces(atom)). % Replaces another package 331pack_info_term(autoload(boolean)). % Default installation options 332 333:- multifile 334 error:has_type/2. 335 336errorhas_type(version, Version) :- 337 atom(Version), 338 is_version(Version). 339errorhas_type(email_or_url, Address) :- 340 atom(Address), 341 ( sub_atom(Address, _, _, _, @) 342 -> true 343 ; uri_is_global(Address) 344 ). 345errorhas_type(email_or_url_or_empty, Address) :- 346 ( Address == '' 347 -> true 348 ; error:has_type(email_or_url, Address) 349 ). 350errorhas_type(dependency, Value) :- 351 is_dependency(Value). 352 353is_version(Version) :- 354 split_string(Version, ".", "", Parts), 355 maplist(number_string, _, Parts). 356 357is_dependency(Var) :- 358 var(Var), 359 !, 360 fail. 361is_dependency(Token) :- 362 atom(Token), 363 !. 364is_dependency(Term) :- 365 compound(Term), 366 compound_name_arguments(Term, Op, [Token,Version]), 367 atom(Token), 368 cmp(Op, _), 369 is_version(Version), 370 !. 371is_dependency(PrologToken) :- 372 is_prolog_token(PrologToken). 373 374cmp(<, @<). 375cmp(=<, @=<). 376cmp(==, ==). 377cmp(>=, @>=). 378cmp(>, @>). 379 380 381 /******************************* 382 * SEARCH * 383 *******************************/
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.
425pack_list(Query) :- 426 pack_list(Query, []). 427 428pack_search(Query) :- 429 pack_list(Query, []). 430 431pack_list(Query, Options) :- 432 ( option(installed(true), Options) 433 ; option(outdated(true), Options) 434 ; option(server(false), Options) 435 ), 436 !, 437 local_search(Query, Local), 438 maplist(arg(1), Local, Packs), 439 ( option(server(false), Options) 440 -> Hits = [] 441 ; query_pack_server(info(Packs), true(Hits), Options) 442 ), 443 list_hits(Hits, Local, Options). 444pack_list(Query, Options) :- 445 query_pack_server(search(Query), Result, Options), 446 ( Result == false 447 -> ( local_search(Query, Packs), 448 Packs \== [] 449 -> forall(member(pack(Pack, Stat, Title, Version, _), Packs), 450 format('~w ~w@~w ~28|- ~w~n', 451 [Stat, Pack, Version, Title])) 452 ; print_message(warning, pack(search_no_matches(Query))) 453 ) 454 ; Result = true(Hits), % Hits = list(pack(Name, p, Title, Version, URL)) 455 local_search(Query, Local), 456 list_hits(Hits, Local, []) 457 ). 458 459list_hits(Hits, Local, Options) :- 460 append(Hits, Local, All), 461 sort(All, Sorted), 462 join_status(Sorted, Packs0), 463 include(filtered(Options), Packs0, Packs), 464 maplist(list_hit(Options), Packs). 465 466filtered(Options, pack(_,Tag,_,_,_)) :- 467 option(outdated(true), Options), 468 !, 469 Tag == 'U'. 470filtered(_, _). 471 472list_hit(_Options, pack(Pack, Tag, Title, Version, _URL)) => 473 list_tag(Tag), 474 ansi_format(code, '~w', [Pack]), 475 format('@'), 476 list_version(Tag, Version), 477 format('~35|- ', []), 478 ansi_format(comment, '~w~n', [Title]). 479 480list_tag(Tag) :- 481 tag_color(Tag, Color), 482 ansi_format(Color, '~w ', [Tag]). 483 484list_version(Tag, VersionI-VersionS) => 485 tag_color(Tag, Color), 486 ansi_format(Color, '~w', [VersionI]), 487 ansi_format(bold, '(~w)', [VersionS]). 488list_version(_Tag, Version) => 489 ansi_format([], '~w', [Version]). 490 491tag_color('U', warning) :- !. 492tag_color('A', comment) :- !. 493tag_color(_, []).
pack(Name, Status, Version, URL)
. If
the versions do not match, Version is
VersionInstalled-VersionRemote
and similar for thee URL.502join_status([], []). 503join_status([ pack(Pack, i, Title, Version, URL), 504 pack(Pack, p, Title, Version, _) 505 | T0 506 ], 507 [ pack(Pack, Tag, Title, Version, URL) 508 | T 509 ]) :- 510 !, 511 ( pack_status(Pack, automatic(true)) 512 -> Tag = a 513 ; Tag = i 514 ), 515 join_status(T0, T). 516join_status([ pack(Pack, i, Title, VersionI, URLI), 517 pack(Pack, p, _, VersionS, URLS) 518 | T0 519 ], 520 [ pack(Pack, Tag, Title, VersionI-VersionS, URLI-URLS) 521 | T 522 ]) :- 523 !, 524 version_sort_key(VersionI, VDI), 525 version_sort_key(VersionS, VDS), 526 ( VDI @< VDS 527 -> Tag = 'U' 528 ; Tag = 'A' 529 ), 530 join_status(T0, T). 531join_status([ pack(Pack, i, Title, VersionI, URL) 532 | T0 533 ], 534 [ pack(Pack, l, Title, VersionI, URL) 535 | T 536 ]) :- 537 !, 538 join_status(T0, T). 539join_status([H|T0], [H|T]) :- 540 join_status(T0, T).
546local_search(Query, Packs) :- 547 findall(Pack, matching_installed_pack(Query, Pack), Packs). 548 549matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :- 550 current_pack(Pack), 551 findall(Term, 552 ( pack_info(Pack, _, Term), 553 search_info(Term) 554 ), Info), 555 ( sub_atom_icasechk(Pack, _, Query) 556 -> true 557 ; memberchk(title(Title), Info), 558 sub_atom_icasechk(Title, _, Query) 559 ), 560 option(title(Title), Info, '<no title>'), 561 option(version(Version), Info, '<no version>'), 562 option(download(URL), Info, '<no download url>'). 563 564search_info(title(_)). 565search_info(version(_)). 566search_info(download(_)). 567 568 569 /******************************* 570 * INSTALL * 571 *******************************/
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.
671pack_install(Spec) :- 672 pack_default_options(Spec, Pack, [], Options), 673 pack_install(Pack, [pack(Pack)|Options]). 674 675pack_install(Specs, Options) :- 676 is_list(Specs), 677 !, 678 maplist(pack_options(Options), Specs, Pairs), 679 pack_install_dir(PackTopDir, Options), 680 pack_install_set(Pairs, PackTopDir, Options). 681pack_install(Spec, Options) :- 682 pack_default_options(Spec, Pack, Options, DefOptions), 683 ( option(already_installed(Installed), DefOptions) 684 -> print_message(informational, pack(already_installed(Installed))) 685 ; merge_options(Options, DefOptions, PackOptions), 686 pack_install_dir(PackTopDir, PackOptions), 687 pack_install_set([Pack-PackOptions], PackTopDir, Options) 688 ). 689 690pack_options(Options, Spec, Pack-PackOptions) :- 691 pack_default_options(Spec, Pack, Options, DefOptions), 692 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.718pack_default_options(_Spec, Pack, OptsIn, Options) :- % (1) 719 option(already_installed(pack(Pack,_Version)), OptsIn), 720 !, 721 Options = OptsIn. 722pack_default_options(_Spec, Pack, OptsIn, Options) :- % (2) 723 option(url(URL), OptsIn), 724 !, 725 ( option(git(_), OptsIn) 726 -> Options = OptsIn 727 ; git_url(URL, Pack) 728 -> Options = [git(true)|OptsIn] 729 ; Options = OptsIn 730 ), 731 ( nonvar(Pack) 732 -> true 733 ; option(pack(Pack), Options) 734 -> true 735 ; pack_version_file(Pack, _Version, URL) 736 ). 737pack_default_options(Archive, Pack, OptsIn, Options) :- % (3) 738 must_be(atom, Archive), 739 \+ uri_is_global(Archive), 740 expand_file_name(Archive, [File]), 741 exists_file(File), 742 !, 743 ( pack_version_file(Pack, Version, File) 744 -> uri_file_name(FileURL, File), 745 merge_options([url(FileURL), version(Version)], OptsIn, Options) 746 ; domain_error(pack_file_name, Archive) 747 ). 748pack_default_options(URL, Pack, OptsIn, Options) :- % (4) 749 git_url(URL, Pack), 750 !, 751 merge_options([git(true), url(URL)], OptsIn, Options). 752pack_default_options(FileURL, Pack, _, Options) :- % (5) 753 uri_file_name(FileURL, Dir), 754 exists_directory(Dir), 755 pack_info_term(Dir, name(Pack)), 756 !, 757 ( pack_info_term(Dir, version(Version)) 758 -> uri_file_name(DirURL, Dir), 759 Options = [url(DirURL), version(Version)] 760 ; throw(error(existence_error(key, version, Dir),_)) 761 ). 762pack_default_options('.', Pack, OptsIn, Options) :- % (6) 763 pack_info_term('.', name(Pack)), 764 !, 765 working_directory(Dir, Dir), 766 ( pack_info_term(Dir, version(Version)) 767 -> uri_file_name(DirURL, Dir), 768 NewOptions = [url(DirURL), version(Version) | Options1], 769 ( current_prolog_flag(windows, true) 770 -> Options1 = [] 771 ; Options1 = [link(true), rebuild(make)] 772 ), 773 merge_options(NewOptions, OptsIn, Options) 774 ; throw(error(existence_error(key, version, Dir),_)) 775 ). 776pack_default_options(URL, Pack, OptsIn, Options) :- % (7) 777 pack_version_file(Pack, Version, URL), 778 download_url(URL), 779 !, 780 available_download_versions(URL, Available), 781 Available = [URLVersion-LatestURL|_], 782 NewOptions = [url(LatestURL)|VersionOptions], 783 version_options(Version, URLVersion, Available, VersionOptions), 784 merge_options(NewOptions, OptsIn, Options). 785pack_default_options(Pack, Pack, Options, Options) :- % (8) 786 \+ uri_is_global(Pack). 787 788version_options(Version, Version, _, [version(Version)]) :- !. 789version_options(Version, _, Available, [versions(Available)]) :- 790 sub_atom(Version, _, _, _, *), 791 !. 792version_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.
812pack_install_dir(PackDir, Options) :- 813 option(pack_directory(PackDir), Options), 814 ensure_directory(PackDir), 815 !. 816pack_install_dir(PackDir, Options) :- 817 base_alias(Alias, Options), 818 absolute_file_name(Alias, PackDir, 819 [ file_type(directory), 820 access(write), 821 file_errors(fail) 822 ]), 823 !. 824pack_install_dir(PackDir, Options) :- 825 pack_create_install_dir(PackDir, Options). 826 827base_alias(Alias, Options) :- 828 option(global(true), Options), 829 !, 830 Alias = common_app_data(pack). 831base_alias(Alias, Options) :- 832 option(global(false), Options), 833 !, 834 Alias = user_app_data(pack). 835base_alias(Alias, _Options) :- 836 Alias = pack('.'). 837 838pack_create_install_dir(PackDir, Options) :- 839 base_alias(Alias, Options), 840 findall(Candidate = create_dir(Candidate), 841 ( absolute_file_name(Alias, Candidate, [solutions(all)]), 842 \+ exists_file(Candidate), 843 \+ exists_directory(Candidate), 844 file_directory_name(Candidate, Super), 845 ( exists_directory(Super) 846 -> access_file(Super, write) 847 ; true 848 ) 849 ), 850 Candidates0), 851 list_to_set(Candidates0, Candidates), % keep order 852 pack_create_install_dir(Candidates, PackDir, Options). 853 854pack_create_install_dir(Candidates, PackDir, Options) :- 855 Candidates = [Default=_|_], 856 !, 857 append(Candidates, [cancel=cancel], Menu), 858 menu(pack(create_pack_dir), Menu, Default, Selected, Options), 859 Selected \== cancel, 860 ( catch(make_directory_path(Selected), E, 861 (print_message(warning, E), fail)) 862 -> PackDir = Selected 863 ; delete(Candidates, PackDir=create_dir(PackDir), Remaining), 864 pack_create_install_dir(Remaining, PackDir, Options) 865 ). 866pack_create_install_dir(_, _, _) :- 867 print_message(error, pack(cannot_create_dir(pack(.)))), 868 fail.
882pack_unpack_from_local(Source, PackTopDir, Name, PackDir, Options) :- 883 exists_directory(Source), 884 !, 885 directory_file_path(PackTopDir, Name, PackDir), 886 ( option(link(true), Options) 887 -> ( same_file(Source, PackDir) 888 -> true 889 ; remove_existing_pack(PackDir, Options), 890 atom_concat(PackTopDir, '/', PackTopDirS), 891 relative_file_name(Source, PackTopDirS, RelPath), 892 link_file(RelPath, PackDir, symbolic), 893 assertion(same_file(Source, PackDir)) 894 ) 895 ; is_git_directory(Source) 896 -> remove_existing_pack(PackDir, Options), 897 run_process(path(git), [clone, Source, PackDir], []) 898 ; prepare_pack_dir(PackDir, Options), 899 copy_directory(Source, PackDir) 900 ). 901pack_unpack_from_local(Source, PackTopDir, Name, PackDir, Options) :- 902 exists_file(Source), 903 directory_file_path(PackTopDir, Name, PackDir), 904 prepare_pack_dir(PackDir, Options), 905 pack_unpack(Source, PackDir, Name, Options).
914:- if(exists_source(library(archive))). 915pack_unpack(Source, PackDir, Pack, Options) :- 916 ensure_loaded_archive, 917 pack_archive_info(Source, Pack, _Info, StripOptions), 918 prepare_pack_dir(PackDir, Options), 919 archive_extract(Source, PackDir, 920 [ exclude(['._*']) % MacOS resource forks 921 | StripOptions 922 ]). 923:- else. 924pack_unpack(_,_,_,_) :- 925 existence_error(library, archive). 926:- endif.
934pack_install_local(M:Gen, Dir, Options) :- 935 findall(Pack-PackOptions, call(M:Gen, Pack, PackOptions), Pairs), 936 pack_install_set(Pairs, Dir, Options). 937 938pack_install_set(Pairs, Dir, Options) :- 939 must_be(list(pair), Pairs), 940 ensure_directory(Dir), 941 partition(known_media, Pairs, Local, Remote), 942 maplist(pack_options_to_versions, Local, LocalVersions), 943 ( Remote == [] 944 -> AllVersions = LocalVersions 945 ; pairs_keys(Remote, Packs), 946 prolog_description(Properties), 947 query_pack_server(versions(Packs, Properties), Result, Options), 948 ( Result = true(RemoteVersions) 949 -> append(LocalVersions, RemoteVersions, AllVersions) 950 ; print_message(error, pack(query_failed(Result))), 951 fail 952 ) 953 ), 954 local_packs(Dir, Existing), 955 pack_resolve(Pairs, Existing, AllVersions, Plan, Options), 956 !, % for now, only first plan 957 Options1 = [pack_directory(Dir)|Options], 958 download_plan(Pairs, Plan, PlanB, Options1), 959 register_downloads(PlanB, Options), 960 maplist(update_automatic, PlanB), 961 build_plan(PlanB, Built, Options1), 962 publish_download(PlanB, Options), 963 work_done(Pairs, Plan, PlanB, Built, Options).
972known_media(_-Options) :-
973 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:
991pack_resolve(Pairs, Existing, Versions, Plan, Options) :-
992 insert_existing(Existing, Versions, AllVersions, Options),
993 phrase(select_version(Pairs, AllVersions,
994 [ plan(PlanA), % access to plan
995 dependency_for([]) % dependencies
996 | Options
997 ]),
998 PlanA),
999 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.1010:- det(insert_existing/4). 1011insert_existing(Existing, [], Versions, _Options) => 1012 maplist(existing_to_versions, Existing, Versions). 1013insert_existing(Existing, [Pack-Versions|T0], AllPackVersions, Options), 1014 select(Installed, Existing, Existing2), 1015 Installed.pack == Pack => 1016 can_upgrade(Installed, Versions, Installed2), 1017 insert_existing_(Installed2, Versions, AllVersions, Options), 1018 AllPackVersions = [Pack-AllVersions|T], 1019 insert_existing(Existing2, T0, T, Options). 1020insert_existing(Existing, [H|T0], AllVersions, Options) => 1021 AllVersions = [H|T], 1022 insert_existing(Existing, T0, T, Options). 1023 1024existing_to_versions(Installed, Pack-[Version-[Installed]]) :- 1025 Pack = Installed.pack, 1026 Version = Installed.version. 1027 1028insert_existing_(Installed, Versions, AllVersions, Options) :- 1029 option(upgrade(true), Options), 1030 !, 1031 insert_existing_(Installed, Versions, AllVersions). 1032insert_existing_(Installed, Versions, AllVersions, _) :- 1033 AllVersions = [Installed.version-[Installed]|Versions]. 1034 1035insert_existing_(Installed, [H|T0], [H|T]) :- 1036 H = V0-_Infos, 1037 cmp_versions(>, V0, Installed.version), 1038 !, 1039 insert_existing_(Installed, T0, T). 1040insert_existing_(Installed, [H0|T], [H|T]) :- 1041 H0 = V0-Infos, 1042 V0 == Installed.version, 1043 !, 1044 H = V0-[Installed|Infos]. 1045insert_existing_(Installed, Versions, All) :- 1046 All = [Installed.version-[Installed]|Versions].
latest_version
key to Installed if its version is older than
the latest available version.1053can_upgrade(Info, [Version-_|_], Info2) :- 1054 cmp_versions(>, Version, Info.version), 1055 !, 1056 Info2 = Info.put(latest_version, Version). 1057can_upgrade(Info, _, Info).
upgrade:true
to elements of PlanA in Existing that are not the
same.1065mark_installed([], _, []). 1066mark_installed([Info|T], Existing, Plan) :- 1067 ( member(Installed, Existing), 1068 Installed.pack == Info.pack 1069 -> ( ( Installed.git == true 1070 -> Info.git == true, 1071 Installed.hash == Info.hash 1072 ; Version = Info.get(version) 1073 -> Installed.version == Version 1074 ) 1075 -> Plan = [Info.put(keep, true)|PlanT] % up-to-date 1076 ; Plan = [Info.put(upgrade, Installed)|PlanT] % needs upgrade 1077 ) 1078 ; Plan = [Info|PlanT] % new install 1079 ), 1080 mark_installed(T, Existing, PlanT).
1088select_version([], _, _) --> 1089 []. 1090select_version([Pack-PackOptions|More], Versions, Options) --> 1091 { memberchk(Pack-PackVersions, Versions), 1092 member(Version-Infos, PackVersions), 1093 compatible_version(Pack, Version, PackOptions), 1094 member(Info, Infos), 1095 pack_options_compatible_with_info(Info, PackOptions), 1096 pack_satisfies(Pack, Version, Info, Info2, PackOptions), 1097 all_downloads(PackVersions, Downloads) 1098 }, 1099 add_to_plan(Info2.put(_{version: Version, all_downloads:Downloads}), 1100 Versions, Options), 1101 select_version(More, Versions, Options). 1102select_version([Pack-_PackOptions|_More], _Versions, _Options) --> 1103 { existence_error(pack, Pack) }. % or warn and continue? 1104 1105all_downloads(PackVersions, AllDownloads) :- 1106 aggregate_all(sum(Downloads), 1107 ( member(_Version-Infos, PackVersions), 1108 member(Info, Infos), 1109 get_dict(downloads, Info, Downloads) 1110 ), 1111 AllDownloads). 1112 1113add_requirements([], _, _) --> 1114 []. 1115add_requirements([H|T], Versions, Options) --> 1116 { is_prolog_token(H), 1117 !, 1118 prolog_satisfies(H) 1119 }, 1120 add_requirements(T, Versions, Options). 1121add_requirements([H|T], Versions, Options) --> 1122 { member(Pack-PackVersions, Versions), 1123 member(Version-Infos, PackVersions), 1124 member(Info, Infos), 1125 ( Provides = @(Pack,Version) 1126 ; member(Provides, Info.get(provides)) 1127 ), 1128 satisfies_req(Provides, H), 1129 all_downloads(PackVersions, Downloads) 1130 }, 1131 add_to_plan(Info.put(_{version: Version, all_downloads:Downloads}), 1132 Versions, Options), 1133 add_requirements(T, Versions, Options).
1141add_to_plan(Info, _Versions, Options) --> 1142 { option(plan(Plan), Options), 1143 member_nonvar(Planned, Plan), 1144 Planned.pack == Info.pack, 1145 !, 1146 same_version(Planned, Info) % same pack, different version 1147 }. 1148add_to_plan(Info, _Versions, _Options) --> 1149 { member(Conflict, Info.get(conflicts)), 1150 is_prolog_token(Conflict), 1151 prolog_satisfies(Conflict), 1152 !, 1153 fail % incompatible with this Prolog 1154 }. 1155add_to_plan(Info, _Versions, Options) --> 1156 { option(plan(Plan), Options), 1157 member_nonvar(Planned, Plan), 1158 info_conflicts(Info, Planned), % Conflicts with a planned pack 1159 !, 1160 fail 1161 }. 1162add_to_plan(Info, Versions, Options) --> 1163 { select_option(dependency_for(Dep0), Options, Options1), 1164 Options2 = [dependency_for([Info.pack|Dep0])|Options1], 1165 ( Dep0 = [DepFor|_] 1166 -> add_dependency_for(DepFor, Info, Info1) 1167 ; Info1 = Info 1168 ) 1169 }, 1170 [Info1], 1171 add_requirements(Info.get(requires,[]), Versions, Options2). 1172 1173add_dependency_for(Pack, Info, Info) :- 1174 Old = Info.get(dependency_for), 1175 !, 1176 b_set_dict(dependency_for, Info, [Pack|Old]). 1177add_dependency_for(Pack, Info0, Info) :- 1178 Info = Info0.put(dependency_for, [Pack]). 1179 1180same_version(Info, Info) :- 1181 !. 1182same_version(Planned, Info) :- 1183 Hash = Planned.get(hash), 1184 Hash \== (-), 1185 !, 1186 Hash == Info.get(hash). 1187same_version(Planned, Info) :- 1188 Planned.get(version) == Info.get(version).
1194info_conflicts(Info, Planned) :- 1195 info_conflicts_(Info, Planned), 1196 !. 1197info_conflicts(Info, Planned) :- 1198 info_conflicts_(Planned, Info), 1199 !. 1200 1201info_conflicts_(Info, Planned) :- 1202 member(Conflict, Info.get(conflicts)), 1203 \+ is_prolog_token(Conflict), 1204 info_provides(Planned, Provides), 1205 satisfies_req(Provides, Conflict), 1206 !. 1207 1208info_provides(Info, Provides) :- 1209 ( Provides = Info.pack@Info.version 1210 ; member(Provides, Info.get(provides)) 1211 ).
1218pack_satisfies(_Pack, _Version, Info0, Info, Options) :- 1219 option(commit('HEAD'), Options), 1220 !, 1221 Info0.get(git) == true, 1222 Info = Info0.put(commit, 'HEAD'). 1223pack_satisfies(_Pack, _Version, Info, Info, Options) :- 1224 option(commit(Commit), Options), 1225 !, 1226 Commit == Info.get(hash). 1227pack_satisfies(Pack, Version, Info, Info, Options) :- 1228 option(version(ReqVersion), Options), 1229 !, 1230 satisfies_version(Pack, Version, ReqVersion). 1231pack_satisfies(_Pack, _Version, Info, Info, _Options).
1235satisfies_version(Pack, Version, ReqVersion) :-
1236 catch(require_version(pack(Pack), Version, ReqVersion),
1237 error(version_error(pack(Pack), Version, ReqVersion),_),
1238 fail).
1244satisfies_req(Token, Token) => true. 1245satisfies_req(@(Token,_), Token) => true. 1246satisfies_req(@(Token,PrvVersion), Req), cmp(Req, Token, Cmp, ReqVersion) => 1247 cmp_versions(Cmp, PrvVersion, ReqVersion). 1248satisfies_req(_,_) => fail. 1249 1250cmp(Token < Version, Token, <, Version). 1251cmp(Token =< Version, Token, =<, Version). 1252cmp(Token = Version, Token, =, Version). 1253cmp(Token == Version, Token, ==, Version). 1254cmp(Token >= Version, Token, >=, Version). 1255cmp(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).
1268:- det(pack_options_to_versions/2). 1269pack_options_to_versions(Pack-PackOptions, Pack-Versions) :- 1270 option(versions(Available), PackOptions), !, 1271 maplist(version_url_info(Pack, PackOptions), Available, Versions). 1272pack_options_to_versions(Pack-PackOptions, Pack-[Version-[Info]]) :- 1273 option(url(URL), PackOptions), 1274 findall(Prop, option_info_prop(PackOptions, Prop), Pairs), 1275 dict_create(Info, #, 1276 [ pack-Pack, 1277 url-URL 1278 | Pairs 1279 ]), 1280 Version = Info.get(version, '0.0.0'). 1281 1282version_url_info(Pack, PackOptions, Version-URL, Version-[Info]) :- 1283 findall(Prop, 1284 ( option_info_prop(PackOptions, Prop), 1285 Prop \= version-_ 1286 ), 1287 Pairs), 1288 dict_create(Info, #, 1289 [ pack-Pack, 1290 url-URL, 1291 version-Version 1292 | Pairs 1293 ]). 1294 1295option_info_prop(PackOptions, Prop-Value) :- 1296 option_info(Prop), 1297 Opt =.. [Prop,Value], 1298 option(Opt, PackOptions). 1299 1300option_info(git). 1301option_info(hash). 1302option_info(version). 1303option_info(branch). 1304option_info(link).
1311compatible_version(Pack, Version, PackOptions) :- 1312 option(version(ReqVersion), PackOptions), 1313 !, 1314 satisfies_version(Pack, Version, ReqVersion). 1315compatible_version(_, _, _).
1322pack_options_compatible_with_info(Info, PackOptions) :-
1323 findall(Prop, option_info_prop(PackOptions, Prop), Pairs),
1324 dict_create(Dict, _, Pairs),
1325 Dict >:< Info.
1335download_plan(_Targets, Plan, Plan, _Options) :- 1336 exclude(installed, Plan, []), 1337 !. 1338download_plan(Targets, Plan0, Plan, Options) :- 1339 confirm(download_plan(Plan0), yes, Options), 1340 maplist(download_from_info(Options), Plan0, Plan1), 1341 plan_unsatisfied_dependencies(Plan1, Deps), 1342 ( Deps == [] 1343 -> Plan = Plan1 1344 ; print_message(informational, pack(new_dependencies(Deps))), 1345 prolog_description(Properties), 1346 query_pack_server(versions(Deps, Properties), Result, []), 1347 ( Result = true(Versions) 1348 -> pack_resolve(Targets, Plan1, Versions, Plan2, Options), 1349 !, 1350 download_plan(Targets, Plan2, Plan, Options) 1351 ; print_message(error, pack(query_failed(Result))), 1352 fail 1353 ) 1354 ).
1361plan_unsatisfied_dependencies(Plan, Deps) :- 1362 phrase(plan_unsatisfied_dependencies(Plan, Plan), Deps). 1363 1364plan_unsatisfied_dependencies([], _) --> 1365 []. 1366plan_unsatisfied_dependencies([Info|Infos], Plan) --> 1367 { Deps = Info.get(requires) }, 1368 plan_unsatisfied_requirements(Deps, Plan), 1369 plan_unsatisfied_dependencies(Infos, Plan). 1370 1371plan_unsatisfied_requirements([], _) --> 1372 []. 1373plan_unsatisfied_requirements([H|T], Plan) --> 1374 { is_prolog_token(H), % Can this fail? 1375 prolog_satisfies(H) 1376 }, 1377 !, 1378 plan_unsatisfied_requirements(T, Plan). 1379plan_unsatisfied_requirements([H|T], Plan) --> 1380 { member(Info, Plan), 1381 ( ( Version = Info.get(version) 1382 -> Provides = @(Info.get(pack), Version) 1383 ; Provides = Info.get(pack) 1384 ) 1385 ; member(Provides, Info.get(provides)) 1386 ), 1387 satisfies_req(Provides, H) 1388 }, !, 1389 plan_unsatisfied_requirements(T, Plan). 1390plan_unsatisfied_requirements([H|T], Plan) --> 1391 [H], 1392 plan_unsatisfied_requirements(T, Plan).
1401build_plan(Plan, Ordered, Options) :- 1402 partition(needs_rebuild_from_info(Options), Plan, ToBuild, NoBuild), 1403 maplist(attach_from_info(Options), NoBuild), 1404 ( ToBuild == [] 1405 -> Ordered = [] 1406 ; order_builds(ToBuild, Ordered), 1407 confirm(build_plan(Ordered), yes, Options), 1408 maplist(exec_plan_rebuild_step(Options), Ordered) 1409 ). 1410 1411needs_rebuild_from_info(Options, Info) :- 1412 needs_rebuild(Info.installed, Options).
1418needs_rebuild(PackDir, Options) :-
1419 ( is_foreign_pack(PackDir, _),
1420 \+ is_built(PackDir, Options)
1421 -> true
1422 ; is_autoload_pack(PackDir, Options),
1423 post_install_autoload(PackDir, Options),
1424 fail
1425 ).
1434is_built(PackDir, _Options) :-
1435 current_prolog_flag(arch, Arch),
1436 prolog_version_dotted(Version), % Major.Minor.Patch
1437 pack_status_dir(PackDir, built(Arch, Version, _)).
1444order_builds(ToBuild, Ordered) :- 1445 findall(Pack-Dep, dep_edge(ToBuild, Pack, Dep), Edges), 1446 maplist(get_dict(pack), ToBuild, Packs), 1447 vertices_edges_to_ugraph(Packs, Edges, Graph), 1448 ugraph_layers(Graph, Layers), 1449 append(Layers, PackNames), 1450 maplist(pack_info_from_name(ToBuild), PackNames, Ordered). 1451 1452dep_edge(Infos, Pack, Dep) :- 1453 member(Info, Infos), 1454 Pack = Info.pack, 1455 member(Dep, Info.get(dependency_for)), 1456 ( member(DepInfo, Infos), 1457 DepInfo.pack == Dep 1458 -> true 1459 ). 1460 1461:- det(pack_info_from_name/3). 1462pack_info_from_name(Infos, Pack, Info) :- 1463 member(Info, Infos), 1464 Info.pack == Pack, 1465 !.
1471exec_plan_rebuild_step(Options, Info) :-
1472 print_message(informational, pack(build(Info.pack, Info.installed))),
1473 pack_post_install(Info.pack, Info.installed, Options),
1474 attach_from_info(Options, Info).
1480attach_from_info(_Options, Info) :- 1481 Info.get(keep) == true, 1482 !. 1483attach_from_info(Options, Info) :- 1484 ( option(pack_directory(_Parent), Options) 1485 -> pack_attach(Info.installed, [duplicate(replace)]) 1486 ; pack_attach(Info.installed, []) 1487 ).
1497download_from_info(Options, Info0, Info), option(dryrun(true), Options) => 1498 print_term(Info0, [nl(true)]), 1499 Info = Info0. 1500download_from_info(_Options, Info0, Info), installed(Info0) => 1501 Info = Info0. 1502download_from_info(_Options, Info0, Info), 1503 _{upgrade:OldInfo, git:true} :< Info0, 1504 is_git_directory(OldInfo.installed) => 1505 PackDir = OldInfo.installed, 1506 git_checkout_version(PackDir, [commit(Info0.hash)]), 1507 reload_info(PackDir, Info0, Info). 1508download_from_info(Options, Info0, Info), 1509 _{upgrade:OldInfo} :< Info0 => 1510 PackDir = OldInfo.installed, 1511 detach_pack(OldInfo.pack, PackDir), 1512 delete_directory_and_contents(PackDir), 1513 del_dict(upgrade, Info0, _, Info1), 1514 download_from_info(Options, Info1, Info). 1515download_from_info(Options, Info0, Info), 1516 _{url:URL, git:true} :< Info0, \+ have_git => 1517 git_archive_url(URL, Archive, Options), 1518 download_from_info([git_url(URL)|Options], 1519 Info0.put(_{ url:Archive, 1520 git:false, 1521 git_url:URL 1522 }), 1523 Info1), 1524 % restore the hash to register the download. 1525 ( Info1.get(version) == Info0.get(version), 1526 Hash = Info0.get(hash) 1527 -> Info = Info1.put(hash, Hash) 1528 ; Info = Info1 1529 ). 1530download_from_info(Options, Info0, Info), 1531 _{url:URL} :< Info0 => 1532 select_option(pack_directory(Dir), Options, Options1), 1533 select_option(version(_), Options1, Options2, _), 1534 download_info_extra(Info0, InstallOptions, Options2), 1535 pack_download_from_url(URL, Dir, Info0.pack, 1536 [ interactive(false), 1537 pack_dir(PackDir) 1538 | InstallOptions 1539 ]), 1540 reload_info(PackDir, Info0, Info). 1541 1542download_info_extra(Info, [git(true),commit(Hash)|Options], Options) :- 1543 Info.get(git) == true, 1544 !, 1545 Hash = Info.get(commit, 'HEAD'). 1546download_info_extra(_, Options, Options). 1547 1548installed(Info) :- 1549 _ = Info.get(installed). 1550 1551detach_pack(Pack, PackDir) :- 1552 ( current_pack(Pack, PackDir) 1553 -> '$pack_detach'(Pack, PackDir) 1554 ; true 1555 ).
1564reload_info(_PackDir, Info, Info) :- 1565 _ = Info.get(installed), % we read it from the package 1566 !. 1567reload_info(PackDir, Info0, Info) :- 1568 local_pack_info(PackDir, Info1), 1569 Info = Info0.put(installed, PackDir) 1570 .put(downloaded, Info0.url) 1571 .put(Info1).
1578work_done(_, _, _, _, Options), 1579 option(silent(true), Options) => 1580 true. 1581work_done(Targets, Plan, Plan, [], _Options) => 1582 convlist(can_upgrade_target(Plan), Targets, CanUpgrade), 1583 ( CanUpgrade == [] 1584 -> pairs_keys(Targets, Packs), 1585 print_message(informational, pack(up_to_date(Packs))) 1586 ; print_message(informational, pack(installed_can_upgrade(CanUpgrade))) 1587 ). 1588work_done(_, _, _, _, _) => 1589 true. 1590 1591can_upgrade_target(Plan, Pack-_, Info) => 1592 member(Info, Plan), 1593 Info.pack == Pack, 1594 !, 1595 _ = Info.get(latest_version).
1602local_packs(Dir, Packs) :- 1603 findall(Pack, pack_in_subdir(Dir, Pack), Packs). 1604 1605pack_in_subdir(Dir, Info) :- 1606 directory_member(Dir, PackDir, 1607 [ file_type(directory), 1608 hidden(false) 1609 ]), 1610 local_pack_info(PackDir, Info). 1611 1612local_pack_info(PackDir, 1613 #{ pack: Pack, 1614 version: Version, 1615 title: Title, 1616 hash: Hash, 1617 url: URL, 1618 git: IsGit, 1619 requires: Requires, 1620 provides: Provides, 1621 conflicts: Conflicts, 1622 installed: PackDir 1623 }) :- 1624 directory_file_path(PackDir, 'pack.pl', MetaFile), 1625 exists_file(MetaFile), 1626 file_base_name(PackDir, DirName), 1627 findall(Term, pack_dir_info(PackDir, _, Term), Info), 1628 option(pack(Pack), Info, DirName), 1629 option(title(Title), Info, '<no title>'), 1630 option(version(Version), Info, '<no version>'), 1631 option(download(URL), Info, '<no download url>'), 1632 findall(Req, member(requires(Req), Info), Requires), 1633 findall(Prv, member(provides(Prv), Info), Provides), 1634 findall(Cfl, member(conflicts(Cfl), Info), Conflicts), 1635 ( have_git, 1636 is_git_directory(PackDir) 1637 -> git_hash(Hash, [directory(PackDir)]), 1638 IsGit = true 1639 ; Hash = '-', 1640 IsGit = false 1641 ). 1642 1643 1644 /******************************* 1645 * PROLOG VERSIONS * 1646 *******************************/
prolog(Dialect, Version)
1657prolog_description([prolog(swi(Version))]) :- 1658 prolog_version(Version). 1659 1660prolog_version(Version) :- 1661 current_prolog_flag(version_git, Version), 1662 !. 1663prolog_version(Version) :- 1664 prolog_version_dotted(Version). 1665 1666prolog_version_dotted(Version) :- 1667 current_prolog_flag(version_data, swi(Major, Minor, Patch, _)), 1668 VNumbers = [Major, Minor, Patch], 1669 atomic_list_concat(VNumbers, '.', Version).
1676is_prolog_token(Token), cmp(Token, prolog, _Cmp, _Version) => true. 1677is_prolog_token(prolog:_Feature) => true. 1678is_prolog_token(_) => fail.
requires(Token)
terms for
library(Lib)
1693prolog_satisfies(Token), cmp(Token, prolog, Cmp, ReqVersion) => 1694 prolog_version(CurrentVersion), 1695 cmp_versions(Cmp, CurrentVersion, ReqVersion). 1696prolog_satisfies(prolog:library(Lib)), atom(Lib) => 1697 exists_source(library(Lib)). 1698prolog_satisfies(prolog:Feature), atom(Feature) => 1699 current_prolog_flag(Feature, true). 1700prolog_satisfies(prolog:Feature), flag_value_feature(Feature, Flag, Value) => 1701 current_prolog_flag(Flag, Value). 1702 1703flag_value_feature(Feature, Flag, Value) :- 1704 compound(Feature), 1705 compound_name_arguments(Feature, Flag, [Value]). 1706 1707 1708 /******************************* 1709 * INFO * 1710 *******************************/
Requires library(archive), which is lazily loaded when needed.
1724:- if(exists_source(library(archive))). 1725ensure_loaded_archive :- 1726 current_predicate(archive_open/3), 1727 !. 1728ensure_loaded_archive :- 1729 use_module(library(archive)). 1730 1731pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :- 1732 ensure_loaded_archive, 1733 size_file(Archive, Bytes), 1734 setup_call_cleanup( 1735 archive_open(Archive, Handle, []), 1736 ( repeat, 1737 ( archive_next_header(Handle, InfoFile) 1738 -> true 1739 ; !, fail 1740 ) 1741 ), 1742 archive_close(Handle)), 1743 file_base_name(InfoFile, 'pack.pl'), 1744 atom_concat(Prefix, 'pack.pl', InfoFile), 1745 strip_option(Prefix, Pack, Strip), 1746 setup_call_cleanup( 1747 archive_open_entry(Handle, Stream), 1748 read_stream_to_terms(Stream, Info), 1749 close(Stream)), 1750 !, 1751 must_be(ground, Info), 1752 maplist(valid_term(pack_info_term), Info). 1753:- else. 1754pack_archive_info(_, _, _, _) :- 1755 existence_error(library, archive). 1756:- endif. 1757pack_archive_info(_, _, _, _) :- 1758 existence_error(pack_file, 'pack.pl'). 1759 1760strip_option('', _, []) :- !. 1761strip_option('./', _, []) :- !. 1762strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :- 1763 atom_concat(PrefixDir, /, Prefix), 1764 file_base_name(PrefixDir, Base), 1765 ( Base == Pack 1766 -> true 1767 ; pack_version_file(Pack, _, Base) 1768 -> true 1769 ; \+ sub_atom(PrefixDir, _, _, _, /) 1770 ). 1771 1772read_stream_to_terms(Stream, Terms) :- 1773 read(Stream, Term0), 1774 read_stream_to_terms(Term0, Stream, Terms). 1775 1776read_stream_to_terms(end_of_file, _, []) :- !. 1777read_stream_to_terms(Term0, Stream, [Term0|Terms]) :- 1778 read(Stream, Term1), 1779 read_stream_to_terms(Term1, Stream, Terms).
1787pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :- 1788 exists_directory(GitDir), 1789 !, 1790 git_ls_tree(Entries, [directory(GitDir)]), 1791 git_hash(Hash, [directory(GitDir)]), 1792 maplist(arg(4), Entries, Sizes), 1793 sum_list(Sizes, Bytes), 1794 dir_metadata(GitDir, Info). 1795 1796dir_metadata(GitDir, Info) :- 1797 directory_file_path(GitDir, 'pack.pl', InfoFile), 1798 read_file_to_terms(InfoFile, Info, [encoding(utf8)]), 1799 must_be(ground, Info), 1800 maplist(valid_term(pack_info_term), Info).
1806download_file_sanity_check(Archive, Pack, Info) :- 1807 info_field(name(PackName), Info), 1808 info_field(version(PackVersion), Info), 1809 pack_version_file(PackFile, FileVersion, Archive), 1810 must_match([Pack, PackName, PackFile], name), 1811 must_match([PackVersion, FileVersion], version). 1812 1813info_field(Field, Info) :- 1814 memberchk(Field, Info), 1815 ground(Field), 1816 !. 1817info_field(Field, _Info) :- 1818 functor(Field, FieldName, _), 1819 print_message(error, pack(missing(FieldName))), 1820 fail. 1821 1822must_match(Values, _Field) :- 1823 sort(Values, [_]), 1824 !. 1825must_match(Values, Field) :- 1826 print_message(error, pack(conflict(Field, Values))), 1827 fail. 1828 1829 1830 /******************************* 1831 * INSTALLATION * 1832 *******************************/
1846prepare_pack_dir(Dir, Options) :- 1847 exists_directory(Dir), 1848 !, 1849 ( empty_directory(Dir) 1850 -> true 1851 ; remove_existing_pack(Dir, Options) 1852 -> make_directory(Dir) 1853 ). 1854prepare_pack_dir(Dir, _) :- 1855 ( read_link(Dir, _, _) 1856 ; access_file(Dir, exist) 1857 ), 1858 !, 1859 delete_file(Dir), 1860 make_directory(Dir). 1861prepare_pack_dir(Dir, _) :- 1862 make_directory(Dir).
1868empty_directory(Dir) :- 1869 \+ ( directory_files(Dir, Entries), 1870 member(Entry, Entries), 1871 \+ special(Entry) 1872 ). 1873 1874special(.). 1875special(..).
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.1884remove_existing_pack(PackDir, Options) :- 1885 exists_directory(PackDir), 1886 !, 1887 ( ( option(upgrade(true), Options) 1888 ; confirm(remove_existing_pack(PackDir), yes, Options) 1889 ) 1890 -> delete_directory_and_contents(PackDir) 1891 ; print_message(error, pack(directory_exists(PackDir))), 1892 fail 1893 ). 1894remove_existing_pack(_, _).
1910pack_download_from_url(URL, PackTopDir, Pack, Options) :- 1911 option(git(true), Options), 1912 !, 1913 directory_file_path(PackTopDir, Pack, PackDir), 1914 prepare_pack_dir(PackDir, Options), 1915 ( option(branch(Branch), Options) 1916 -> Extra = ['--branch', Branch] 1917 ; Extra = [] 1918 ), 1919 run_process(path(git), [clone, URL, PackDir|Extra], []), 1920 git_checkout_version(PackDir, [update(false)|Options]), 1921 option(pack_dir(PackDir), Options, _). 1922pack_download_from_url(URL, PackTopDir, Pack, Options) :- 1923 download_url(URL), 1924 !, 1925 directory_file_path(PackTopDir, Pack, PackDir), 1926 prepare_pack_dir(PackDir, Options), 1927 pack_download_dir(PackTopDir, DownLoadDir), 1928 download_file(URL, Pack, DownloadBase, Options), 1929 directory_file_path(DownLoadDir, DownloadBase, DownloadFile), 1930 ( option(insecure(true), Options, false) 1931 -> TLSOptions = [cert_verify_hook(ssl_verify)] 1932 ; TLSOptions = [] 1933 ), 1934 print_message(informational, pack(download(begin, Pack, URL, DownloadFile))), 1935 setup_call_cleanup( 1936 http_open(URL, In, TLSOptions), 1937 setup_call_cleanup( 1938 open(DownloadFile, write, Out, [type(binary)]), 1939 copy_stream_data(In, Out), 1940 close(Out)), 1941 close(In)), 1942 print_message(informational, pack(download(end, Pack, URL, DownloadFile))), 1943 pack_archive_info(DownloadFile, Pack, Info, _), 1944 ( option(git_url(GitURL), Options) 1945 -> Origin = GitURL % implicit download from git. 1946 ; download_file_sanity_check(DownloadFile, Pack, Info), 1947 Origin = URL 1948 ), 1949 pack_unpack_from_local(DownloadFile, PackTopDir, Pack, PackDir, Options), 1950 pack_assert(PackDir, archive(DownloadFile, Origin)), 1951 option(pack_dir(PackDir), Options, _). 1952pack_download_from_url(URL, PackTopDir, Pack, Options) :- 1953 local_uri_file_name(URL, File), 1954 !, 1955 pack_unpack_from_local(File, PackTopDir, Pack, PackDir, Options), 1956 pack_assert(PackDir, archive(File, URL)), 1957 option(pack_dir(PackDir), Options, _). 1958pack_download_from_url(URL, _PackTopDir, _Pack, _Options) :- 1959 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')
.1983git_checkout_version(PackDir, Options) :- 1984 option(commit('HEAD'), Options), 1985 option(branch(Branch), Options), 1986 !, 1987 git_ensure_on_branch(PackDir, Branch), 1988 run_process(path(git), ['-C', PackDir, pull], []). 1989git_checkout_version(PackDir, Options) :- 1990 option(commit('HEAD'), Options), 1991 git_current_branch(_, [directory(PackDir)]), 1992 !, 1993 run_process(path(git), ['-C', PackDir, pull], []). 1994git_checkout_version(PackDir, Options) :- 1995 option(commit('HEAD'), Options), 1996 !, 1997 git_default_branch(Branch, [directory(PackDir)]), 1998 git_ensure_on_branch(PackDir, Branch), 1999 run_process(path(git), ['-C', PackDir, pull], []). 2000git_checkout_version(PackDir, Options) :- 2001 option(commit(Hash), Options), 2002 run_process(path(git), ['-C', PackDir, fetch], []), 2003 git_branches(Branches, [contains(Hash), directory(PackDir)]), 2004 git_process_output(['-C', PackDir, 'rev-parse' | Branches], 2005 read_lines_to_atoms(Commits), 2006 []), 2007 nth1(I, Commits, Hash), 2008 nth1(I, Branches, Branch), 2009 !, 2010 git_ensure_on_branch(PackDir, Branch). 2011git_checkout_version(PackDir, Options) :- 2012 option(commit(Hash), Options), 2013 !, 2014 run_process(path(git), ['-C', PackDir, checkout, '--quiet', Hash], []). 2015git_checkout_version(PackDir, Options) :- 2016 option(version(Version), Options), 2017 !, 2018 git_tags(Tags, [directory(PackDir)]), 2019 ( memberchk(Version, Tags) 2020 -> Tag = Version 2021 ; member(Tag, Tags), 2022 sub_atom(Tag, B, _, 0, Version), 2023 sub_atom(Tag, 0, B, _, Prefix), 2024 version_prefix(Prefix) 2025 -> true 2026 ; existence_error(version_tag, Version) 2027 ), 2028 run_process(path(git), ['-C', PackDir, checkout, Tag], []). 2029git_checkout_version(_PackDir, Options) :- 2030 option(fresh(true), Options), 2031 !. 2032git_checkout_version(PackDir, _Options) :- 2033 git_current_branch(_, [directory(PackDir)]), 2034 !, 2035 run_process(path(git), ['-C', PackDir, pull], []). 2036git_checkout_version(PackDir, _Options) :- 2037 git_default_branch(Branch, [directory(PackDir)]), 2038 git_ensure_on_branch(PackDir, Branch), 2039 run_process(path(git), ['-C', PackDir, pull], []).
2045git_ensure_on_branch(PackDir, Branch) :- 2046 git_current_branch(Branch, [directory(PackDir)]), 2047 !. 2048git_ensure_on_branch(PackDir, Branch) :- 2049 run_process(path(git), ['-C', PackDir, checkout, Branch], []). 2050 2051read_lines_to_atoms(Atoms, In) :- 2052 read_line_to_string(In, Line), 2053 ( Line == end_of_file 2054 -> Atoms = [] 2055 ; atom_string(Atom, Line), 2056 Atoms = [Atom|T], 2057 read_lines_to_atoms(T, In) 2058 ). 2059 2060version_prefix(Prefix) :- 2061 atom_codes(Prefix, Codes), 2062 phrase(version_prefix, Codes). 2063 2064version_prefix --> 2065 [C], 2066 { code_type(C, alpha) }, 2067 !, 2068 version_prefix. 2069version_prefix --> 2070 "-". 2071version_prefix --> 2072 "_". 2073version_prefix --> 2074 "".
2081download_file(URL, Pack, File, Options) :- 2082 option(version(Version), Options), 2083 !, 2084 file_name_extension(_, Ext, URL), 2085 format(atom(File), '~w-~w.~w', [Pack, Version, Ext]). 2086download_file(URL, Pack, File, _) :- 2087 file_base_name(URL,Basename), 2088 no_int_file_name_extension(Tag,Ext,Basename), 2089 tag_version(Tag,Version), 2090 !, 2091 format(atom(File0), '~w-~w', [Pack, Version]), 2092 file_name_extension(File0, Ext, File). 2093download_file(URL, _, File, _) :- 2094 file_base_name(URL, File).
2102:- public pack_url_file/2. 2103pack_url_file(URL, FileID) :- 2104 github_release_url(URL, Pack, Version), 2105 !, 2106 download_file(URL, Pack, FileID, [version(Version)]). 2107pack_url_file(URL, FileID) :- 2108 file_base_name(URL, FileID). 2109 2110% ssl_verify(+SSL, +ProblemCert, +AllCerts, +FirstCert, +Error) 2111% 2112% Used if insecure(true) is given to pack_install/2. Accepts any 2113% certificate. 2114 2115:- public ssl_verify/5. 2116ssl_verify(_SSL, 2117 _ProblemCertificate, _AllCertificates, _FirstCertificate, 2118 _Error). 2119 2120pack_download_dir(PackTopDir, DownLoadDir) :- 2121 directory_file_path(PackTopDir, 'Downloads', DownLoadDir), 2122 ( exists_directory(DownLoadDir) 2123 -> true 2124 ; make_directory(DownLoadDir) 2125 ), 2126 ( access_file(DownLoadDir, write) 2127 -> true 2128 ; permission_error(write, directory, DownLoadDir) 2129 ).
ftp://
are also download URLs, but we cannot download
from them.2137download_url(URL) :- 2138 atom(URL), 2139 uri_components(URL, Components), 2140 uri_data(scheme, Components, Scheme), 2141 download_scheme(Scheme). 2142 2143download_scheme(http). 2144download_scheme(https).
2154pack_post_install(Pack, PackDir, Options) :-
2155 post_install_foreign(Pack, PackDir, Options),
2156 post_install_autoload(PackDir, Options),
2157 attach_packs(PackDir, [duplicate(warning)]).
2165pack_rebuild :- 2166 forall(current_pack(Pack), 2167 ( print_message(informational, pack(rebuild(Pack))), 2168 pack_rebuild(Pack) 2169 )). 2170 2171pack_rebuild(Pack) :- 2172 current_pack(Pack, PackDir), 2173 !, 2174 post_install_foreign(Pack, PackDir, [rebuild(true)]). 2175pack_rebuild(Pack) :- 2176 unattached_pack(Pack, PackDir), 2177 !, 2178 post_install_foreign(Pack, PackDir, [rebuild(true)]). 2179pack_rebuild(Pack) :- 2180 existence_error(pack, Pack). 2181 2182unattached_pack(Pack, BaseDir) :- 2183 directory_file_path(Pack, 'pack.pl', PackFile), 2184 absolute_file_name(pack(PackFile), PackPath, 2185 [ access(read), 2186 file_errors(fail) 2187 ]), 2188 file_directory_name(PackPath, BaseDir).
2204post_install_foreign(Pack, PackDir, Options) :- 2205 is_foreign_pack(PackDir, _), 2206 !, 2207 ( pack_info_term(PackDir, pack_version(Version)) 2208 -> true 2209 ; Version = 1 2210 ), 2211 option(rebuild(Rebuild), Options, if_absent), 2212 current_prolog_flag(arch, Arch), 2213 prolog_version_dotted(PrologVersion), 2214 ( Rebuild == if_absent, 2215 foreign_present(PackDir, Arch) 2216 -> print_message(informational, pack(kept_foreign(Pack, Arch))), 2217 ( pack_status_dir(PackDir, built(Arch, _, _)) 2218 -> true 2219 ; pack_assert(PackDir, built(Arch, PrologVersion, downloaded)) 2220 ) 2221 ; BuildSteps0 = [[dependencies], [configure], build, install, [test]], 2222 ( Rebuild == true 2223 -> BuildSteps1 = [distclean|BuildSteps0] 2224 ; BuildSteps1 = BuildSteps0 2225 ), 2226 ( option(test(false), Options) 2227 -> delete(BuildSteps1, [test], BuildSteps2) 2228 ; BuildSteps2 = BuildSteps1 2229 ), 2230 ( option(clean(true), Options) 2231 -> append(BuildSteps2, [[clean]], BuildSteps) 2232 ; BuildSteps = BuildSteps2 2233 ), 2234 build_steps(BuildSteps, PackDir, [pack_version(Version)|Options]), 2235 pack_assert(PackDir, built(Arch, PrologVersion, built)) 2236 ). 2237post_install_foreign(_, _, _).
lib
directory for
the current architecture.
2248foreign_present(PackDir, Arch) :-
2249 atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
2250 exists_directory(ForeignBaseDir),
2251 !,
2252 atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
2253 exists_directory(ForeignDir),
2254 current_prolog_flag(shared_object_extension, Ext),
2255 atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
2256 expand_file_name(Pattern, Files),
2257 Files \== [].
2264is_foreign_pack(PackDir, Type) :- 2265 foreign_file(File, Type), 2266 directory_file_path(PackDir, File, Path), 2267 exists_file(Path). 2268 2269foreign_file('CMakeLists.txt', cmake). 2270foreign_file('configure', configure). 2271foreign_file('configure.in', autoconf). 2272foreign_file('configure.ac', autoconf). 2273foreign_file('Makefile.am', automake). 2274foreign_file('Makefile', make). 2275foreign_file('makefile', make). 2276foreign_file('conanfile.txt', conan). 2277foreign_file('conanfile.py', conan). 2278 2279 2280 /******************************* 2281 * AUTOLOAD * 2282 *******************************/
2288post_install_autoload(PackDir, Options) :- 2289 is_autoload_pack(PackDir, Options), 2290 !, 2291 directory_file_path(PackDir, prolog, PrologLibDir), 2292 make_library_index(PrologLibDir). 2293post_install_autoload(_, _). 2294 2295is_autoload_pack(PackDir, Options) :- 2296 option(autoload(true), Options, true), 2297 pack_info_term(PackDir, autoload(true)). 2298 2299 2300 /******************************* 2301 * UPGRADE * 2302 *******************************/
pack_install(Pack, [upgrade(true)])
.2308pack_upgrade(Pack) :- 2309 pack_install(Pack, [upgrade(true)]). 2310 2311 2312 /******************************* 2313 * REMOVE * 2314 *******************************/
true
delete dependencies without asking.2327pack_remove(Pack) :- 2328 pack_remove(Pack, []). 2329 2330pack_remove(Pack, Options) :- 2331 option(dependencies(false), Options), 2332 !, 2333 pack_remove_forced(Pack). 2334pack_remove(Pack, Options) :- 2335 ( dependents(Pack, Deps) 2336 -> ( option(dependencies(true), Options) 2337 -> true 2338 ; confirm_remove(Pack, Deps, Delete, Options) 2339 ), 2340 forall(member(P, Delete), pack_remove_forced(P)) 2341 ; pack_remove_forced(Pack) 2342 ). 2343 2344pack_remove_forced(Pack) :- 2345 catch('$pack_detach'(Pack, BaseDir), 2346 error(existence_error(pack, Pack), _), 2347 fail), 2348 !, 2349 print_message(informational, pack(remove(BaseDir))), 2350 delete_directory_and_contents(BaseDir). 2351pack_remove_forced(Pack) :- 2352 unattached_pack(Pack, BaseDir), 2353 !, 2354 delete_directory_and_contents(BaseDir). 2355pack_remove_forced(Pack) :- 2356 print_message(informational, error(existence_error(pack, Pack),_)). 2357 2358confirm_remove(Pack, Deps, Delete, Options) :- 2359 print_message(warning, pack(depends(Pack, Deps))), 2360 menu(pack(resolve_remove), 2361 [ [Pack] = remove_only(Pack), 2362 [Pack|Deps] = remove_deps(Pack, Deps), 2363 [] = cancel 2364 ], [], Delete, Options), 2365 Delete \== []. 2366 2367 2368 /******************************* 2369 * PUBLISH * 2370 *******************************/
?- 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 first2423pack_publish(Dir, Options) :- 2424 \+ download_url(Dir), 2425 is_git_directory(Dir), !, 2426 pack_git_info(Dir, _Hash, Metadata), 2427 prepare_repository(Dir, Metadata, Options), 2428 ( memberchk(download(URL), Metadata), 2429 git_url(URL, _) 2430 -> true 2431 ; option(remote(Remote), Options, origin), 2432 git_remote_url(Remote, RemoteURL, [directory(Dir)]), 2433 git_to_https_url(RemoteURL, URL) 2434 ), 2435 memberchk(version(Version), Metadata), 2436 pack_publish_(URL, 2437 [ version(Version) 2438 | Options 2439 ]). 2440pack_publish(Spec, Options) :- 2441 pack_publish_(Spec, Options). 2442 2443pack_publish_(Spec, Options) :- 2444 pack_default_options(Spec, Pack, Options, DefOptions), 2445 option(url(URL), DefOptions), 2446 valid_publish_url(URL, Options), 2447 prepare_build_location(Pack, Dir, Clean, Options), 2448 ( option(register(false), Options) 2449 -> InstallOptions = DefOptions 2450 ; InstallOptions = [publish(Pack)|DefOptions] 2451 ), 2452 call_cleanup(pack_install(Pack, 2453 [ pack(Pack) 2454 | InstallOptions 2455 ]), 2456 cleanup_publish(Clean, Dir)). 2457 2458cleanup_publish(true, Dir) :- 2459 !, 2460 delete_directory_and_contents(Dir). 2461cleanup_publish(_, _). 2462 2463valid_publish_url(URL, Options) :- 2464 option(register(Register), Options, true), 2465 ( Register == false 2466 -> true 2467 ; download_url(URL) 2468 -> true 2469 ; permission_error(publish, pack, URL) 2470 ). 2471 2472prepare_build_location(Pack, Dir, Clean, Options) :- 2473 ( option(pack_directory(Dir), Options) 2474 -> ensure_directory(Dir), 2475 ( option(clean(true), Options, true) 2476 -> delete_directory_contents(Dir) 2477 ; true 2478 ) 2479 ; tmp_file(pack, Dir), 2480 make_directory(Dir), 2481 Clean = true 2482 ), 2483 ( option(isolated(false), Options) 2484 -> detach_pack(Pack, _), 2485 attach_packs(Dir, [search(first)]) 2486 ; attach_packs(Dir, [replace(true)]) 2487 ).
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.2498prepare_repository(_Dir, _Metadata, Options) :- 2499 option(register(false), Options), 2500 !. 2501prepare_repository(Dir, Metadata, Options) :- 2502 git_dir_must_be_clean(Dir), 2503 git_must_be_on_default_branch(Dir, Options), 2504 tag_git_dir(Dir, Metadata, Action, Options), 2505 confirm(git_push, yes, Options), 2506 run_process(path(git), ['-C', file(Dir), push ], []), 2507 ( Action = push_tag(Tag) 2508 -> run_process(path(git), ['-C', file(Dir), push, origin, Tag ], []) 2509 ; true 2510 ). 2511 2512git_dir_must_be_clean(Dir) :- 2513 git_describe(Description, [directory(Dir)]), 2514 ( sub_atom(Description, _, _, 0, '-DIRTY') 2515 -> print_message(error, pack(git_not_clean(Dir))), 2516 fail 2517 ; true 2518 ). 2519 2520git_must_be_on_default_branch(Dir, Options) :- 2521 ( option(branch(Default), Options) 2522 -> true 2523 ; git_default_branch(Default, [directory(Dir)]) 2524 ), 2525 git_current_branch(Current, [directory(Dir)]), 2526 ( Default == Current 2527 -> true 2528 ; print_message(error, 2529 pack(git_branch_not_default(Dir, Default, Current))), 2530 fail 2531 ).
2540tag_git_dir(Dir, Metadata, Action, Options) :- 2541 memberchk(version(Version), Metadata), 2542 atom_concat('V', Version, Tag), 2543 git_tags(Tags, [directory(Dir)]), 2544 ( memberchk(Tag, Tags) 2545 -> git_tag_is_consistent(Dir, Tag, Action, Options) 2546 ; format(string(Message), 'Release ~w', [Version]), 2547 findall(Opt, git_tag_option(Opt, Options), Argv, 2548 [ '-m', Message, Tag ]), 2549 confirm(git_tag(Tag), yes, Options), 2550 run_process(path(git), ['-C', file(Dir), tag | Argv ], []), 2551 Action = push_tag(Tag) 2552 ). 2553 2554git_tag_option('-s', Options) :- option(sign(true), Options, true). 2555git_tag_option('-f', Options) :- option(force(true), Options, true). 2556 2557git_tag_is_consistent(Dir, Tag, Action, Options) :- 2558 format(atom(TagRef), 'refs/tags/~w', [Tag]), 2559 format(atom(CommitRef), 'refs/tags/~w^{}', [Tag]), 2560 option(remote(Remote), Options, origin), 2561 git_ls_remote(Dir, LocalTags, [tags(true)]), 2562 memberchk(CommitHash-CommitRef, LocalTags), 2563 ( git_hash(CommitHash, [directory(Dir)]) 2564 -> true 2565 ; print_message(error, pack(git_release_tag_not_at_head(Tag))), 2566 fail 2567 ), 2568 memberchk(TagHash-TagRef, LocalTags), 2569 git_ls_remote(Remote, RemoteTags, [tags(true)]), 2570 ( memberchk(RemoteCommitHash-CommitRef, RemoteTags), 2571 memberchk(RemoteTagHash-TagRef, RemoteTags) 2572 -> ( RemoteCommitHash == CommitHash, 2573 RemoteTagHash == TagHash 2574 -> Action = none 2575 ; print_message(error, pack(git_tag_out_of_sync(Tag))), 2576 fail 2577 ) 2578 ; Action = push_tag(Tag) 2579 ).
2587git_to_https_url(URL, URL) :- 2588 download_url(URL), 2589 !. 2590git_to_https_url(GitURL, URL) :- 2591 atom_concat('git@github.com:', Repo, GitURL), 2592 !, 2593 atom_concat('https://github.com/', Repo, URL). 2594git_to_https_url(GitURL, _) :- 2595 print_message(error, pack(git_no_https(GitURL))), 2596 fail. 2597 2598 2599 /******************************* 2600 * PROPERTIES * 2601 *******************************/
README
file (if present)TODO
file (if present)2624pack_property(Pack, Property) :- 2625 findall(Pack-Property, pack_property_(Pack, Property), List), 2626 member(Pack-Property, List). % make det if applicable 2627 2628pack_property_(Pack, Property) :- 2629 pack_info(Pack, _, Property). 2630pack_property_(Pack, Property) :- 2631 \+ \+ info_file(Property, _), 2632 '$pack':pack(Pack, BaseDir), 2633 access_file(BaseDir, read), 2634 directory_files(BaseDir, Files), 2635 member(File, Files), 2636 info_file(Property, Pattern), 2637 downcase_atom(File, Pattern), 2638 directory_file_path(BaseDir, File, InfoFile), 2639 arg(1, Property, InfoFile). 2640 2641info_file(readme(_), 'readme.txt'). 2642info_file(readme(_), 'readme'). 2643info_file(todo(_), 'todo.txt'). 2644info_file(todo(_), 'todo'). 2645 2646 2647 /******************************* 2648 * VERSION LOGIC * 2649 *******************************/
mypack-1.5
.2658pack_version_file(Pack, Version, GitHubRelease) :- 2659 atomic(GitHubRelease), 2660 github_release_url(GitHubRelease, Pack, Version), 2661 !. 2662pack_version_file(Pack, Version, Path) :- 2663 atomic(Path), 2664 file_base_name(Path, File), 2665 no_int_file_name_extension(Base, _Ext, File), 2666 atom_codes(Base, Codes), 2667 ( phrase(pack_version(Pack, Version), Codes), 2668 safe_pack_name(Pack) 2669 -> true 2670 ). 2671 2672no_int_file_name_extension(Base, Ext, File) :- 2673 file_name_extension(Base0, Ext0, File), 2674 \+ atom_number(Ext0, _), 2675 !, 2676 Base = Base0, 2677 Ext = Ext0. 2678no_int_file_name_extension(File, '', File).
2685safe_pack_name(Name) :- 2686 atom_length(Name, Len), 2687 Len >= 3, % demand at least three length 2688 atom_codes(Name, Codes), 2689 maplist(safe_pack_char, Codes), 2690 !. 2691 2692safe_pack_char(C) :- between(0'a, 0'z, C), !. 2693safe_pack_char(C) :- between(0'A, 0'Z, C), !. 2694safe_pack_char(C) :- between(0'0, 0'9, C), !. 2695safe_pack_char(0'_).
2701pack_version(Pack, Version) --> 2702 string(Codes), "-", 2703 version(Parts), 2704 !, 2705 { atom_codes(Pack, Codes), 2706 atomic_list_concat(Parts, '.', Version) 2707 }. 2708 2709version([H|T]) --> 2710 version_part(H), 2711 ( "." 2712 -> version(T) 2713 ; {T=[]} 2714 ). 2715 2716version_part(*) --> "*", !. 2717version_part(Int) --> integer(Int). 2718 2719 2720 /******************************* 2721 * GIT LOGIC * 2722 *******************************/ 2723 2724have_git :- 2725 process_which(path(git), _).
2732git_url(URL, Pack) :- 2733 uri_components(URL, Components), 2734 uri_data(scheme, Components, Scheme), 2735 nonvar(Scheme), % must be full URL 2736 uri_data(path, Components, Path), 2737 ( Scheme == git 2738 -> true 2739 ; git_download_scheme(Scheme), 2740 file_name_extension(_, git, Path) 2741 ; git_download_scheme(Scheme), 2742 catch(git_ls_remote(URL, _, [refs(['HEAD']), error(_)]), _, fail) 2743 -> true 2744 ), 2745 file_base_name(Path, PackExt), 2746 ( file_name_extension(Pack, git, PackExt) 2747 -> true 2748 ; Pack = PackExt 2749 ), 2750 ( safe_pack_name(Pack) 2751 -> true 2752 ; domain_error(pack_name, Pack) 2753 ). 2754 2755git_download_scheme(http). 2756git_download_scheme(https).
https:/github.com/<owner>/<pack>/archive/[vV]?<version>.zip'
2765github_release_url(URL, Pack, Version) :- 2766 uri_components(URL, Components), 2767 uri_data(authority, Components, 'github.com'), 2768 uri_data(scheme, Components, Scheme), 2769 download_scheme(Scheme), 2770 uri_data(path, Components, Path), 2771 github_archive_path(Archive,Pack,File), 2772 atomic_list_concat(Archive, /, Path), 2773 file_name_extension(Tag, Ext, File), 2774 github_archive_extension(Ext), 2775 tag_version(Tag, Version), 2776 !. 2777 2778github_archive_path(['',_User,Pack,archive,File],Pack,File). 2779github_archive_path(['',_User,Pack,archive,refs,tags,File],Pack,File). 2780 2781github_archive_extension(tgz). 2782github_archive_extension(zip).
[vV]?int(\.int)*
.2789tag_version(Tag, Version) :- 2790 version_tag_prefix(Prefix), 2791 atom_concat(Prefix, Version, Tag), 2792 is_version(Version). 2793 2794version_tag_prefix(v). 2795version_tag_prefix('V'). 2796version_tag_prefix('').
2805git_archive_url(URL, Archive, Options) :- 2806 uri_components(URL, Components), 2807 uri_data(authority, Components, 'github.com'), 2808 uri_data(path, Components, Path), 2809 atomic_list_concat(['', User, RepoGit], /, Path), 2810 $, 2811 remove_git_ext(RepoGit, Repo), 2812 git_archive_version(Version, Options), 2813 atomic_list_concat(['', User, Repo, zip, Version], /, ArchivePath), 2814 uri_edit([ path(ArchivePath), 2815 host('codeload.github.com') 2816 ], 2817 URL, Archive). 2818git_archive_url(URL, _, _) :- 2819 print_message(error, pack(no_git(URL))), 2820 fail. 2821 2822remove_git_ext(RepoGit, Repo) :- 2823 file_name_extension(Repo, git, RepoGit), 2824 !. 2825remove_git_ext(Repo, Repo). 2826 2827git_archive_version(Version, Options) :- 2828 option(commit(Version), Options), 2829 !. 2830git_archive_version(Version, Options) :- 2831 option(branch(Version), Options), 2832 !. 2833git_archive_version(Version, Options) :- 2834 option(version(Version), Options), 2835 !. 2836git_archive_version('HEAD', _). 2837 2838 /******************************* 2839 * QUERY CENTRAL DB * 2840 *******************************/
2847register_downloads(_, Options) :- 2848 option(register(false), Options), 2849 \+ option(do_publish(_), Options), 2850 !. 2851register_downloads(Infos, Options) :- 2852 convlist(download_data, Infos, Data), 2853 ( Data == [] 2854 -> true 2855 ; query_pack_server(downloaded(Data), Reply, Options), 2856 ( option(do_publish(Pack), Options) 2857 -> ( member(Info, Infos), 2858 Info.pack == Pack 2859 -> true 2860 ), 2861 ( Reply = true(Actions), 2862 memberchk(Pack-Result, Actions) 2863 -> ( registered(Result) 2864 -> true 2865 ; print_message(error, pack(publish_failed(Info, Result))), 2866 fail 2867 ) 2868 ; print_message(error, pack(publish_failed(Info, false))) 2869 ) 2870 ; true 2871 ) 2872 ). 2873 2874registered(git(_URL)). 2875registered(file(_URL)). 2876 2877publish_download(Infos, Options) :- 2878 select_option(publish(Pack), Options, Options1), 2879 !, 2880 register_downloads(Infos, [do_publish(Pack)|Options1]). 2881publish_download(_Infos, _Options). 2882 2883download_data(Info, Data), 2884 Info.get(git) == true => % Git clone 2885 Data = download(URL, Hash, Metadata), 2886 URL = Info.get(downloaded), 2887 pack_git_info(Info.installed, Hash, Metadata). 2888download_data(Info, Data), 2889 _{git_url:URL,hash:Hash} :< Info, Hash \== (-) => 2890 Data = download(URL, Hash, Metadata), % Git downloaded as zip 2891 dir_metadata(Info.installed, Metadata). 2892download_data(Info, Data) => % Archive download. 2893 Data = download(URL, Hash, Metadata), 2894 URL = Info.get(downloaded), 2895 download_url(URL), 2896 pack_status_dir(Info.installed, archive(Archive, URL)), 2897 file_sha1(Archive, Hash), 2898 pack_archive_info(Archive, _Pack, Metadata, _).
2905query_pack_server(Query, Result, Options) :- 2906 ( option(server(ServerOpt), Options) 2907 -> server_url(ServerOpt, ServerBase) 2908 ; setting(server, ServerBase), 2909 ServerBase \== '' 2910 ), 2911 atom_concat(ServerBase, query, Server), 2912 format(codes(Data), '~q.~n', Query), 2913 info_level(Informational, Options), 2914 print_message(Informational, pack(contacting_server(Server))), 2915 setup_call_cleanup( 2916 http_open(Server, In, 2917 [ post(codes(application/'x-prolog', Data)), 2918 header(content_type, ContentType) 2919 ]), 2920 read_reply(ContentType, In, Result), 2921 close(In)), 2922 message_severity(Result, Level, Informational), 2923 print_message(Level, pack(server_reply(Result))). 2924 2925server_url(URL0, URL) :- 2926 uri_components(URL0, Components), 2927 uri_data(scheme, Components, Scheme), 2928 var(Scheme), 2929 !, 2930 atom_concat('https://', URL0, URL1), 2931 server_url(URL1, URL). 2932server_url(URL0, URL) :- 2933 uri_components(URL0, Components), 2934 uri_data(path, Components, ''), 2935 !, 2936 uri_edit([path('/pack/')], URL0, URL). 2937server_url(URL, URL). 2938 2939read_reply(ContentType, In, Result) :- 2940 sub_atom(ContentType, 0, _, _, 'application/x-prolog'), 2941 !, 2942 set_stream(In, encoding(utf8)), 2943 read(In, Result). 2944read_reply(ContentType, In, _Result) :- 2945 read_string(In, 500, String), 2946 print_message(error, pack(no_prolog_response(ContentType, String))), 2947 fail. 2948 2949info_level(Level, Options) :- 2950 option(silent(true), Options), 2951 !, 2952 Level = silent. 2953info_level(informational, _). 2954 2955message_severity(true(_), Informational, Informational). 2956message_severity(false, warning, _). 2957message_severity(exception(_), error, _). 2958 2959 2960 /******************************* 2961 * WILDCARD URIs * 2962 *******************************/
2971available_download_versions(URL, Versions) :- 2972 wildcard_pattern(URL), 2973 github_url(URL, User, Repo), 2974 !, 2975 findall(Version-VersionURL, 2976 github_version(User, Repo, Version, VersionURL), 2977 Versions). 2978available_download_versions(URL, Versions) :- 2979 wildcard_pattern(URL), 2980 !, 2981 file_directory_name(URL, DirURL0), 2982 ensure_slash(DirURL0, DirURL), 2983 print_message(informational, pack(query_versions(DirURL))), 2984 setup_call_cleanup( 2985 http_open(DirURL, In, []), 2986 load_html(stream(In), DOM, 2987 [ syntax_errors(quiet) 2988 ]), 2989 close(In)), 2990 findall(MatchingURL, 2991 absolute_matching_href(DOM, URL, MatchingURL), 2992 MatchingURLs), 2993 ( MatchingURLs == [] 2994 -> print_message(warning, pack(no_matching_urls(URL))) 2995 ; true 2996 ), 2997 versioned_urls(MatchingURLs, VersionedURLs), 2998 sort_version_pairs(VersionedURLs, Versions), 2999 print_message(informational, pack(found_versions(Versions))). 3000available_download_versions(URL, [Version-URL]) :- 3001 ( pack_version_file(_Pack, Version0, URL) 3002 -> Version = Version0 3003 ; Version = '0.0.0' 3004 ).
3010sort_version_pairs(Pairs, Sorted) :- 3011 map_list_to_pairs(version_pair_sort_key_, Pairs, Keyed), 3012 sort(1, @>=, Keyed, SortedKeyed), 3013 pairs_values(SortedKeyed, Sorted). 3014 3015version_pair_sort_key_(Version-_Data, Key) :- 3016 version_sort_key(Version, Key). 3017 3018version_sort_key(Version, Key) :- 3019 split_string(Version, ".", "", Parts), 3020 maplist(number_string, Key, Parts), 3021 !. 3022version_sort_key(Version, _) :- 3023 domain_error(version, Version).
3029github_url(URL, User, Repo) :-
3030 uri_components(URL, uri_components(https,'github.com',Path,_,_)),
3031 atomic_list_concat(['',User,Repo|_], /, Path).
3039github_version(User, Repo, Version, VersionURI) :- 3040 atomic_list_concat(['',repos,User,Repo,tags], /, Path1), 3041 uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)), 3042 setup_call_cleanup( 3043 http_open(ApiUri, In, 3044 [ request_header('Accept'='application/vnd.github.v3+json') 3045 ]), 3046 json_read_dict(In, Dicts), 3047 close(In)), 3048 member(Dict, Dicts), 3049 atom_string(Tag, Dict.name), 3050 tag_version(Tag, Version), 3051 atom_string(VersionURI, Dict.zipball_url). 3052 3053wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *). 3054wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?). 3055 3056ensure_slash(Dir, DirS) :- 3057 ( sub_atom(Dir, _, _, 0, /) 3058 -> DirS = Dir 3059 ; atom_concat(Dir, /, DirS) 3060 ). 3061 3062absolute_matching_href(DOM, Pattern, Match) :- 3063 xpath(DOM, //a(@href), HREF), 3064 uri_normalized(HREF, Pattern, Match), 3065 wildcard_match(Pattern, Match). 3066 3067versioned_urls([], []). 3068versioned_urls([H|T0], List) :- 3069 file_base_name(H, File), 3070 ( pack_version_file(_Pack, Version, File) 3071 -> List = [Version-H|T] 3072 ; List = T 3073 ), 3074 versioned_urls(T0, T). 3075 3076 3077 /******************************* 3078 * DEPENDENCIES * 3079 *******************************/
3087pack_provides(Pack, Pack@Version) :- 3088 current_pack(Pack), 3089 once(pack_info(Pack, version, version(Version))). 3090pack_provides(Pack, Provides) :- 3091 findall(Prv, pack_info(Pack, dependency, provides(Prv)), PrvList), 3092 member(Provides, PrvList). 3093 3094pack_requires(Pack, Requires) :- 3095 current_pack(Pack), 3096 findall(Req, pack_info(Pack, dependency, requires(Req)), ReqList), 3097 member(Requires, ReqList). 3098 3099pack_conflicts(Pack, Conflicts) :- 3100 current_pack(Pack), 3101 findall(Cfl, pack_info(Pack, dependency, conflicts(Cfl)), CflList), 3102 member(Conflicts, CflList).
3109pack_depends_on(Pack, Dependency) :- 3110 ground(Pack), 3111 !, 3112 pack_requires(Pack, Requires), 3113 \+ is_prolog_token(Requires), 3114 pack_provides(Dependency, Provides), 3115 satisfies_req(Provides, Requires). 3116pack_depends_on(Pack, Dependency) :- 3117 ground(Dependency), 3118 !, 3119 pack_provides(Dependency, Provides), 3120 pack_requires(Pack, Requires), 3121 satisfies_req(Provides, Requires). 3122pack_depends_on(Pack, Dependency) :- 3123 current_pack(Pack), 3124 pack_depends_on(Pack, Dependency).
3131dependents(Pack, Deps) :- 3132 setof(Dep, dependent(Pack, Dep, []), Deps). 3133 3134dependent(Pack, Dep, Seen) :- 3135 pack_depends_on(Dep0, Pack), 3136 \+ memberchk(Dep0, Seen), 3137 ( Dep = Dep0 3138 ; dependent(Dep0, Dep, [Dep0|Seen]) 3139 ).
3145validate_dependencies :- 3146 setof(Issue, pack_dependency_issue(_, Issue), Issues), 3147 !, 3148 print_message(warning, pack(dependency_issues(Issues))). 3149validate_dependencies.
3161pack_dependency_issue(Pack, Issue) :- 3162 current_pack(Pack), 3163 pack_dependency_issue_(Pack, Issue). 3164 3165pack_dependency_issue_(Pack, unsatisfied(Pack, Requires)) :- 3166 pack_requires(Pack, Requires), 3167 ( is_prolog_token(Requires) 3168 -> \+ prolog_satisfies(Requires) 3169 ; \+ ( pack_provides(_, Provides), 3170 satisfies_req(Provides, Requires) ) 3171 ). 3172pack_dependency_issue_(Pack, conflicts(Pack, Conflicts)) :- 3173 pack_conflicts(Pack, Conflicts), 3174 ( is_prolog_token(Conflicts) 3175 -> prolog_satisfies(Conflicts) 3176 ; pack_provides(_, Provides), 3177 satisfies_req(Provides, Conflicts) 3178 ). 3179 3180 3181 /******************************* 3182 * RECORD PACK FACTS * 3183 *******************************/
built
if we built it or downloaded
if it was downloaded.true
, pack was installed as dependency.3199pack_assert(PackDir, Fact) :- 3200 must_be(ground, Fact), 3201 findall(Term, pack_status_dir(PackDir, Term), Facts0), 3202 update_facts(Facts0, Fact, Facts), 3203 OpenOptions = [encoding(utf8), lock(exclusive)], 3204 status_file(PackDir, StatusFile), 3205 ( Facts == Facts0 3206 -> true 3207 ; Facts0 \== [], 3208 append(Facts0, New, Facts) 3209 -> setup_call_cleanup( 3210 open(StatusFile, append, Out, OpenOptions), 3211 maplist(write_fact(Out), New), 3212 close(Out)) 3213 ; setup_call_cleanup( 3214 open(StatusFile, write, Out, OpenOptions), 3215 ( write_facts_header(Out), 3216 maplist(write_fact(Out), Facts) 3217 ), 3218 close(Out)) 3219 ). 3220 3221update_facts([], Fact, [Fact]) :- 3222 !. 3223update_facts([H|T], Fact, [Fact|T]) :- 3224 general_pack_fact(Fact, GenFact), 3225 general_pack_fact(H, GenTerm), 3226 GenFact =@= GenTerm, 3227 !. 3228update_facts([H|T0], Fact, [H|T]) :- 3229 update_facts(T0, Fact, T). 3230 3231general_pack_fact(built(Arch, _Version, _How), General) => 3232 General = built(Arch, _, _). 3233general_pack_fact(Term, General), compound(Term) => 3234 compound_name_arity(Term, Name, Arity), 3235 compound_name_arity(General, Name, Arity). 3236general_pack_fact(Term, General) => 3237 General = Term. 3238 3239write_facts_header(Out) :- 3240 format(Out, '% Fact status file. Managed by package manager.~n', []). 3241 3242write_fact(Out, Term) :- 3243 format(Out, '~q.~n', [Term]).
status.db
.3251pack_status(Pack, Fact) :- 3252 current_pack(Pack, PackDir), 3253 pack_status_dir(PackDir, Fact). 3254 3255pack_status_dir(PackDir, Fact) :- 3256 det_if(ground(Fact), pack_status_(PackDir, Fact)). 3257 3258pack_status_(PackDir, Fact) :- 3259 status_file(PackDir, StatusFile), 3260 catch(term_in_file(valid_term(pack_status_term), StatusFile, Fact), 3261 error(existence_error(source_sink, StatusFile), _), 3262 fail). 3263 3264pack_status_term(built(atom, version, oneof([built,downloaded]))). 3265pack_status_term(automatic(boolean)). 3266pack_status_term(archive(atom, atom)).
3276update_automatic(Info) :- 3277 _ = Info.get(dependency_for), 3278 \+ pack_status(Info.installed, automatic(_)), 3279 !, 3280 pack_assert(Info.installed, automatic(true)). 3281update_automatic(Info) :- 3282 pack_assert(Info.installed, automatic(false)). 3283 3284status_file(PackDir, StatusFile) :- 3285 directory_file_path(PackDir, 'status.db', StatusFile). 3286 3287 /******************************* 3288 * USER INTERACTION * 3289 *******************************/ 3290 3291:- multifile prolog:message//1.
3295menu(_Question, _Alternatives, Default, Selection, Options) :- 3296 option(interactive(false), Options), 3297 !, 3298 Selection = Default. 3299menu(Question, Alternatives, Default, Selection, _) :- 3300 length(Alternatives, N), 3301 between(1, 5, _), 3302 print_message(query, Question), 3303 print_menu(Alternatives, Default, 1), 3304 print_message(query, pack(menu(select))), 3305 read_selection(N, Choice), 3306 !, 3307 ( Choice == default 3308 -> Selection = Default 3309 ; nth1(Choice, Alternatives, Selection=_) 3310 -> true 3311 ). 3312 [], _, _) (. 3314print_menu([Value=Label|T], Default, I) :- 3315 ( Value == Default 3316 -> print_message(query, pack(menu(default_item(I, Label)))) 3317 ; print_message(query, pack(menu(item(I, Label)))) 3318 ), 3319 I2 is I + 1, 3320 print_menu(T, Default, I2). 3321 3322read_selection(Max, Choice) :- 3323 get_single_char(Code), 3324 ( answered_default(Code) 3325 -> Choice = default 3326 ; code_type(Code, digit(Choice)), 3327 between(1, Max, Choice) 3328 -> true 3329 ; print_message(warning, pack(menu(reply(1,Max)))), 3330 fail 3331 ).
3339confirm(_Question, Default, Options) :- 3340 Default \== none, 3341 option(interactive(false), Options, true), 3342 !, 3343 Default == yes. 3344confirm(Question, Default, _) :- 3345 between(1, 5, _), 3346 print_message(query, pack(confirm(Question, Default))), 3347 read_yes_no(YesNo, Default), 3348 !, 3349 format(user_error, '~N', []), 3350 YesNo == yes. 3351 3352read_yes_no(YesNo, Default) :- 3353 get_single_char(Code), 3354 code_yes_no(Code, Default, YesNo), 3355 !. 3356 3357code_yes_no(0'y, _, yes). 3358code_yes_no(0'Y, _, yes). 3359code_yes_no(0'n, _, no). 3360code_yes_no(0'N, _, no). 3361code_yes_no(_, none, _) :- !, fail. 3362code_yes_no(C, Default, Default) :- 3363 answered_default(C). 3364 3365answered_default(0'\r). 3366answered_default(0'\n). 3367answered_default(0'\s). 3368 3369 3370 /******************************* 3371 * MESSAGES * 3372 *******************************/ 3373 3374:- multifile prolog:message//1. 3375 3376prologmessage(pack(Message)) --> 3377 message(Message). 3378 3379:- discontiguous 3380 message//1, 3381 label//1. 3382 3383message(invalid_term(pack_info_term, Term)) --> 3384 [ 'Invalid package meta data: ~q'-[Term] ]. 3385message(invalid_term(pack_status_term, Term)) --> 3386 [ 'Invalid package status data: ~q'-[Term] ]. 3387message(directory_exists(Dir)) --> 3388 [ 'Package target directory exists and is not empty:', nl, 3389 '\t~q'-[Dir] 3390 ]. 3391message(already_installed(pack(Pack, Version))) --> 3392 [ 'Pack `~w'' is already installed @~w'-[Pack, Version] ]. 3393message(already_installed(Pack)) --> 3394 [ 'Pack `~w'' is already installed. Package info:'-[Pack] ]. 3395message(kept_foreign(Pack, Arch)) --> 3396 [ 'Found foreign libraries for architecture '-[], 3397 ansi(code, '~q', [Arch]), nl, 3398 'Use ', ansi(code, '?- pack_rebuild(~q).', [Pack]), 3399 ' to rebuild from sources'-[] 3400 ]. 3401message(no_pack_installed(Pack)) --> 3402 [ 'No pack ~q installed. Use ?- pack_list(Pattern) to search'-[Pack] ]. 3403message(dependency_issues(Issues)) --> 3404 [ 'The current set of packs has dependency issues:', nl ], 3405 dep_issues(Issues). 3406message(depends(Pack, Deps)) --> 3407 [ 'The following packs depend on `~w\':'-[Pack], nl ], 3408 pack_list(Deps). 3409message(remove(PackDir)) --> 3410 [ 'Removing ~q and contents'-[PackDir] ]. 3411message(remove_existing_pack(PackDir)) --> 3412 [ 'Remove old installation in ~q'-[PackDir] ]. 3413message(download_plan(Plan)) --> 3414 [ ansi(bold, 'Installation plan:', []), nl ], 3415 install_plan(Plan, Actions), 3416 install_label(Actions). 3417message(build_plan(Plan)) --> 3418 [ ansi(bold, 'The following packs have post install scripts:', []), nl ], 3419 msg_build_plan(Plan), 3420 [ nl, ansi(bold, 'Run scripts?', []) ]. 3421message(no_meta_data(BaseDir)) --> 3422 [ 'Cannot find pack.pl inside directory ~q. Not a package?'-[BaseDir] ]. 3423message(search_no_matches(Name)) --> 3424 [ 'Search for "~w", returned no matching packages'-[Name] ]. 3425message(rebuild(Pack)) --> 3426 [ 'Checking pack "~w" for rebuild ...'-[Pack] ]. 3427message(up_to_date([Pack])) --> 3428 !, 3429 [ 'Pack ' ], msg_pack(Pack), [' is up-to-date' ]. 3430message(up_to_date(Packs)) --> 3431 [ 'Packs ' ], sequence(msg_pack, [', '], Packs), [' are up-to-date' ]. 3432message(installed_can_upgrade(List)) --> 3433 sequence(msg_can_upgrade_target, [nl], List). 3434message(new_dependencies(Deps)) --> 3435 [ 'Found new dependencies after downloading (~p).'-[Deps], nl ]. 3436message(query_versions(URL)) --> 3437 [ 'Querying "~w" to find new versions ...'-[URL] ]. 3438message(no_matching_urls(URL)) --> 3439 [ 'Could not find any matching URL: ~q'-[URL] ]. 3440message(found_versions([Latest-_URL|More])) --> 3441 { length(More, Len) }, 3442 [ ' Latest version: ~w (~D older)'-[Latest, Len] ]. 3443message(build(Pack, PackDir)) --> 3444 [ ansi(bold, 'Building pack ~w in directory ~w', [Pack, PackDir]) ]. 3445message(contacting_server(Server)) --> 3446 [ 'Contacting server at ~w ...'-[Server], flush ]. 3447message(server_reply(true(_))) --> 3448 [ at_same_line, ' ok'-[] ]. 3449message(server_reply(false)) --> 3450 [ at_same_line, ' done'-[] ]. 3451message(server_reply(exception(E))) --> 3452 [ 'Server reported the following error:'-[], nl ], 3453 '$messages':translate_message(E). 3454message(cannot_create_dir(Alias)) --> 3455 { findall(PackDir, 3456 absolute_file_name(Alias, PackDir, [solutions(all)]), 3457 PackDirs0), 3458 sort(PackDirs0, PackDirs) 3459 }, 3460 [ 'Cannot find a place to create a package directory.'-[], 3461 'Considered:'-[] 3462 ], 3463 candidate_dirs(PackDirs). 3464message(conflict(version, [PackV, FileV])) --> 3465 ['Version mismatch: pack.pl: '-[]], msg_version(PackV), 3466 [', file claims version '-[]], msg_version(FileV). 3467message(conflict(name, [PackInfo, FileInfo])) --> 3468 ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]], 3469 [', file claims ~w: ~p'-[FileInfo]]. 3470message(no_prolog_response(ContentType, String)) --> 3471 [ 'Expected Prolog response. Got content of type ~p'-[ContentType], nl, 3472 '~s'-[String] 3473 ]. 3474message(download(begin, Pack, _URL, _DownloadFile)) --> 3475 [ 'Downloading ' ], msg_pack(Pack), [ ' ... ', flush ]. 3476message(download(end, _, _, File)) --> 3477 { size_file(File, Bytes) }, 3478 [ at_same_line, '~D bytes'-[Bytes] ]. 3479message(no_git(URL)) --> 3480 [ 'Cannot install from git repository ', url(URL), '.', nl, 3481 'Cannot find git program and do not know how to download the code', nl, 3482 'from this git service. Please install git and retry.' 3483 ]. 3484message(git_no_https(GitURL)) --> 3485 [ 'Do not know how to get an HTTP(s) URL for ', url(GitURL) ]. 3486message(git_branch_not_default(Dir, Default, Current)) --> 3487 [ 'GIT current branch on ', url(Dir), ' is not default.', nl, 3488 ' Current branch: ', ansi(code, '~w', [Current]), 3489 ' default: ', ansi(code, '~w', [Default]) 3490 ]. 3491message(git_not_clean(Dir)) --> 3492 [ 'GIT working directory is dirty: ', url(Dir), nl, 3493 'Your repository must be clean before publishing.' 3494 ]. 3495message(git_push) --> 3496 [ 'Push release to GIT origin?' ]. 3497message(git_tag(Tag)) --> 3498 [ 'Tag repository with release tag ', ansi(code, '~w', [Tag]) ]. 3499message(git_release_tag_not_at_head(Tag)) --> 3500 [ 'Release tag ', ansi(code, '~w', [Tag]), ' is not at HEAD.', nl, 3501 'If you want to update the tag, please run ', 3502 ansi(code, 'git tag -d ~w', [Tag]) 3503 ]. 3504message(git_tag_out_of_sync(Tag)) --> 3505 [ 'Release tag ', ansi(code, '~w', [Tag]), 3506 ' differs from this tag at the origin' 3507 ]. 3508 3509message(publish_failed(Info, Reason)) --> 3510 [ 'Pack ' ], msg_pack(Info), [ ' at version ~w'-[Info.version] ], 3511 msg_publish_failed(Reason). 3512 3513msg_publish_failed(throw(error(permission_error(register, 3514 pack(_),_URL),_))) --> 3515 [ ' is already registered with a different URL']. 3516msg_publish_failed(download) --> 3517 [' was already published?']. 3518msg_publish_failed(Status) --> 3519 [ ' failed for unknown reason (~p)'-[Status] ]. 3520 3521candidate_dirs([]) --> []. 3522candidate_dirs([H|T]) --> [ nl, ' ~w'-[H] ], candidate_dirs(T). 3523 % Questions 3524message(resolve_remove) --> 3525 [ nl, 'Please select an action:', nl, nl ]. 3526message(create_pack_dir) --> 3527 [ nl, 'Create directory for packages', nl ]. 3528message(menu(item(I, Label))) --> 3529 [ '~t(~d)~6| '-[I] ], 3530 label(Label). 3531message(menu(default_item(I, Label))) --> 3532 [ '~t(~d)~6| * '-[I] ], 3533 label(Label). 3534message(menu(select)) --> 3535 [ nl, 'Your choice? ', flush ]. 3536message(confirm(Question, Default)) --> 3537 message(Question), 3538 confirm_default(Default), 3539 [ flush ]. 3540message(menu(reply(Min,Max))) --> 3541 ( { Max =:= Min+1 } 3542 -> [ 'Please enter ~w or ~w'-[Min,Max] ] 3543 ; [ 'Please enter a number between ~w and ~w'-[Min,Max] ] 3544 ). 3545 3546 % support predicates 3547dep_issues(Issues) --> 3548 sequence(dep_issue, [nl], Issues). 3549 3550dep_issue(unsatisfied(Pack, Requires)) --> 3551 [ ' - Pack ' ], msg_pack(Pack), [' requires ~p'-[Requires]]. 3552dep_issue(conflicts(Pack, Conflict)) --> 3553 [ ' - Pack ' ], msg_pack(Pack), [' conflicts with ~p'-[Conflict]].
3560install_label([link]) --> 3561 !, 3562 [ ansi(bold, 'Activate pack?', []) ]. 3563install_label([unpack]) --> 3564 !, 3565 [ ansi(bold, 'Unpack archive?', []) ]. 3566install_label(_) --> 3567 [ ansi(bold, 'Download packs?', []) ]. 3568 3569install_plan([], []) --> 3570 []. 3571install_plan([H|T], [AH|AT]) --> 3572 install_step(H, AH), [nl], 3573 install_plan(T, AT). 3574 3575install_step(Info, keep) --> 3576 { Info.get(keep) == true }, 3577 !, 3578 [ ' Keep ' ], msg_pack(Info), [ ' at version ~w'-[Info.version] ], 3579 msg_can_upgrade(Info). 3580install_step(Info, Action) --> 3581 { From = Info.get(upgrade), 3582 VFrom = From.version, 3583 VTo = Info.get(version), 3584 ( cmp_versions(>=, VTo, VFrom) 3585 -> Label = ansi(bold, ' Upgrade ', []) 3586 ; Label = ansi(warning, ' Downgrade ', []) 3587 ) 3588 }, 3589 [ Label ], msg_pack(Info), 3590 [ ' from version ~w to ~w'- [From.version, Info.get(version)] ], 3591 install_from(Info, Action). 3592install_step(Info, Action) --> 3593 { _From = Info.get(upgrade) }, 3594 [ ' Upgrade ' ], msg_pack(Info), 3595 install_from(Info, Action). 3596install_step(Info, Action) --> 3597 { Dep = Info.get(dependency_for) }, 3598 [ ' Install ' ], msg_pack(Info), 3599 [ ' at version ~w as dependency for '-[Info.version], 3600 ansi(code, '~w', [Dep]) 3601 ], 3602 install_from(Info, Action), 3603 msg_downloads(Info). 3604install_step(Info, Action) --> 3605 { Info.get(commit) == 'HEAD' }, 3606 !, 3607 [ ' Install ' ], msg_pack(Info), [ ' at current GIT HEAD'-[] ], 3608 install_from(Info, Action), 3609 msg_downloads(Info). 3610install_step(Info, link) --> 3611 { Info.get(link) == true, 3612 uri_file_name(Info.get(url), Dir) 3613 }, 3614 !, 3615 [ ' Install ' ], msg_pack(Info), [ ' as symlink to ', url(Dir) ]. 3616install_step(Info, Action) --> 3617 [ ' Install ' ], msg_pack(Info), [ ' at version ~w'-[Info.get(version)] ], 3618 install_from(Info, Action), 3619 msg_downloads(Info). 3620install_step(Info, Action) --> 3621 [ ' Install ' ], msg_pack(Info), 3622 install_from(Info, Action), 3623 msg_downloads(Info). 3624 3625install_from(Info, download) --> 3626 { download_url(Info.url) }, 3627 !, 3628 [ ' from ', url(Info.url) ]. 3629install_from(Info, unpack) --> 3630 [ ' from ', url(Info.url) ]. 3631 3632msg_downloads(Info) --> 3633 { Downloads = Info.get(all_downloads), 3634 Downloads > 0 3635 }, 3636 [ ansi(comment, ' (downloaded ~D times)', [Downloads]) ], 3637 !. 3638msg_downloads(_) --> 3639 []. 3640 3641msg_pack(Pack) --> 3642 { atom(Pack) }, 3643 !, 3644 [ ansi(code, '~w', [Pack]) ]. 3645msg_pack(Info) --> 3646 msg_pack(Info.pack).
3652msg_build_plan(Plan) --> 3653 sequence(build_step, [nl], Plan). 3654 3655build_step(Info) --> 3656 [ ' Build ' ], msg_pack(Info), [' in directory ', url(Info.installed) ]. 3657 3658msg_can_upgrade_target(Info) --> 3659 [ ' Pack ' ], msg_pack(Info), 3660 [ ' is installed at version ~w'-[Info.version] ], 3661 msg_can_upgrade(Info). 3662 3663pack_list([]) --> []. 3664pack_list([H|T]) --> 3665 [ ' - Pack ' ], msg_pack(H), [nl], 3666 pack_list(T). 3667 3668label(remove_only(Pack)) --> 3669 [ 'Only remove package ~w (break dependencies)'-[Pack] ]. 3670label(remove_deps(Pack, Deps)) --> 3671 { length(Deps, Count) }, 3672 [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ]. 3673label(create_dir(Dir)) --> 3674 [ '~w'-[Dir] ]. 3675label(install_from(git(URL))) --> 3676 !, 3677 [ 'GIT repository at ~w'-[URL] ]. 3678label(install_from(URL)) --> 3679 [ '~w'-[URL] ]. 3680label(cancel) --> 3681 [ 'Cancel' ]. 3682 3683confirm_default(yes) --> 3684 [ ' Y/n? ' ]. 3685confirm_default(no) --> 3686 [ ' y/N? ' ]. 3687confirm_default(none) --> 3688 [ ' y/n? ' ]. 3689 3690msg_version(Version) --> 3691 [ '~w'-[Version] ]. 3692 3693msg_can_upgrade(Info) --> 3694 { Latest = Info.get(latest_version) }, 3695 [ ansi(warning, ' (can be upgraded to ~w)', [Latest]) ]. 3696msg_can_upgrade(_) --> 3697 []. 3698 3699 3700 /******************************* 3701 * MISC * 3702 *******************************/ 3703 3704local_uri_file_name(URL, FileName) :- 3705 uri_file_name(URL, FileName), 3706 !. 3707local_uri_file_name(URL, FileName) :- 3708 uri_components(URL, Components), 3709 uri_data(scheme, Components, File), File == file, 3710 uri_data(authority, Components, FileNameEnc), 3711 uri_data(path, Components, ''), 3712 uri_encoded(path, FileName, FileNameEnc). 3713 3714det_if(Cond, Goal) :- 3715 ( 3716 -> , 3717 ! 3718 ; 3719 ). 3720 3721member_nonvar(_, Var) :- 3722 var(Var), 3723 !, 3724 fail. 3725member_nonvar(E, [E|_]). 3726member_nonvar(E, [_|T]) :- 3727 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*/