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, _Token, _Version). 352 353is_version(Version) :- 354 split_string(Version, ".", "", Parts), 355 maplist(number_string, _, Parts). 356 357is_dependency(Token, Token, *) :- 358 atom(Token). 359is_dependency(Term, Token, VersionCmp) :- 360 Term =.. [Op,Token,Version], 361 cmp(Op, _), 362 is_version(Version), 363 VersionCmp =.. [Op,Version]. 364 365cmp(<, @<). 366cmp(=<, @=<). 367cmp(==, ==). 368cmp(>=, @>=). 369cmp(>, @>). 370 371 372 /******************************* 373 * SEARCH * 374 *******************************/
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.
416pack_list(Query) :- 417 pack_list(Query, []). 418 419pack_search(Query) :- 420 pack_list(Query, []). 421 422pack_list(Query, Options) :- 423 ( option(installed(true), Options) 424 ; option(outdated(true), Options) 425 ; option(server(false), Options) 426 ), 427 !, 428 local_search(Query, Local), 429 maplist(arg(1), Local, Packs), 430 ( option(server(false), Options) 431 -> Hits = [] 432 ; query_pack_server(info(Packs), true(Hits), Options) 433 ), 434 list_hits(Hits, Local, Options). 435pack_list(Query, Options) :- 436 query_pack_server(search(Query), Result, Options), 437 ( Result == false 438 -> ( local_search(Query, Packs), 439 Packs \== [] 440 -> forall(member(pack(Pack, Stat, Title, Version, _), Packs), 441 format('~w ~w@~w ~28|- ~w~n', 442 [Stat, Pack, Version, Title])) 443 ; print_message(warning, pack(search_no_matches(Query))) 444 ) 445 ; Result = true(Hits), % Hits = list(pack(Name, p, Title, Version, URL)) 446 local_search(Query, Local), 447 list_hits(Hits, Local, []) 448 ). 449 450list_hits(Hits, Local, Options) :- 451 append(Hits, Local, All), 452 sort(All, Sorted), 453 join_status(Sorted, Packs0), 454 include(filtered(Options), Packs0, Packs), 455 maplist(list_hit(Options), Packs). 456 457filtered(Options, pack(_,Tag,_,_,_)) :- 458 option(outdated(true), Options), 459 !, 460 Tag == 'U'. 461filtered(_, _). 462 463list_hit(_Options, pack(Pack, Tag, Title, Version, _URL)) => 464 list_tag(Tag), 465 ansi_format(code, '~w', [Pack]), 466 format('@'), 467 list_version(Tag, Version), 468 format('~35|- ', []), 469 ansi_format(comment, '~w~n', [Title]). 470 471list_tag(Tag) :- 472 tag_color(Tag, Color), 473 ansi_format(Color, '~w ', [Tag]). 474 475list_version(Tag, VersionI-VersionS) => 476 tag_color(Tag, Color), 477 ansi_format(Color, '~w', [VersionI]), 478 ansi_format(bold, '(~w)', [VersionS]). 479list_version(_Tag, Version) => 480 ansi_format([], '~w', [Version]). 481 482tag_color('U', warning) :- !. 483tag_color('A', comment) :- !. 484tag_color(_, []).
pack(Name, Status, Version, URL)
. If
the versions do not match, Version is
VersionInstalled-VersionRemote
and similar for thee URL.493join_status([], []). 494join_status([ pack(Pack, i, Title, Version, URL), 495 pack(Pack, p, Title, Version, _) 496 | T0 497 ], 498 [ pack(Pack, Tag, Title, Version, URL) 499 | T 500 ]) :- 501 !, 502 ( pack_status(Pack, automatic(true)) 503 -> Tag = a 504 ; Tag = i 505 ), 506 join_status(T0, T). 507join_status([ pack(Pack, i, Title, VersionI, URLI), 508 pack(Pack, p, _, VersionS, URLS) 509 | T0 510 ], 511 [ pack(Pack, Tag, Title, VersionI-VersionS, URLI-URLS) 512 | T 513 ]) :- 514 !, 515 version_sort_key(VersionI, VDI), 516 version_sort_key(VersionS, VDS), 517 ( VDI @< VDS 518 -> Tag = 'U' 519 ; Tag = 'A' 520 ), 521 join_status(T0, T). 522join_status([ pack(Pack, i, Title, VersionI, URL) 523 | T0 524 ], 525 [ pack(Pack, l, Title, VersionI, URL) 526 | T 527 ]) :- 528 !, 529 join_status(T0, T). 530join_status([H|T0], [H|T]) :- 531 join_status(T0, T).
537local_search(Query, Packs) :- 538 findall(Pack, matching_installed_pack(Query, Pack), Packs). 539 540matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :- 541 current_pack(Pack), 542 findall(Term, 543 ( pack_info(Pack, _, Term), 544 search_info(Term) 545 ), Info), 546 ( sub_atom_icasechk(Pack, _, Query) 547 -> true 548 ; memberchk(title(Title), Info), 549 sub_atom_icasechk(Title, _, Query) 550 ), 551 option(title(Title), Info, '<no title>'), 552 option(version(Version), Info, '<no version>'), 553 option(download(URL), Info, '<no download url>'). 554 555search_info(title(_)). 556search_info(version(_)). 557search_info(download(_)). 558 559 560 /******************************* 561 * INSTALL * 562 *******************************/
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.
662pack_install(Spec) :- 663 pack_default_options(Spec, Pack, [], Options), 664 pack_install(Pack, [pack(Pack)|Options]). 665 666pack_install(Specs, Options) :- 667 is_list(Specs), 668 !, 669 maplist(pack_options(Options), Specs, Pairs), 670 pack_install_dir(PackTopDir, Options), 671 pack_install_set(Pairs, PackTopDir, Options). 672pack_install(Spec, Options) :- 673 pack_default_options(Spec, Pack, Options, DefOptions), 674 ( option(already_installed(Installed), DefOptions) 675 -> print_message(informational, pack(already_installed(Installed))) 676 ; merge_options(Options, DefOptions, PackOptions), 677 pack_install_dir(PackTopDir, PackOptions), 678 pack_install_set([Pack-PackOptions], PackTopDir, Options) 679 ). 680 681pack_options(Options, Spec, Pack-PackOptions) :- 682 pack_default_options(Spec, Pack, Options, DefOptions), 683 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.709pack_default_options(_Spec, Pack, OptsIn, Options) :- % (1) 710 option(already_installed(pack(Pack,_Version)), OptsIn), 711 !, 712 Options = OptsIn. 713pack_default_options(_Spec, Pack, OptsIn, Options) :- % (2) 714 option(url(URL), OptsIn), 715 !, 716 ( option(git(_), OptsIn) 717 -> Options = OptsIn 718 ; git_url(URL, Pack) 719 -> Options = [git(true)|OptsIn] 720 ; Options = OptsIn 721 ), 722 ( nonvar(Pack) 723 -> true 724 ; option(pack(Pack), Options) 725 -> true 726 ; pack_version_file(Pack, _Version, URL) 727 ). 728pack_default_options(Archive, Pack, OptsIn, Options) :- % (3) 729 must_be(atom, Archive), 730 \+ uri_is_global(Archive), 731 expand_file_name(Archive, [File]), 732 exists_file(File), 733 !, 734 ( pack_version_file(Pack, Version, File) 735 -> uri_file_name(FileURL, File), 736 merge_options([url(FileURL), version(Version)], OptsIn, Options) 737 ; domain_error(pack_file_name, Archive) 738 ). 739pack_default_options(URL, Pack, OptsIn, Options) :- % (4) 740 git_url(URL, Pack), 741 !, 742 merge_options([git(true), url(URL)], OptsIn, Options). 743pack_default_options(FileURL, Pack, _, Options) :- % (5) 744 uri_file_name(FileURL, Dir), 745 exists_directory(Dir), 746 pack_info_term(Dir, name(Pack)), 747 !, 748 ( pack_info_term(Dir, version(Version)) 749 -> uri_file_name(DirURL, Dir), 750 Options = [url(DirURL), version(Version)] 751 ; throw(error(existence_error(key, version, Dir),_)) 752 ). 753pack_default_options('.', Pack, OptsIn, Options) :- % (6) 754 pack_info_term('.', name(Pack)), 755 !, 756 working_directory(Dir, Dir), 757 ( pack_info_term(Dir, version(Version)) 758 -> uri_file_name(DirURL, Dir), 759 NewOptions = [url(DirURL), version(Version) | Options1], 760 ( current_prolog_flag(windows, true) 761 -> Options1 = [] 762 ; Options1 = [link(true), rebuild(make)] 763 ), 764 merge_options(NewOptions, OptsIn, Options) 765 ; throw(error(existence_error(key, version, Dir),_)) 766 ). 767pack_default_options(URL, Pack, OptsIn, Options) :- % (7) 768 pack_version_file(Pack, Version, URL), 769 download_url(URL), 770 !, 771 available_download_versions(URL, Available), 772 Available = [URLVersion-LatestURL|_], 773 NewOptions = [url(LatestURL)|VersionOptions], 774 version_options(Version, URLVersion, Available, VersionOptions), 775 merge_options(NewOptions, OptsIn, Options). 776pack_default_options(Pack, Pack, Options, Options) :- % (8) 777 \+ uri_is_global(Pack). 778 779version_options(Version, Version, _, [version(Version)]) :- !. 780version_options(Version, _, Available, [versions(Available)]) :- 781 sub_atom(Version, _, _, _, *), 782 !. 783version_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.
803pack_install_dir(PackDir, Options) :- 804 option(pack_directory(PackDir), Options), 805 ensure_directory(PackDir), 806 !. 807pack_install_dir(PackDir, Options) :- 808 base_alias(Alias, Options), 809 absolute_file_name(Alias, PackDir, 810 [ file_type(directory), 811 access(write), 812 file_errors(fail) 813 ]), 814 !. 815pack_install_dir(PackDir, Options) :- 816 pack_create_install_dir(PackDir, Options). 817 818base_alias(Alias, Options) :- 819 option(global(true), Options), 820 !, 821 Alias = common_app_data(pack). 822base_alias(Alias, Options) :- 823 option(global(false), Options), 824 !, 825 Alias = user_app_data(pack). 826base_alias(Alias, _Options) :- 827 Alias = pack('.'). 828 829pack_create_install_dir(PackDir, Options) :- 830 base_alias(Alias, Options), 831 findall(Candidate = create_dir(Candidate), 832 ( absolute_file_name(Alias, Candidate, [solutions(all)]), 833 \+ exists_file(Candidate), 834 \+ exists_directory(Candidate), 835 file_directory_name(Candidate, Super), 836 ( exists_directory(Super) 837 -> access_file(Super, write) 838 ; true 839 ) 840 ), 841 Candidates0), 842 list_to_set(Candidates0, Candidates), % keep order 843 pack_create_install_dir(Candidates, PackDir, Options). 844 845pack_create_install_dir(Candidates, PackDir, Options) :- 846 Candidates = [Default=_|_], 847 !, 848 append(Candidates, [cancel=cancel], Menu), 849 menu(pack(create_pack_dir), Menu, Default, Selected, Options), 850 Selected \== cancel, 851 ( catch(make_directory_path(Selected), E, 852 (print_message(warning, E), fail)) 853 -> PackDir = Selected 854 ; delete(Candidates, PackDir=create_dir(PackDir), Remaining), 855 pack_create_install_dir(Remaining, PackDir, Options) 856 ). 857pack_create_install_dir(_, _, _) :- 858 print_message(error, pack(cannot_create_dir(pack(.)))), 859 fail.
873pack_unpack_from_local(Source, PackTopDir, Name, PackDir, Options) :- 874 exists_directory(Source), 875 !, 876 directory_file_path(PackTopDir, Name, PackDir), 877 ( option(link(true), Options) 878 -> ( same_file(Source, PackDir) 879 -> true 880 ; remove_existing_pack(PackDir, Options), 881 atom_concat(PackTopDir, '/', PackTopDirS), 882 relative_file_name(Source, PackTopDirS, RelPath), 883 link_file(RelPath, PackDir, symbolic), 884 assertion(same_file(Source, PackDir)) 885 ) 886 ; is_git_directory(Source) 887 -> remove_existing_pack(PackDir, Options), 888 run_process(path(git), [clone, Source, PackDir], []) 889 ; prepare_pack_dir(PackDir, Options), 890 copy_directory(Source, PackDir) 891 ). 892pack_unpack_from_local(Source, PackTopDir, Name, PackDir, Options) :- 893 exists_file(Source), 894 directory_file_path(PackTopDir, Name, PackDir), 895 prepare_pack_dir(PackDir, Options), 896 pack_unpack(Source, PackDir, Name, Options).
905:- if(exists_source(library(archive))). 906pack_unpack(Source, PackDir, Pack, Options) :- 907 ensure_loaded_archive, 908 pack_archive_info(Source, Pack, _Info, StripOptions), 909 prepare_pack_dir(PackDir, Options), 910 archive_extract(Source, PackDir, 911 [ exclude(['._*']) % MacOS resource forks 912 | StripOptions 913 ]). 914:- else. 915pack_unpack(_,_,_,_) :- 916 existence_error(library, archive). 917:- endif.
925pack_install_local(M:Gen, Dir, Options) :- 926 findall(Pack-PackOptions, call(M:Gen, Pack, PackOptions), Pairs), 927 pack_install_set(Pairs, Dir, Options). 928 929pack_install_set(Pairs, Dir, Options) :- 930 must_be(list(pair), Pairs), 931 ensure_directory(Dir), 932 partition(known_media, Pairs, Local, Remote), 933 maplist(pack_options_to_versions, Local, LocalVersions), 934 ( Remote == [] 935 -> AllVersions = LocalVersions 936 ; pairs_keys(Remote, Packs), 937 prolog_description(Properties), 938 query_pack_server(versions(Packs, Properties), Result, Options), 939 ( Result = true(RemoteVersions) 940 -> append(LocalVersions, RemoteVersions, AllVersions) 941 ; print_message(error, pack(query_failed(Result))), 942 fail 943 ) 944 ), 945 local_packs(Dir, Existing), 946 pack_resolve(Pairs, Existing, AllVersions, Plan, Options), 947 !, % for now, only first plan 948 Options1 = [pack_directory(Dir)|Options], 949 download_plan(Pairs, Plan, PlanB, Options1), 950 register_downloads(PlanB, Options), 951 maplist(update_automatic, PlanB), 952 build_plan(PlanB, Built, Options1), 953 publish_download(PlanB, Options), 954 work_done(Pairs, Plan, PlanB, Built, Options).
963known_media(_-Options) :-
964 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:
982pack_resolve(Pairs, Existing, Versions, Plan, Options) :-
983 insert_existing(Existing, Versions, AllVersions, Options),
984 phrase(select_version(Pairs, AllVersions,
985 [ plan(PlanA), % access to plan
986 dependency_for([]) % dependencies
987 | Options
988 ]),
989 PlanA),
990 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.1001:- det(insert_existing/4). 1002insert_existing(Existing, [], Versions, _Options) => 1003 maplist(existing_to_versions, Existing, Versions). 1004insert_existing(Existing, [Pack-Versions|T0], AllPackVersions, Options), 1005 select(Installed, Existing, Existing2), 1006 Installed.pack == Pack => 1007 can_upgrade(Installed, Versions, Installed2), 1008 insert_existing_(Installed2, Versions, AllVersions, Options), 1009 AllPackVersions = [Pack-AllVersions|T], 1010 insert_existing(Existing2, T0, T, Options). 1011insert_existing(Existing, [H|T0], AllVersions, Options) => 1012 AllVersions = [H|T], 1013 insert_existing(Existing, T0, T, Options). 1014 1015existing_to_versions(Installed, Pack-[Version-[Installed]]) :- 1016 Pack = Installed.pack, 1017 Version = Installed.version. 1018 1019insert_existing_(Installed, Versions, AllVersions, Options) :- 1020 option(upgrade(true), Options), 1021 !, 1022 insert_existing_(Installed, Versions, AllVersions). 1023insert_existing_(Installed, Versions, AllVersions, _) :- 1024 AllVersions = [Installed.version-[Installed]|Versions]. 1025 1026insert_existing_(Installed, [H|T0], [H|T]) :- 1027 H = V0-_Infos, 1028 cmp_versions(>, V0, Installed.version), 1029 !, 1030 insert_existing_(Installed, T0, T). 1031insert_existing_(Installed, [H0|T], [H|T]) :- 1032 H0 = V0-Infos, 1033 V0 == Installed.version, 1034 !, 1035 H = V0-[Installed|Infos]. 1036insert_existing_(Installed, Versions, All) :- 1037 All = [Installed.version-[Installed]|Versions].
latest_version
key to Installed if its version is older than
the latest available version.1044can_upgrade(Info, [Version-_|_], Info2) :- 1045 cmp_versions(>, Version, Info.version), 1046 !, 1047 Info2 = Info.put(latest_version, Version). 1048can_upgrade(Info, _, Info).
upgrade:true
to elements of PlanA in Existing that are not the
same.1056mark_installed([], _, []). 1057mark_installed([Info|T], Existing, Plan) :- 1058 ( member(Installed, Existing), 1059 Installed.pack == Info.pack 1060 -> ( ( Installed.git == true 1061 -> Info.git == true, 1062 Installed.hash == Info.hash 1063 ; Version = Info.get(version) 1064 -> Installed.version == Version 1065 ) 1066 -> Plan = [Info.put(keep, true)|PlanT] % up-to-date 1067 ; Plan = [Info.put(upgrade, Installed)|PlanT] % needs upgrade 1068 ) 1069 ; Plan = [Info|PlanT] % new install 1070 ), 1071 mark_installed(T, Existing, PlanT).
1079select_version([], _, _) --> 1080 []. 1081select_version([Pack-PackOptions|More], Versions, Options) --> 1082 { memberchk(Pack-PackVersions, Versions), 1083 member(Version-Infos, PackVersions), 1084 compatible_version(Pack, Version, PackOptions), 1085 member(Info, Infos), 1086 pack_options_compatible_with_info(Info, PackOptions), 1087 pack_satisfies(Pack, Version, Info, Info2, PackOptions), 1088 all_downloads(PackVersions, Downloads) 1089 }, 1090 add_to_plan(Info2.put(_{version: Version, all_downloads:Downloads}), 1091 Versions, Options), 1092 select_version(More, Versions, Options). 1093select_version([Pack-_PackOptions|_More], _Versions, _Options) --> 1094 { existence_error(pack, Pack) }. % or warn and continue? 1095 1096all_downloads(PackVersions, AllDownloads) :- 1097 aggregate_all(sum(Downloads), 1098 ( member(_Version-Infos, PackVersions), 1099 member(Info, Infos), 1100 get_dict(downloads, Info, Downloads) 1101 ), 1102 AllDownloads). 1103 1104add_requirements([], _, _) --> 1105 []. 1106add_requirements([H|T], Versions, Options) --> 1107 { is_prolog_token(H), 1108 !, 1109 prolog_satisfies(H) 1110 }, 1111 add_requirements(T, Versions, Options). 1112add_requirements([H|T], Versions, Options) --> 1113 { member(Pack-PackVersions, Versions), 1114 member(Version-Infos, PackVersions), 1115 member(Info, Infos), 1116 ( Provides = @(Pack,Version) 1117 ; member(Provides, Info.get(provides)) 1118 ), 1119 satisfies_req(Provides, H), 1120 all_downloads(PackVersions, Downloads) 1121 }, 1122 add_to_plan(Info.put(_{version: Version, all_downloads:Downloads}), 1123 Versions, Options), 1124 add_requirements(T, Versions, Options).
1132add_to_plan(Info, _Versions, Options) --> 1133 { option(plan(Plan), Options), 1134 member_nonvar(Planned, Plan), 1135 Planned.pack == Info.pack, 1136 !, 1137 same_version(Planned, Info) % same pack, different version 1138 }. 1139add_to_plan(Info, _Versions, _Options) --> 1140 { member(Conflict, Info.get(conflicts)), 1141 is_prolog_token(Conflict), 1142 prolog_satisfies(Conflict), 1143 !, 1144 fail % incompatible with this Prolog 1145 }. 1146add_to_plan(Info, _Versions, Options) --> 1147 { option(plan(Plan), Options), 1148 member_nonvar(Planned, Plan), 1149 info_conflicts(Info, Planned), % Conflicts with a planned pack 1150 !, 1151 fail 1152 }. 1153add_to_plan(Info, Versions, Options) --> 1154 { select_option(dependency_for(Dep0), Options, Options1), 1155 Options2 = [dependency_for([Info.pack|Dep0])|Options1], 1156 ( Dep0 = [DepFor|_] 1157 -> add_dependency_for(DepFor, Info, Info1) 1158 ; Info1 = Info 1159 ) 1160 }, 1161 [Info1], 1162 add_requirements(Info.get(requires,[]), Versions, Options2). 1163 1164add_dependency_for(Pack, Info, Info) :- 1165 Old = Info.get(dependency_for), 1166 !, 1167 b_set_dict(dependency_for, Info, [Pack|Old]). 1168add_dependency_for(Pack, Info0, Info) :- 1169 Info = Info0.put(dependency_for, [Pack]). 1170 1171same_version(Info, Info) :- 1172 !. 1173same_version(Planned, Info) :- 1174 Hash = Planned.get(hash), 1175 Hash \== (-), 1176 !, 1177 Hash == Info.get(hash). 1178same_version(Planned, Info) :- 1179 Planned.get(version) == Info.get(version).
1185info_conflicts(Info, Planned) :- 1186 info_conflicts_(Info, Planned), 1187 !. 1188info_conflicts(Info, Planned) :- 1189 info_conflicts_(Planned, Info), 1190 !. 1191 1192info_conflicts_(Info, Planned) :- 1193 member(Conflict, Info.get(conflicts)), 1194 \+ is_prolog_token(Conflict), 1195 info_provides(Planned, Provides), 1196 satisfies_req(Provides, Conflict), 1197 !. 1198 1199info_provides(Info, Provides) :- 1200 ( Provides = Info.pack@Info.version 1201 ; member(Provides, Info.get(provides)) 1202 ).
1209pack_satisfies(_Pack, _Version, Info0, Info, Options) :- 1210 option(commit('HEAD'), Options), 1211 !, 1212 Info0.get(git) == true, 1213 Info = Info0.put(commit, 'HEAD'). 1214pack_satisfies(_Pack, _Version, Info, Info, Options) :- 1215 option(commit(Commit), Options), 1216 !, 1217 Commit == Info.get(hash). 1218pack_satisfies(Pack, Version, Info, Info, Options) :- 1219 option(version(ReqVersion), Options), 1220 !, 1221 satisfies_version(Pack, Version, ReqVersion). 1222pack_satisfies(_Pack, _Version, Info, Info, _Options).
1226satisfies_version(Pack, Version, ReqVersion) :-
1227 catch(require_version(pack(Pack), Version, ReqVersion),
1228 error(version_error(pack(Pack), Version, ReqVersion),_),
1229 fail).
1235satisfies_req(Token, Token) => true. 1236satisfies_req(@(Token,_), Token) => true. 1237satisfies_req(@(Token,PrvVersion), Req), cmp(Req, Token, Cmp, ReqVersion) => 1238 cmp_versions(Cmp, PrvVersion, ReqVersion). 1239satisfies_req(_,_) => fail. 1240 1241cmp(Token < Version, Token, <, Version). 1242cmp(Token =< Version, Token, =<, Version). 1243cmp(Token = Version, Token, =, Version). 1244cmp(Token == Version, Token, ==, Version). 1245cmp(Token >= Version, Token, >=, Version). 1246cmp(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).
1259:- det(pack_options_to_versions/2). 1260pack_options_to_versions(Pack-PackOptions, Pack-Versions) :- 1261 option(versions(Available), PackOptions), !, 1262 maplist(version_url_info(Pack, PackOptions), Available, Versions). 1263pack_options_to_versions(Pack-PackOptions, Pack-[Version-[Info]]) :- 1264 option(url(URL), PackOptions), 1265 findall(Prop, option_info_prop(PackOptions, Prop), Pairs), 1266 dict_create(Info, #, 1267 [ pack-Pack, 1268 url-URL 1269 | Pairs 1270 ]), 1271 Version = Info.get(version, '0.0.0'). 1272 1273version_url_info(Pack, PackOptions, Version-URL, Version-[Info]) :- 1274 findall(Prop, 1275 ( option_info_prop(PackOptions, Prop), 1276 Prop \= version-_ 1277 ), 1278 Pairs), 1279 dict_create(Info, #, 1280 [ pack-Pack, 1281 url-URL, 1282 version-Version 1283 | Pairs 1284 ]). 1285 1286option_info_prop(PackOptions, Prop-Value) :- 1287 option_info(Prop), 1288 Opt =.. [Prop,Value], 1289 option(Opt, PackOptions). 1290 1291option_info(git). 1292option_info(hash). 1293option_info(version). 1294option_info(branch). 1295option_info(link).
1302compatible_version(Pack, Version, PackOptions) :- 1303 option(version(ReqVersion), PackOptions), 1304 !, 1305 satisfies_version(Pack, Version, ReqVersion). 1306compatible_version(_, _, _).
1313pack_options_compatible_with_info(Info, PackOptions) :-
1314 findall(Prop, option_info_prop(PackOptions, Prop), Pairs),
1315 dict_create(Dict, _, Pairs),
1316 Dict >:< Info.
1326download_plan(_Targets, Plan, Plan, _Options) :- 1327 exclude(installed, Plan, []), 1328 !. 1329download_plan(Targets, Plan0, Plan, Options) :- 1330 confirm(download_plan(Plan0), yes, Options), 1331 maplist(download_from_info(Options), Plan0, Plan1), 1332 plan_unsatisfied_dependencies(Plan1, Deps), 1333 ( Deps == [] 1334 -> Plan = Plan1 1335 ; print_message(informational, pack(new_dependencies(Deps))), 1336 prolog_description(Properties), 1337 query_pack_server(versions(Deps, Properties), Result, []), 1338 ( Result = true(Versions) 1339 -> pack_resolve(Targets, Plan1, Versions, Plan2, Options), 1340 !, 1341 download_plan(Targets, Plan2, Plan, Options) 1342 ; print_message(error, pack(query_failed(Result))), 1343 fail 1344 ) 1345 ).
1352plan_unsatisfied_dependencies(Plan, Deps) :- 1353 phrase(plan_unsatisfied_dependencies(Plan, Plan), Deps). 1354 1355plan_unsatisfied_dependencies([], _) --> 1356 []. 1357plan_unsatisfied_dependencies([Info|Infos], Plan) --> 1358 { Deps = Info.get(requires) }, 1359 plan_unsatisfied_requirements(Deps, Plan), 1360 plan_unsatisfied_dependencies(Infos, Plan). 1361 1362plan_unsatisfied_requirements([], _) --> 1363 []. 1364plan_unsatisfied_requirements([H|T], Plan) --> 1365 { is_prolog_token(H), % Can this fail? 1366 prolog_satisfies(H) 1367 }, 1368 !, 1369 plan_unsatisfied_requirements(T, Plan). 1370plan_unsatisfied_requirements([H|T], Plan) --> 1371 { member(Info, Plan), 1372 ( ( Version = Info.get(version) 1373 -> Provides = @(Info.get(pack), Version) 1374 ; Provides = Info.get(pack) 1375 ) 1376 ; member(Provides, Info.get(provides)) 1377 ), 1378 satisfies_req(Provides, H) 1379 }, !, 1380 plan_unsatisfied_requirements(T, Plan). 1381plan_unsatisfied_requirements([H|T], Plan) --> 1382 [H], 1383 plan_unsatisfied_requirements(T, Plan).
1392build_plan(Plan, Ordered, Options) :- 1393 partition(needs_rebuild_from_info(Options), Plan, ToBuild, NoBuild), 1394 maplist(attach_from_info(Options), NoBuild), 1395 ( ToBuild == [] 1396 -> Ordered = [] 1397 ; order_builds(ToBuild, Ordered), 1398 confirm(build_plan(Ordered), yes, Options), 1399 maplist(exec_plan_rebuild_step(Options), Ordered) 1400 ). 1401 1402needs_rebuild_from_info(Options, Info) :- 1403 needs_rebuild(Info.installed, Options).
1409needs_rebuild(PackDir, Options) :-
1410 ( is_foreign_pack(PackDir, _),
1411 \+ is_built(PackDir, Options)
1412 -> true
1413 ; is_autoload_pack(PackDir, Options),
1414 post_install_autoload(PackDir, Options),
1415 fail
1416 ).
1425is_built(PackDir, _Options) :-
1426 current_prolog_flag(arch, Arch),
1427 prolog_version_dotted(Version), % Major.Minor.Patch
1428 pack_status_dir(PackDir, built(Arch, Version, _)).
1435order_builds(ToBuild, Ordered) :- 1436 findall(Pack-Dep, dep_edge(ToBuild, Pack, Dep), Edges), 1437 maplist(get_dict(pack), ToBuild, Packs), 1438 vertices_edges_to_ugraph(Packs, Edges, Graph), 1439 ugraph_layers(Graph, Layers), 1440 append(Layers, PackNames), 1441 maplist(pack_info_from_name(ToBuild), PackNames, Ordered). 1442 1443dep_edge(Infos, Pack, Dep) :- 1444 member(Info, Infos), 1445 Pack = Info.pack, 1446 member(Dep, Info.get(dependency_for)), 1447 ( member(DepInfo, Infos), 1448 DepInfo.pack == Dep 1449 -> true 1450 ). 1451 1452:- det(pack_info_from_name/3). 1453pack_info_from_name(Infos, Pack, Info) :- 1454 member(Info, Infos), 1455 Info.pack == Pack, 1456 !.
1462exec_plan_rebuild_step(Options, Info) :-
1463 print_message(informational, pack(build(Info.pack, Info.installed))),
1464 pack_post_install(Info.pack, Info.installed, Options),
1465 attach_from_info(Options, Info).
1471attach_from_info(_Options, Info) :- 1472 Info.get(keep) == true, 1473 !. 1474attach_from_info(Options, Info) :- 1475 ( option(pack_directory(_Parent), Options) 1476 -> pack_attach(Info.installed, [duplicate(replace)]) 1477 ; pack_attach(Info.installed, []) 1478 ).
1488download_from_info(Options, Info0, Info), option(dryrun(true), Options) => 1489 print_term(Info0, [nl(true)]), 1490 Info = Info0. 1491download_from_info(_Options, Info0, Info), installed(Info0) => 1492 Info = Info0. 1493download_from_info(_Options, Info0, Info), 1494 _{upgrade:OldInfo, git:true} :< Info0, 1495 is_git_directory(OldInfo.installed) => 1496 PackDir = OldInfo.installed, 1497 git_checkout_version(PackDir, [commit(Info0.hash)]), 1498 reload_info(PackDir, Info0, Info). 1499download_from_info(Options, Info0, Info), 1500 _{upgrade:OldInfo} :< Info0 => 1501 PackDir = OldInfo.installed, 1502 detach_pack(OldInfo.pack, PackDir), 1503 delete_directory_and_contents(PackDir), 1504 del_dict(upgrade, Info0, _, Info1), 1505 download_from_info(Options, Info1, Info). 1506download_from_info(Options, Info0, Info), 1507 _{url:URL, git:true} :< Info0, \+ have_git => 1508 git_archive_url(URL, Archive, Options), 1509 download_from_info([git_url(URL)|Options], 1510 Info0.put(_{ url:Archive, 1511 git:false, 1512 git_url:URL 1513 }), 1514 Info1), 1515 % restore the hash to register the download. 1516 ( Info1.get(version) == Info0.get(version), 1517 Hash = Info0.get(hash) 1518 -> Info = Info1.put(hash, Hash) 1519 ; Info = Info1 1520 ). 1521download_from_info(Options, Info0, Info), 1522 _{url:URL} :< Info0 => 1523 select_option(pack_directory(Dir), Options, Options1), 1524 select_option(version(_), Options1, Options2, _), 1525 download_info_extra(Info0, InstallOptions, Options2), 1526 pack_download_from_url(URL, Dir, Info0.pack, 1527 [ interactive(false), 1528 pack_dir(PackDir) 1529 | InstallOptions 1530 ]), 1531 reload_info(PackDir, Info0, Info). 1532 1533download_info_extra(Info, [git(true),commit(Hash)|Options], Options) :- 1534 Info.get(git) == true, 1535 !, 1536 Hash = Info.get(commit, 'HEAD'). 1537download_info_extra(_, Options, Options). 1538 1539installed(Info) :- 1540 _ = Info.get(installed). 1541 1542detach_pack(Pack, PackDir) :- 1543 ( current_pack(Pack, PackDir) 1544 -> '$pack_detach'(Pack, PackDir) 1545 ; true 1546 ).
1555reload_info(_PackDir, Info, Info) :- 1556 _ = Info.get(installed), % we read it from the package 1557 !. 1558reload_info(PackDir, Info0, Info) :- 1559 local_pack_info(PackDir, Info1), 1560 Info = Info0.put(installed, PackDir) 1561 .put(downloaded, Info0.url) 1562 .put(Info1).
1569work_done(_, _, _, _, Options), 1570 option(silent(true), Options) => 1571 true. 1572work_done(Targets, Plan, Plan, [], _Options) => 1573 convlist(can_upgrade_target(Plan), Targets, CanUpgrade), 1574 ( CanUpgrade == [] 1575 -> pairs_keys(Targets, Packs), 1576 print_message(informational, pack(up_to_date(Packs))) 1577 ; print_message(informational, pack(installed_can_upgrade(CanUpgrade))) 1578 ). 1579work_done(_, _, _, _, _) => 1580 true. 1581 1582can_upgrade_target(Plan, Pack-_, Info) => 1583 member(Info, Plan), 1584 Info.pack == Pack, 1585 !, 1586 _ = Info.get(latest_version).
1593local_packs(Dir, Packs) :- 1594 findall(Pack, pack_in_subdir(Dir, Pack), Packs). 1595 1596pack_in_subdir(Dir, Info) :- 1597 directory_member(Dir, PackDir, 1598 [ file_type(directory), 1599 hidden(false) 1600 ]), 1601 local_pack_info(PackDir, Info). 1602 1603local_pack_info(PackDir, 1604 #{ pack: Pack, 1605 version: Version, 1606 title: Title, 1607 hash: Hash, 1608 url: URL, 1609 git: IsGit, 1610 requires: Requires, 1611 provides: Provides, 1612 conflicts: Conflicts, 1613 installed: PackDir 1614 }) :- 1615 directory_file_path(PackDir, 'pack.pl', MetaFile), 1616 exists_file(MetaFile), 1617 file_base_name(PackDir, DirName), 1618 findall(Term, pack_dir_info(PackDir, _, Term), Info), 1619 option(pack(Pack), Info, DirName), 1620 option(title(Title), Info, '<no title>'), 1621 option(version(Version), Info, '<no version>'), 1622 option(download(URL), Info, '<no download url>'), 1623 findall(Req, member(requires(Req), Info), Requires), 1624 findall(Prv, member(provides(Prv), Info), Provides), 1625 findall(Cfl, member(conflicts(Cfl), Info), Conflicts), 1626 ( have_git, 1627 is_git_directory(PackDir) 1628 -> git_hash(Hash, [directory(PackDir)]), 1629 IsGit = true 1630 ; Hash = '-', 1631 IsGit = false 1632 ). 1633 1634 1635 /******************************* 1636 * PROLOG VERSIONS * 1637 *******************************/
prolog(Dialect, Version)
1648prolog_description([prolog(swi(Version))]) :- 1649 prolog_version(Version). 1650 1651prolog_version(Version) :- 1652 current_prolog_flag(version_git, Version), 1653 !. 1654prolog_version(Version) :- 1655 prolog_version_dotted(Version). 1656 1657prolog_version_dotted(Version) :- 1658 current_prolog_flag(version_data, swi(Major, Minor, Patch, _)), 1659 VNumbers = [Major, Minor, Patch], 1660 atomic_list_concat(VNumbers, '.', Version).
1667is_prolog_token(Token), cmp(Token, prolog, _Cmp, _Version) => true. 1668is_prolog_token(prolog:_Feature) => true. 1669is_prolog_token(_) => fail.
requires(Token)
terms for
library(Lib)
1684prolog_satisfies(Token), cmp(Token, prolog, Cmp, ReqVersion) => 1685 prolog_version(CurrentVersion), 1686 cmp_versions(Cmp, CurrentVersion, ReqVersion). 1687prolog_satisfies(prolog:library(Lib)), atom(Lib) => 1688 exists_source(library(Lib)). 1689prolog_satisfies(prolog:Feature), atom(Feature) => 1690 current_prolog_flag(Feature, true). 1691prolog_satisfies(prolog:Feature), flag_value_feature(Feature, Flag, Value) => 1692 current_prolog_flag(Flag, Value). 1693 1694flag_value_feature(Feature, Flag, Value) :- 1695 compound(Feature), 1696 compound_name_arguments(Feature, Flag, [Value]). 1697 1698 1699 /******************************* 1700 * INFO * 1701 *******************************/
pack.pl
in the pack and Strip is the strip-option for
archive_extract/3.
Requires library(archive), which is lazily loaded when needed.
1715:- if(exists_source(library(archive))). 1716ensure_loaded_archive :- 1717 current_predicate(archive_open/3), 1718 !. 1719ensure_loaded_archive :- 1720 use_module(library(archive)). 1721 1722pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :- 1723 ensure_loaded_archive, 1724 size_file(Archive, Bytes), 1725 setup_call_cleanup( 1726 archive_open(Archive, Handle, []), 1727 ( repeat, 1728 ( archive_next_header(Handle, InfoFile) 1729 -> true 1730 ; !, fail 1731 ) 1732 ), 1733 archive_close(Handle)), 1734 file_base_name(InfoFile, 'pack.pl'), 1735 atom_concat(Prefix, 'pack.pl', InfoFile), 1736 strip_option(Prefix, Pack, Strip), 1737 setup_call_cleanup( 1738 archive_open_entry(Handle, Stream), 1739 read_stream_to_terms(Stream, Info), 1740 close(Stream)), 1741 !, 1742 must_be(ground, Info), 1743 maplist(valid_term(pack_info_term), Info). 1744:- else. 1745pack_archive_info(_, _, _, _) :- 1746 existence_error(library, archive). 1747:- endif. 1748pack_archive_info(_, _, _, _) :- 1749 existence_error(pack_file, 'pack.pl'). 1750 1751strip_option('', _, []) :- !. 1752strip_option('./', _, []) :- !. 1753strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :- 1754 atom_concat(PrefixDir, /, Prefix), 1755 file_base_name(PrefixDir, Base), 1756 ( Base == Pack 1757 -> true 1758 ; pack_version_file(Pack, _, Base) 1759 -> true 1760 ; \+ sub_atom(PrefixDir, _, _, _, /) 1761 ). 1762 1763read_stream_to_terms(Stream, Terms) :- 1764 read(Stream, Term0), 1765 read_stream_to_terms(Term0, Stream, Terms). 1766 1767read_stream_to_terms(end_of_file, _, []) :- !. 1768read_stream_to_terms(Term0, Stream, [Term0|Terms]) :- 1769 read(Stream, Term1), 1770 read_stream_to_terms(Term1, Stream, Terms).
1778pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :- 1779 exists_directory(GitDir), 1780 !, 1781 git_ls_tree(Entries, [directory(GitDir)]), 1782 git_hash(Hash, [directory(GitDir)]), 1783 maplist(arg(4), Entries, Sizes), 1784 sum_list(Sizes, Bytes), 1785 dir_metadata(GitDir, Info). 1786 1787dir_metadata(GitDir, Info) :- 1788 directory_file_path(GitDir, 'pack.pl', InfoFile), 1789 read_file_to_terms(InfoFile, Info, [encoding(utf8)]), 1790 must_be(ground, Info), 1791 maplist(valid_term(pack_info_term), Info).
1797download_file_sanity_check(Archive, Pack, Info) :- 1798 info_field(name(PackName), Info), 1799 info_field(version(PackVersion), Info), 1800 pack_version_file(PackFile, FileVersion, Archive), 1801 must_match([Pack, PackName, PackFile], name), 1802 must_match([PackVersion, FileVersion], version). 1803 1804info_field(Field, Info) :- 1805 memberchk(Field, Info), 1806 ground(Field), 1807 !. 1808info_field(Field, _Info) :- 1809 functor(Field, FieldName, _), 1810 print_message(error, pack(missing(FieldName))), 1811 fail. 1812 1813must_match(Values, _Field) :- 1814 sort(Values, [_]), 1815 !. 1816must_match(Values, Field) :- 1817 print_message(error, pack(conflict(Field, Values))), 1818 fail. 1819 1820 1821 /******************************* 1822 * INSTALLATION * 1823 *******************************/
1837prepare_pack_dir(Dir, Options) :- 1838 exists_directory(Dir), 1839 !, 1840 ( empty_directory(Dir) 1841 -> true 1842 ; remove_existing_pack(Dir, Options) 1843 -> make_directory(Dir) 1844 ). 1845prepare_pack_dir(Dir, _) :- 1846 ( read_link(Dir, _, _) 1847 ; access_file(Dir, exist) 1848 ), 1849 !, 1850 delete_file(Dir), 1851 make_directory(Dir). 1852prepare_pack_dir(Dir, _) :- 1853 make_directory(Dir).
1859empty_directory(Dir) :- 1860 \+ ( directory_files(Dir, Entries), 1861 member(Entry, Entries), 1862 \+ special(Entry) 1863 ). 1864 1865special(.). 1866special(..).
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.1875remove_existing_pack(PackDir, Options) :- 1876 exists_directory(PackDir), 1877 !, 1878 ( ( option(upgrade(true), Options) 1879 ; confirm(remove_existing_pack(PackDir), yes, Options) 1880 ) 1881 -> delete_directory_and_contents(PackDir) 1882 ; print_message(error, pack(directory_exists(PackDir))), 1883 fail 1884 ). 1885remove_existing_pack(_, _).
1901pack_download_from_url(URL, PackTopDir, Pack, Options) :- 1902 option(git(true), Options), 1903 !, 1904 directory_file_path(PackTopDir, Pack, PackDir), 1905 prepare_pack_dir(PackDir, Options), 1906 ( option(branch(Branch), Options) 1907 -> Extra = ['--branch', Branch] 1908 ; Extra = [] 1909 ), 1910 run_process(path(git), [clone, URL, PackDir|Extra], []), 1911 git_checkout_version(PackDir, [update(false)|Options]), 1912 option(pack_dir(PackDir), Options, _). 1913pack_download_from_url(URL, PackTopDir, Pack, Options) :- 1914 download_url(URL), 1915 !, 1916 directory_file_path(PackTopDir, Pack, PackDir), 1917 prepare_pack_dir(PackDir, Options), 1918 pack_download_dir(PackTopDir, DownLoadDir), 1919 download_file(URL, Pack, DownloadBase, Options), 1920 directory_file_path(DownLoadDir, DownloadBase, DownloadFile), 1921 ( option(insecure(true), Options, false) 1922 -> TLSOptions = [cert_verify_hook(ssl_verify)] 1923 ; TLSOptions = [] 1924 ), 1925 print_message(informational, pack(download(begin, Pack, URL, DownloadFile))), 1926 setup_call_cleanup( 1927 http_open(URL, In, TLSOptions), 1928 setup_call_cleanup( 1929 open(DownloadFile, write, Out, [type(binary)]), 1930 copy_stream_data(In, Out), 1931 close(Out)), 1932 close(In)), 1933 print_message(informational, pack(download(end, Pack, URL, DownloadFile))), 1934 pack_archive_info(DownloadFile, Pack, Info, _), 1935 ( option(git_url(GitURL), Options) 1936 -> Origin = GitURL % implicit download from git. 1937 ; download_file_sanity_check(DownloadFile, Pack, Info), 1938 Origin = URL 1939 ), 1940 pack_unpack_from_local(DownloadFile, PackTopDir, Pack, PackDir, Options), 1941 pack_assert(PackDir, archive(DownloadFile, Origin)), 1942 option(pack_dir(PackDir), Options, _). 1943pack_download_from_url(URL, PackTopDir, Pack, Options) :- 1944 local_uri_file_name(URL, File), 1945 !, 1946 pack_unpack_from_local(File, PackTopDir, Pack, PackDir, Options), 1947 pack_assert(PackDir, archive(File, URL)), 1948 option(pack_dir(PackDir), Options, _). 1949pack_download_from_url(URL, _PackTopDir, _Pack, _Options) :- 1950 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')
.1974git_checkout_version(PackDir, Options) :- 1975 option(commit('HEAD'), Options), 1976 option(branch(Branch), Options), 1977 !, 1978 git_ensure_on_branch(PackDir, Branch), 1979 run_process(path(git), ['-C', PackDir, pull], []). 1980git_checkout_version(PackDir, Options) :- 1981 option(commit('HEAD'), Options), 1982 git_current_branch(_, [directory(PackDir)]), 1983 !, 1984 run_process(path(git), ['-C', PackDir, pull], []). 1985git_checkout_version(PackDir, Options) :- 1986 option(commit('HEAD'), Options), 1987 !, 1988 git_default_branch(Branch, [directory(PackDir)]), 1989 git_ensure_on_branch(PackDir, Branch), 1990 run_process(path(git), ['-C', PackDir, pull], []). 1991git_checkout_version(PackDir, Options) :- 1992 option(commit(Hash), Options), 1993 run_process(path(git), ['-C', PackDir, fetch], []), 1994 git_branches(Branches, [contains(Hash), directory(PackDir)]), 1995 git_process_output(['-C', PackDir, 'rev-parse' | Branches], 1996 read_lines_to_atoms(Commits), 1997 []), 1998 nth1(I, Commits, Hash), 1999 nth1(I, Branches, Branch), 2000 !, 2001 git_ensure_on_branch(PackDir, Branch). 2002git_checkout_version(PackDir, Options) :- 2003 option(commit(Hash), Options), 2004 !, 2005 run_process(path(git), ['-C', PackDir, checkout, '--quiet', Hash], []). 2006git_checkout_version(PackDir, Options) :- 2007 option(version(Version), Options), 2008 !, 2009 git_tags(Tags, [directory(PackDir)]), 2010 ( memberchk(Version, Tags) 2011 -> Tag = Version 2012 ; member(Tag, Tags), 2013 sub_atom(Tag, B, _, 0, Version), 2014 sub_atom(Tag, 0, B, _, Prefix), 2015 version_prefix(Prefix) 2016 -> true 2017 ; existence_error(version_tag, Version) 2018 ), 2019 run_process(path(git), ['-C', PackDir, checkout, Tag], []). 2020git_checkout_version(_PackDir, Options) :- 2021 option(fresh(true), Options), 2022 !. 2023git_checkout_version(PackDir, _Options) :- 2024 git_current_branch(_, [directory(PackDir)]), 2025 !, 2026 run_process(path(git), ['-C', PackDir, pull], []). 2027git_checkout_version(PackDir, _Options) :- 2028 git_default_branch(Branch, [directory(PackDir)]), 2029 git_ensure_on_branch(PackDir, Branch), 2030 run_process(path(git), ['-C', PackDir, pull], []).
2036git_ensure_on_branch(PackDir, Branch) :- 2037 git_current_branch(Branch, [directory(PackDir)]), 2038 !. 2039git_ensure_on_branch(PackDir, Branch) :- 2040 run_process(path(git), ['-C', PackDir, checkout, Branch], []). 2041 2042read_lines_to_atoms(Atoms, In) :- 2043 read_line_to_string(In, Line), 2044 ( Line == end_of_file 2045 -> Atoms = [] 2046 ; atom_string(Atom, Line), 2047 Atoms = [Atom|T], 2048 read_lines_to_atoms(T, In) 2049 ). 2050 2051version_prefix(Prefix) :- 2052 atom_codes(Prefix, Codes), 2053 phrase(version_prefix, Codes). 2054 2055version_prefix --> 2056 [C], 2057 { code_type(C, alpha) }, 2058 !, 2059 version_prefix. 2060version_prefix --> 2061 "-". 2062version_prefix --> 2063 "_". 2064version_prefix --> 2065 "".
2072download_file(URL, Pack, File, Options) :- 2073 option(version(Version), Options), 2074 !, 2075 file_name_extension(_, Ext, URL), 2076 format(atom(File), '~w-~w.~w', [Pack, Version, Ext]). 2077download_file(URL, Pack, File, _) :- 2078 file_base_name(URL,Basename), 2079 no_int_file_name_extension(Tag,Ext,Basename), 2080 tag_version(Tag,Version), 2081 !, 2082 format(atom(File0), '~w-~w', [Pack, Version]), 2083 file_name_extension(File0, Ext, File). 2084download_file(URL, _, File, _) :- 2085 file_base_name(URL, File).
2093:- public pack_url_file/2. 2094pack_url_file(URL, FileID) :- 2095 github_release_url(URL, Pack, Version), 2096 !, 2097 download_file(URL, Pack, FileID, [version(Version)]). 2098pack_url_file(URL, FileID) :- 2099 file_base_name(URL, FileID). 2100 2101% ssl_verify(+SSL, +ProblemCert, +AllCerts, +FirstCert, +Error) 2102% 2103% Used if insecure(true) is given to pack_install/2. Accepts any 2104% certificate. 2105 2106:- public ssl_verify/5. 2107ssl_verify(_SSL, 2108 _ProblemCertificate, _AllCertificates, _FirstCertificate, 2109 _Error). 2110 2111pack_download_dir(PackTopDir, DownLoadDir) :- 2112 directory_file_path(PackTopDir, 'Downloads', DownLoadDir), 2113 ( exists_directory(DownLoadDir) 2114 -> true 2115 ; make_directory(DownLoadDir) 2116 ), 2117 ( access_file(DownLoadDir, write) 2118 -> true 2119 ; permission_error(write, directory, DownLoadDir) 2120 ).
ftp://
are also download URLs, but we cannot download
from them.2128download_url(URL) :- 2129 atom(URL), 2130 uri_components(URL, Components), 2131 uri_data(scheme, Components, Scheme), 2132 download_scheme(Scheme). 2133 2134download_scheme(http). 2135download_scheme(https).
2145pack_post_install(Pack, PackDir, Options) :-
2146 post_install_foreign(Pack, PackDir, Options),
2147 post_install_autoload(PackDir, Options),
2148 attach_packs(PackDir, [duplicate(warning)]).
2156pack_rebuild :- 2157 forall(current_pack(Pack), 2158 ( print_message(informational, pack(rebuild(Pack))), 2159 pack_rebuild(Pack) 2160 )). 2161 2162pack_rebuild(Pack) :- 2163 current_pack(Pack, PackDir), 2164 !, 2165 post_install_foreign(Pack, PackDir, [rebuild(true)]). 2166pack_rebuild(Pack) :- 2167 unattached_pack(Pack, PackDir), 2168 !, 2169 post_install_foreign(Pack, PackDir, [rebuild(true)]). 2170pack_rebuild(Pack) :- 2171 existence_error(pack, Pack). 2172 2173unattached_pack(Pack, BaseDir) :- 2174 directory_file_path(Pack, 'pack.pl', PackFile), 2175 absolute_file_name(pack(PackFile), PackPath, 2176 [ access(read), 2177 file_errors(fail) 2178 ]), 2179 file_directory_name(PackPath, BaseDir).
2195post_install_foreign(Pack, PackDir, Options) :- 2196 is_foreign_pack(PackDir, _), 2197 !, 2198 ( pack_info_term(PackDir, pack_version(Version)) 2199 -> true 2200 ; Version = 1 2201 ), 2202 option(rebuild(Rebuild), Options, if_absent), 2203 current_prolog_flag(arch, Arch), 2204 prolog_version_dotted(PrologVersion), 2205 ( Rebuild == if_absent, 2206 foreign_present(PackDir, Arch) 2207 -> print_message(informational, pack(kept_foreign(Pack, Arch))), 2208 ( pack_status_dir(PackDir, built(Arch, _, _)) 2209 -> true 2210 ; pack_assert(PackDir, built(Arch, PrologVersion, downloaded)) 2211 ) 2212 ; BuildSteps0 = [[dependencies], [configure], build, install, [test]], 2213 ( Rebuild == true 2214 -> BuildSteps1 = [distclean|BuildSteps0] 2215 ; BuildSteps1 = BuildSteps0 2216 ), 2217 ( option(test(false), Options) 2218 -> delete(BuildSteps1, [test], BuildSteps2) 2219 ; BuildSteps2 = BuildSteps1 2220 ), 2221 ( option(clean(true), Options) 2222 -> append(BuildSteps2, [[clean]], BuildSteps) 2223 ; BuildSteps = BuildSteps2 2224 ), 2225 build_steps(BuildSteps, PackDir, [pack_version(Version)|Options]), 2226 pack_assert(PackDir, built(Arch, PrologVersion, built)) 2227 ). 2228post_install_foreign(_, _, _).
lib
directory for
the current architecture.
2239foreign_present(PackDir, Arch) :-
2240 atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
2241 exists_directory(ForeignBaseDir),
2242 !,
2243 atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
2244 exists_directory(ForeignDir),
2245 current_prolog_flag(shared_object_extension, Ext),
2246 atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
2247 expand_file_name(Pattern, Files),
2248 Files \== [].
2255is_foreign_pack(PackDir, Type) :- 2256 foreign_file(File, Type), 2257 directory_file_path(PackDir, File, Path), 2258 exists_file(Path). 2259 2260foreign_file('CMakeLists.txt', cmake). 2261foreign_file('configure', configure). 2262foreign_file('configure.in', autoconf). 2263foreign_file('configure.ac', autoconf). 2264foreign_file('Makefile.am', automake). 2265foreign_file('Makefile', make). 2266foreign_file('makefile', make). 2267foreign_file('conanfile.txt', conan). 2268foreign_file('conanfile.py', conan). 2269 2270 2271 /******************************* 2272 * AUTOLOAD * 2273 *******************************/
2279post_install_autoload(PackDir, Options) :- 2280 is_autoload_pack(PackDir, Options), 2281 !, 2282 directory_file_path(PackDir, prolog, PrologLibDir), 2283 make_library_index(PrologLibDir). 2284post_install_autoload(_, _). 2285 2286is_autoload_pack(PackDir, Options) :- 2287 option(autoload(true), Options, true), 2288 pack_info_term(PackDir, autoload(true)). 2289 2290 2291 /******************************* 2292 * UPGRADE * 2293 *******************************/
pack_install(Pack, [upgrade(true)])
.2299pack_upgrade(Pack) :- 2300 pack_install(Pack, [upgrade(true)]). 2301 2302 2303 /******************************* 2304 * REMOVE * 2305 *******************************/
true
delete dependencies without asking.2318pack_remove(Pack) :- 2319 pack_remove(Pack, []). 2320 2321pack_remove(Pack, Options) :- 2322 option(dependencies(false), Options), 2323 !, 2324 pack_remove_forced(Pack). 2325pack_remove(Pack, Options) :- 2326 ( dependents(Pack, Deps) 2327 -> ( option(dependencies(true), Options) 2328 -> true 2329 ; confirm_remove(Pack, Deps, Delete, Options) 2330 ), 2331 forall(member(P, Delete), pack_remove_forced(P)) 2332 ; pack_remove_forced(Pack) 2333 ). 2334 2335pack_remove_forced(Pack) :- 2336 catch('$pack_detach'(Pack, BaseDir), 2337 error(existence_error(pack, Pack), _), 2338 fail), 2339 !, 2340 print_message(informational, pack(remove(BaseDir))), 2341 delete_directory_and_contents(BaseDir). 2342pack_remove_forced(Pack) :- 2343 unattached_pack(Pack, BaseDir), 2344 !, 2345 delete_directory_and_contents(BaseDir). 2346pack_remove_forced(Pack) :- 2347 print_message(informational, error(existence_error(pack, Pack),_)). 2348 2349confirm_remove(Pack, Deps, Delete, Options) :- 2350 print_message(warning, pack(depends(Pack, Deps))), 2351 menu(pack(resolve_remove), 2352 [ [Pack] = remove_only(Pack), 2353 [Pack|Deps] = remove_deps(Pack, Deps), 2354 [] = cancel 2355 ], [], Delete, Options), 2356 Delete \== []. 2357 2358 2359 /******************************* 2360 * PUBLISH * 2361 *******************************/
?- 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 first2414pack_publish(Dir, Options) :- 2415 \+ download_url(Dir), 2416 is_git_directory(Dir), !, 2417 pack_git_info(Dir, _Hash, Metadata), 2418 prepare_repository(Dir, Metadata, Options), 2419 ( memberchk(download(URL), Metadata), 2420 git_url(URL, _) 2421 -> true 2422 ; option(remote(Remote), Options, origin), 2423 git_remote_url(Remote, RemoteURL, [directory(Dir)]), 2424 git_to_https_url(RemoteURL, URL) 2425 ), 2426 memberchk(version(Version), Metadata), 2427 pack_publish_(URL, 2428 [ version(Version) 2429 | Options 2430 ]). 2431pack_publish(Spec, Options) :- 2432 pack_publish_(Spec, Options). 2433 2434pack_publish_(Spec, Options) :- 2435 pack_default_options(Spec, Pack, Options, DefOptions), 2436 option(url(URL), DefOptions), 2437 valid_publish_url(URL, Options), 2438 prepare_build_location(Pack, Dir, Clean, Options), 2439 ( option(register(false), Options) 2440 -> InstallOptions = DefOptions 2441 ; InstallOptions = [publish(Pack)|DefOptions] 2442 ), 2443 call_cleanup(pack_install(Pack, 2444 [ pack(Pack) 2445 | InstallOptions 2446 ]), 2447 cleanup_publish(Clean, Dir)). 2448 2449cleanup_publish(true, Dir) :- 2450 !, 2451 delete_directory_and_contents(Dir). 2452cleanup_publish(_, _). 2453 2454valid_publish_url(URL, Options) :- 2455 option(register(Register), Options, true), 2456 ( Register == false 2457 -> true 2458 ; download_url(URL) 2459 -> true 2460 ; permission_error(publish, pack, URL) 2461 ). 2462 2463prepare_build_location(Pack, Dir, Clean, Options) :- 2464 ( option(pack_directory(Dir), Options) 2465 -> ensure_directory(Dir), 2466 ( option(clean(true), Options, true) 2467 -> delete_directory_contents(Dir) 2468 ; true 2469 ) 2470 ; tmp_file(pack, Dir), 2471 make_directory(Dir), 2472 Clean = true 2473 ), 2474 ( option(isolated(false), Options) 2475 -> detach_pack(Pack, _), 2476 attach_packs(Dir, [search(first)]) 2477 ; attach_packs(Dir, [replace(true)]) 2478 ).
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.2489prepare_repository(_Dir, _Metadata, Options) :- 2490 option(register(false), Options), 2491 !. 2492prepare_repository(Dir, Metadata, Options) :- 2493 git_dir_must_be_clean(Dir), 2494 git_must_be_on_default_branch(Dir, Options), 2495 tag_git_dir(Dir, Metadata, Action, Options), 2496 confirm(git_push, yes, Options), 2497 run_process(path(git), ['-C', file(Dir), push ], []), 2498 ( Action = push_tag(Tag) 2499 -> run_process(path(git), ['-C', file(Dir), push, origin, Tag ], []) 2500 ; true 2501 ). 2502 2503git_dir_must_be_clean(Dir) :- 2504 git_describe(Description, [directory(Dir)]), 2505 ( sub_atom(Description, _, _, 0, '-DIRTY') 2506 -> print_message(error, pack(git_not_clean(Dir))), 2507 fail 2508 ; true 2509 ). 2510 2511git_must_be_on_default_branch(Dir, Options) :- 2512 ( option(branch(Default), Options) 2513 -> true 2514 ; git_default_branch(Default, [directory(Dir)]) 2515 ), 2516 git_current_branch(Current, [directory(Dir)]), 2517 ( Default == Current 2518 -> true 2519 ; print_message(error, 2520 pack(git_branch_not_default(Dir, Default, Current))), 2521 fail 2522 ).
2531tag_git_dir(Dir, Metadata, Action, Options) :- 2532 memberchk(version(Version), Metadata), 2533 atom_concat('V', Version, Tag), 2534 git_tags(Tags, [directory(Dir)]), 2535 ( memberchk(Tag, Tags) 2536 -> git_tag_is_consistent(Dir, Tag, Action, Options) 2537 ; format(string(Message), 'Release ~w', [Version]), 2538 findall(Opt, git_tag_option(Opt, Options), Argv, 2539 [ '-m', Message, Tag ]), 2540 confirm(git_tag(Tag), yes, Options), 2541 run_process(path(git), ['-C', file(Dir), tag | Argv ], []), 2542 Action = push_tag(Tag) 2543 ). 2544 2545git_tag_option('-s', Options) :- option(sign(true), Options, true). 2546git_tag_option('-f', Options) :- option(force(true), Options, true). 2547 2548git_tag_is_consistent(Dir, Tag, Action, Options) :- 2549 format(atom(TagRef), 'refs/tags/~w', [Tag]), 2550 format(atom(CommitRef), 'refs/tags/~w^{}', [Tag]), 2551 option(remote(Remote), Options, origin), 2552 git_ls_remote(Dir, LocalTags, [tags(true)]), 2553 memberchk(CommitHash-CommitRef, LocalTags), 2554 ( git_hash(CommitHash, [directory(Dir)]) 2555 -> true 2556 ; print_message(error, pack(git_release_tag_not_at_head(Tag))), 2557 fail 2558 ), 2559 memberchk(TagHash-TagRef, LocalTags), 2560 git_ls_remote(Remote, RemoteTags, [tags(true)]), 2561 ( memberchk(RemoteCommitHash-CommitRef, RemoteTags), 2562 memberchk(RemoteTagHash-TagRef, RemoteTags) 2563 -> ( RemoteCommitHash == CommitHash, 2564 RemoteTagHash == TagHash 2565 -> Action = none 2566 ; print_message(error, pack(git_tag_out_of_sync(Tag))), 2567 fail 2568 ) 2569 ; Action = push_tag(Tag) 2570 ).
2578git_to_https_url(URL, URL) :- 2579 download_url(URL), 2580 !. 2581git_to_https_url(GitURL, URL) :- 2582 atom_concat('git@github.com:', Repo, GitURL), 2583 !, 2584 atom_concat('https://github.com/', Repo, URL). 2585git_to_https_url(GitURL, _) :- 2586 print_message(error, pack(git_no_https(GitURL))), 2587 fail. 2588 2589 2590 /******************************* 2591 * PROPERTIES * 2592 *******************************/
README
file (if present)TODO
file (if present)2615pack_property(Pack, Property) :- 2616 findall(Pack-Property, pack_property_(Pack, Property), List), 2617 member(Pack-Property, List). % make det if applicable 2618 2619pack_property_(Pack, Property) :- 2620 pack_info(Pack, _, Property). 2621pack_property_(Pack, Property) :- 2622 \+ \+ info_file(Property, _), 2623 '$pack':pack(Pack, BaseDir), 2624 access_file(BaseDir, read), 2625 directory_files(BaseDir, Files), 2626 member(File, Files), 2627 info_file(Property, Pattern), 2628 downcase_atom(File, Pattern), 2629 directory_file_path(BaseDir, File, InfoFile), 2630 arg(1, Property, InfoFile). 2631 2632info_file(readme(_), 'readme.txt'). 2633info_file(readme(_), 'readme'). 2634info_file(todo(_), 'todo.txt'). 2635info_file(todo(_), 'todo'). 2636 2637 2638 /******************************* 2639 * VERSION LOGIC * 2640 *******************************/
mypack-1.5
.2649pack_version_file(Pack, Version, GitHubRelease) :- 2650 atomic(GitHubRelease), 2651 github_release_url(GitHubRelease, Pack, Version), 2652 !. 2653pack_version_file(Pack, Version, Path) :- 2654 atomic(Path), 2655 file_base_name(Path, File), 2656 no_int_file_name_extension(Base, _Ext, File), 2657 atom_codes(Base, Codes), 2658 ( phrase(pack_version(Pack, Version), Codes), 2659 safe_pack_name(Pack) 2660 -> true 2661 ). 2662 2663no_int_file_name_extension(Base, Ext, File) :- 2664 file_name_extension(Base0, Ext0, File), 2665 \+ atom_number(Ext0, _), 2666 !, 2667 Base = Base0, 2668 Ext = Ext0. 2669no_int_file_name_extension(File, '', File).
2676safe_pack_name(Name) :- 2677 atom_length(Name, Len), 2678 Len >= 3, % demand at least three length 2679 atom_codes(Name, Codes), 2680 maplist(safe_pack_char, Codes), 2681 !. 2682 2683safe_pack_char(C) :- between(0'a, 0'z, C), !. 2684safe_pack_char(C) :- between(0'A, 0'Z, C), !. 2685safe_pack_char(C) :- between(0'0, 0'9, C), !. 2686safe_pack_char(0'_).
2692pack_version(Pack, Version) --> 2693 string(Codes), "-", 2694 version(Parts), 2695 !, 2696 { atom_codes(Pack, Codes), 2697 atomic_list_concat(Parts, '.', Version) 2698 }. 2699 2700version([H|T]) --> 2701 version_part(H), 2702 ( "." 2703 -> version(T) 2704 ; {T=[]} 2705 ). 2706 2707version_part(*) --> "*", !. 2708version_part(Int) --> integer(Int). 2709 2710 2711 /******************************* 2712 * GIT LOGIC * 2713 *******************************/ 2714 2715have_git :- 2716 process_which(path(git), _).
2723git_url(URL, Pack) :- 2724 uri_components(URL, Components), 2725 uri_data(scheme, Components, Scheme), 2726 nonvar(Scheme), % must be full URL 2727 uri_data(path, Components, Path), 2728 ( Scheme == git 2729 -> true 2730 ; git_download_scheme(Scheme), 2731 file_name_extension(_, git, Path) 2732 ; git_download_scheme(Scheme), 2733 catch(git_ls_remote(URL, _, [refs(['HEAD']), error(_)]), _, fail) 2734 -> true 2735 ), 2736 file_base_name(Path, PackExt), 2737 ( file_name_extension(Pack, git, PackExt) 2738 -> true 2739 ; Pack = PackExt 2740 ), 2741 ( safe_pack_name(Pack) 2742 -> true 2743 ; domain_error(pack_name, Pack) 2744 ). 2745 2746git_download_scheme(http). 2747git_download_scheme(https).
https:/github.com/<owner>/<pack>/archive/[vV]?<version>.zip'
2756github_release_url(URL, Pack, Version) :- 2757 uri_components(URL, Components), 2758 uri_data(authority, Components, 'github.com'), 2759 uri_data(scheme, Components, Scheme), 2760 download_scheme(Scheme), 2761 uri_data(path, Components, Path), 2762 github_archive_path(Archive,Pack,File), 2763 atomic_list_concat(Archive, /, Path), 2764 file_name_extension(Tag, Ext, File), 2765 github_archive_extension(Ext), 2766 tag_version(Tag, Version), 2767 !. 2768 2769github_archive_path(['',_User,Pack,archive,File],Pack,File). 2770github_archive_path(['',_User,Pack,archive,refs,tags,File],Pack,File). 2771 2772github_archive_extension(tgz). 2773github_archive_extension(zip).
[vV]?int(\.int)*
.2780tag_version(Tag, Version) :- 2781 version_tag_prefix(Prefix), 2782 atom_concat(Prefix, Version, Tag), 2783 is_version(Version). 2784 2785version_tag_prefix(v). 2786version_tag_prefix('V'). 2787version_tag_prefix('').
2796git_archive_url(URL, Archive, Options) :- 2797 uri_components(URL, Components), 2798 uri_data(authority, Components, 'github.com'), 2799 uri_data(path, Components, Path), 2800 atomic_list_concat(['', User, RepoGit], /, Path), 2801 $, 2802 remove_git_ext(RepoGit, Repo), 2803 git_archive_version(Version, Options), 2804 atomic_list_concat(['', User, Repo, zip, Version], /, ArchivePath), 2805 uri_edit([ path(ArchivePath), 2806 host('codeload.github.com') 2807 ], 2808 URL, Archive). 2809git_archive_url(URL, _, _) :- 2810 print_message(error, pack(no_git(URL))), 2811 fail. 2812 2813remove_git_ext(RepoGit, Repo) :- 2814 file_name_extension(Repo, git, RepoGit), 2815 !. 2816remove_git_ext(Repo, Repo). 2817 2818git_archive_version(Version, Options) :- 2819 option(commit(Version), Options), 2820 !. 2821git_archive_version(Version, Options) :- 2822 option(branch(Version), Options), 2823 !. 2824git_archive_version(Version, Options) :- 2825 option(version(Version), Options), 2826 !. 2827git_archive_version('HEAD', _). 2828 2829 /******************************* 2830 * QUERY CENTRAL DB * 2831 *******************************/
2838register_downloads(_, Options) :- 2839 option(register(false), Options), 2840 \+ option(do_publish(_), Options), 2841 !. 2842register_downloads(Infos, Options) :- 2843 convlist(download_data, Infos, Data), 2844 ( Data == [] 2845 -> true 2846 ; query_pack_server(downloaded(Data), Reply, Options), 2847 ( option(do_publish(Pack), Options) 2848 -> ( member(Info, Infos), 2849 Info.pack == Pack 2850 -> true 2851 ), 2852 ( Reply = true(Actions), 2853 memberchk(Pack-Result, Actions) 2854 -> ( registered(Result) 2855 -> true 2856 ; print_message(error, pack(publish_failed(Info, Result))), 2857 fail 2858 ) 2859 ; print_message(error, pack(publish_failed(Info, false))) 2860 ) 2861 ; true 2862 ) 2863 ). 2864 2865registered(git(_URL)). 2866registered(file(_URL)). 2867 2868publish_download(Infos, Options) :- 2869 select_option(publish(Pack), Options, Options1), 2870 !, 2871 register_downloads(Infos, [do_publish(Pack)|Options1]). 2872publish_download(_Infos, _Options). 2873 2874download_data(Info, Data), 2875 Info.get(git) == true => % Git clone 2876 Data = download(URL, Hash, Metadata), 2877 URL = Info.get(downloaded), 2878 pack_git_info(Info.installed, Hash, Metadata). 2879download_data(Info, Data), 2880 _{git_url:URL,hash:Hash} :< Info, Hash \== (-) => 2881 Data = download(URL, Hash, Metadata), % Git downloaded as zip 2882 dir_metadata(Info.installed, Metadata). 2883download_data(Info, Data) => % Archive download. 2884 Data = download(URL, Hash, Metadata), 2885 URL = Info.get(downloaded), 2886 download_url(URL), 2887 pack_status_dir(Info.installed, archive(Archive, URL)), 2888 file_sha1(Archive, Hash), 2889 pack_archive_info(Archive, _Pack, Metadata, _).
2896query_pack_server(Query, Result, Options) :- 2897 ( option(server(ServerOpt), Options) 2898 -> server_url(ServerOpt, ServerBase) 2899 ; setting(server, ServerBase), 2900 ServerBase \== '' 2901 ), 2902 atom_concat(ServerBase, query, Server), 2903 format(codes(Data), '~q.~n', Query), 2904 info_level(Informational, Options), 2905 print_message(Informational, pack(contacting_server(Server))), 2906 setup_call_cleanup( 2907 http_open(Server, In, 2908 [ post(codes(application/'x-prolog', Data)), 2909 header(content_type, ContentType) 2910 ]), 2911 read_reply(ContentType, In, Result), 2912 close(In)), 2913 message_severity(Result, Level, Informational), 2914 print_message(Level, pack(server_reply(Result))). 2915 2916server_url(URL0, URL) :- 2917 uri_components(URL0, Components), 2918 uri_data(scheme, Components, Scheme), 2919 var(Scheme), 2920 !, 2921 atom_concat('https://', URL0, URL1), 2922 server_url(URL1, URL). 2923server_url(URL0, URL) :- 2924 uri_components(URL0, Components), 2925 uri_data(path, Components, ''), 2926 !, 2927 uri_edit([path('/pack/')], URL0, URL). 2928server_url(URL, URL). 2929 2930read_reply(ContentType, In, Result) :- 2931 sub_atom(ContentType, 0, _, _, 'application/x-prolog'), 2932 !, 2933 set_stream(In, encoding(utf8)), 2934 read(In, Result). 2935read_reply(ContentType, In, _Result) :- 2936 read_string(In, 500, String), 2937 print_message(error, pack(no_prolog_response(ContentType, String))), 2938 fail. 2939 2940info_level(Level, Options) :- 2941 option(silent(true), Options), 2942 !, 2943 Level = silent. 2944info_level(informational, _). 2945 2946message_severity(true(_), Informational, Informational). 2947message_severity(false, warning, _). 2948message_severity(exception(_), error, _). 2949 2950 2951 /******************************* 2952 * WILDCARD URIs * 2953 *******************************/
2962available_download_versions(URL, Versions) :- 2963 wildcard_pattern(URL), 2964 github_url(URL, User, Repo), 2965 !, 2966 findall(Version-VersionURL, 2967 github_version(User, Repo, Version, VersionURL), 2968 Versions). 2969available_download_versions(URL, Versions) :- 2970 wildcard_pattern(URL), 2971 !, 2972 file_directory_name(URL, DirURL0), 2973 ensure_slash(DirURL0, DirURL), 2974 print_message(informational, pack(query_versions(DirURL))), 2975 setup_call_cleanup( 2976 http_open(DirURL, In, []), 2977 load_html(stream(In), DOM, 2978 [ syntax_errors(quiet) 2979 ]), 2980 close(In)), 2981 findall(MatchingURL, 2982 absolute_matching_href(DOM, URL, MatchingURL), 2983 MatchingURLs), 2984 ( MatchingURLs == [] 2985 -> print_message(warning, pack(no_matching_urls(URL))) 2986 ; true 2987 ), 2988 versioned_urls(MatchingURLs, VersionedURLs), 2989 sort_version_pairs(VersionedURLs, Versions), 2990 print_message(informational, pack(found_versions(Versions))). 2991available_download_versions(URL, [Version-URL]) :- 2992 ( pack_version_file(_Pack, Version0, URL) 2993 -> Version = Version0 2994 ; Version = '0.0.0' 2995 ).
3001sort_version_pairs(Pairs, Sorted) :- 3002 map_list_to_pairs(version_pair_sort_key_, Pairs, Keyed), 3003 sort(1, @>=, Keyed, SortedKeyed), 3004 pairs_values(SortedKeyed, Sorted). 3005 3006version_pair_sort_key_(Version-_Data, Key) :- 3007 version_sort_key(Version, Key). 3008 3009version_sort_key(Version, Key) :- 3010 split_string(Version, ".", "", Parts), 3011 maplist(number_string, Key, Parts), 3012 !. 3013version_sort_key(Version, _) :- 3014 domain_error(version, Version).
3020github_url(URL, User, Repo) :-
3021 uri_components(URL, uri_components(https,'github.com',Path,_,_)),
3022 atomic_list_concat(['',User,Repo|_], /, Path).
3030github_version(User, Repo, Version, VersionURI) :- 3031 atomic_list_concat(['',repos,User,Repo,tags], /, Path1), 3032 uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)), 3033 setup_call_cleanup( 3034 http_open(ApiUri, In, 3035 [ request_header('Accept'='application/vnd.github.v3+json') 3036 ]), 3037 json_read_dict(In, Dicts), 3038 close(In)), 3039 member(Dict, Dicts), 3040 atom_string(Tag, Dict.name), 3041 tag_version(Tag, Version), 3042 atom_string(VersionURI, Dict.zipball_url). 3043 3044wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *). 3045wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?). 3046 3047ensure_slash(Dir, DirS) :- 3048 ( sub_atom(Dir, _, _, 0, /) 3049 -> DirS = Dir 3050 ; atom_concat(Dir, /, DirS) 3051 ). 3052 3053absolute_matching_href(DOM, Pattern, Match) :- 3054 xpath(DOM, //a(@href), HREF), 3055 uri_normalized(HREF, Pattern, Match), 3056 wildcard_match(Pattern, Match). 3057 3058versioned_urls([], []). 3059versioned_urls([H|T0], List) :- 3060 file_base_name(H, File), 3061 ( pack_version_file(_Pack, Version, File) 3062 -> List = [Version-H|T] 3063 ; List = T 3064 ), 3065 versioned_urls(T0, T). 3066 3067 3068 /******************************* 3069 * DEPENDENCIES * 3070 *******************************/
3078pack_provides(Pack, Pack@Version) :- 3079 current_pack(Pack), 3080 once(pack_info(Pack, version, version(Version))). 3081pack_provides(Pack, Provides) :- 3082 findall(Prv, pack_info(Pack, dependency, provides(Prv)), PrvList), 3083 member(Provides, PrvList). 3084 3085pack_requires(Pack, Requires) :- 3086 current_pack(Pack), 3087 findall(Req, pack_info(Pack, dependency, requires(Req)), ReqList), 3088 member(Requires, ReqList). 3089 3090pack_conflicts(Pack, Conflicts) :- 3091 current_pack(Pack), 3092 findall(Cfl, pack_info(Pack, dependency, conflicts(Cfl)), CflList), 3093 member(Conflicts, CflList).
3100pack_depends_on(Pack, Dependency) :- 3101 ground(Pack), 3102 !, 3103 pack_requires(Pack, Requires), 3104 \+ is_prolog_token(Requires), 3105 pack_provides(Dependency, Provides), 3106 satisfies_req(Provides, Requires). 3107pack_depends_on(Pack, Dependency) :- 3108 ground(Dependency), 3109 !, 3110 pack_provides(Dependency, Provides), 3111 pack_requires(Pack, Requires), 3112 satisfies_req(Provides, Requires). 3113pack_depends_on(Pack, Dependency) :- 3114 current_pack(Pack), 3115 pack_depends_on(Pack, Dependency).
3122dependents(Pack, Deps) :- 3123 setof(Dep, dependent(Pack, Dep, []), Deps). 3124 3125dependent(Pack, Dep, Seen) :- 3126 pack_depends_on(Dep0, Pack), 3127 \+ memberchk(Dep0, Seen), 3128 ( Dep = Dep0 3129 ; dependent(Dep0, Dep, [Dep0|Seen]) 3130 ).
3136validate_dependencies :- 3137 setof(Issue, pack_dependency_issue(_, Issue), Issues), 3138 !, 3139 print_message(warning, pack(dependency_issues(Issues))). 3140validate_dependencies.
3152pack_dependency_issue(Pack, Issue) :- 3153 current_pack(Pack), 3154 pack_dependency_issue_(Pack, Issue). 3155 3156pack_dependency_issue_(Pack, unsatisfied(Pack, Requires)) :- 3157 pack_requires(Pack, Requires), 3158 ( is_prolog_token(Requires) 3159 -> \+ prolog_satisfies(Requires) 3160 ; \+ ( pack_provides(_, Provides), 3161 satisfies_req(Provides, Requires) ) 3162 ). 3163pack_dependency_issue_(Pack, conflicts(Pack, Conflicts)) :- 3164 pack_conflicts(Pack, Conflicts), 3165 ( is_prolog_token(Conflicts) 3166 -> prolog_satisfies(Conflicts) 3167 ; pack_provides(_, Provides), 3168 satisfies_req(Provides, Conflicts) 3169 ). 3170 3171 3172 /******************************* 3173 * RECORD PACK FACTS * 3174 *******************************/
built
if we built it or downloaded
if it was downloaded.true
, pack was installed as dependency.3190pack_assert(PackDir, Fact) :- 3191 must_be(ground, Fact), 3192 findall(Term, pack_status_dir(PackDir, Term), Facts0), 3193 update_facts(Facts0, Fact, Facts), 3194 OpenOptions = [encoding(utf8), lock(exclusive)], 3195 status_file(PackDir, StatusFile), 3196 ( Facts == Facts0 3197 -> true 3198 ; Facts0 \== [], 3199 append(Facts0, New, Facts) 3200 -> setup_call_cleanup( 3201 open(StatusFile, append, Out, OpenOptions), 3202 maplist(write_fact(Out), New), 3203 close(Out)) 3204 ; setup_call_cleanup( 3205 open(StatusFile, write, Out, OpenOptions), 3206 ( write_facts_header(Out), 3207 maplist(write_fact(Out), Facts) 3208 ), 3209 close(Out)) 3210 ). 3211 3212update_facts([], Fact, [Fact]) :- 3213 !. 3214update_facts([H|T], Fact, [Fact|T]) :- 3215 general_pack_fact(Fact, GenFact), 3216 general_pack_fact(H, GenTerm), 3217 GenFact =@= GenTerm, 3218 !. 3219update_facts([H|T0], Fact, [H|T]) :- 3220 update_facts(T0, Fact, T). 3221 3222general_pack_fact(built(Arch, _Version, _How), General) => 3223 General = built(Arch, _, _). 3224general_pack_fact(Term, General), compound(Term) => 3225 compound_name_arity(Term, Name, Arity), 3226 compound_name_arity(General, Name, Arity). 3227general_pack_fact(Term, General) => 3228 General = Term. 3229 3230write_facts_header(Out) :- 3231 format(Out, '% Fact status file. Managed by package manager.~n', []). 3232 3233write_fact(Out, Term) :- 3234 format(Out, '~q.~n', [Term]).
status.db
.3242pack_status(Pack, Fact) :- 3243 current_pack(Pack, PackDir), 3244 pack_status_dir(PackDir, Fact). 3245 3246pack_status_dir(PackDir, Fact) :- 3247 det_if(ground(Fact), pack_status_(PackDir, Fact)). 3248 3249pack_status_(PackDir, Fact) :- 3250 status_file(PackDir, StatusFile), 3251 catch(term_in_file(valid_term(pack_status_term), StatusFile, Fact), 3252 error(existence_error(source_sink, StatusFile), _), 3253 fail). 3254 3255pack_status_term(built(atom, version, oneof([built,downloaded]))). 3256pack_status_term(automatic(boolean)). 3257pack_status_term(archive(atom, atom)).
3267update_automatic(Info) :- 3268 _ = Info.get(dependency_for), 3269 \+ pack_status(Info.installed, automatic(_)), 3270 !, 3271 pack_assert(Info.installed, automatic(true)). 3272update_automatic(Info) :- 3273 pack_assert(Info.installed, automatic(false)). 3274 3275status_file(PackDir, StatusFile) :- 3276 directory_file_path(PackDir, 'status.db', StatusFile). 3277 3278 /******************************* 3279 * USER INTERACTION * 3280 *******************************/ 3281 3282:- multifile prolog:message//1.
3286menu(_Question, _Alternatives, Default, Selection, Options) :- 3287 option(interactive(false), Options), 3288 !, 3289 Selection = Default. 3290menu(Question, Alternatives, Default, Selection, _) :- 3291 length(Alternatives, N), 3292 between(1, 5, _), 3293 print_message(query, Question), 3294 print_menu(Alternatives, Default, 1), 3295 print_message(query, pack(menu(select))), 3296 read_selection(N, Choice), 3297 !, 3298 ( Choice == default 3299 -> Selection = Default 3300 ; nth1(Choice, Alternatives, Selection=_) 3301 -> true 3302 ). 3303 [], _, _) (. 3305print_menu([Value=Label|T], Default, I) :- 3306 ( Value == Default 3307 -> print_message(query, pack(menu(default_item(I, Label)))) 3308 ; print_message(query, pack(menu(item(I, Label)))) 3309 ), 3310 I2 is I + 1, 3311 print_menu(T, Default, I2). 3312 3313read_selection(Max, Choice) :- 3314 get_single_char(Code), 3315 ( answered_default(Code) 3316 -> Choice = default 3317 ; code_type(Code, digit(Choice)), 3318 between(1, Max, Choice) 3319 -> true 3320 ; print_message(warning, pack(menu(reply(1,Max)))), 3321 fail 3322 ).
3330confirm(_Question, Default, Options) :- 3331 Default \== none, 3332 option(interactive(false), Options, true), 3333 !, 3334 Default == yes. 3335confirm(Question, Default, _) :- 3336 between(1, 5, _), 3337 print_message(query, pack(confirm(Question, Default))), 3338 read_yes_no(YesNo, Default), 3339 !, 3340 format(user_error, '~N', []), 3341 YesNo == yes. 3342 3343read_yes_no(YesNo, Default) :- 3344 get_single_char(Code), 3345 code_yes_no(Code, Default, YesNo), 3346 !. 3347 3348code_yes_no(0'y, _, yes). 3349code_yes_no(0'Y, _, yes). 3350code_yes_no(0'n, _, no). 3351code_yes_no(0'N, _, no). 3352code_yes_no(_, none, _) :- !, fail. 3353code_yes_no(C, Default, Default) :- 3354 answered_default(C). 3355 3356answered_default(0'\r). 3357answered_default(0'\n). 3358answered_default(0'\s). 3359 3360 3361 /******************************* 3362 * MESSAGES * 3363 *******************************/ 3364 3365:- multifile prolog:message//1. 3366 3367prologmessage(pack(Message)) --> 3368 message(Message). 3369 3370:- discontiguous 3371 message//1, 3372 label//1. 3373 3374message(invalid_term(pack_info_term, Term)) --> 3375 [ 'Invalid package meta data: ~q'-[Term] ]. 3376message(invalid_term(pack_status_term, Term)) --> 3377 [ 'Invalid package status data: ~q'-[Term] ]. 3378message(directory_exists(Dir)) --> 3379 [ 'Package target directory exists and is not empty:', nl, 3380 '\t~q'-[Dir] 3381 ]. 3382message(already_installed(pack(Pack, Version))) --> 3383 [ 'Pack `~w'' is already installed @~w'-[Pack, Version] ]. 3384message(already_installed(Pack)) --> 3385 [ 'Pack `~w'' is already installed. Package info:'-[Pack] ]. 3386message(kept_foreign(Pack, Arch)) --> 3387 [ 'Found foreign libraries for architecture '-[], 3388 ansi(code, '~q', [Arch]), nl, 3389 'Use ', ansi(code, '?- pack_rebuild(~q).', [Pack]), 3390 ' to rebuild from sources'-[] 3391 ]. 3392message(no_pack_installed(Pack)) --> 3393 [ 'No pack ~q installed. Use ?- pack_list(Pattern) to search'-[Pack] ]. 3394message(dependency_issues(Issues)) --> 3395 [ 'The current set of packs has dependency issues:', nl ], 3396 dep_issues(Issues). 3397message(depends(Pack, Deps)) --> 3398 [ 'The following packs depend on `~w\':'-[Pack], nl ], 3399 pack_list(Deps). 3400message(remove(PackDir)) --> 3401 [ 'Removing ~q and contents'-[PackDir] ]. 3402message(remove_existing_pack(PackDir)) --> 3403 [ 'Remove old installation in ~q'-[PackDir] ]. 3404message(download_plan(Plan)) --> 3405 [ ansi(bold, 'Installation plan:', []), nl ], 3406 install_plan(Plan, Actions), 3407 install_label(Actions). 3408message(build_plan(Plan)) --> 3409 [ ansi(bold, 'The following packs have post install scripts:', []), nl ], 3410 msg_build_plan(Plan), 3411 [ nl, ansi(bold, 'Run scripts?', []) ]. 3412message(no_meta_data(BaseDir)) --> 3413 [ 'Cannot find pack.pl inside directory ~q. Not a package?'-[BaseDir] ]. 3414message(search_no_matches(Name)) --> 3415 [ 'Search for "~w", returned no matching packages'-[Name] ]. 3416message(rebuild(Pack)) --> 3417 [ 'Checking pack "~w" for rebuild ...'-[Pack] ]. 3418message(up_to_date([Pack])) --> 3419 !, 3420 [ 'Pack ' ], msg_pack(Pack), [' is up-to-date' ]. 3421message(up_to_date(Packs)) --> 3422 [ 'Packs ' ], sequence(msg_pack, [', '], Packs), [' are up-to-date' ]. 3423message(installed_can_upgrade(List)) --> 3424 sequence(msg_can_upgrade_target, [nl], List). 3425message(new_dependencies(Deps)) --> 3426 [ 'Found new dependencies after downloading (~p).'-[Deps], nl ]. 3427message(query_versions(URL)) --> 3428 [ 'Querying "~w" to find new versions ...'-[URL] ]. 3429message(no_matching_urls(URL)) --> 3430 [ 'Could not find any matching URL: ~q'-[URL] ]. 3431message(found_versions([Latest-_URL|More])) --> 3432 { length(More, Len) }, 3433 [ ' Latest version: ~w (~D older)'-[Latest, Len] ]. 3434message(build(Pack, PackDir)) --> 3435 [ ansi(bold, 'Building pack ~w in directory ~w', [Pack, PackDir]) ]. 3436message(contacting_server(Server)) --> 3437 [ 'Contacting server at ~w ...'-[Server], flush ]. 3438message(server_reply(true(_))) --> 3439 [ at_same_line, ' ok'-[] ]. 3440message(server_reply(false)) --> 3441 [ at_same_line, ' done'-[] ]. 3442message(server_reply(exception(E))) --> 3443 [ 'Server reported the following error:'-[], nl ], 3444 '$messages':translate_message(E). 3445message(cannot_create_dir(Alias)) --> 3446 { findall(PackDir, 3447 absolute_file_name(Alias, PackDir, [solutions(all)]), 3448 PackDirs0), 3449 sort(PackDirs0, PackDirs) 3450 }, 3451 [ 'Cannot find a place to create a package directory.'-[], 3452 'Considered:'-[] 3453 ], 3454 candidate_dirs(PackDirs). 3455message(conflict(version, [PackV, FileV])) --> 3456 ['Version mismatch: pack.pl: '-[]], msg_version(PackV), 3457 [', file claims version '-[]], msg_version(FileV). 3458message(conflict(name, [PackInfo, FileInfo])) --> 3459 ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]], 3460 [', file claims ~w: ~p'-[FileInfo]]. 3461message(no_prolog_response(ContentType, String)) --> 3462 [ 'Expected Prolog response. Got content of type ~p'-[ContentType], nl, 3463 '~s'-[String] 3464 ]. 3465message(download(begin, Pack, _URL, _DownloadFile)) --> 3466 [ 'Downloading ' ], msg_pack(Pack), [ ' ... ', flush ]. 3467message(download(end, _, _, File)) --> 3468 { size_file(File, Bytes) }, 3469 [ at_same_line, '~D bytes'-[Bytes] ]. 3470message(no_git(URL)) --> 3471 [ 'Cannot install from git repository ', url(URL), '.', nl, 3472 'Cannot find git program and do not know how to download the code', nl, 3473 'from this git service. Please install git and retry.' 3474 ]. 3475message(git_no_https(GitURL)) --> 3476 [ 'Do not know how to get an HTTP(s) URL for ', url(GitURL) ]. 3477message(git_branch_not_default(Dir, Default, Current)) --> 3478 [ 'GIT current branch on ', url(Dir), ' is not default.', nl, 3479 ' Current branch: ', ansi(code, '~w', [Current]), 3480 ' default: ', ansi(code, '~w', [Default]) 3481 ]. 3482message(git_not_clean(Dir)) --> 3483 [ 'GIT working directory is dirty: ', url(Dir), nl, 3484 'Your repository must be clean before publishing.' 3485 ]. 3486message(git_push) --> 3487 [ 'Push release to GIT origin?' ]. 3488message(git_tag(Tag)) --> 3489 [ 'Tag repository with release tag ', ansi(code, '~w', [Tag]) ]. 3490message(git_release_tag_not_at_head(Tag)) --> 3491 [ 'Release tag ', ansi(code, '~w', [Tag]), ' is not at HEAD.', nl, 3492 'If you want to update the tag, please run ', 3493 ansi(code, 'git tag -d ~w', [Tag]) 3494 ]. 3495message(git_tag_out_of_sync(Tag)) --> 3496 [ 'Release tag ', ansi(code, '~w', [Tag]), 3497 ' differs from this tag at the origin' 3498 ]. 3499 3500message(publish_failed(Info, Reason)) --> 3501 [ 'Pack ' ], msg_pack(Info), [ ' at version ~w'-[Info.version] ], 3502 msg_publish_failed(Reason). 3503 3504msg_publish_failed(throw(error(permission_error(register, 3505 pack(_),_URL),_))) --> 3506 [ ' is already registered with a different URL']. 3507msg_publish_failed(download) --> 3508 [' was already published?']. 3509msg_publish_failed(Status) --> 3510 [ ' failed for unknown reason (~p)'-[Status] ]. 3511 3512candidate_dirs([]) --> []. 3513candidate_dirs([H|T]) --> [ nl, ' ~w'-[H] ], candidate_dirs(T). 3514 % Questions 3515message(resolve_remove) --> 3516 [ nl, 'Please select an action:', nl, nl ]. 3517message(create_pack_dir) --> 3518 [ nl, 'Create directory for packages', nl ]. 3519message(menu(item(I, Label))) --> 3520 [ '~t(~d)~6| '-[I] ], 3521 label(Label). 3522message(menu(default_item(I, Label))) --> 3523 [ '~t(~d)~6| * '-[I] ], 3524 label(Label). 3525message(menu(select)) --> 3526 [ nl, 'Your choice? ', flush ]. 3527message(confirm(Question, Default)) --> 3528 message(Question), 3529 confirm_default(Default), 3530 [ flush ]. 3531message(menu(reply(Min,Max))) --> 3532 ( { Max =:= Min+1 } 3533 -> [ 'Please enter ~w or ~w'-[Min,Max] ] 3534 ; [ 'Please enter a number between ~w and ~w'-[Min,Max] ] 3535 ). 3536 3537 % support predicates 3538dep_issues(Issues) --> 3539 sequence(dep_issue, [nl], Issues). 3540 3541dep_issue(unsatisfied(Pack, Requires)) --> 3542 [ ' - Pack ' ], msg_pack(Pack), [' requires ~p'-[Requires]]. 3543dep_issue(conflicts(Pack, Conflict)) --> 3544 [ ' - Pack ' ], msg_pack(Pack), [' conflicts with ~p'-[Conflict]].
3551install_label([link]) --> 3552 !, 3553 [ ansi(bold, 'Activate pack?', []) ]. 3554install_label([unpack]) --> 3555 !, 3556 [ ansi(bold, 'Unpack archive?', []) ]. 3557install_label(_) --> 3558 [ ansi(bold, 'Download packs?', []) ]. 3559 3560install_plan([], []) --> 3561 []. 3562install_plan([H|T], [AH|AT]) --> 3563 install_step(H, AH), [nl], 3564 install_plan(T, AT). 3565 3566install_step(Info, keep) --> 3567 { Info.get(keep) == true }, 3568 !, 3569 [ ' Keep ' ], msg_pack(Info), [ ' at version ~w'-[Info.version] ], 3570 msg_can_upgrade(Info). 3571install_step(Info, Action) --> 3572 { From = Info.get(upgrade), 3573 VFrom = From.version, 3574 VTo = Info.get(version), 3575 ( cmp_versions(>=, VTo, VFrom) 3576 -> Label = ansi(bold, ' Upgrade ', []) 3577 ; Label = ansi(warning, ' Downgrade ', []) 3578 ) 3579 }, 3580 [ Label ], msg_pack(Info), 3581 [ ' from version ~w to ~w'- [From.version, Info.get(version)] ], 3582 install_from(Info, Action). 3583install_step(Info, Action) --> 3584 { _From = Info.get(upgrade) }, 3585 [ ' Upgrade ' ], msg_pack(Info), 3586 install_from(Info, Action). 3587install_step(Info, Action) --> 3588 { Dep = Info.get(dependency_for) }, 3589 [ ' Install ' ], msg_pack(Info), 3590 [ ' at version ~w as dependency for '-[Info.version], 3591 ansi(code, '~w', [Dep]) 3592 ], 3593 install_from(Info, Action), 3594 msg_downloads(Info). 3595install_step(Info, Action) --> 3596 { Info.get(commit) == 'HEAD' }, 3597 !, 3598 [ ' Install ' ], msg_pack(Info), [ ' at current GIT HEAD'-[] ], 3599 install_from(Info, Action), 3600 msg_downloads(Info). 3601install_step(Info, link) --> 3602 { Info.get(link) == true, 3603 uri_file_name(Info.get(url), Dir) 3604 }, 3605 !, 3606 [ ' Install ' ], msg_pack(Info), [ ' as symlink to ', url(Dir) ]. 3607install_step(Info, Action) --> 3608 [ ' Install ' ], msg_pack(Info), [ ' at version ~w'-[Info.get(version)] ], 3609 install_from(Info, Action), 3610 msg_downloads(Info). 3611install_step(Info, Action) --> 3612 [ ' Install ' ], msg_pack(Info), 3613 install_from(Info, Action), 3614 msg_downloads(Info). 3615 3616install_from(Info, download) --> 3617 { download_url(Info.url) }, 3618 !, 3619 [ ' from ', url(Info.url) ]. 3620install_from(Info, unpack) --> 3621 [ ' from ', url(Info.url) ]. 3622 3623msg_downloads(Info) --> 3624 { Downloads = Info.get(all_downloads), 3625 Downloads > 0 3626 }, 3627 [ ansi(comment, ' (downloaded ~D times)', [Downloads]) ], 3628 !. 3629msg_downloads(_) --> 3630 []. 3631 3632msg_pack(Pack) --> 3633 { atom(Pack) }, 3634 !, 3635 [ ansi(code, '~w', [Pack]) ]. 3636msg_pack(Info) --> 3637 msg_pack(Info.pack).
3643msg_build_plan(Plan) --> 3644 sequence(build_step, [nl], Plan). 3645 3646build_step(Info) --> 3647 [ ' Build ' ], msg_pack(Info), [' in directory ', url(Info.installed) ]. 3648 3649msg_can_upgrade_target(Info) --> 3650 [ ' Pack ' ], msg_pack(Info), 3651 [ ' is installed at version ~w'-[Info.version] ], 3652 msg_can_upgrade(Info). 3653 3654pack_list([]) --> []. 3655pack_list([H|T]) --> 3656 [ ' - Pack ' ], msg_pack(H), [nl], 3657 pack_list(T). 3658 3659label(remove_only(Pack)) --> 3660 [ 'Only remove package ~w (break dependencies)'-[Pack] ]. 3661label(remove_deps(Pack, Deps)) --> 3662 { length(Deps, Count) }, 3663 [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ]. 3664label(create_dir(Dir)) --> 3665 [ '~w'-[Dir] ]. 3666label(install_from(git(URL))) --> 3667 !, 3668 [ 'GIT repository at ~w'-[URL] ]. 3669label(install_from(URL)) --> 3670 [ '~w'-[URL] ]. 3671label(cancel) --> 3672 [ 'Cancel' ]. 3673 3674confirm_default(yes) --> 3675 [ ' Y/n? ' ]. 3676confirm_default(no) --> 3677 [ ' y/N? ' ]. 3678confirm_default(none) --> 3679 [ ' y/n? ' ]. 3680 3681msg_version(Version) --> 3682 [ '~w'-[Version] ]. 3683 3684msg_can_upgrade(Info) --> 3685 { Latest = Info.get(latest_version) }, 3686 [ ansi(warning, ' (can be upgraded to ~w)', [Latest]) ]. 3687msg_can_upgrade(_) --> 3688 []. 3689 3690 3691 /******************************* 3692 * MISC * 3693 *******************************/ 3694 3695local_uri_file_name(URL, FileName) :- 3696 uri_file_name(URL, FileName), 3697 !. 3698local_uri_file_name(URL, FileName) :- 3699 uri_components(URL, Components), 3700 uri_data(scheme, Components, File), File == file, 3701 uri_data(authority, Components, FileNameEnc), 3702 uri_data(path, Components, ''), 3703 uri_encoded(path, FileName, FileNameEnc). 3704 3705det_if(Cond, Goal) :- 3706 ( 3707 -> , 3708 ! 3709 ; 3710 ). 3711 3712member_nonvar(_, Var) :- 3713 var(Var), 3714 !, 3715 fail. 3716member_nonvar(E, [E|_]). 3717member_nonvar(E, [_|T]) :- 3718 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*/