1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2012-2019, VU University Amsterdam 7 CWI, Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(prolog_pack, 37 [ pack_list_installed/0, 38 pack_info/1, % +Name 39 pack_list/1, % +Keyword 40 pack_search/1, % +Keyword 41 pack_install/1, % +Name 42 pack_install/2, % +Name, +Options 43 pack_upgrade/1, % +Name 44 pack_rebuild/1, % +Name 45 pack_rebuild/0, % All packages 46 pack_remove/1, % +Name 47 pack_property/2, % ?Name, ?Property 48 pack_attach/2, % +Dir, +Options 49 50 pack_url_file/2 % +URL, -File 51 ]). 52:- use_module(library(apply)). 53:- use_module(library(error)). 54:- use_module(library(process)). 55:- use_module(library(option)). 56:- use_module(library(readutil)). 57:- use_module(library(lists)). 58:- use_module(library(filesex)). 59:- use_module(library(xpath)). 60:- use_module(library(settings)). 61:- use_module(library(uri)). 62:- use_module(library(http/http_open)). 63:- use_module(library(http/json)). 64:- use_module(library(http/http_client), []). % plugin for POST support 65:- use_module(library(prolog_config)).
82:- multifile 83 environment/2. % Name, Value 84 85:- dynamic 86 pack_requires/2, % Pack, Requirement 87 pack_provides_db/2. % Pack, Provided 88 89 90 /******************************* 91 * CONSTANTS * 92 *******************************/ 93 94:- setting(server, atom, 'https://www.swi-prolog.org/pack/', 95 'Server to exchange pack information'). 96 97 98 /******************************* 99 * PACKAGE INFO * 100 *******************************/
106current_pack(Pack) :-
107 '$pack':pack(Pack, _).
117pack_list_installed :- 118 findall(Pack, current_pack(Pack), Packages0), 119 Packages0 \== [], 120 !, 121 sort(Packages0, Packages), 122 length(Packages, Count), 123 format('Installed packages (~D):~n~n', [Count]), 124 maplist(pack_info(list), Packages), 125 validate_dependencies. 126pack_list_installed :- 127 print_message(informational, pack(no_packages_installed)).
133pack_info(Name) :- 134 pack_info(info, Name). 135 136pack_info(Level, Name) :- 137 must_be(atom, Name), 138 findall(Info, pack_info(Name, Level, Info), Infos0), 139 ( Infos0 == [] 140 -> print_message(warning, pack(no_pack_installed(Name))), 141 fail 142 ; true 143 ), 144 update_dependency_db(Name, Infos0), 145 findall(Def, pack_default(Level, Infos, Def), Defs), 146 append(Infos0, Defs, Infos1), 147 sort(Infos1, Infos), 148 show_info(Name, Infos, [info(Level)]). 149 150 151show_info(_Name, _Properties, Options) :- 152 option(silent(true), Options), 153 !. 154show_info(Name, Properties, Options) :- 155 option(info(list), Options), 156 !, 157 memberchk(title(Title), Properties), 158 memberchk(version(Version), Properties), 159 format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]). 160show_info(Name, Properties, _) :- 161 !, 162 print_property_value('Package'-'~w', [Name]), 163 findall(Term, pack_level_info(info, Term, _, _), Terms), 164 maplist(print_property(Properties), Terms). 165 166print_property(_, nl) :- 167 !, 168 format('~n'). 169print_property(Properties, Term) :- 170 findall(Term, member(Term, Properties), Terms), 171 Terms \== [], 172 !, 173 pack_level_info(_, Term, LabelFmt, _Def), 174 ( LabelFmt = Label-FmtElem 175 -> true 176 ; Label = LabelFmt, 177 FmtElem = '~w' 178 ), 179 multi_valued(Terms, FmtElem, FmtList, Values), 180 atomic_list_concat(FmtList, ', ', Fmt), 181 print_property_value(Label-Fmt, Values). 182print_property(_, _). 183 184multi_valued([H], LabelFmt, [LabelFmt], Values) :- 185 !, 186 H =.. [_|Values]. 187multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :- 188 H =.. [_|VH], 189 append(VH, MoreValues, Values), 190 multi_valued(T, LabelFmt, LT, MoreValues). 191 192 193pvalue_column(24). 194print_property_value(Prop-Fmt, Values) :- 195 !, 196 pvalue_column(C), 197 atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format), 198 format(Format, [Prop,C|Values]). 199 200pack_info(Name, Level, Info) :- 201 '$pack':pack(Name, BaseDir), 202 ( Info = directory(BaseDir) 203 ; pack_info_term(BaseDir, Info) 204 ), 205 pack_level_info(Level, Info, _Format, _Default). 206 207:- public pack_level_info/4. % used by web-server 208 209pack_level_info(_, title(_), 'Title', '<no title>'). 210pack_level_info(_, version(_), 'Installed version', '<unknown>'). 211pack_level_info(info, directory(_), 'Installed in directory', -). 212pack_level_info(info, author(_, _), 'Author'-'~w <~w>', -). 213pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>', -). 214pack_level_info(info, packager(_, _), 'Packager'-'~w <~w>', -). 215pack_level_info(info, home(_), 'Home page', -). 216pack_level_info(info, download(_), 'Download URL', -). 217pack_level_info(_, provides(_), 'Provides', -). 218pack_level_info(_, requires(_), 'Requires', -). 219pack_level_info(_, conflicts(_), 'Conflicts with', -). 220pack_level_info(_, replaces(_), 'Replaces packages', -). 221pack_level_info(info, library(_), 'Provided libraries', -). 222 223pack_default(Level, Infos, Def) :- 224 pack_level_info(Level, ITerm, _Format, Def), 225 Def \== (-), 226 \+ memberchk(ITerm, Infos).
232pack_info_term(BaseDir, Info) :- 233 directory_file_path(BaseDir, 'pack.pl', InfoFile), 234 catch( 235 setup_call_cleanup( 236 open(InfoFile, read, In), 237 term_in_stream(In, Info), 238 close(In)), 239 error(existence_error(source_sink, InfoFile), _), 240 ( print_message(error, pack(no_meta_data(BaseDir))), 241 fail 242 )). 243pack_info_term(BaseDir, library(Lib)) :- 244 atom_concat(BaseDir, '/prolog/', LibDir), 245 atom_concat(LibDir, '*.pl', Pattern), 246 expand_file_name(Pattern, Files), 247 maplist(atom_concat(LibDir), Plain, Files), 248 convlist(base_name, Plain, Libs), 249 member(Lib, Libs). 250 251base_name(File, Base) :- 252 file_name_extension(Base, pl, File). 253 254term_in_stream(In, Term) :- 255 repeat, 256 read_term(In, Term0, []), 257 ( Term0 == end_of_file 258 -> !, fail 259 ; Term = Term0, 260 valid_info_term(Term0) 261 ). 262 263valid_info_term(Term) :- 264 Term =.. [Name|Args], 265 same_length(Args, Types), 266 Decl =.. [Name|Types], 267 ( pack_info_term(Decl) 268 -> maplist(valid_info_arg, Types, Args) 269 ; print_message(warning, pack(invalid_info(Term))), 270 fail 271 ). 272 273valid_info_arg(Type, Arg) :- 274 must_be(Type, Arg).
281pack_info_term(name(atom)). % Synopsis 282pack_info_term(title(atom)). 283pack_info_term(keywords(list(atom))). 284pack_info_term(description(list(atom))). 285pack_info_term(version(version)). 286pack_info_term(author(atom, email_or_url)). % Persons 287pack_info_term(maintainer(atom, email_or_url)). 288pack_info_term(packager(atom, email_or_url)). 289pack_info_term(home(atom)). % Home page 290pack_info_term(download(atom)). % Source 291pack_info_term(provides(atom)). % Dependencies 292pack_info_term(requires(dependency)). 293pack_info_term(conflicts(dependency)). % Conflicts with package 294pack_info_term(replaces(atom)). % Replaces another package 295pack_info_term(autoload(boolean)). % Default installation options 296 297:- multifile 298 error:has_type/2. 299 300errorhas_type(version, Version) :- 301 atom(Version), 302 version_data(Version, _Data). 303errorhas_type(email_or_url, Address) :- 304 atom(Address), 305 ( sub_atom(Address, _, _, _, @) 306 -> true 307 ; uri_is_global(Address) 308 ). 309errorhas_type(dependency, Value) :- 310 is_dependency(Value, _Token, _Version). 311 312version_data(Version, version(Data)) :- 313 atomic_list_concat(Parts, '.', Version), 314 maplist(atom_number, Parts, Data). 315 316is_dependency(Token, Token, *) :- 317 atom(Token). 318is_dependency(Term, Token, VersionCmp) :- 319 Term =.. [Op,Token,Version], 320 cmp(Op, _), 321 version_data(Version, _), 322 VersionCmp =.. [Op,Version]. 323 324cmp(<, @<). 325cmp(=<, @=<). 326cmp(==, ==). 327cmp(>=, @>=). 328cmp(>, @>). 329 330 331 /******************************* 332 * SEARCH * 333 *******************************/
Hint: ?- pack_list('').
lists all packages.
The predicates pack_list/1 and pack_search/1 are synonyms. Both contact the package server at http://www.swi-prolog.org to find available packages.
362pack_list(Query) :- 363 pack_search(Query). 364 365pack_search(Query) :- 366 query_pack_server(search(Query), Result, []), 367 ( Result == false 368 -> ( local_search(Query, Packs), 369 Packs \== [] 370 -> forall(member(pack(Pack, Stat, Title, Version, _), Packs), 371 format('~w ~w@~w ~28|- ~w~n', 372 [Stat, Pack, Version, Title])) 373 ; print_message(warning, pack(search_no_matches(Query))) 374 ) 375 ; Result = true(Hits), 376 local_search(Query, Local), 377 append(Hits, Local, All), 378 sort(All, Sorted), 379 list_hits(Sorted) 380 ). 381 382list_hits([]). 383list_hits([ pack(Pack, i, Title, Version, _), 384 pack(Pack, p, Title, Version, _) 385 | More 386 ]) :- 387 !, 388 format('i ~w@~w ~28|- ~w~n', [Pack, Version, Title]), 389 list_hits(More). 390list_hits([ pack(Pack, i, Title, VersionI, _), 391 pack(Pack, p, _, VersionS, _) 392 | More 393 ]) :- 394 !, 395 version_data(VersionI, VDI), 396 version_data(VersionS, VDS), 397 ( VDI @< VDS 398 -> Tag = ('U') 399 ; Tag = ('A') 400 ), 401 format('~w ~w@~w(~w) ~28|- ~w~n', [Tag, Pack, VersionI, VersionS, Title]), 402 list_hits(More). 403list_hits([ pack(Pack, i, Title, VersionI, _) 404 | More 405 ]) :- 406 !, 407 format('l ~w@~w ~28|- ~w~n', [Pack, VersionI, Title]), 408 list_hits(More). 409list_hits([pack(Pack, Stat, Title, Version, _)|More]) :- 410 format('~w ~w@~w ~28|- ~w~n', [Stat, Pack, Version, Title]), 411 list_hits(More). 412 413 414local_search(Query, Packs) :- 415 findall(Pack, matching_installed_pack(Query, Pack), Packs). 416 417matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :- 418 current_pack(Pack), 419 findall(Term, 420 ( pack_info(Pack, _, Term), 421 search_info(Term) 422 ), Info), 423 ( sub_atom_icasechk(Pack, _, Query) 424 -> true 425 ; memberchk(title(Title), Info), 426 sub_atom_icasechk(Title, _, Query) 427 ), 428 option(title(Title), Info, '<no title>'), 429 option(version(Version), Info, '<no version>'), 430 option(download(URL), Info, '<no download url>'). 431 432search_info(title(_)). 433search_info(version(_)). 434search_info(download(_)). 435 436 437 /******************************* 438 * INSTALL * 439 *******************************/
file://
URL.After resolving the type of package, pack_install/2 is used to do the actual installation.
457pack_install(Spec) :-
458 pack_default_options(Spec, Pack, [], Options),
459 pack_install(Pack, [pack(Pack)|Options]).
466pack_default_options(_Spec, Pack, OptsIn, Options) :- 467 option(already_installed(pack(Pack,_Version)), OptsIn), 468 !, 469 Options = OptsIn. 470pack_default_options(_Spec, Pack, OptsIn, Options) :- 471 option(url(URL), OptsIn), 472 !, 473 ( option(git(_), OptsIn) 474 -> Options = OptsIn 475 ; git_url(URL, Pack) 476 -> Options = [git(true)|OptsIn] 477 ; Options = OptsIn 478 ), 479 ( nonvar(Pack) 480 -> true 481 ; option(pack(Pack), Options) 482 -> true 483 ; pack_version_file(Pack, _Version, URL) 484 ). 485pack_default_options(Archive, Pack, _, Options) :- % Install from archive 486 must_be(atom, Archive), 487 \+ uri_is_global(Archive), 488 expand_file_name(Archive, [File]), 489 exists_file(File), 490 !, 491 pack_version_file(Pack, Version, File), 492 uri_file_name(FileURL, File), 493 Options = [url(FileURL), version(Version)]. 494pack_default_options(URL, Pack, _, Options) :- 495 git_url(URL, Pack), 496 !, 497 Options = [git(true), url(URL)]. 498pack_default_options(FileURL, Pack, _, Options) :- % Install from directory 499 uri_file_name(FileURL, Dir), 500 exists_directory(Dir), 501 pack_info_term(Dir, name(Pack)), 502 !, 503 ( pack_info_term(Dir, version(Version)) 504 -> uri_file_name(DirURL, Dir), 505 Options = [url(DirURL), version(Version)] 506 ; throw(error(existence_error(key, version, Dir),_)) 507 ). 508pack_default_options(URL, Pack, _, Options) :- % Install from URL 509 pack_version_file(Pack, Version, URL), 510 download_url(URL), 511 !, 512 available_download_versions(URL, [URLVersion-LatestURL|_]), 513 Options = [url(LatestURL)|VersionOptions], 514 version_options(Version, URLVersion, VersionOptions). 515pack_default_options(Pack, Pack, OptsIn, Options) :- % Install from name 516 \+ uri_is_global(Pack), % ignore URLs 517 query_pack_server(locate(Pack), Reply, OptsIn), 518 ( Reply = true(Results) 519 -> pack_select_candidate(Pack, Results, OptsIn, Options) 520 ; print_message(warning, pack(no_match(Pack))), 521 fail 522 ). 523 524version_options(Version, Version, [version(Version)]) :- !. 525version_options(Version, _, [version(Version)]) :- 526 Version = version(List), 527 maplist(integer, List), 528 !. 529version_options(_, _, []).
535pack_select_candidate(Pack, [Version-_|_], Options, 536 [already_installed(pack(Pack, Installed))|Options]) :- 537 current_pack(Pack), 538 pack_info(Pack, _, version(InstalledAtom)), 539 atom_version(InstalledAtom, Installed), 540 Installed @>= Version, 541 !. 542pack_select_candidate(Pack, Available, Options, OptsOut) :- 543 option(url(URL), Options), 544 memberchk(_Version-URLs, Available), 545 memberchk(URL, URLs), 546 !, 547 ( git_url(URL, Pack) 548 -> Extra = [git(true)] 549 ; Extra = [] 550 ), 551 OptsOut = [url(URL), inquiry(true) | Extra]. 552pack_select_candidate(Pack, [Version-[URL]|_], Options, 553 [url(URL), git(true), inquiry(true)]) :- 554 git_url(URL, Pack), 555 !, 556 confirm(install_from(Pack, Version, git(URL)), yes, Options). 557pack_select_candidate(Pack, [Version-[URL]|More], Options, 558 [url(URL), inquiry(true)]) :- 559 ( More == [] 560 -> ! 561 ; true 562 ), 563 confirm(install_from(Pack, Version, URL), yes, Options), 564 !. 565pack_select_candidate(Pack, [Version-URLs|_], Options, 566 [url(URL), inquiry(true)|Rest]) :- 567 maplist(url_menu_item, URLs, Tagged), 568 append(Tagged, [cancel=cancel], Menu), 569 Menu = [Default=_|_], 570 menu(pack(select_install_from(Pack, Version)), 571 Menu, Default, Choice, Options), 572 ( Choice == cancel 573 -> fail 574 ; Choice = git(URL) 575 -> Rest = [git(true)] 576 ; Choice = URL, 577 Rest = [] 578 ). 579 URL, git(URL)=install_from(git(URL))) (:- 581 git_url(URL, _), 582 !. 583url_menu_item(URL, URL=install_from(URL)).
true
(default false), suppress informational progress
messages.true
(default false
), upgrade package if it is already
installed.true
(default false
unless URL ends with =.git=),
assume the URL is a GIT repository.
Non-interactive installation can be established using the option
interactive(false)
. It is adviced to install from a particular
trusted URL instead of the plain pack name for unattented
operation.
614pack_install(Spec, Options) :- 615 pack_default_options(Spec, Pack, Options, DefOptions), 616 ( option(already_installed(Installed), DefOptions) 617 -> print_message(informational, pack(already_installed(Installed))) 618 ; merge_options(Options, DefOptions, PackOptions), 619 update_dependency_db, 620 pack_install_dir(PackDir, PackOptions), 621 pack_install(Pack, PackDir, PackOptions) 622 ). 623 624pack_install_dir(PackDir, Options) :- 625 option(package_directory(PackDir), Options), 626 !. 627pack_install_dir(PackDir, _Options) :- % TBD: global/user? 628 absolute_file_name(pack(.), PackDir, 629 [ file_type(directory), 630 access(write), 631 file_errors(fail) 632 ]), 633 !. 634pack_install_dir(PackDir, Options) :- % TBD: global/user? 635 pack_create_install_dir(PackDir, Options). 636 637pack_create_install_dir(PackDir, Options) :- 638 findall(Candidate = create_dir(Candidate), 639 ( absolute_file_name(pack(.), Candidate, [solutions(all)]), 640 \+ exists_file(Candidate), 641 \+ exists_directory(Candidate), 642 file_directory_name(Candidate, Super), 643 ( exists_directory(Super) 644 -> access_file(Super, write) 645 ; true 646 ) 647 ), 648 Candidates0), 649 list_to_set(Candidates0, Candidates), % keep order 650 pack_create_install_dir(Candidates, PackDir, Options). 651 652pack_create_install_dir(Candidates, PackDir, Options) :- 653 Candidates = [Default=_|_], 654 !, 655 append(Candidates, [cancel=cancel], Menu), 656 menu(pack(create_pack_dir), Menu, Default, Selected, Options), 657 Selected \== cancel, 658 ( catch(make_directory_path(Selected), E, 659 (print_message(warning, E), fail)) 660 -> PackDir = Selected 661 ; delete(Candidates, PackDir=create_dir(PackDir), Remaining), 662 pack_create_install_dir(Remaining, PackDir, Options) 663 ). 664pack_create_install_dir(_, _, _) :- 665 print_message(error, pack(cannot_create_dir(pack(.)))), 666 fail.
true
, update the
package to the latest version. If Boolean is false
print
an error and fail.681pack_install(Name, _, Options) :- 682 current_pack(Name), 683 option(upgrade(false), Options, false), 684 print_message(error, pack(already_installed(Name))), 685 pack_info(Name), 686 print_message(information, pack(remove_with(Name))), 687 !, 688 fail. 689pack_install(Name, PackDir, Options) :- 690 option(url(URL), Options), 691 uri_file_name(URL, Source), 692 !, 693 pack_install_from_local(Source, PackDir, Name, Options). 694pack_install(Name, PackDir, Options) :- 695 option(url(URL), Options), 696 uri_components(URL, Components), 697 uri_data(scheme, Components, Scheme), 698 pack_install_from_url(Scheme, URL, PackDir, Name, Options).
707pack_install_from_local(Source, PackTopDir, Name, Options) :- 708 exists_directory(Source), 709 !, 710 directory_file_path(PackTopDir, Name, PackDir), 711 prepare_pack_dir(PackDir, Options), 712 copy_directory(Source, PackDir), 713 pack_post_install(Name, PackDir, Options). 714pack_install_from_local(Source, PackTopDir, Name, Options) :- 715 exists_file(Source), 716 directory_file_path(PackTopDir, Name, PackDir), 717 prepare_pack_dir(PackDir, Options), 718 pack_unpack(Source, PackDir, Name, Options), 719 pack_post_install(Name, PackDir, Options).
726:- if(exists_source(library(archive))). 727pack_unpack(Source, PackDir, Pack, Options) :- 728 ensure_loaded_archive, 729 pack_archive_info(Source, Pack, _Info, StripOptions), 730 prepare_pack_dir(PackDir, Options), 731 archive_extract(Source, PackDir, 732 [ exclude(['._*']) % MacOS resource forks 733 | StripOptions 734 ]). 735:- else. 736pack_unpack(_,_,_,_) :- 737 existence_error(library, archive). 738:- endif. 739 740 /******************************* 741 * INFO * 742 *******************************/
pack.pl
in the pack and Strip is the strip-option for
archive_extract/3.
Requires library(archive), which is lazily loaded when needed.
756:- if(exists_source(library(archive))). 757ensure_loaded_archive :- 758 current_predicate(archive_open/3), 759 !. 760ensure_loaded_archive :- 761 use_module(library(archive)). 762 763pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :- 764 ensure_loaded_archive, 765 size_file(Archive, Bytes), 766 setup_call_cleanup( 767 archive_open(Archive, Handle, []), 768 ( repeat, 769 ( archive_next_header(Handle, InfoFile) 770 -> true 771 ; !, fail 772 ) 773 ), 774 archive_close(Handle)), 775 file_base_name(InfoFile, 'pack.pl'), 776 atom_concat(Prefix, 'pack.pl', InfoFile), 777 strip_option(Prefix, Pack, Strip), 778 setup_call_cleanup( 779 archive_open_entry(Handle, Stream), 780 read_stream_to_terms(Stream, Info), 781 close(Stream)), 782 !, 783 must_be(ground, Info), 784 maplist(valid_info_term, Info). 785:- else. 786pack_archive_info(_, _, _, _) :- 787 existence_error(library, archive). 788:- endif. 789pack_archive_info(_, _, _, _) :- 790 existence_error(pack_file, 'pack.pl'). 791 792strip_option('', _, []) :- !. 793strip_option('./', _, []) :- !. 794strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :- 795 atom_concat(PrefixDir, /, Prefix), 796 file_base_name(PrefixDir, Base), 797 ( Base == Pack 798 -> true 799 ; pack_version_file(Pack, _, Base) 800 -> true 801 ; \+ sub_atom(PrefixDir, _, _, _, /) 802 ). 803 804read_stream_to_terms(Stream, Terms) :- 805 read(Stream, Term0), 806 read_stream_to_terms(Term0, Stream, Terms). 807 808read_stream_to_terms(end_of_file, _, []) :- !. 809read_stream_to_terms(Term0, Stream, [Term0|Terms]) :- 810 read(Stream, Term1), 811 read_stream_to_terms(Term1, Stream, Terms).
819pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
820 exists_directory(GitDir),
821 !,
822 git_ls_tree(Entries, [directory(GitDir)]),
823 git_hash(Hash, [directory(GitDir)]),
824 maplist(arg(4), Entries, Sizes),
825 sum_list(Sizes, Bytes),
826 directory_file_path(GitDir, 'pack.pl', InfoFile),
827 read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
828 must_be(ground, Info),
829 maplist(valid_info_term, Info).
835download_file_sanity_check(Archive, Pack, Info) :- 836 info_field(name(Name), Info), 837 info_field(version(VersionAtom), Info), 838 atom_version(VersionAtom, Version), 839 pack_version_file(PackA, VersionA, Archive), 840 must_match([Pack, PackA, Name], name), 841 must_match([Version, VersionA], version). 842 843info_field(Field, Info) :- 844 memberchk(Field, Info), 845 ground(Field), 846 !. 847info_field(Field, _Info) :- 848 functor(Field, FieldName, _), 849 print_message(error, pack(missing(FieldName))), 850 fail. 851 852must_match(Values, _Field) :- 853 sort(Values, [_]), 854 !. 855must_match(Values, Field) :- 856 print_message(error, pack(conflict(Field, Values))), 857 fail. 858 859 860 /******************************* 861 * INSTALLATION * 862 *******************************/
870prepare_pack_dir(Dir, Options) :- 871 exists_directory(Dir), 872 !, 873 ( empty_directory(Dir) 874 -> true 875 ; option(upgrade(true), Options) 876 -> delete_directory_contents(Dir) 877 ; confirm(remove_existing_pack(Dir), yes, Options), 878 delete_directory_contents(Dir) 879 ). 880prepare_pack_dir(Dir, _) :- 881 make_directory(Dir).
887empty_directory(Dir) :- 888 \+ ( directory_files(Dir, Entries), 889 member(Entry, Entries), 890 \+ special(Entry) 891 ). 892 893special(.). 894special(..).
904pack_install_from_url(_, URL, PackTopDir, Pack, Options) :- 905 option(git(true), Options), 906 !, 907 directory_file_path(PackTopDir, Pack, PackDir), 908 prepare_pack_dir(PackDir, Options), 909 run_process(path(git), [clone, URL, PackDir], []), 910 pack_git_info(PackDir, Hash, Info), 911 pack_inquiry(URL, git(Hash), Info, Options), 912 show_info(Pack, Info, Options), 913 confirm(git_post_install(PackDir, Pack), yes, Options), 914 pack_post_install(Pack, PackDir, Options). 915pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :- 916 download_scheme(Scheme), 917 directory_file_path(PackTopDir, Pack, PackDir), 918 prepare_pack_dir(PackDir, Options), 919 pack_download_dir(PackTopDir, DownLoadDir), 920 download_file(URL, Pack, DownloadBase, Options), 921 directory_file_path(DownLoadDir, DownloadBase, DownloadFile), 922 setup_call_cleanup( 923 http_open(URL, In, 924 [ cert_verify_hook(ssl_verify) 925 ]), 926 setup_call_cleanup( 927 open(DownloadFile, write, Out, [type(binary)]), 928 copy_stream_data(In, Out), 929 close(Out)), 930 close(In)), 931 pack_archive_info(DownloadFile, Pack, Info, _), 932 download_file_sanity_check(DownloadFile, Pack, Info), 933 pack_inquiry(URL, DownloadFile, Info, Options), 934 show_info(Pack, Info, Options), 935 confirm(install_downloaded(DownloadFile), yes, Options), 936 pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).
940download_file(URL, Pack, File, Options) :- 941 option(version(Version), Options), 942 !, 943 atom_version(VersionA, Version), 944 file_name_extension(_, Ext, URL), 945 format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]). 946download_file(URL, Pack, File, _) :- 947 file_base_name(URL,Basename), 948 no_int_file_name_extension(Tag,Ext,Basename), 949 tag_version(Tag,Version), 950 !, 951 atom_version(VersionA,Version), 952 format(atom(File0), '~w-~w', [Pack, VersionA]), 953 file_name_extension(File0, Ext, File). 954download_file(URL, _, File, _) :- 955 file_base_name(URL, File).
963pack_url_file(URL, FileID) :- 964 github_release_url(URL, Pack, Version), 965 !, 966 download_file(URL, Pack, FileID, [version(Version)]). 967pack_url_file(URL, FileID) :- 968 file_base_name(URL, FileID). 969 970 971:- public ssl_verify/5.
979ssl_verify(_SSL, 980 _ProblemCertificate, _AllCertificates, _FirstCertificate, 981 _Error). 982 983pack_download_dir(PackTopDir, DownLoadDir) :- 984 directory_file_path(PackTopDir, 'Downloads', DownLoadDir), 985 ( exists_directory(DownLoadDir) 986 -> true 987 ; make_directory(DownLoadDir) 988 ), 989 ( access_file(DownLoadDir, write) 990 -> true 991 ; permission_error(write, directory, DownLoadDir) 992 ).
998download_url(URL) :- 999 atom(URL), 1000 uri_components(URL, Components), 1001 uri_data(scheme, Components, Scheme), 1002 download_scheme(Scheme). 1003 1004download_scheme(http). 1005download_scheme(https) :- 1006 catch(use_module(library(http/http_ssl_plugin)), 1007 E, (print_message(warning, E), fail)).
1017pack_post_install(Pack, PackDir, Options) :-
1018 post_install_foreign(Pack, PackDir,
1019 [ build_foreign(if_absent)
1020 | Options
1021 ]),
1022 post_install_autoload(PackDir, Options),
1023 '$pack_attach'(PackDir).
1029pack_rebuild(Pack) :- 1030 '$pack':pack(Pack, BaseDir), 1031 !, 1032 catch(pack_make(BaseDir, [distclean], []), E, 1033 print_message(warning, E)), 1034 post_install_foreign(Pack, BaseDir, []). 1035pack_rebuild(Pack) :- 1036 existence_error(pack, Pack).
1042pack_rebuild :-
1043 forall(current_pack(Pack),
1044 ( print_message(informational, pack(rebuild(Pack))),
1045 pack_rebuild(Pack)
1046 )).
1053post_install_foreign(Pack, PackDir, Options) :- 1054 is_foreign_pack(PackDir), 1055 !, 1056 ( option(build_foreign(if_absent), Options), 1057 foreign_present(PackDir) 1058 -> print_message(informational, pack(kept_foreign(Pack))) 1059 ; setup_path, 1060 save_build_environment(PackDir), 1061 configure_foreign(PackDir, Options), 1062 make_foreign(PackDir, Options) 1063 ). 1064post_install_foreign(_, _, _). 1065 1066foreign_present(PackDir) :- 1067 current_prolog_flag(arch, Arch), 1068 atomic_list_concat([PackDir, '/lib'], ForeignBaseDir), 1069 exists_directory(ForeignBaseDir), 1070 !, 1071 atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir), 1072 exists_directory(ForeignDir), 1073 current_prolog_flag(shared_object_extension, Ext), 1074 atomic_list_concat([ForeignDir, '/*.', Ext], Pattern), 1075 expand_file_name(Pattern, Files), 1076 Files \== []. 1077 1078is_foreign_pack(PackDir) :- 1079 foreign_file(File), 1080 directory_file_path(PackDir, File, Path), 1081 exists_file(Path), 1082 !. 1083 1084foreign_file('configure.in'). 1085foreign_file('configure.ac'). 1086foreign_file('configure'). 1087foreign_file('Makefile'). 1088foreign_file('makefile'). 1089foreign_file('CMakeLists.txt').
configure.ac
or configure.in
exists, first run autoheader
and autoconf
1097configure_foreign(PackDir, Options) :- 1098 directory_file_path(PackDir, 'CMakeLists.txt', CMakeFile), 1099 exists_file(CMakeFile), 1100 !, 1101 cmake_configure_foreign(PackDir, Options). 1102configure_foreign(PackDir, Options) :- 1103 make_configure(PackDir, Options), 1104 directory_file_path(PackDir, configure, Configure), 1105 exists_file(Configure), 1106 !, 1107 build_environment(BuildEnv), 1108 run_process(path(bash), [Configure], 1109 [ env(BuildEnv), 1110 directory(PackDir) 1111 ]). 1112configure_foreign(_, _). 1113 1114make_configure(PackDir, _Options) :- 1115 directory_file_path(PackDir, 'configure', Configure), 1116 exists_file(Configure), 1117 !. 1118make_configure(PackDir, _Options) :- 1119 autoconf_master(ConfigMaster), 1120 directory_file_path(PackDir, ConfigMaster, ConfigureIn), 1121 exists_file(ConfigureIn), 1122 !, 1123 run_process(path(autoheader), [], [directory(PackDir)]), 1124 run_process(path(autoconf), [], [directory(PackDir)]). 1125make_configure(_, _). 1126 1127autoconf_master('configure.ac'). 1128autoconf_master('configure.in').
build
directory in PackDir and run `cmake ..`
1134cmake_configure_foreign(PackDir, _Options) :-
1135 directory_file_path(PackDir, build, BuildDir),
1136 make_directory_path(BuildDir),
1137 current_prolog_flag(executable, Exe),
1138 format(atom(CDEF), '-DSWIPL=~w', [Exe]),
1139 run_process(path(cmake), [CDEF, '..'],
1140 [directory(BuildDir)]).
1147make_foreign(PackDir, Options) :- 1148 pack_make(PackDir, [all, check, install], Options). 1149 1150pack_make(PackDir, Targets, _Options) :- 1151 directory_file_path(PackDir, 'Makefile', Makefile), 1152 exists_file(Makefile), 1153 !, 1154 build_environment(BuildEnv), 1155 ProcessOptions = [ directory(PackDir), env(BuildEnv) ], 1156 forall(member(Target, Targets), 1157 run_process(path(make), [Target], ProcessOptions)). 1158pack_make(PackDir, Targets, _Options) :- 1159 directory_file_path(PackDir, 'CMakeLists.txt', CMakefile), 1160 exists_file(CMakefile), 1161 directory_file_path(PackDir, 'build', BuildDir), 1162 exists_directory(BuildDir), 1163 !, 1164 ( Targets == [distclean] 1165 -> delete_directory_contents(BuildDir) 1166 ; build_environment(BuildEnv), 1167 ProcessOptions = [ directory(BuildDir), env(BuildEnv) ], 1168 forall(member(Target, Targets), 1169 run_cmake_target(Target, BuildDir, ProcessOptions)) 1170 ). 1171pack_make(_, _, _). 1172 1173run_cmake_target(check, BuildDir, ProcessOptions) :- 1174 !, 1175 ( directory_file_path(BuildDir, 'CTestTestfile.cmake', TestFile), 1176 exists_file(TestFile) 1177 -> run_process(path(ctest), [], ProcessOptions) 1178 ; true 1179 ). 1180run_cmake_target(Target, _, ProcessOptions) :- 1181 run_process(path(make), [Target], ProcessOptions).
1188save_build_environment(PackDir) :- 1189 directory_file_path(PackDir, 'buildenv.sh', EnvFile), 1190 build_environment(Env), 1191 setup_call_cleanup( 1192 open(EnvFile, write, Out), 1193 write_env_script(Out, Env), 1194 close(Out)). 1195 1196write_env_script(Out, Env) :- 1197 format(Out, 1198 '# This file contains the environment that can be used to\n\c 1199 # build the foreign pack outside Prolog. This file must\n\c 1200 # be loaded into a bourne-compatible shell using\n\c 1201 #\n\c 1202 # $ source buildenv.sh\n\n', 1203 []), 1204 forall(member(Var=Value, Env), 1205 format(Out, '~w=\'~w\'\n', [Var, Value])), 1206 format(Out, '\nexport ', []), 1207 forall(member(Var=_, Env), 1208 format(Out, ' ~w', [Var])), 1209 format(Out, '\n', []). 1210 1211build_environment(Env) :- 1212 findall(Name=Value, environment(Name, Value), UserEnv), 1213 findall(Name=Value, 1214 ( def_environment(Name, Value), 1215 \+ memberchk(Name=_, UserEnv) 1216 ), 1217 DefEnv), 1218 append(UserEnv, DefEnv, Env).
prolog_pack:environment('USER', User) :- getenv('USER', User).
1245def_environment('PATH', Value) :- 1246 getenv('PATH', PATH), 1247 current_prolog_flag(executable, Exe), 1248 file_directory_name(Exe, ExeDir), 1249 prolog_to_os_filename(ExeDir, OsExeDir), 1250 ( current_prolog_flag(windows, true) 1251 -> Sep = (;) 1252 ; Sep = (:) 1253 ), 1254 atomic_list_concat([OsExeDir, Sep, PATH], Value). 1255def_environment('SWIPL', Value) :- 1256 current_prolog_flag(executable, Value). 1257def_environment('SWIPLVERSION', Value) :- 1258 current_prolog_flag(version, Value). 1259def_environment('SWIHOME', Value) :- 1260 current_prolog_flag(home, Value). 1261def_environment('SWIARCH', Value) :- 1262 current_prolog_flag(arch, Value). 1263def_environment('PACKSODIR', Value) :- 1264 current_prolog_flag(arch, Arch), 1265 atom_concat('lib/', Arch, Value). 1266def_environment('SWISOLIB', Value) :- 1267 current_prolog_flag(c_libplso, Value). 1268def_environment('SWILIB', '-lswipl'). 1269def_environment('CC', Value) :- 1270 ( getenv('CC', Value) 1271 -> true 1272 ; default_c_compiler(Value) 1273 -> true 1274 ; current_prolog_flag(c_cc, Value) 1275 ). 1276def_environment('LD', Value) :- 1277 ( getenv('LD', Value) 1278 -> true 1279 ; current_prolog_flag(c_cc, Value) 1280 ). 1281def_environment('CFLAGS', Value) :- 1282 ( getenv('CFLAGS', SystemFlags) 1283 -> Extra = [' ', SystemFlags] 1284 ; Extra = [] 1285 ), 1286 current_prolog_flag(c_cflags, Value0), 1287 current_prolog_flag(home, Home), 1288 atomic_list_concat([Value0, ' -I"', Home, '/include"' | Extra], Value). 1289def_environment('LDSOFLAGS', Value) :- 1290 ( getenv('LDFLAGS', SystemFlags) 1291 -> Extra = [SystemFlags|System] 1292 ; Extra = System 1293 ), 1294 ( current_prolog_flag(windows, true) 1295 -> current_prolog_flag(home, Home), 1296 atomic_list_concat(['-L"', Home, '/bin"'], SystemLib), 1297 System = [SystemLib] 1298 ; apple_bundle_libdir(LibDir) 1299 -> atomic_list_concat(['-L"', LibDir, '"'], SystemLib), 1300 System = [SystemLib] 1301 ; current_prolog_flag(c_libplso, '') 1302 -> System = [] % ELF systems do not need this 1303 ; prolog_library_dir(SystemLibDir), 1304 atomic_list_concat(['-L"',SystemLibDir,'"'], SystemLib), 1305 System = [SystemLib] 1306 ), 1307 current_prolog_flag(c_ldflags, LDFlags), 1308 atomic_list_concat([LDFlags, '-shared' | Extra], ' ', Value). 1309def_environment('SOEXT', Value) :- 1310 current_prolog_flag(shared_object_extension, Value). 1311def_environment(Pass, Value) :- 1312 pass_env(Pass), 1313 getenv(Pass, Value). 1314 1315pass_env('TMP'). 1316pass_env('TEMP'). 1317pass_env('USER'). 1318pass_env('HOME'). 1319 1320:- multifile 1321 prolog:runtime_config/2. 1322 1323prolog_library_dir(Dir) :- 1324 prolog:runtime_config(c_libdir, Dir), 1325 !. 1326prolog_library_dir(Dir) :- 1327 current_prolog_flag(home, Home), 1328 ( current_prolog_flag(c_libdir, Rel) 1329 -> atomic_list_concat([Home, Rel], /, Dir) 1330 ; current_prolog_flag(arch, Arch) 1331 -> atomic_list_concat([Home, lib, Arch], /, Dir) 1332 ).
1341default_c_compiler(CC) :- 1342 preferred_c_compiler(CC), 1343 has_program(path(CC), _), 1344 !. 1345 1346preferred_c_compiler(gcc). 1347preferred_c_compiler(clang). 1348preferred_c_compiler(cc). 1349 1350 1351 /******************************* 1352 * PATHS * 1353 *******************************/ 1354 1355setup_path :- 1356 has_program(path(make), _), 1357 has_program(path(gcc), _), 1358 !. 1359setup_path :- 1360 current_prolog_flag(windows, true), 1361 !, 1362 ( mingw_extend_path 1363 -> true 1364 ; print_message(error, pack(no_mingw)) 1365 ). 1366setup_path. 1367 1368has_program(Program, Path) :- 1369 exe_options(ExeOptions), 1370 absolute_file_name(Program, Path, 1371 [ file_errors(fail) 1372 | ExeOptions 1373 ]). 1374 1375exe_options(Options) :- 1376 current_prolog_flag(windows, true), 1377 !, 1378 Options = [ extensions(['',exe,com]), access(read) ]. 1379exe_options(Options) :- 1380 Options = [ access(execute) ]. 1381 1382mingw_extend_path :- 1383 mingw_root(MinGW), 1384 directory_file_path(MinGW, bin, MinGWBinDir), 1385 atom_concat(MinGW, '/msys/*/bin', Pattern), 1386 expand_file_name(Pattern, MsysDirs), 1387 last(MsysDirs, MSysBinDir), 1388 prolog_to_os_filename(MinGWBinDir, WinDirMinGW), 1389 prolog_to_os_filename(MSysBinDir, WinDirMSYS), 1390 getenv('PATH', Path0), 1391 atomic_list_concat([WinDirMSYS, WinDirMinGW, Path0], ';', Path), 1392 setenv('PATH', Path). 1393 1394mingw_root(MinGwRoot) :- 1395 current_prolog_flag(executable, Exe), 1396 sub_atom(Exe, 1, _, _, :), 1397 sub_atom(Exe, 0, 1, _, PlDrive), 1398 Drives = [PlDrive,c,d], 1399 member(Drive, Drives), 1400 format(atom(MinGwRoot), '~a:/MinGW', [Drive]), 1401 exists_directory(MinGwRoot), 1402 !. 1403 1404 1405 /******************************* 1406 * AUTOLOAD * 1407 *******************************/
1413post_install_autoload(PackDir, Options) :- 1414 option(autoload(true), Options, true), 1415 pack_info_term(PackDir, autoload(true)), 1416 !, 1417 directory_file_path(PackDir, prolog, PrologLibDir), 1418 make_library_index(PrologLibDir). 1419post_install_autoload(_, _). 1420 1421 1422 /******************************* 1423 * UPGRADE * 1424 *******************************/
1432pack_upgrade(Pack) :- 1433 pack_info(Pack, _, directory(Dir)), 1434 directory_file_path(Dir, '.git', GitDir), 1435 exists_directory(GitDir), 1436 !, 1437 print_message(informational, pack(git_fetch(Dir))), 1438 git([fetch], [ directory(Dir) ]), 1439 git_describe(V0, [ directory(Dir) ]), 1440 git_describe(V1, [ directory(Dir), commit('origin/master') ]), 1441 ( V0 == V1 1442 -> print_message(informational, pack(up_to_date(Pack))) 1443 ; confirm(upgrade(Pack, V0, V1), yes, []), 1444 git([merge, 'origin/master'], [ directory(Dir) ]), 1445 pack_rebuild(Pack) 1446 ). 1447pack_upgrade(Pack) :- 1448 once(pack_info(Pack, _, version(VersionAtom))), 1449 atom_version(VersionAtom, Version), 1450 pack_info(Pack, _, download(URL)), 1451 ( wildcard_pattern(URL) 1452 -> true 1453 ; github_url(URL, _User, _Repo) 1454 ), 1455 !, 1456 available_download_versions(URL, [Latest-LatestURL|_Versions]), 1457 ( Latest @> Version 1458 -> confirm(upgrade(Pack, Version, Latest), yes, []), 1459 pack_install(Pack, 1460 [ url(LatestURL), 1461 upgrade(true), 1462 pack(Pack) 1463 ]) 1464 ; print_message(informational, pack(up_to_date(Pack))) 1465 ). 1466pack_upgrade(Pack) :- 1467 print_message(warning, pack(no_upgrade_info(Pack))). 1468 1469 1470 /******************************* 1471 * REMOVE * 1472 *******************************/
1478pack_remove(Pack) :- 1479 update_dependency_db, 1480 ( setof(Dep, pack_depends_on(Dep, Pack), Deps) 1481 -> confirm_remove(Pack, Deps, Delete), 1482 forall(member(P, Delete), pack_remove_forced(P)) 1483 ; pack_remove_forced(Pack) 1484 ). 1485 1486pack_remove_forced(Pack) :- 1487 catch('$pack_detach'(Pack, BaseDir), 1488 error(existence_error(pack, Pack), _), 1489 fail), 1490 !, 1491 print_message(informational, pack(remove(BaseDir))), 1492 delete_directory_and_contents(BaseDir). 1493pack_remove_forced(Pack) :- 1494 directory_file_path(Pack, 'pack.pl', PackFile), 1495 absolute_file_name(pack(PackFile), PackPath, 1496 [ access(read), 1497 file_errors(fail) 1498 ]), 1499 !, 1500 file_directory_name(PackPath, BaseDir), 1501 delete_directory_and_contents(BaseDir). 1502pack_remove_forced(Pack) :- 1503 print_message(informational, error(existence_error(pack, Pack),_)). 1504 1505confirm_remove(Pack, Deps, Delete) :- 1506 print_message(warning, pack(depends(Pack, Deps))), 1507 menu(pack(resolve_remove), 1508 [ [Pack] = remove_only(Pack), 1509 [Pack|Deps] = remove_deps(Pack, Deps), 1510 [] = cancel 1511 ], [], Delete, []), 1512 Delete \== []. 1513 1514 1515 /******************************* 1516 * PROPERTIES * 1517 *******************************/
README
file (if present)TODO
file (if present)1540pack_property(Pack, Property) :- 1541 findall(Pack-Property, pack_property_(Pack, Property), List), 1542 member(Pack-Property, List). % make det if applicable 1543 1544pack_property_(Pack, Property) :- 1545 pack_info(Pack, _, Property). 1546pack_property_(Pack, Property) :- 1547 \+ \+ info_file(Property, _), 1548 '$pack':pack(Pack, BaseDir), 1549 access_file(BaseDir, read), 1550 directory_files(BaseDir, Files), 1551 member(File, Files), 1552 info_file(Property, Pattern), 1553 downcase_atom(File, Pattern), 1554 directory_file_path(BaseDir, File, InfoFile), 1555 arg(1, Property, InfoFile). 1556 1557info_file(readme(_), 'readme.txt'). 1558info_file(readme(_), 'readme'). 1559info_file(todo(_), 'todo.txt'). 1560info_file(todo(_), 'todo'). 1561 1562 1563 /******************************* 1564 * GIT * 1565 *******************************/
1571git_url(URL, Pack) :- 1572 uri_components(URL, Components), 1573 uri_data(scheme, Components, Scheme), 1574 uri_data(path, Components, Path), 1575 ( Scheme == git 1576 -> true 1577 ; git_download_scheme(Scheme), 1578 file_name_extension(_, git, Path) 1579 ), 1580 file_base_name(Path, PackExt), 1581 ( file_name_extension(Pack, git, PackExt) 1582 -> true 1583 ; Pack = PackExt 1584 ), 1585 ( safe_pack_name(Pack) 1586 -> true 1587 ; domain_error(pack_name, Pack) 1588 ). 1589 1590git_download_scheme(http). 1591git_download_scheme(https).
1598safe_pack_name(Name) :- 1599 atom_length(Name, Len), 1600 Len >= 3, % demand at least three length 1601 atom_codes(Name, Codes), 1602 maplist(safe_pack_char, Codes), 1603 !. 1604 1605safe_pack_char(C) :- between(0'a, 0'z, C), !. 1606safe_pack_char(C) :- between(0'A, 0'Z, C), !. 1607safe_pack_char(C) :- between(0'0, 0'9, C), !. 1608safe_pack_char(0'_). 1609 1610 1611 /******************************* 1612 * VERSION LOGIC * 1613 *******************************/
mypack-1.5
.1622pack_version_file(Pack, Version, GitHubRelease) :- 1623 atomic(GitHubRelease), 1624 github_release_url(GitHubRelease, Pack, Version), 1625 !. 1626pack_version_file(Pack, Version, Path) :- 1627 atomic(Path), 1628 file_base_name(Path, File), 1629 no_int_file_name_extension(Base, _Ext, File), 1630 atom_codes(Base, Codes), 1631 ( phrase(pack_version(Pack, Version), Codes), 1632 safe_pack_name(Pack) 1633 -> true 1634 ). 1635 1636no_int_file_name_extension(Base, Ext, File) :- 1637 file_name_extension(Base0, Ext0, File), 1638 \+ atom_number(Ext0, _), 1639 !, 1640 Base = Base0, 1641 Ext = Ext0. 1642no_int_file_name_extension(File, '', File).
https:/github.com/<owner>/<pack>/archive/[vV]?<version>.zip'
1655github_release_url(URL, Pack, Version) :- 1656 uri_components(URL, Components), 1657 uri_data(authority, Components, 'github.com'), 1658 uri_data(scheme, Components, Scheme), 1659 download_scheme(Scheme), 1660 uri_data(path, Components, Path), 1661 atomic_list_concat(['',_Project,Pack,archive,File], /, Path), 1662 file_name_extension(Tag, Ext, File), 1663 github_archive_extension(Ext), 1664 tag_version(Tag, Version), 1665 !. 1666 1667github_archive_extension(tgz). 1668github_archive_extension(zip). 1669 1670tag_version(Tag, Version) :- 1671 version_tag_prefix(Prefix), 1672 atom_concat(Prefix, AtomVersion, Tag), 1673 atom_version(AtomVersion, Version). 1674 1675version_tag_prefix(v). 1676version_tag_prefix('V'). 1677version_tag_prefix(''). 1678 1679 1680:- public 1681 atom_version/2.
@>
1689atom_version(Atom, version(Parts)) :- 1690 ( atom(Atom) 1691 -> atom_codes(Atom, Codes), 1692 phrase(version(Parts), Codes) 1693 ; atomic_list_concat(Parts, '.', Atom) 1694 ). 1695 1696pack_version(Pack, version(Parts)) --> 1697 string(Codes), "-", 1698 version(Parts), 1699 !, 1700 { atom_codes(Pack, Codes) 1701 }. 1702 1703version([_|T]) --> 1704 "*", 1705 !, 1706 ( "." 1707 -> version(T) 1708 ; [] 1709 ). 1710version([H|T]) --> 1711 integer(H), 1712 ( "." 1713 -> version(T) 1714 ; { T = [] } 1715 ). 1716 1717integer(H) --> digit(D0), digits(L), { number_codes(H, [D0|L]) }. 1718digit(D) --> [D], { code_type(D, digit) }. 1719digits([H|T]) --> digit(H), !, digits(T). 1720digits([]) --> []. 1721 1722 1723 /******************************* 1724 * QUERY CENTRAL DB * 1725 *******************************/
1745pack_inquiry(_, _, _, Options) :- 1746 option(inquiry(false), Options), 1747 !. 1748pack_inquiry(URL, DownloadFile, Info, Options) :- 1749 setting(server, ServerBase), 1750 ServerBase \== '', 1751 atom_concat(ServerBase, query, Server), 1752 ( option(inquiry(true), Options) 1753 -> true 1754 ; confirm(inquiry(Server), yes, Options) 1755 ), 1756 !, 1757 ( DownloadFile = git(SHA1) 1758 -> true 1759 ; file_sha1(DownloadFile, SHA1) 1760 ), 1761 query_pack_server(install(URL, SHA1, Info), Reply, Options), 1762 inquiry_result(Reply, URL, Options). 1763pack_inquiry(_, _, _, _).
1771query_pack_server(Query, Result, Options) :- 1772 setting(server, ServerBase), 1773 ServerBase \== '', 1774 atom_concat(ServerBase, query, Server), 1775 format(codes(Data), '~q.~n', Query), 1776 info_level(Informational, Options), 1777 print_message(Informational, pack(contacting_server(Server))), 1778 setup_call_cleanup( 1779 http_open(Server, In, 1780 [ post(codes(application/'x-prolog', Data)), 1781 header(content_type, ContentType) 1782 ]), 1783 read_reply(ContentType, In, Result), 1784 close(In)), 1785 message_severity(Result, Level, Informational), 1786 print_message(Level, pack(server_reply(Result))). 1787 1788read_reply(ContentType, In, Result) :- 1789 sub_atom(ContentType, 0, _, _, 'application/x-prolog'), 1790 !, 1791 set_stream(In, encoding(utf8)), 1792 read(In, Result). 1793read_reply(ContentType, In, _Result) :- 1794 read_string(In, 500, String), 1795 print_message(error, pack(no_prolog_response(ContentType, String))), 1796 fail. 1797 1798info_level(Level, Options) :- 1799 option(silent(true), Options), 1800 !, 1801 Level = silent. 1802info_level(informational, _). 1803 1804message_severity(true(_), Informational, Informational). 1805message_severity(false, warning, _). 1806message_severity(exception(_), error, _).
1814inquiry_result(Reply, File, Options) :- 1815 findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation), 1816 \+ member(cancel, Evaluation), 1817 select_option(git(_), Options, Options1, _), 1818 forall(member(install_dependencies(Resolution), Evaluation), 1819 maplist(install_dependency(Options1), Resolution)). 1820 1821eval_inquiry(true(Reply), URL, Eval, _) :- 1822 include(alt_hash, Reply, Alts), 1823 Alts \== [], 1824 print_message(warning, pack(alt_hashes(URL, Alts))), 1825 ( memberchk(downloads(Count), Reply), 1826 ( git_url(URL, _) 1827 -> Default = yes, 1828 Eval = with_git_commits_in_same_version 1829 ; Default = no, 1830 Eval = with_alt_hashes 1831 ), 1832 confirm(continue_with_alt_hashes(Count, URL), Default, []) 1833 -> true 1834 ; !, % Stop other rules 1835 Eval = cancel 1836 ). 1837eval_inquiry(true(Reply), _, Eval, Options) :- 1838 include(dependency, Reply, Deps), 1839 Deps \== [], 1840 select_dependency_resolution(Deps, Eval, Options), 1841 ( Eval == cancel 1842 -> ! 1843 ; true 1844 ). 1845eval_inquiry(true(Reply), URL, true, Options) :- 1846 file_base_name(URL, File), 1847 info_level(Informational, Options), 1848 print_message(Informational, pack(inquiry_ok(Reply, File))). 1849eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))), 1850 URL, Eval, Options) :- 1851 ( confirm(continue_with_modified_hash(URL), no, Options) 1852 -> Eval = true 1853 ; Eval = cancel 1854 ). 1855 1856alt_hash(alt_hash(_,_,_)). 1857dependency(dependency(_,_,_,_,_)).
1866select_dependency_resolution(Deps, Eval, Options) :- 1867 resolve_dependencies(Deps, Resolution), 1868 exclude(local_dep, Resolution, ToBeDone), 1869 ( ToBeDone == [] 1870 -> !, Eval = true 1871 ; print_message(warning, pack(install_dependencies(Resolution))), 1872 ( memberchk(_-unresolved, Resolution) 1873 -> Default = cancel 1874 ; Default = install_deps 1875 ), 1876 menu(pack(resolve_deps), 1877 [ install_deps = install_deps, 1878 install_no_deps = install_no_deps, 1879 cancel = cancel 1880 ], Default, Choice, Options), 1881 ( Choice == cancel 1882 -> !, Eval = cancel 1883 ; Choice == install_no_deps 1884 -> !, Eval = install_no_deps 1885 ; !, Eval = install_dependencies(Resolution) 1886 ) 1887 ). 1888 1889local_dep(_-resolved(_)).
1898install_dependency(Options, 1899 _Token-resolve(Pack, VersionAtom, [_URL|_], SubResolve)) :- 1900 atom_version(VersionAtom, Version), 1901 current_pack(Pack), 1902 pack_info(Pack, _, version(InstalledAtom)), 1903 atom_version(InstalledAtom, Installed), 1904 Installed == Version, % already installed 1905 !, 1906 maplist(install_dependency(Options), SubResolve). 1907install_dependency(Options, 1908 _Token-resolve(Pack, VersionAtom, [URL|_], SubResolve)) :- 1909 !, 1910 atom_version(VersionAtom, Version), 1911 merge_options([ url(URL), 1912 version(Version), 1913 interactive(false), 1914 inquiry(false), 1915 info(list), 1916 pack(Pack) 1917 ], Options, InstallOptions), 1918 pack_install(Pack, InstallOptions), 1919 maplist(install_dependency(Options), SubResolve). 1920install_dependency(_, _-_). 1921 1922 1923 /******************************* 1924 * WILDCARD URIs * 1925 *******************************/
1934available_download_versions(URL, Versions) :- 1935 wildcard_pattern(URL), 1936 github_url(URL, User, Repo), 1937 !, 1938 findall(Version-VersionURL, 1939 github_version(User, Repo, Version, VersionURL), 1940 Versions). 1941available_download_versions(URL, Versions) :- 1942 wildcard_pattern(URL), 1943 !, 1944 file_directory_name(URL, DirURL0), 1945 ensure_slash(DirURL0, DirURL), 1946 print_message(informational, pack(query_versions(DirURL))), 1947 setup_call_cleanup( 1948 http_open(DirURL, In, []), 1949 load_html(stream(In), DOM, 1950 [ syntax_errors(quiet) 1951 ]), 1952 close(In)), 1953 findall(MatchingURL, 1954 absolute_matching_href(DOM, URL, MatchingURL), 1955 MatchingURLs), 1956 ( MatchingURLs == [] 1957 -> print_message(warning, pack(no_matching_urls(URL))) 1958 ; true 1959 ), 1960 versioned_urls(MatchingURLs, VersionedURLs), 1961 keysort(VersionedURLs, SortedVersions), 1962 reverse(SortedVersions, Versions), 1963 print_message(informational, pack(found_versions(Versions))). 1964available_download_versions(URL, [Version-URL]) :- 1965 ( pack_version_file(_Pack, Version0, URL) 1966 -> Version = Version0 1967 ; Version = unknown 1968 ).
1974github_url(URL, User, Repo) :-
1975 uri_components(URL, uri_components(https,'github.com',Path,_,_)),
1976 atomic_list_concat(['',User,Repo|_], /, Path).
1984github_version(User, Repo, Version, VersionURI) :- 1985 atomic_list_concat(['',repos,User,Repo,tags], /, Path1), 1986 uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)), 1987 setup_call_cleanup( 1988 http_open(ApiUri, In, 1989 [ request_header('Accept'='application/vnd.github.v3+json') 1990 ]), 1991 json_read_dict(In, Dicts), 1992 close(In)), 1993 member(Dict, Dicts), 1994 atom_string(Tag, Dict.name), 1995 tag_version(Tag, Version), 1996 atom_string(VersionURI, Dict.zipball_url). 1997 1998wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *). 1999wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?). 2000 2001ensure_slash(Dir, DirS) :- 2002 ( sub_atom(Dir, _, _, 0, /) 2003 -> DirS = Dir 2004 ; atom_concat(Dir, /, DirS) 2005 ). 2006 2007absolute_matching_href(DOM, Pattern, Match) :- 2008 xpath(DOM, //a(@href), HREF), 2009 uri_normalized(HREF, Pattern, Match), 2010 wildcard_match(Pattern, Match). 2011 2012versioned_urls([], []). 2013versioned_urls([H|T0], List) :- 2014 file_base_name(H, File), 2015 ( pack_version_file(_Pack, Version, File) 2016 -> List = [Version-H|T] 2017 ; List = T 2018 ), 2019 versioned_urls(T0, T). 2020 2021 2022 /******************************* 2023 * DEPENDENCIES * 2024 *******************************/
2030update_dependency_db :- 2031 retractall(pack_requires(_,_)), 2032 retractall(pack_provides_db(_,_)), 2033 forall(current_pack(Pack), 2034 ( findall(Info, pack_info(Pack, dependency, Info), Infos), 2035 update_dependency_db(Pack, Infos) 2036 )). 2037 2038update_dependency_db(Name, Info) :- 2039 retractall(pack_requires(Name, _)), 2040 retractall(pack_provides_db(Name, _)), 2041 maplist(assert_dep(Name), Info). 2042 2043assert_dep(Pack, provides(Token)) :- 2044 !, 2045 assertz(pack_provides_db(Pack, Token)). 2046assert_dep(Pack, requires(Token)) :- 2047 !, 2048 assertz(pack_requires(Pack, Token)). 2049assert_dep(_, _).
2055validate_dependencies :- 2056 unsatisfied_dependencies(Unsatisfied), 2057 !, 2058 print_message(warning, pack(unsatisfied(Unsatisfied))). 2059validate_dependencies. 2060 2061 2062unsatisfied_dependencies(Unsatisfied) :- 2063 findall(Req-Pack, pack_requires(Pack, Req), Reqs0), 2064 keysort(Reqs0, Reqs1), 2065 group_pairs_by_key(Reqs1, GroupedReqs), 2066 exclude(satisfied_dependency, GroupedReqs, Unsatisfied), 2067 Unsatisfied \== []. 2068 2069satisfied_dependency(Needed-_By) :- 2070 pack_provides(_, Needed), 2071 !. 2072satisfied_dependency(Needed-_By) :- 2073 compound(Needed), 2074 Needed =.. [Op, Pack, ReqVersion], 2075 ( pack_provides(Pack, Pack) 2076 -> pack_info(Pack, _, version(PackVersion)), 2077 version_data(PackVersion, PackData) 2078 ; Pack == prolog 2079 -> current_prolog_flag(version_data, swi(Major,Minor,Patch,_)), 2080 PackData = [Major,Minor,Patch] 2081 ), 2082 version_data(ReqVersion, ReqData), 2083 cmp(Op, Cmp), 2084 call(Cmp, PackData, ReqData).
2090pack_provides(Pack, Pack) :- 2091 current_pack(Pack). 2092pack_provides(Pack, Token) :- 2093 pack_provides_db(Pack, Token).
2099pack_depends_on(Pack, Dependency) :- 2100 ( atom(Pack) 2101 -> pack_depends_on_fwd(Pack, Dependency, [Pack]) 2102 ; pack_depends_on_bwd(Pack, Dependency, [Dependency]) 2103 ). 2104 2105pack_depends_on_fwd(Pack, Dependency, Visited) :- 2106 pack_depends_on_1(Pack, Dep1), 2107 \+ memberchk(Dep1, Visited), 2108 ( Dependency = Dep1 2109 ; pack_depends_on_fwd(Dep1, Dependency, [Dep1|Visited]) 2110 ). 2111 2112pack_depends_on_bwd(Pack, Dependency, Visited) :- 2113 pack_depends_on_1(Dep1, Dependency), 2114 \+ memberchk(Dep1, Visited), 2115 ( Pack = Dep1 2116 ; pack_depends_on_bwd(Pack, Dep1, [Dep1|Visited]) 2117 ). 2118 2119pack_depends_on_1(Pack, Dependency) :- 2120 atom(Dependency), 2121 !, 2122 pack_provides(Dependency, Token), 2123 pack_requires(Pack, Token). 2124pack_depends_on_1(Pack, Dependency) :- 2125 pack_requires(Pack, Token), 2126 pack_provides(Dependency, Token).
2143resolve_dependencies(Dependencies, Resolution) :- 2144 maplist(dependency_pair, Dependencies, Pairs0), 2145 keysort(Pairs0, Pairs1), 2146 group_pairs_by_key(Pairs1, ByToken), 2147 maplist(resolve_dep, ByToken, Resolution). 2148 2149dependency_pair(dependency(Token, Pack, Version, URLs, SubDeps), 2150 Token-(Pack-pack(Version,URLs, SubDeps))). 2151 2152resolve_dep(Token-Pairs, Token-Resolution) :- 2153 ( resolve_dep2(Token-Pairs, Resolution) 2154 *-> true 2155 ; Resolution = unresolved 2156 ). 2157 2158resolve_dep2(Token-_, resolved(Pack)) :- 2159 pack_provides(Pack, Token). 2160resolve_dep2(_-Pairs, resolve(Pack, VersionAtom, URLs, SubResolves)) :- 2161 keysort(Pairs, Sorted), 2162 group_pairs_by_key(Sorted, ByPack), 2163 member(Pack-Versions, ByPack), 2164 Pack \== (-), 2165 maplist(version_pack, Versions, VersionData), 2166 sort(VersionData, ByVersion), 2167 reverse(ByVersion, ByVersionLatest), 2168 member(pack(Version,URLs,SubDeps), ByVersionLatest), 2169 atom_version(VersionAtom, Version), 2170 include(dependency, SubDeps, Deps), 2171 resolve_dependencies(Deps, SubResolves). 2172 2173version_pack(pack(VersionAtom,URLs,SubDeps), 2174 pack(Version,URLs,SubDeps)) :- 2175 atom_version(VersionAtom, Version). 2176 2177 2178 /******************************* 2179 * RUN PROCESSES * 2180 *******************************/
informational
.output(Out)
, but messages are printed at level error
.2197run_process(Executable, Argv, Options) :- 2198 \+ option(output(_), Options), 2199 \+ option(error(_), Options), 2200 current_prolog_flag(unix, true), 2201 current_prolog_flag(threads, true), 2202 !, 2203 process_create_options(Options, Extra), 2204 process_create(Executable, Argv, 2205 [ stdout(pipe(Out)), 2206 stderr(pipe(Error)), 2207 process(PID) 2208 | Extra 2209 ]), 2210 thread_create(relay_output([output-Out, error-Error]), Id, []), 2211 process_wait(PID, Status), 2212 thread_join(Id, _), 2213 ( Status == exit(0) 2214 -> true 2215 ; throw(error(process_error(process(Executable, Argv), Status), _)) 2216 ). 2217run_process(Executable, Argv, Options) :- 2218 process_create_options(Options, Extra), 2219 setup_call_cleanup( 2220 process_create(Executable, Argv, 2221 [ stdout(pipe(Out)), 2222 stderr(pipe(Error)), 2223 process(PID) 2224 | Extra 2225 ]), 2226 ( read_stream_to_codes(Out, OutCodes, []), 2227 read_stream_to_codes(Error, ErrorCodes, []), 2228 process_wait(PID, Status) 2229 ), 2230 ( close(Out), 2231 close(Error) 2232 )), 2233 print_error(ErrorCodes, Options), 2234 print_output(OutCodes, Options), 2235 ( Status == exit(0) 2236 -> true 2237 ; throw(error(process_error(process(Executable, Argv), Status), _)) 2238 ). 2239 2240process_create_options(Options, Extra) :- 2241 option(directory(Dir), Options, .), 2242 ( option(env(Env), Options) 2243 -> Extra = [cwd(Dir), env(Env)] 2244 ; Extra = [cwd(Dir)] 2245 ). 2246 2247relay_output([]) :- !. 2248relay_output(Output) :- 2249 pairs_values(Output, Streams), 2250 wait_for_input(Streams, Ready, infinite), 2251 relay(Ready, Output, NewOutputs), 2252 relay_output(NewOutputs). 2253 2254relay([], Outputs, Outputs). 2255relay([H|T], Outputs0, Outputs) :- 2256 selectchk(Type-H, Outputs0, Outputs1), 2257 ( at_end_of_stream(H) 2258 -> close(H), 2259 relay(T, Outputs1, Outputs) 2260 ; read_pending_codes(H, Codes, []), 2261 relay(Type, Codes), 2262 relay(T, Outputs0, Outputs) 2263 ). 2264 2265relay(error, Codes) :- 2266 set_prolog_flag(message_context, []), 2267 print_error(Codes, []). 2268relay(output, Codes) :- 2269 print_output(Codes, []). 2270 2271print_output(OutCodes, Options) :- 2272 option(output(Codes), Options), 2273 !, 2274 Codes = OutCodes. 2275print_output(OutCodes, _) :- 2276 print_message(informational, pack(process_output(OutCodes))). 2277 2278print_error(OutCodes, Options) :- 2279 option(error(Codes), Options), 2280 !, 2281 Codes = OutCodes. 2282print_error(OutCodes, _) :- 2283 phrase(classify_message(Level), OutCodes, _), 2284 print_message(Level, pack(process_output(OutCodes))). 2285 2286classify_message(error) --> 2287 string(_), "fatal:", 2288 !. 2289classify_message(error) --> 2290 string(_), "error:", 2291 !. 2292classify_message(warning) --> 2293 string(_), "warning:", 2294 !. 2295classify_message(informational) --> 2296 []. 2297 2298string([]) --> []. 2299string([H|T]) --> [H], string(T).
pack.pl
and a prolog
directory. Options processed:
last
, alternative is first
.2322pack_attach(Dir, Options) :- 2323 '$pack_attach'(Dir, Options). 2324 2325 2326 /******************************* 2327 * USER INTERACTION * 2328 *******************************/ 2329 2330:- multifile prolog:message//1.
2334menu(_Question, _Alternatives, Default, Selection, Options) :- 2335 option(interactive(false), Options), 2336 !, 2337 Selection = Default. 2338menu(Question, Alternatives, Default, Selection, _) :- 2339 length(Alternatives, N), 2340 between(1, 5, _), 2341 print_message(query, Question), 2342 print_menu(Alternatives, Default, 1), 2343 print_message(query, pack(menu(select))), 2344 read_selection(N, Choice), 2345 !, 2346 ( Choice == default 2347 -> Selection = Default 2348 ; nth1(Choice, Alternatives, Selection=_) 2349 -> true 2350 ). 2351 [], _, _) (. 2353print_menu([Value=Label|T], Default, I) :- 2354 ( Value == Default 2355 -> print_message(query, pack(menu(default_item(I, Label)))) 2356 ; print_message(query, pack(menu(item(I, Label)))) 2357 ), 2358 I2 is I + 1, 2359 print_menu(T, Default, I2). 2360 2361read_selection(Max, Choice) :- 2362 get_single_char(Code), 2363 ( answered_default(Code) 2364 -> Choice = default 2365 ; code_type(Code, digit(Choice)), 2366 between(1, Max, Choice) 2367 -> true 2368 ; print_message(warning, pack(menu(reply(1,Max)))), 2369 fail 2370 ).
2378confirm(_Question, Default, Options) :- 2379 Default \== none, 2380 option(interactive(false), Options, true), 2381 !, 2382 Default == yes. 2383confirm(Question, Default, _) :- 2384 between(1, 5, _), 2385 print_message(query, pack(confirm(Question, Default))), 2386 read_yes_no(YesNo, Default), 2387 !, 2388 format(user_error, '~N', []), 2389 YesNo == yes. 2390 2391read_yes_no(YesNo, Default) :- 2392 get_single_char(Code), 2393 code_yes_no(Code, Default, YesNo), 2394 !. 2395 2396code_yes_no(0'y, _, yes). 2397code_yes_no(0'Y, _, yes). 2398code_yes_no(0'n, _, no). 2399code_yes_no(0'N, _, no). 2400code_yes_no(_, none, _) :- !, fail. 2401code_yes_no(C, Default, Default) :- 2402 answered_default(C). 2403 2404answered_default(0'\r). 2405answered_default(0'\n). 2406answered_default(0'\s). 2407 2408 2409 /******************************* 2410 * MESSAGES * 2411 *******************************/ 2412 2413:- multifile prolog:message//1. 2414 2415prologmessage(pack(Message)) --> 2416 message(Message). 2417 2418:- discontiguous 2419 message//1, 2420 label//1. 2421 2422message(invalid_info(Term)) --> 2423 [ 'Invalid package description: ~q'-[Term] ]. 2424message(directory_exists(Dir)) --> 2425 [ 'Package target directory exists and is not empty:', nl, 2426 '\t~q'-[Dir] 2427 ]. 2428message(already_installed(pack(Pack, Version))) --> 2429 { atom_version(AVersion, Version) }, 2430 [ 'Pack `~w'' is already installed @~w'-[Pack, AVersion] ]. 2431message(already_installed(Pack)) --> 2432 [ 'Pack `~w'' is already installed. Package info:'-[Pack] ]. 2433message(invalid_name(File)) --> 2434 [ '~w: A package archive must be named <pack>-<version>.<ext>'-[File] ], 2435 no_tar_gz(File). 2436 2437no_tar_gz(File) --> 2438 { sub_atom(File, _, _, 0, '.tar.gz') }, 2439 !, 2440 [ nl, 2441 'Package archive files must have a single extension. E.g., \'.tgz\''-[] 2442 ]. 2443no_tar_gz(_) --> []. 2444 2445message(kept_foreign(Pack)) --> 2446 [ 'Found foreign libraries for target platform.'-[], nl, 2447 'Use ?- pack_rebuild(~q). to rebuild from sources'-[Pack] 2448 ]. 2449message(no_pack_installed(Pack)) --> 2450 [ 'No pack ~q installed. Use ?- pack_list(Pattern) to search'-[Pack] ]. 2451message(no_packages_installed) --> 2452 { setting(server, ServerBase) }, 2453 [ 'There are no extra packages installed.', nl, 2454 'Please visit ~wlist.'-[ServerBase] 2455 ]. 2456message(remove_with(Pack)) --> 2457 [ 'The package can be removed using: ?- ~q.'-[pack_remove(Pack)] 2458 ]. 2459message(unsatisfied(Packs)) --> 2460 [ 'The following dependencies are not satisfied:', nl ], 2461 unsatisfied(Packs). 2462message(depends(Pack, Deps)) --> 2463 [ 'The following packages depend on `~w\':'-[Pack], nl ], 2464 pack_list(Deps). 2465message(remove(PackDir)) --> 2466 [ 'Removing ~q and contents'-[PackDir] ]. 2467message(remove_existing_pack(PackDir)) --> 2468 [ 'Remove old installation in ~q'-[PackDir] ]. 2469message(install_from(Pack, Version, git(URL))) --> 2470 [ 'Install ~w@~w from GIT at ~w'-[Pack, Version, URL] ]. 2471message(install_from(Pack, Version, URL)) --> 2472 [ 'Install ~w@~w from ~w'-[Pack, Version, URL] ]. 2473message(select_install_from(Pack, Version)) --> 2474 [ 'Select download location for ~w@~w'-[Pack, Version] ]. 2475message(install_downloaded(File)) --> 2476 { file_base_name(File, Base), 2477 size_file(File, Size) }, 2478 [ 'Install "~w" (~D bytes)'-[Base, Size] ]. 2479message(git_post_install(PackDir, Pack)) --> 2480 ( { is_foreign_pack(PackDir) } 2481 -> [ 'Run post installation scripts for pack "~w"'-[Pack] ] 2482 ; [ 'Activate pack "~w"'-[Pack] ] 2483 ). 2484message(no_meta_data(BaseDir)) --> 2485 [ 'Cannot find pack.pl inside directory ~q. Not a package?'-[BaseDir] ]. 2486message(inquiry(Server)) --> 2487 [ 'Verify package status (anonymously)', nl, 2488 '\tat "~w"'-[Server] 2489 ]. 2490message(search_no_matches(Name)) --> 2491 [ 'Search for "~w", returned no matching packages'-[Name] ]. 2492message(rebuild(Pack)) --> 2493 [ 'Checking pack "~w" for rebuild ...'-[Pack] ]. 2494message(upgrade(Pack, From, To)) --> 2495 [ 'Upgrade "~w" from '-[Pack] ], 2496 msg_version(From), [' to '-[]], msg_version(To). 2497message(up_to_date(Pack)) --> 2498 [ 'Package "~w" is up-to-date'-[Pack] ]. 2499message(query_versions(URL)) --> 2500 [ 'Querying "~w" to find new versions ...'-[URL] ]. 2501message(no_matching_urls(URL)) --> 2502 [ 'Could not find any matching URL: ~q'-[URL] ]. 2503message(found_versions([Latest-_URL|More])) --> 2504 { length(More, Len), 2505 atom_version(VLatest, Latest) 2506 }, 2507 [ ' Latest version: ~w (~D older)'-[VLatest, Len] ]. 2508message(process_output(Codes)) --> 2509 { split_lines(Codes, Lines) }, 2510 process_lines(Lines). 2511message(contacting_server(Server)) --> 2512 [ 'Contacting server at ~w ...'-[Server], flush ]. 2513message(server_reply(true(_))) --> 2514 [ at_same_line, ' ok'-[] ]. 2515message(server_reply(false)) --> 2516 [ at_same_line, ' done'-[] ]. 2517message(server_reply(exception(E))) --> 2518 [ 'Server reported the following error:'-[], nl ], 2519 '$messages':translate_message(E). 2520message(cannot_create_dir(Alias)) --> 2521 { findall(PackDir, 2522 absolute_file_name(Alias, PackDir, [solutions(all)]), 2523 PackDirs0), 2524 sort(PackDirs0, PackDirs) 2525 }, 2526 [ 'Cannot find a place to create a package directory.'-[], 2527 'Considered:'-[] 2528 ], 2529 candidate_dirs(PackDirs). 2530message(no_match(Name)) --> 2531 [ 'No registered pack matches "~w"'-[Name] ]. 2532message(conflict(version, [PackV, FileV])) --> 2533 ['Version mismatch: pack.pl: '-[]], msg_version(PackV), 2534 [', file claims version '-[]], msg_version(FileV). 2535message(conflict(name, [PackInfo, FileInfo])) --> 2536 ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]], 2537 [', file claims ~w: ~p'-[FileInfo]]. 2538message(no_prolog_response(ContentType, String)) --> 2539 [ 'Expected Prolog response. Got content of type ~p'-[ContentType], nl, 2540 '~s'-[String] 2541 ]. 2542message(pack(no_upgrade_info(Pack))) --> 2543 [ '~w: pack meta-data does not provide an upgradable URL'-[Pack] ]. 2544 2545candidate_dirs([]) --> []. 2546candidate_dirs([H|T]) --> [ nl, ' ~w'-[H] ], candidate_dirs(T). 2547 2548message(no_mingw) --> 2549 [ 'Cannot find MinGW and/or MSYS.'-[] ]. 2550 2551 % Questions 2552message(resolve_remove) --> 2553 [ nl, 'Please select an action:', nl, nl ]. 2554message(create_pack_dir) --> 2555 [ nl, 'Create directory for packages', nl ]. 2556message(menu(item(I, Label))) --> 2557 [ '~t(~d)~6| '-[I] ], 2558 label(Label). 2559message(menu(default_item(I, Label))) --> 2560 [ '~t(~d)~6| * '-[I] ], 2561 label(Label). 2562message(menu(select)) --> 2563 [ nl, 'Your choice? ', flush ]. 2564message(confirm(Question, Default)) --> 2565 message(Question), 2566 confirm_default(Default), 2567 [ flush ]. 2568message(menu(reply(Min,Max))) --> 2569 ( { Max =:= Min+1 } 2570 -> [ 'Please enter ~w or ~w'-[Min,Max] ] 2571 ; [ 'Please enter a number between ~w and ~w'-[Min,Max] ] 2572 ). 2573 2574% Alternate hashes for found for the same file 2575 2576message(alt_hashes(URL, _Alts)) --> 2577 { git_url(URL, _) 2578 }, 2579 !, 2580 [ 'GIT repository was updated without updating version' ]. 2581message(alt_hashes(URL, Alts)) --> 2582 { file_base_name(URL, File) 2583 }, 2584 [ 'Found multiple versions of "~w".'-[File], nl, 2585 'This could indicate a compromised or corrupted file', nl 2586 ], 2587 alt_hashes(Alts). 2588message(continue_with_alt_hashes(Count, URL)) --> 2589 [ 'Continue installation from "~w" (downloaded ~D times)'-[URL, Count] ]. 2590message(continue_with_modified_hash(_URL)) --> 2591 [ 'Pack may be compromised. Continue anyway' 2592 ]. 2593message(modified_hash(_SHA1-URL, _SHA2-[URL])) --> 2594 [ 'Content of ~q has changed.'-[URL] 2595 ]. 2596 2597alt_hashes([]) --> []. 2598alt_hashes([H|T]) --> alt_hash(H), ( {T == []} -> [] ; [nl], alt_hashes(T) ). 2599 2600alt_hash(alt_hash(Count, URLs, Hash)) --> 2601 [ '~t~d~8| ~w'-[Count, Hash] ], 2602 alt_urls(URLs). 2603 2604alt_urls([]) --> []. 2605alt_urls([H|T]) --> 2606 [ nl, ' ~w'-[H] ], 2607 alt_urls(T). 2608 2609% Installation dependencies gathered from inquiry server. 2610 2611message(install_dependencies(Resolution)) --> 2612 [ 'Package depends on the following:' ], 2613 msg_res_tokens(Resolution, 1). 2614 2615msg_res_tokens([], _) --> []. 2616msg_res_tokens([H|T], L) --> msg_res_token(H, L), msg_res_tokens(T, L). 2617 2618msg_res_token(Token-unresolved, L) --> 2619 res_indent(L), 2620 [ '"~w" cannot be satisfied'-[Token] ]. 2621msg_res_token(Token-resolve(Pack, Version, [URL|_], SubResolves), L) --> 2622 !, 2623 res_indent(L), 2624 [ '"~w", provided by ~w@~w from ~w'-[Token, Pack, Version, URL] ], 2625 { L2 is L+1 }, 2626 msg_res_tokens(SubResolves, L2). 2627msg_res_token(Token-resolved(Pack), L) --> 2628 !, 2629 res_indent(L), 2630 [ '"~w", provided by installed pack ~w'-[Token,Pack] ]. 2631 2632res_indent(L) --> 2633 { I is L*2 }, 2634 [ nl, '~*c'-[I,0'\s] ]. 2635 2636message(resolve_deps) --> 2637 [ nl, 'What do you wish to do' ]. 2638label(install_deps) --> 2639 [ 'Install proposed dependencies' ]. 2640label(install_no_deps) --> 2641 [ 'Only install requested package' ]. 2642 2643 2644message(git_fetch(Dir)) --> 2645 [ 'Running "git fetch" in ~q'-[Dir] ]. 2646 2647% inquiry is blank 2648 2649message(inquiry_ok(Reply, File)) --> 2650 { memberchk(downloads(Count), Reply), 2651 memberchk(rating(VoteCount, Rating), Reply), 2652 !, 2653 length(Stars, Rating), 2654 maplist(=(0'*), Stars) 2655 }, 2656 [ '"~w" was downloaded ~D times. Package rated ~s (~D votes)'- 2657 [ File, Count, Stars, VoteCount ] 2658 ]. 2659message(inquiry_ok(Reply, File)) --> 2660 { memberchk(downloads(Count), Reply) 2661 }, 2662 [ '"~w" was downloaded ~D times'-[ File, Count ] ]. 2663 2664 % support predicates 2665unsatisfied([]) --> []. 2666unsatisfied([Needed-[By]|T]) --> 2667 [ ' - "~w" is needed by package "~w"'-[Needed, By], nl ], 2668 unsatisfied(T). 2669unsatisfied([Needed-By|T]) --> 2670 [ ' - "~w" is needed by the following packages:'-[Needed], nl ], 2671 pack_list(By), 2672 unsatisfied(T). 2673 2674pack_list([]) --> []. 2675pack_list([H|T]) --> 2676 [ ' - Package "~w"'-[H], nl ], 2677 pack_list(T). 2678 2679process_lines([]) --> []. 2680process_lines([H|T]) --> 2681 [ '~s'-[H] ], 2682 ( {T==[]} 2683 -> [] 2684 ; [nl], process_lines(T) 2685 ). 2686 2687split_lines([], []) :- !. 2688split_lines(All, [Line1|More]) :- 2689 append(Line1, [0'\n|Rest], All), 2690 !, 2691 split_lines(Rest, More). 2692split_lines(Line, [Line]). 2693 2694label(remove_only(Pack)) --> 2695 [ 'Only remove package ~w (break dependencies)'-[Pack] ]. 2696label(remove_deps(Pack, Deps)) --> 2697 { length(Deps, Count) }, 2698 [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ]. 2699label(create_dir(Dir)) --> 2700 [ '~w'-[Dir] ]. 2701label(install_from(git(URL))) --> 2702 !, 2703 [ 'GIT repository at ~w'-[URL] ]. 2704label(install_from(URL)) --> 2705 [ '~w'-[URL] ]. 2706label(cancel) --> 2707 [ 'Cancel' ]. 2708 2709confirm_default(yes) --> 2710 [ ' Y/n? ' ]. 2711confirm_default(no) --> 2712 [ ' y/N? ' ]. 2713confirm_default(none) --> 2714 [ ' y/n? ' ]. 2715 2716msg_version(Version) --> 2717 { atom(Version) }, 2718 !, 2719 [ '~w'-[Version] ]. 2720msg_version(VersionData) --> 2721 !, 2722 { atom_version(Atom, VersionData) }, 2723 [ '~w'-[Atom] ]
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. It is complemented by the built-in attach_packs/0 that makes installed packages available as libraries.
?- doc_browser.