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-2021, 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_search/1, % +Keyword 42 pack_install/1, % +Name 43 pack_install/2, % +Name, +Options 44 pack_upgrade/1, % +Name 45 pack_rebuild/1, % +Name 46 pack_rebuild/0, % All packages 47 pack_remove/1, % +Name 48 pack_property/2, % ?Name, ?Property 49 pack_attach/2, % +Dir, +Options 50 51 pack_url_file/2 % +URL, -File 52 ]). 53:- use_module(library(apply)). 54:- use_module(library(error)). 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(dcg/basics)). 63:- use_module(library(http/http_open)). 64:- use_module(library(http/json)). 65:- use_module(library(http/http_client), []). % plugin for POST support 66:- use_module(library(prolog_config)). 67:- use_module(library(debug), [assertion/1]). 68:- use_module(library(pairs), [group_pairs_by_key/2]). 69% Stuff we may not have and may not need 70:- autoload(library(git)). 71:- autoload(library(sgml)). 72:- autoload(library(sha)). 73:- autoload(library(build/tools)).
107:- multifile 108 environment/2. % Name, Value 109 110:- dynamic 111 pack_requires/2, % Pack, Requirement 112 pack_provides_db/2. % Pack, Provided 113 114 115 /******************************* 116 * CONSTANTS * 117 *******************************/ 118 119:- setting(server, atom, 'https://www.swi-prolog.org/pack/', 120 'Server to exchange pack information'). 121 122 123 /******************************* 124 * PACKAGE INFO * 125 *******************************/
132current_pack(Pack) :- 133 current_pack(Pack, _). 134 135current_pack(Pack, Dir) :- 136 '$pack':pack(Pack, Dir).
146pack_list_installed :- 147 findall(Pack, current_pack(Pack), Packages0), 148 Packages0 \== [], 149 !, 150 sort(Packages0, Packages), 151 length(Packages, Count), 152 format('Installed packages (~D):~n~n', [Count]), 153 maplist(pack_info(list), Packages), 154 validate_dependencies. 155pack_list_installed :- 156 print_message(informational, pack(no_packages_installed)).
162pack_info(Name) :- 163 pack_info(info, Name). 164 165pack_info(Level, Name) :- 166 must_be(atom, Name), 167 findall(Info, pack_info(Name, Level, Info), Infos0), 168 ( Infos0 == [] 169 -> print_message(warning, pack(no_pack_installed(Name))), 170 fail 171 ; true 172 ), 173 update_dependency_db(Name, Infos0), 174 findall(Def, pack_default(Level, Infos, Def), Defs), 175 append(Infos0, Defs, Infos1), 176 sort(Infos1, Infos), 177 show_info(Name, Infos, [info(Level)]). 178 179 180show_info(_Name, _Properties, Options) :- 181 option(silent(true), Options), 182 !. 183show_info(Name, Properties, Options) :- 184 option(info(list), Options), 185 !, 186 memberchk(title(Title), Properties), 187 memberchk(version(Version), Properties), 188 format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]). 189show_info(Name, Properties, _) :- 190 !, 191 print_property_value('Package'-'~w', [Name]), 192 findall(Term, pack_level_info(info, Term, _, _), Terms), 193 maplist(print_property(Properties), Terms). 194 195print_property(_, nl) :- 196 !, 197 format('~n'). 198print_property(Properties, Term) :- 199 findall(Term, member(Term, Properties), Terms), 200 Terms \== [], 201 !, 202 pack_level_info(_, Term, LabelFmt, _Def), 203 ( LabelFmt = Label-FmtElem 204 -> true 205 ; Label = LabelFmt, 206 FmtElem = '~w' 207 ), 208 multi_valued(Terms, FmtElem, FmtList, Values), 209 atomic_list_concat(FmtList, ', ', Fmt), 210 print_property_value(Label-Fmt, Values). 211print_property(_, _). 212 213multi_valued([H], LabelFmt, [LabelFmt], Values) :- 214 !, 215 H =.. [_|Values]. 216multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :- 217 H =.. [_|VH], 218 append(VH, MoreValues, Values), 219 multi_valued(T, LabelFmt, LT, MoreValues). 220 221 222pvalue_column(24). 223print_property_value(Prop-Fmt, Values) :- 224 !, 225 pvalue_column(C), 226 atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format), 227 format(Format, [Prop,C|Values]). 228 229pack_info(Name, Level, Info) :- 230 '$pack':pack(Name, BaseDir), 231 ( Info = directory(BaseDir) 232 ; pack_info_term(BaseDir, Info) 233 ), 234 pack_level_info(Level, Info, _Format, _Default). 235 236:- public pack_level_info/4. % used by web-server 237 238pack_level_info(_, title(_), 'Title', '<no title>'). 239pack_level_info(_, version(_), 'Installed version', '<unknown>'). 240pack_level_info(info, directory(_), 'Installed in directory', -). 241pack_level_info(info, author(_, _), 'Author'-'~w <~w>', -). 242pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>', -). 243pack_level_info(info, packager(_, _), 'Packager'-'~w <~w>', -). 244pack_level_info(info, home(_), 'Home page', -). 245pack_level_info(info, download(_), 'Download URL', -). 246pack_level_info(_, provides(_), 'Provides', -). 247pack_level_info(_, requires(_), 'Requires', -). 248pack_level_info(_, conflicts(_), 'Conflicts with', -). 249pack_level_info(_, replaces(_), 'Replaces packages', -). 250pack_level_info(info, library(_), 'Provided libraries', -). 251 252pack_default(Level, Infos, Def) :- 253 pack_level_info(Level, ITerm, _Format, Def), 254 Def \== (-), 255 \+ memberchk(ITerm, Infos).
261pack_info_term(BaseDir, Info) :- 262 directory_file_path(BaseDir, 'pack.pl', InfoFile), 263 catch( 264 setup_call_cleanup( 265 open(InfoFile, read, In), 266 term_in_stream(In, Info), 267 close(In)), 268 error(existence_error(source_sink, InfoFile), _), 269 ( print_message(error, pack(no_meta_data(BaseDir))), 270 fail 271 )). 272pack_info_term(BaseDir, library(Lib)) :- 273 atom_concat(BaseDir, '/prolog/', LibDir), 274 atom_concat(LibDir, '*.pl', Pattern), 275 expand_file_name(Pattern, Files), 276 maplist(atom_concat(LibDir), Plain, Files), 277 convlist(base_name, Plain, Libs), 278 member(Lib, Libs). 279 280base_name(File, Base) :- 281 file_name_extension(Base, pl, File). 282 283term_in_stream(In, Term) :- 284 repeat, 285 read_term(In, Term0, []), 286 ( Term0 == end_of_file 287 -> !, fail 288 ; Term = Term0, 289 valid_info_term(Term0) 290 ). 291 292valid_info_term(Term) :- 293 Term =.. [Name|Args], 294 same_length(Args, Types), 295 Decl =.. [Name|Types], 296 ( pack_info_term(Decl) 297 -> maplist(valid_info_arg, Types, Args) 298 ; print_message(warning, pack(invalid_info(Term))), 299 fail 300 ). 301 302valid_info_arg(Type, Arg) :- 303 must_be(Type, Arg).
310pack_info_term(name(atom)). % Synopsis 311pack_info_term(title(atom)). 312pack_info_term(keywords(list(atom))). 313pack_info_term(description(list(atom))). 314pack_info_term(version(version)). 315pack_info_term(author(atom, email_or_url_or_empty)). % Persons 316pack_info_term(maintainer(atom, email_or_url)). 317pack_info_term(packager(atom, email_or_url)). 318pack_info_term(pack_version(nonneg)). % Package convention version 319pack_info_term(home(atom)). % Home page 320pack_info_term(download(atom)). % Source 321pack_info_term(provides(atom)). % Dependencies 322pack_info_term(requires(dependency)). 323pack_info_term(conflicts(dependency)). % Conflicts with package 324pack_info_term(replaces(atom)). % Replaces another package 325pack_info_term(autoload(boolean)). % Default installation options 326 327:- multifile 328 error:has_type/2. 329 330errorhas_type(version, Version) :- 331 atom(Version), 332 version_data(Version, _Data). 333errorhas_type(email_or_url, Address) :- 334 atom(Address), 335 ( sub_atom(Address, _, _, _, @) 336 -> true 337 ; uri_is_global(Address) 338 ). 339errorhas_type(email_or_url_or_empty, Address) :- 340 ( Address == '' 341 -> true 342 ; error:has_type(email_or_url, Address) 343 ). 344errorhas_type(dependency, Value) :- 345 is_dependency(Value, _Token, _Version). 346 347version_data(Version, version(Data)) :- 348 atomic_list_concat(Parts, '.', Version), 349 maplist(atom_number, Parts, Data). 350 351is_dependency(Token, Token, *) :- 352 atom(Token). 353is_dependency(Term, Token, VersionCmp) :- 354 Term =.. [Op,Token,Version], 355 cmp(Op, _), 356 version_data(Version, _), 357 VersionCmp =.. [Op,Version]. 358 359cmp(<, @<). 360cmp(=<, @=<). 361cmp(==, ==). 362cmp(>=, @>=). 363cmp(>, @>). 364 365 366 /******************************* 367 * SEARCH * 368 *******************************/
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.
397pack_list(Query) :- 398 pack_search(Query). 399 400pack_search(Query) :- 401 query_pack_server(search(Query), Result, []), 402 ( Result == false 403 -> ( local_search(Query, Packs), 404 Packs \== [] 405 -> forall(member(pack(Pack, Stat, Title, Version, _), Packs), 406 format('~w ~w@~w ~28|- ~w~n', 407 [Stat, Pack, Version, Title])) 408 ; print_message(warning, pack(search_no_matches(Query))) 409 ) 410 ; Result = true(Hits), 411 local_search(Query, Local), 412 append(Hits, Local, All), 413 sort(All, Sorted), 414 list_hits(Sorted) 415 ). 416 417list_hits([]). 418list_hits([ pack(Pack, i, Title, Version, _), 419 pack(Pack, p, Title, Version, _) 420 | More 421 ]) :- 422 !, 423 format('i ~w@~w ~28|- ~w~n', [Pack, Version, Title]), 424 list_hits(More). 425list_hits([ pack(Pack, i, Title, VersionI, _), 426 pack(Pack, p, _, VersionS, _) 427 | More 428 ]) :- 429 !, 430 version_data(VersionI, VDI), 431 version_data(VersionS, VDS), 432 ( VDI @< VDS 433 -> Tag = ('U') 434 ; Tag = ('A') 435 ), 436 format('~w ~w@~w(~w) ~28|- ~w~n', [Tag, Pack, VersionI, VersionS, Title]), 437 list_hits(More). 438list_hits([ pack(Pack, i, Title, VersionI, _) 439 | More 440 ]) :- 441 !, 442 format('l ~w@~w ~28|- ~w~n', [Pack, VersionI, Title]), 443 list_hits(More). 444list_hits([pack(Pack, Stat, Title, Version, _)|More]) :- 445 format('~w ~w@~w ~28|- ~w~n', [Stat, Pack, Version, Title]), 446 list_hits(More). 447 448 449local_search(Query, Packs) :- 450 findall(Pack, matching_installed_pack(Query, Pack), Packs). 451 452matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :- 453 current_pack(Pack), 454 findall(Term, 455 ( pack_info(Pack, _, Term), 456 search_info(Term) 457 ), Info), 458 ( sub_atom_icasechk(Pack, _, Query) 459 -> true 460 ; memberchk(title(Title), Info), 461 sub_atom_icasechk(Title, _, Query) 462 ), 463 option(title(Title), Info, '<no title>'), 464 option(version(Version), Info, '<no version>'), 465 option(download(URL), Info, '<no download url>'). 466 467search_info(title(_)). 468search_info(version(_)). 469search_info(download(_)). 470 471 472 /******************************* 473 * INSTALL * 474 *******************************/
file://
URL or '.'
After resolving the type of package, pack_install/2 is used to do the actual installation.
492pack_install(Spec) :-
493 pack_default_options(Spec, Pack, [], Options),
494 pack_install(Pack, [pack(Pack)|Options]).
501pack_default_options(_Spec, Pack, OptsIn, Options) :- 502 option(already_installed(pack(Pack,_Version)), OptsIn), 503 !, 504 Options = OptsIn. 505pack_default_options(_Spec, Pack, OptsIn, Options) :- 506 option(url(URL), OptsIn), 507 !, 508 ( option(git(_), OptsIn) 509 -> Options = OptsIn 510 ; git_url(URL, Pack) 511 -> Options = [git(true)|OptsIn] 512 ; Options = OptsIn 513 ), 514 ( nonvar(Pack) 515 -> true 516 ; option(pack(Pack), Options) 517 -> true 518 ; pack_version_file(Pack, _Version, URL) 519 ). 520pack_default_options(Archive, Pack, _, Options) :- % Install from archive 521 must_be(atom, Archive), 522 \+ uri_is_global(Archive), 523 expand_file_name(Archive, [File]), 524 exists_file(File), 525 !, 526 pack_version_file(Pack, Version, File), 527 uri_file_name(FileURL, File), 528 Options = [url(FileURL), version(Version)]. 529pack_default_options(URL, Pack, _, Options) :- 530 git_url(URL, Pack), 531 !, 532 Options = [git(true), url(URL)]. 533pack_default_options(FileURL, Pack, _, Options) :- % Install from directory 534 uri_file_name(FileURL, Dir), 535 exists_directory(Dir), 536 pack_info_term(Dir, name(Pack)), 537 !, 538 ( pack_info_term(Dir, version(Version)) 539 -> uri_file_name(DirURL, Dir), 540 Options = [url(DirURL), version(Version)] 541 ; throw(error(existence_error(key, version, Dir),_)) 542 ). 543pack_default_options('.', Pack, _, Options) :- % Install from CWD 544 pack_info_term('.', name(Pack)), 545 !, 546 working_directory(Dir, Dir), 547 ( pack_info_term(Dir, version(Version)) 548 -> uri_file_name(DirURL, Dir), 549 Options = [url(DirURL), version(Version) | Options1], 550 ( current_prolog_flag(windows, true) 551 -> Options1 = [] 552 ; Options1 = [link(true), rebuild(make)] 553 ) 554 ; throw(error(existence_error(key, version, Dir),_)) 555 ). 556pack_default_options(URL, Pack, _, Options) :- % Install from URL 557 pack_version_file(Pack, Version, URL), 558 download_url(URL), 559 !, 560 available_download_versions(URL, [URLVersion-LatestURL|_]), 561 Options = [url(LatestURL)|VersionOptions], 562 version_options(Version, URLVersion, VersionOptions). 563pack_default_options(Pack, Pack, OptsIn, Options) :- % Install from name 564 \+ uri_is_global(Pack), % ignore URLs 565 query_pack_server(locate(Pack), Reply, OptsIn), 566 ( Reply = true(Results) 567 -> pack_select_candidate(Pack, Results, OptsIn, Options) 568 ; print_message(warning, pack(no_match(Pack))), 569 fail 570 ). 571 572version_options(Version, Version, [version(Version)]) :- !. 573version_options(Version, _, [version(Version)]) :- 574 Version = version(List), 575 maplist(integer, List), 576 !. 577version_options(_, _, []).
583pack_select_candidate(Pack, [AtomVersion-_|_], Options, 584 [already_installed(pack(Pack, Installed))|Options]) :- 585 current_pack(Pack), 586 pack_info(Pack, _, version(InstalledAtom)), 587 atom_version(InstalledAtom, Installed), 588 atom_version(AtomVersion, Version), 589 Installed @>= Version, 590 !. 591pack_select_candidate(Pack, Available, Options, OptsOut) :- 592 option(url(URL), Options), 593 memberchk(_Version-URLs, Available), 594 memberchk(URL, URLs), 595 !, 596 ( git_url(URL, Pack) 597 -> Extra = [git(true)] 598 ; Extra = [] 599 ), 600 OptsOut = [url(URL), inquiry(true) | Extra]. 601pack_select_candidate(Pack, [Version-[URL]|_], Options, 602 [url(URL), git(true), inquiry(true)]) :- 603 git_url(URL, Pack), 604 !, 605 confirm(install_from(Pack, Version, git(URL)), yes, Options). 606pack_select_candidate(Pack, [Version-[URL]|More], Options, 607 [url(URL), inquiry(true) | Upgrade]) :- 608 ( More == [] 609 -> ! 610 ; true 611 ), 612 confirm(install_from(Pack, Version, URL), yes, Options), 613 !, 614 add_upgrade(Pack, Upgrade). 615pack_select_candidate(Pack, [Version-URLs|_], Options, 616 [url(URL), inquiry(true)|Rest]) :- 617 maplist(url_menu_item, URLs, Tagged), 618 append(Tagged, [cancel=cancel], Menu), 619 Menu = [Default=_|_], 620 menu(pack(select_install_from(Pack, Version)), 621 Menu, Default, Choice, Options), 622 ( Choice == cancel 623 -> fail 624 ; Choice = git(URL) 625 -> Rest = [git(true)|Upgrade] 626 ; Choice = URL, 627 Rest = Upgrade 628 ), 629 add_upgrade(Pack, Upgrade). 630 631add_upgrade(Pack, Options) :- 632 current_pack(Pack), 633 !, 634 Options = [upgrade(true)]. 635add_upgrade(_, []). 636 URL, git(URL)=install_from(git(URL))) (:- 638 git_url(URL, _), 639 !. 640url_menu_item(URL, URL=install_from(URL)).
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), 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.
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.
691pack_install(Spec, Options) :- 692 pack_default_options(Spec, Pack, Options, DefOptions), 693 ( option(already_installed(Installed), DefOptions) 694 -> print_message(informational, pack(already_installed(Installed))) 695 ; merge_options(Options, DefOptions, PackOptions), 696 update_dependency_db, 697 pack_install_dir(PackDir, PackOptions), 698 pack_install(Pack, PackDir, PackOptions) 699 ). 700 701pack_install_dir(PackDir, Options) :- 702 option(package_directory(PackDir), Options), 703 !. 704pack_install_dir(PackDir, Options) :- 705 base_alias(Alias, Options), 706 absolute_file_name(Alias, PackDir, 707 [ file_type(directory), 708 access(write), 709 file_errors(fail) 710 ]), 711 !. 712pack_install_dir(PackDir, Options) :- 713 pack_create_install_dir(PackDir, Options). 714 715base_alias(Alias, Options) :- 716 option(global(true), Options), 717 !, 718 Alias = common_app_data(pack). 719base_alias(Alias, Options) :- 720 option(global(false), Options), 721 !, 722 Alias = user_app_data(pack). 723base_alias(Alias, _Options) :- 724 Alias = pack('.'). 725 726pack_create_install_dir(PackDir, Options) :- 727 base_alias(Alias, Options), 728 findall(Candidate = create_dir(Candidate), 729 ( absolute_file_name(Alias, Candidate, [solutions(all)]), 730 \+ exists_file(Candidate), 731 \+ exists_directory(Candidate), 732 file_directory_name(Candidate, Super), 733 ( exists_directory(Super) 734 -> access_file(Super, write) 735 ; true 736 ) 737 ), 738 Candidates0), 739 list_to_set(Candidates0, Candidates), % keep order 740 pack_create_install_dir(Candidates, PackDir, Options). 741 742pack_create_install_dir(Candidates, PackDir, Options) :- 743 Candidates = [Default=_|_], 744 !, 745 append(Candidates, [cancel=cancel], Menu), 746 menu(pack(create_pack_dir), Menu, Default, Selected, Options), 747 Selected \== cancel, 748 ( catch(make_directory_path(Selected), E, 749 (print_message(warning, E), fail)) 750 -> PackDir = Selected 751 ; delete(Candidates, PackDir=create_dir(PackDir), Remaining), 752 pack_create_install_dir(Remaining, PackDir, Options) 753 ). 754pack_create_install_dir(_, _, _) :- 755 print_message(error, pack(cannot_create_dir(pack(.)))), 756 fail.
true
, update the
package to the latest version. If Boolean is false
print
an error and fail.771pack_install(Name, _, Options) :- 772 current_pack(Name, Dir), 773 option(upgrade(false), Options, false), 774 \+ pack_is_in_local_dir(Name, Dir, Options), 775 print_message(error, pack(already_installed(Name))), 776 pack_info(Name), 777 print_message(information, pack(remove_with(Name))), 778 !, 779 fail. 780pack_install(Name, PackDir, Options) :- 781 option(url(URL), Options), 782 uri_file_name(URL, Source), 783 !, 784 pack_install_from_local(Source, PackDir, Name, Options). 785pack_install(Name, PackDir, Options) :- 786 option(url(URL), Options), 787 uri_components(URL, Components), 788 uri_data(scheme, Components, Scheme), 789 pack_install_from_url(Scheme, URL, PackDir, Name, Options).
798pack_install_from_local(Source, PackTopDir, Name, Options) :- 799 exists_directory(Source), 800 !, 801 directory_file_path(PackTopDir, Name, PackDir), 802 ( option(link(true), Options) 803 -> ( same_file(Source, PackDir) 804 -> true 805 ; atom_concat(PackTopDir, '/', PackTopDirS), 806 relative_file_name(Source, PackTopDirS, RelPath), 807 link_file(RelPath, PackDir, symbolic), 808 assertion(same_file(Source, PackDir)) 809 ) 810 ; prepare_pack_dir(PackDir, Options), 811 copy_directory(Source, PackDir) 812 ), 813 pack_post_install(Name, PackDir, Options). 814pack_install_from_local(Source, PackTopDir, Name, Options) :- 815 exists_file(Source), 816 directory_file_path(PackTopDir, Name, PackDir), 817 prepare_pack_dir(PackDir, Options), 818 pack_unpack(Source, PackDir, Name, Options), 819 pack_post_install(Name, PackDir, Options). 820 821pack_is_in_local_dir(_Pack, PackDir, Options) :- 822 option(url(DirURL), Options), 823 uri_file_name(DirURL, Dir), 824 same_file(PackDir, Dir).
831:- if(exists_source(library(archive))). 832pack_unpack(Source, PackDir, Pack, Options) :- 833 ensure_loaded_archive, 834 pack_archive_info(Source, Pack, _Info, StripOptions), 835 prepare_pack_dir(PackDir, Options), 836 archive_extract(Source, PackDir, 837 [ exclude(['._*']) % MacOS resource forks 838 | StripOptions 839 ]). 840:- else. 841pack_unpack(_,_,_,_) :- 842 existence_error(library, archive). 843:- endif. 844 845 /******************************* 846 * INFO * 847 *******************************/
Requires library(archive), which is lazily loaded when needed.
861:- if(exists_source(library(archive))). 862ensure_loaded_archive :- 863 current_predicate(archive_open/3), 864 !. 865ensure_loaded_archive :- 866 use_module(library(archive)). 867 868pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :- 869 ensure_loaded_archive, 870 size_file(Archive, Bytes), 871 setup_call_cleanup( 872 archive_open(Archive, Handle, []), 873 ( repeat, 874 ( archive_next_header(Handle, InfoFile) 875 -> true 876 ; !, fail 877 ) 878 ), 879 archive_close(Handle)), 880 file_base_name(InfoFile, 'pack.pl'), 881 atom_concat(Prefix, 'pack.pl', InfoFile), 882 strip_option(Prefix, Pack, Strip), 883 setup_call_cleanup( 884 archive_open_entry(Handle, Stream), 885 read_stream_to_terms(Stream, Info), 886 close(Stream)), 887 !, 888 must_be(ground, Info), 889 maplist(valid_info_term, Info). 890:- else. 891pack_archive_info(_, _, _, _) :- 892 existence_error(library, archive). 893:- endif. 894pack_archive_info(_, _, _, _) :- 895 existence_error(pack_file, 'pack.pl'). 896 897strip_option('', _, []) :- !. 898strip_option('./', _, []) :- !. 899strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :- 900 atom_concat(PrefixDir, /, Prefix), 901 file_base_name(PrefixDir, Base), 902 ( Base == Pack 903 -> true 904 ; pack_version_file(Pack, _, Base) 905 -> true 906 ; \+ sub_atom(PrefixDir, _, _, _, /) 907 ). 908 909read_stream_to_terms(Stream, Terms) :- 910 read(Stream, Term0), 911 read_stream_to_terms(Term0, Stream, Terms). 912 913read_stream_to_terms(end_of_file, _, []) :- !. 914read_stream_to_terms(Term0, Stream, [Term0|Terms]) :- 915 read(Stream, Term1), 916 read_stream_to_terms(Term1, Stream, Terms).
924pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
925 exists_directory(GitDir),
926 !,
927 git_ls_tree(Entries, [directory(GitDir)]),
928 git_hash(Hash, [directory(GitDir)]),
929 maplist(arg(4), Entries, Sizes),
930 sum_list(Sizes, Bytes),
931 directory_file_path(GitDir, 'pack.pl', InfoFile),
932 read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
933 must_be(ground, Info),
934 maplist(valid_info_term, Info).
940download_file_sanity_check(Archive, Pack, Info) :- 941 info_field(name(Name), Info), 942 info_field(version(VersionAtom), Info), 943 atom_version(VersionAtom, Version), 944 pack_version_file(PackA, VersionA, Archive), 945 must_match([Pack, PackA, Name], name), 946 must_match([Version, VersionA], version). 947 948info_field(Field, Info) :- 949 memberchk(Field, Info), 950 ground(Field), 951 !. 952info_field(Field, _Info) :- 953 functor(Field, FieldName, _), 954 print_message(error, pack(missing(FieldName))), 955 fail. 956 957must_match(Values, _Field) :- 958 sort(Values, [_]), 959 !. 960must_match(Values, Field) :- 961 print_message(error, pack(conflict(Field, Values))), 962 fail. 963 964 965 /******************************* 966 * INSTALLATION * 967 *******************************/
979prepare_pack_dir(Dir, Options) :- 980 exists_directory(Dir), 981 !, 982 ( empty_directory(Dir) 983 -> true 984 ; ( option(upgrade(true), Options) 985 ; confirm(remove_existing_pack(Dir), yes, Options) 986 ) 987 -> delete_directory_and_contents(Dir), 988 make_directory(Dir) 989 ). 990prepare_pack_dir(Dir, _) :- 991 make_directory(Dir).
997empty_directory(Dir) :- 998 \+ ( directory_files(Dir, Entries), 999 member(Entry, Entries), 1000 \+ special(Entry) 1001 ). 1002 1003special(.). 1004special(..).
1014pack_install_from_url(_, URL, PackTopDir, Pack, Options) :- 1015 option(git(true), Options), 1016 !, 1017 directory_file_path(PackTopDir, Pack, PackDir), 1018 prepare_pack_dir(PackDir, Options), 1019 run_process(path(git), [clone, URL, PackDir], []), 1020 pack_git_info(PackDir, Hash, Info), 1021 pack_inquiry(URL, git(Hash), Info, Options), 1022 show_info(Pack, Info, Options), 1023 confirm(git_post_install(PackDir, Pack), yes, Options), 1024 pack_post_install(Pack, PackDir, Options). 1025pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :- 1026 download_scheme(Scheme), 1027 directory_file_path(PackTopDir, Pack, PackDir), 1028 prepare_pack_dir(PackDir, Options), 1029 pack_download_dir(PackTopDir, DownLoadDir), 1030 download_file(URL, Pack, DownloadBase, Options), 1031 directory_file_path(DownLoadDir, DownloadBase, DownloadFile), 1032 setup_call_cleanup( 1033 http_open(URL, In, 1034 [ cert_verify_hook(ssl_verify) 1035 ]), 1036 setup_call_cleanup( 1037 open(DownloadFile, write, Out, [type(binary)]), 1038 copy_stream_data(In, Out), 1039 close(Out)), 1040 close(In)), 1041 pack_archive_info(DownloadFile, Pack, Info, _), 1042 download_file_sanity_check(DownloadFile, Pack, Info), 1043 pack_inquiry(URL, DownloadFile, Info, Options), 1044 show_info(Pack, Info, Options), 1045 confirm(install_downloaded(DownloadFile), yes, Options), 1046 pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).
1050download_file(URL, Pack, File, Options) :- 1051 option(version(Version), Options), 1052 !, 1053 atom_version(VersionA, Version), 1054 file_name_extension(_, Ext, URL), 1055 format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]). 1056download_file(URL, Pack, File, _) :- 1057 file_base_name(URL,Basename), 1058 no_int_file_name_extension(Tag,Ext,Basename), 1059 tag_version(Tag,Version), 1060 !, 1061 atom_version(VersionA,Version), 1062 format(atom(File0), '~w-~w', [Pack, VersionA]), 1063 file_name_extension(File0, Ext, File). 1064download_file(URL, _, File, _) :- 1065 file_base_name(URL, File).
1073pack_url_file(URL, FileID) :- 1074 github_release_url(URL, Pack, Version), 1075 !, 1076 download_file(URL, Pack, FileID, [version(Version)]). 1077pack_url_file(URL, FileID) :- 1078 file_base_name(URL, FileID). 1079 1080 1081:- public ssl_verify/5.
1089ssl_verify(_SSL, 1090 _ProblemCertificate, _AllCertificates, _FirstCertificate, 1091 _Error). 1092 1093pack_download_dir(PackTopDir, DownLoadDir) :- 1094 directory_file_path(PackTopDir, 'Downloads', DownLoadDir), 1095 ( exists_directory(DownLoadDir) 1096 -> true 1097 ; make_directory(DownLoadDir) 1098 ), 1099 ( access_file(DownLoadDir, write) 1100 -> true 1101 ; permission_error(write, directory, DownLoadDir) 1102 ).
1108download_url(URL) :- 1109 atom(URL), 1110 uri_components(URL, Components), 1111 uri_data(scheme, Components, Scheme), 1112 download_scheme(Scheme). 1113 1114download_scheme(http). 1115download_scheme(https) :- 1116 catch(use_module(library(http/http_ssl_plugin)), 1117 E, (print_message(warning, E), fail)).
1127pack_post_install(Pack, PackDir, Options) :-
1128 post_install_foreign(Pack, PackDir, Options),
1129 post_install_autoload(PackDir, Options),
1130 '$pack_attach'(PackDir).
1136pack_rebuild(Pack) :- 1137 current_pack(Pack, PackDir), 1138 !, 1139 post_install_foreign(Pack, PackDir, [rebuild(true)]). 1140pack_rebuild(Pack) :- 1141 unattached_pacth(Pack, PackDir), 1142 !, 1143 post_install_foreign(Pack, PackDir, [rebuild(true)]). 1144pack_rebuild(Pack) :- 1145 existence_error(pack, Pack). 1146 1147unattached_pacth(Pack, BaseDir) :- 1148 directory_file_path(Pack, 'pack.pl', PackFile), 1149 absolute_file_name(pack(PackFile), PackPath, 1150 [ access(read), 1151 file_errors(fail) 1152 ]), 1153 file_directory_name(PackPath, BaseDir).
1159pack_rebuild :-
1160 forall(current_pack(Pack),
1161 ( print_message(informational, pack(rebuild(Pack))),
1162 pack_rebuild(Pack)
1163 )).
1170post_install_foreign(Pack, PackDir, Options) :- 1171 is_foreign_pack(PackDir, _), 1172 !, 1173 ( pack_info_term(PackDir, pack_version(Version)) 1174 -> true 1175 ; Version = 1 1176 ), 1177 option(rebuild(Rebuild), Options, if_absent), 1178 ( Rebuild == if_absent, 1179 foreign_present(PackDir) 1180 -> print_message(informational, pack(kept_foreign(Pack))) 1181 ; BuildSteps0 = [[dependencies], [configure], build, [test], install], 1182 ( Rebuild == true 1183 -> BuildSteps1 = [distclean|BuildSteps0] 1184 ; BuildSteps1 = BuildSteps0 1185 ), 1186 ( option(test(false), Options) 1187 -> delete(BuildSteps1, [test], BuildSteps) 1188 ; BuildSteps = BuildSteps1 1189 ), 1190 build_steps(BuildSteps, PackDir, [pack_version(Version)|Options]) 1191 ). 1192post_install_foreign(_, _, _).
lib
directory for
the current architecture. Does not check that these can be loaded,
nor whether all required modules are present.
1201foreign_present(PackDir) :-
1202 current_prolog_flag(arch, Arch),
1203 atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
1204 exists_directory(ForeignBaseDir),
1205 !,
1206 atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
1207 exists_directory(ForeignDir),
1208 current_prolog_flag(shared_object_extension, Ext),
1209 atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
1210 expand_file_name(Pattern, Files),
1211 Files \== [].
1218is_foreign_pack(PackDir, Type) :- 1219 foreign_file(File, Type), 1220 directory_file_path(PackDir, File, Path), 1221 exists_file(Path). 1222 1223foreign_file('CMakeLists.txt', cmake). 1224foreign_file('configure', configure). 1225foreign_file('configure.in', autoconf). 1226foreign_file('configure.ac', autoconf). 1227foreign_file('Makefile.am', automake). 1228foreign_file('Makefile', make). 1229foreign_file('makefile', make). 1230foreign_file('conanfile.txt', conan). 1231foreign_file('conanfile.py', conan). 1232 1233 1234 /******************************* 1235 * AUTOLOAD * 1236 *******************************/
1242post_install_autoload(PackDir, Options) :- 1243 option(autoload(true), Options, true), 1244 pack_info_term(PackDir, autoload(true)), 1245 !, 1246 directory_file_path(PackDir, prolog, PrologLibDir), 1247 make_library_index(PrologLibDir). 1248post_install_autoload(_, _). 1249 1250 1251 /******************************* 1252 * UPGRADE * 1253 *******************************/
1261pack_upgrade(Pack) :- 1262 pack_info(Pack, _, directory(Dir)), 1263 directory_file_path(Dir, '.git', GitDir), 1264 exists_directory(GitDir), 1265 !, 1266 print_message(informational, pack(git_fetch(Dir))), 1267 git([fetch], [ directory(Dir) ]), 1268 git_describe(V0, [ directory(Dir) ]), 1269 git_describe(V1, [ directory(Dir), commit('origin/master') ]), 1270 ( V0 == V1 1271 -> print_message(informational, pack(up_to_date(Pack))) 1272 ; confirm(upgrade(Pack, V0, V1), yes, []), 1273 git([merge, 'origin/master'], [ directory(Dir) ]), 1274 pack_rebuild(Pack) 1275 ). 1276pack_upgrade(Pack) :- 1277 once(pack_info(Pack, _, version(VersionAtom))), 1278 atom_version(VersionAtom, Version), 1279 pack_info(Pack, _, download(URL)), 1280 ( wildcard_pattern(URL) 1281 -> true 1282 ; github_url(URL, _User, _Repo) 1283 ), 1284 !, 1285 available_download_versions(URL, [Latest-LatestURL|_Versions]), 1286 ( Latest @> Version 1287 -> confirm(upgrade(Pack, Version, Latest), yes, []), 1288 pack_install(Pack, 1289 [ url(LatestURL), 1290 upgrade(true), 1291 pack(Pack) 1292 ]) 1293 ; print_message(informational, pack(up_to_date(Pack))) 1294 ). 1295pack_upgrade(Pack) :- 1296 print_message(warning, pack(no_upgrade_info(Pack))). 1297 1298 1299 /******************************* 1300 * REMOVE * 1301 *******************************/
1307pack_remove(Pack) :- 1308 update_dependency_db, 1309 ( setof(Dep, pack_depends_on(Dep, Pack), Deps) 1310 -> confirm_remove(Pack, Deps, Delete), 1311 forall(member(P, Delete), pack_remove_forced(P)) 1312 ; pack_remove_forced(Pack) 1313 ). 1314 1315pack_remove_forced(Pack) :- 1316 catch('$pack_detach'(Pack, BaseDir), 1317 error(existence_error(pack, Pack), _), 1318 fail), 1319 !, 1320 print_message(informational, pack(remove(BaseDir))), 1321 delete_directory_and_contents(BaseDir). 1322pack_remove_forced(Pack) :- 1323 unattached_pacth(Pack, BaseDir), 1324 !, 1325 delete_directory_and_contents(BaseDir). 1326pack_remove_forced(Pack) :- 1327 print_message(informational, error(existence_error(pack, Pack),_)). 1328 1329confirm_remove(Pack, Deps, Delete) :- 1330 print_message(warning, pack(depends(Pack, Deps))), 1331 menu(pack(resolve_remove), 1332 [ [Pack] = remove_only(Pack), 1333 [Pack|Deps] = remove_deps(Pack, Deps), 1334 [] = cancel 1335 ], [], Delete, []), 1336 Delete \== []. 1337 1338 1339 /******************************* 1340 * PROPERTIES * 1341 *******************************/
README
file (if present)TODO
file (if present)1364pack_property(Pack, Property) :- 1365 findall(Pack-Property, pack_property_(Pack, Property), List), 1366 member(Pack-Property, List). % make det if applicable 1367 1368pack_property_(Pack, Property) :- 1369 pack_info(Pack, _, Property). 1370pack_property_(Pack, Property) :- 1371 \+ \+ info_file(Property, _), 1372 '$pack':pack(Pack, BaseDir), 1373 access_file(BaseDir, read), 1374 directory_files(BaseDir, Files), 1375 member(File, Files), 1376 info_file(Property, Pattern), 1377 downcase_atom(File, Pattern), 1378 directory_file_path(BaseDir, File, InfoFile), 1379 arg(1, Property, InfoFile). 1380 1381info_file(readme(_), 'readme.txt'). 1382info_file(readme(_), 'readme'). 1383info_file(todo(_), 'todo.txt'). 1384info_file(todo(_), 'todo'). 1385 1386 1387 /******************************* 1388 * GIT * 1389 *******************************/
1395git_url(URL, Pack) :- 1396 uri_components(URL, Components), 1397 uri_data(scheme, Components, Scheme), 1398 nonvar(Scheme), % must be full URL 1399 uri_data(path, Components, Path), 1400 ( Scheme == git 1401 -> true 1402 ; git_download_scheme(Scheme), 1403 file_name_extension(_, git, Path) 1404 ; git_download_scheme(Scheme), 1405 catch(git_ls_remote(URL, _, [refs(['HEAD']), error(_)]), _, fail) 1406 -> true 1407 ), 1408 file_base_name(Path, PackExt), 1409 ( file_name_extension(Pack, git, PackExt) 1410 -> true 1411 ; Pack = PackExt 1412 ), 1413 ( safe_pack_name(Pack) 1414 -> true 1415 ; domain_error(pack_name, Pack) 1416 ). 1417 1418git_download_scheme(http). 1419git_download_scheme(https).
1426safe_pack_name(Name) :- 1427 atom_length(Name, Len), 1428 Len >= 3, % demand at least three length 1429 atom_codes(Name, Codes), 1430 maplist(safe_pack_char, Codes), 1431 !. 1432 1433safe_pack_char(C) :- between(0'a, 0'z, C), !. 1434safe_pack_char(C) :- between(0'A, 0'Z, C), !. 1435safe_pack_char(C) :- between(0'0, 0'9, C), !. 1436safe_pack_char(0'_). 1437 1438 1439 /******************************* 1440 * VERSION LOGIC * 1441 *******************************/
mypack-1.5
.1450pack_version_file(Pack, Version, GitHubRelease) :- 1451 atomic(GitHubRelease), 1452 github_release_url(GitHubRelease, Pack, Version), 1453 !. 1454pack_version_file(Pack, Version, Path) :- 1455 atomic(Path), 1456 file_base_name(Path, File), 1457 no_int_file_name_extension(Base, _Ext, File), 1458 atom_codes(Base, Codes), 1459 ( phrase(pack_version(Pack, Version), Codes), 1460 safe_pack_name(Pack) 1461 -> true 1462 ). 1463 1464no_int_file_name_extension(Base, Ext, File) :- 1465 file_name_extension(Base0, Ext0, File), 1466 \+ atom_number(Ext0, _), 1467 !, 1468 Base = Base0, 1469 Ext = Ext0. 1470no_int_file_name_extension(File, '', File).
https:/github.com/<owner>/<pack>/archive/[vV]?<version>.zip'
1483github_release_url(URL, Pack, Version) :- 1484 uri_components(URL, Components), 1485 uri_data(authority, Components, 'github.com'), 1486 uri_data(scheme, Components, Scheme), 1487 download_scheme(Scheme), 1488 uri_data(path, Components, Path), 1489 github_archive_path(Archive,Pack,File), 1490 atomic_list_concat(Archive, /, Path), 1491 file_name_extension(Tag, Ext, File), 1492 github_archive_extension(Ext), 1493 tag_version(Tag, Version), 1494 !. 1495 1496github_archive_path(['',_User,Pack,archive,File],Pack,File). 1497github_archive_path(['',_User,Pack,archive,refs,tags,File],Pack,File). 1498 1499github_archive_extension(tgz). 1500github_archive_extension(zip). 1501 1502tag_version(Tag, Version) :- 1503 version_tag_prefix(Prefix), 1504 atom_concat(Prefix, AtomVersion, Tag), 1505 atom_version(AtomVersion, Version). 1506 1507version_tag_prefix(v). 1508version_tag_prefix('V'). 1509version_tag_prefix(''). 1510 1511 1512:- public 1513 atom_version/2.
@>
1521atom_version(Atom, version(Parts)) :- 1522 ( atom(Atom) 1523 -> atom_codes(Atom, Codes), 1524 phrase(version(Parts), Codes) 1525 ; atomic_list_concat(Parts, '.', Atom) 1526 ). 1527 1528pack_version(Pack, version(Parts)) --> 1529 string(Codes), "-", 1530 version(Parts), 1531 !, 1532 { atom_codes(Pack, Codes) 1533 }. 1534 1535version([_|T]) --> 1536 "*", 1537 !, 1538 ( "." 1539 -> version(T) 1540 ; [] 1541 ). 1542version([H|T]) --> 1543 integer(H), 1544 ( "." 1545 -> version(T) 1546 ; { T = [] } 1547 ). 1548 1549 /******************************* 1550 * QUERY CENTRAL DB * 1551 *******************************/
1571pack_inquiry(_, _, _, Options) :- 1572 option(inquiry(false), Options), 1573 !. 1574pack_inquiry(URL, DownloadFile, Info, Options) :- 1575 setting(server, ServerBase), 1576 ServerBase \== '', 1577 atom_concat(ServerBase, query, Server), 1578 ( option(inquiry(true), Options) 1579 -> true 1580 ; confirm(inquiry(Server), yes, Options) 1581 ), 1582 !, 1583 ( DownloadFile = git(SHA1) 1584 -> true 1585 ; file_sha1(DownloadFile, SHA1) 1586 ), 1587 query_pack_server(install(URL, SHA1, Info), Reply, Options), 1588 inquiry_result(Reply, URL, Options). 1589pack_inquiry(_, _, _, _).
1597query_pack_server(Query, Result, Options) :- 1598 setting(server, ServerBase), 1599 ServerBase \== '', 1600 atom_concat(ServerBase, query, Server), 1601 format(codes(Data), '~q.~n', Query), 1602 info_level(Informational, Options), 1603 print_message(Informational, pack(contacting_server(Server))), 1604 setup_call_cleanup( 1605 http_open(Server, In, 1606 [ post(codes(application/'x-prolog', Data)), 1607 header(content_type, ContentType) 1608 ]), 1609 read_reply(ContentType, In, Result), 1610 close(In)), 1611 message_severity(Result, Level, Informational), 1612 print_message(Level, pack(server_reply(Result))). 1613 1614read_reply(ContentType, In, Result) :- 1615 sub_atom(ContentType, 0, _, _, 'application/x-prolog'), 1616 !, 1617 set_stream(In, encoding(utf8)), 1618 read(In, Result). 1619read_reply(ContentType, In, _Result) :- 1620 read_string(In, 500, String), 1621 print_message(error, pack(no_prolog_response(ContentType, String))), 1622 fail. 1623 1624info_level(Level, Options) :- 1625 option(silent(true), Options), 1626 !, 1627 Level = silent. 1628info_level(informational, _). 1629 1630message_severity(true(_), Informational, Informational). 1631message_severity(false, warning, _). 1632message_severity(exception(_), error, _).
1640inquiry_result(Reply, File, Options) :- 1641 findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation), 1642 \+ member(cancel, Evaluation), 1643 select_option(git(_), Options, Options1, _), 1644 forall(member(install_dependencies(Resolution), Evaluation), 1645 maplist(install_dependency(Options1), Resolution)). 1646 1647eval_inquiry(true(Reply), URL, Eval, _) :- 1648 include(alt_hash, Reply, Alts), 1649 Alts \== [], 1650 print_message(warning, pack(alt_hashes(URL, Alts))), 1651 ( memberchk(downloads(Count), Reply), 1652 ( git_url(URL, _) 1653 -> Default = yes, 1654 Eval = with_git_commits_in_same_version 1655 ; Default = no, 1656 Eval = with_alt_hashes 1657 ), 1658 confirm(continue_with_alt_hashes(Count, URL), Default, []) 1659 -> true 1660 ; !, % Stop other rules 1661 Eval = cancel 1662 ). 1663eval_inquiry(true(Reply), _, Eval, Options) :- 1664 include(dependency, Reply, Deps), 1665 Deps \== [], 1666 select_dependency_resolution(Deps, Eval, Options), 1667 ( Eval == cancel 1668 -> ! 1669 ; true 1670 ). 1671eval_inquiry(true(Reply), URL, true, Options) :- 1672 file_base_name(URL, File), 1673 info_level(Informational, Options), 1674 print_message(Informational, pack(inquiry_ok(Reply, File))). 1675eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))), 1676 URL, Eval, Options) :- 1677 ( confirm(continue_with_modified_hash(URL), no, Options) 1678 -> Eval = true 1679 ; Eval = cancel 1680 ). 1681 1682alt_hash(alt_hash(_,_,_)). 1683dependency(dependency(_,_,_,_,_)).
1692select_dependency_resolution(Deps, Eval, Options) :- 1693 resolve_dependencies(Deps, Resolution), 1694 exclude(local_dep, Resolution, ToBeDone), 1695 ( ToBeDone == [] 1696 -> !, Eval = true 1697 ; print_message(warning, pack(install_dependencies(Resolution))), 1698 ( memberchk(_-unresolved, Resolution) 1699 -> Default = cancel 1700 ; Default = install_deps 1701 ), 1702 menu(pack(resolve_deps), 1703 [ install_deps = install_deps, 1704 install_no_deps = install_no_deps, 1705 cancel = cancel 1706 ], Default, Choice, Options), 1707 ( Choice == cancel 1708 -> !, Eval = cancel 1709 ; Choice == install_no_deps 1710 -> !, Eval = install_no_deps 1711 ; !, Eval = install_dependencies(Resolution) 1712 ) 1713 ). 1714 1715local_dep(_-resolved(_)).
1724install_dependency(Options, 1725 _Token-resolve(Pack, VersionAtom, [_URL|_], SubResolve)) :- 1726 atom_version(VersionAtom, Version), 1727 current_pack(Pack), 1728 pack_info(Pack, _, version(InstalledAtom)), 1729 atom_version(InstalledAtom, Installed), 1730 Installed == Version, % already installed 1731 !, 1732 maplist(install_dependency(Options), SubResolve). 1733install_dependency(Options, 1734 _Token-resolve(Pack, VersionAtom, [URL|_], SubResolve)) :- 1735 !, 1736 atom_version(VersionAtom, Version), 1737 merge_options([ url(URL), 1738 version(Version), 1739 interactive(false), 1740 inquiry(false), 1741 info(list), 1742 pack(Pack) 1743 ], Options, InstallOptions), 1744 pack_install(Pack, InstallOptions), 1745 maplist(install_dependency(Options), SubResolve). 1746install_dependency(_, _-_). 1747 1748 1749 /******************************* 1750 * WILDCARD URIs * 1751 *******************************/
1760available_download_versions(URL, Versions) :- 1761 wildcard_pattern(URL), 1762 github_url(URL, User, Repo), 1763 !, 1764 findall(Version-VersionURL, 1765 github_version(User, Repo, Version, VersionURL), 1766 Versions). 1767available_download_versions(URL, Versions) :- 1768 wildcard_pattern(URL), 1769 !, 1770 file_directory_name(URL, DirURL0), 1771 ensure_slash(DirURL0, DirURL), 1772 print_message(informational, pack(query_versions(DirURL))), 1773 setup_call_cleanup( 1774 http_open(DirURL, In, []), 1775 load_html(stream(In), DOM, 1776 [ syntax_errors(quiet) 1777 ]), 1778 close(In)), 1779 findall(MatchingURL, 1780 absolute_matching_href(DOM, URL, MatchingURL), 1781 MatchingURLs), 1782 ( MatchingURLs == [] 1783 -> print_message(warning, pack(no_matching_urls(URL))) 1784 ; true 1785 ), 1786 versioned_urls(MatchingURLs, VersionedURLs), 1787 keysort(VersionedURLs, SortedVersions), 1788 reverse(SortedVersions, Versions), 1789 print_message(informational, pack(found_versions(Versions))). 1790available_download_versions(URL, [Version-URL]) :- 1791 ( pack_version_file(_Pack, Version0, URL) 1792 -> Version = Version0 1793 ; Version = unknown 1794 ).
1800github_url(URL, User, Repo) :-
1801 uri_components(URL, uri_components(https,'github.com',Path,_,_)),
1802 atomic_list_concat(['',User,Repo|_], /, Path).
1810github_version(User, Repo, Version, VersionURI) :- 1811 atomic_list_concat(['',repos,User,Repo,tags], /, Path1), 1812 uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)), 1813 setup_call_cleanup( 1814 http_open(ApiUri, In, 1815 [ request_header('Accept'='application/vnd.github.v3+json') 1816 ]), 1817 json_read_dict(In, Dicts), 1818 close(In)), 1819 member(Dict, Dicts), 1820 atom_string(Tag, Dict.name), 1821 tag_version(Tag, Version), 1822 atom_string(VersionURI, Dict.zipball_url). 1823 1824wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *). 1825wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?). 1826 1827ensure_slash(Dir, DirS) :- 1828 ( sub_atom(Dir, _, _, 0, /) 1829 -> DirS = Dir 1830 ; atom_concat(Dir, /, DirS) 1831 ). 1832 1833absolute_matching_href(DOM, Pattern, Match) :- 1834 xpath(DOM, //a(@href), HREF), 1835 uri_normalized(HREF, Pattern, Match), 1836 wildcard_match(Pattern, Match). 1837 1838versioned_urls([], []). 1839versioned_urls([H|T0], List) :- 1840 file_base_name(H, File), 1841 ( pack_version_file(_Pack, Version, File) 1842 -> List = [Version-H|T] 1843 ; List = T 1844 ), 1845 versioned_urls(T0, T). 1846 1847 1848 /******************************* 1849 * DEPENDENCIES * 1850 *******************************/
1856update_dependency_db :- 1857 retractall(pack_requires(_,_)), 1858 retractall(pack_provides_db(_,_)), 1859 forall(current_pack(Pack), 1860 ( findall(Info, pack_info(Pack, dependency, Info), Infos), 1861 update_dependency_db(Pack, Infos) 1862 )). 1863 1864update_dependency_db(Name, Info) :- 1865 retractall(pack_requires(Name, _)), 1866 retractall(pack_provides_db(Name, _)), 1867 maplist(assert_dep(Name), Info). 1868 1869assert_dep(Pack, provides(Token)) :- 1870 !, 1871 assertz(pack_provides_db(Pack, Token)). 1872assert_dep(Pack, requires(Token)) :- 1873 !, 1874 assertz(pack_requires(Pack, Token)). 1875assert_dep(_, _).
1881validate_dependencies :- 1882 unsatisfied_dependencies(Unsatisfied), 1883 !, 1884 print_message(warning, pack(unsatisfied(Unsatisfied))). 1885validate_dependencies. 1886 1887 1888unsatisfied_dependencies(Unsatisfied) :- 1889 findall(Req-Pack, pack_requires(Pack, Req), Reqs0), 1890 keysort(Reqs0, Reqs1), 1891 group_pairs_by_key(Reqs1, GroupedReqs), 1892 exclude(satisfied_dependency, GroupedReqs, Unsatisfied), 1893 Unsatisfied \== []. 1894 1895satisfied_dependency(Needed-_By) :- 1896 pack_provides(_, Needed), 1897 !. 1898satisfied_dependency(Needed-_By) :- 1899 compound(Needed), 1900 Needed =.. [Op, Pack, ReqVersion], 1901 ( pack_provides(Pack, Pack) 1902 -> pack_info(Pack, _, version(PackVersion)), 1903 version_data(PackVersion, PackData) 1904 ; Pack == prolog 1905 -> current_prolog_flag(version_data, swi(Major,Minor,Patch,_)), 1906 PackData = [Major,Minor,Patch] 1907 ), 1908 version_data(ReqVersion, ReqData), 1909 cmp(Op, Cmp), 1910 call(Cmp, PackData, ReqData).
1916pack_provides(Pack, Pack) :- 1917 current_pack(Pack). 1918pack_provides(Pack, Token) :- 1919 pack_provides_db(Pack, Token).
1925pack_depends_on(Pack, Dependency) :- 1926 ( atom(Pack) 1927 -> pack_depends_on_fwd(Pack, Dependency, [Pack]) 1928 ; pack_depends_on_bwd(Pack, Dependency, [Dependency]) 1929 ). 1930 1931pack_depends_on_fwd(Pack, Dependency, Visited) :- 1932 pack_depends_on_1(Pack, Dep1), 1933 \+ memberchk(Dep1, Visited), 1934 ( Dependency = Dep1 1935 ; pack_depends_on_fwd(Dep1, Dependency, [Dep1|Visited]) 1936 ). 1937 1938pack_depends_on_bwd(Pack, Dependency, Visited) :- 1939 pack_depends_on_1(Dep1, Dependency), 1940 \+ memberchk(Dep1, Visited), 1941 ( Pack = Dep1 1942 ; pack_depends_on_bwd(Pack, Dep1, [Dep1|Visited]) 1943 ). 1944 1945pack_depends_on_1(Pack, Dependency) :- 1946 atom(Dependency), 1947 !, 1948 pack_provides(Dependency, Token), 1949 pack_requires(Pack, Token). 1950pack_depends_on_1(Pack, Dependency) :- 1951 pack_requires(Pack, Token), 1952 pack_provides(Dependency, Token).
1969resolve_dependencies(Dependencies, Resolution) :- 1970 maplist(dependency_pair, Dependencies, Pairs0), 1971 keysort(Pairs0, Pairs1), 1972 group_pairs_by_key(Pairs1, ByToken), 1973 maplist(resolve_dep, ByToken, Resolution). 1974 1975dependency_pair(dependency(Token, Pack, Version, URLs, SubDeps), 1976 Token-(Pack-pack(Version,URLs, SubDeps))). 1977 1978resolve_dep(Token-Pairs, Token-Resolution) :- 1979 ( resolve_dep2(Token-Pairs, Resolution) 1980 *-> true 1981 ; Resolution = unresolved 1982 ). 1983 1984resolve_dep2(Token-_, resolved(Pack)) :- 1985 pack_provides(Pack, Token). 1986resolve_dep2(_-Pairs, resolve(Pack, VersionAtom, URLs, SubResolves)) :- 1987 keysort(Pairs, Sorted), 1988 group_pairs_by_key(Sorted, ByPack), 1989 member(Pack-Versions, ByPack), 1990 Pack \== (-), 1991 maplist(version_pack, Versions, VersionData), 1992 sort(VersionData, ByVersion), 1993 reverse(ByVersion, ByVersionLatest), 1994 member(pack(Version,URLs,SubDeps), ByVersionLatest), 1995 atom_version(VersionAtom, Version), 1996 include(dependency, SubDeps, Deps), 1997 resolve_dependencies(Deps, SubResolves). 1998 1999version_pack(pack(VersionAtom,URLs,SubDeps), 2000 pack(Version,URLs,SubDeps)) :- 2001 atom_version(VersionAtom, Version).
pack.pl
and a prolog
directory. Options processed:
last
, alternative is first
.2025pack_attach(Dir, Options) :- 2026 '$pack_attach'(Dir, Options). 2027 2028 2029 /******************************* 2030 * USER INTERACTION * 2031 *******************************/ 2032 2033:- multifile prolog:message//1.
2037menu(_Question, _Alternatives, Default, Selection, Options) :- 2038 option(interactive(false), Options), 2039 !, 2040 Selection = Default. 2041menu(Question, Alternatives, Default, Selection, _) :- 2042 length(Alternatives, N), 2043 between(1, 5, _), 2044 print_message(query, Question), 2045 print_menu(Alternatives, Default, 1), 2046 print_message(query, pack(menu(select))), 2047 read_selection(N, Choice), 2048 !, 2049 ( Choice == default 2050 -> Selection = Default 2051 ; nth1(Choice, Alternatives, Selection=_) 2052 -> true 2053 ). 2054 [], _, _) (. 2056print_menu([Value=Label|T], Default, I) :- 2057 ( Value == Default 2058 -> print_message(query, pack(menu(default_item(I, Label)))) 2059 ; print_message(query, pack(menu(item(I, Label)))) 2060 ), 2061 I2 is I + 1, 2062 print_menu(T, Default, I2). 2063 2064read_selection(Max, Choice) :- 2065 get_single_char(Code), 2066 ( answered_default(Code) 2067 -> Choice = default 2068 ; code_type(Code, digit(Choice)), 2069 between(1, Max, Choice) 2070 -> true 2071 ; print_message(warning, pack(menu(reply(1,Max)))), 2072 fail 2073 ).
2081confirm(_Question, Default, Options) :- 2082 Default \== none, 2083 option(interactive(false), Options, true), 2084 !, 2085 Default == yes. 2086confirm(Question, Default, _) :- 2087 between(1, 5, _), 2088 print_message(query, pack(confirm(Question, Default))), 2089 read_yes_no(YesNo, Default), 2090 !, 2091 format(user_error, '~N', []), 2092 YesNo == yes. 2093 2094read_yes_no(YesNo, Default) :- 2095 get_single_char(Code), 2096 code_yes_no(Code, Default, YesNo), 2097 !. 2098 2099code_yes_no(0'y, _, yes). 2100code_yes_no(0'Y, _, yes). 2101code_yes_no(0'n, _, no). 2102code_yes_no(0'N, _, no). 2103code_yes_no(_, none, _) :- !, fail. 2104code_yes_no(C, Default, Default) :- 2105 answered_default(C). 2106 2107answered_default(0'\r). 2108answered_default(0'\n). 2109answered_default(0'\s). 2110 2111 2112 /******************************* 2113 * MESSAGES * 2114 *******************************/ 2115 2116:- multifile prolog:message//1. 2117 2118prologmessage(pack(Message)) --> 2119 message(Message). 2120 2121:- discontiguous 2122 message//1, 2123 label//1. 2124 2125message(invalid_info(Term)) --> 2126 [ 'Invalid package description: ~q'-[Term] ]. 2127message(directory_exists(Dir)) --> 2128 [ 'Package target directory exists and is not empty:', nl, 2129 '\t~q'-[Dir] 2130 ]. 2131message(already_installed(pack(Pack, Version))) --> 2132 { atom_version(AVersion, Version) }, 2133 [ 'Pack `~w'' is already installed @~w'-[Pack, AVersion] ]. 2134message(already_installed(Pack)) --> 2135 [ 'Pack `~w'' is already installed. Package info:'-[Pack] ]. 2136message(invalid_name(File)) --> 2137 [ '~w: A package archive must be named <pack>-<version>.<ext>'-[File] ], 2138 no_tar_gz(File). 2139 2140no_tar_gz(File) --> 2141 { sub_atom(File, _, _, 0, '.tar.gz') }, 2142 !, 2143 [ nl, 2144 'Package archive files must have a single extension. E.g., \'.tgz\''-[] 2145 ]. 2146no_tar_gz(_) --> []. 2147 2148message(kept_foreign(Pack)) --> 2149 [ 'Found foreign libraries for target platform.'-[], nl, 2150 'Use ?- pack_rebuild(~q). to rebuild from sources'-[Pack] 2151 ]. 2152message(no_pack_installed(Pack)) --> 2153 [ 'No pack ~q installed. Use ?- pack_list(Pattern) to search'-[Pack] ]. 2154message(no_packages_installed) --> 2155 { setting(server, ServerBase) }, 2156 [ 'There are no extra packages installed.', nl, 2157 'Please visit ~wlist.'-[ServerBase] 2158 ]. 2159message(remove_with(Pack)) --> 2160 [ 'The package can be removed using: ?- ~q.'-[pack_remove(Pack)] 2161 ]. 2162message(unsatisfied(Packs)) --> 2163 [ 'The following dependencies are not satisfied:', nl ], 2164 unsatisfied(Packs). 2165message(depends(Pack, Deps)) --> 2166 [ 'The following packages depend on `~w\':'-[Pack], nl ], 2167 pack_list(Deps). 2168message(remove(PackDir)) --> 2169 [ 'Removing ~q and contents'-[PackDir] ]. 2170message(remove_existing_pack(PackDir)) --> 2171 [ 'Remove old installation in ~q'-[PackDir] ]. 2172message(install_from(Pack, Version, git(URL))) --> 2173 [ 'Install ~w@~w from GIT at ~w'-[Pack, Version, URL] ]. 2174message(install_from(Pack, Version, URL)) --> 2175 [ 'Install ~w@~w from ~w'-[Pack, Version, URL] ]. 2176message(select_install_from(Pack, Version)) --> 2177 [ 'Select download location for ~w@~w'-[Pack, Version] ]. 2178message(install_downloaded(File)) --> 2179 { file_base_name(File, Base), 2180 size_file(File, Size) }, 2181 [ 'Install "~w" (~D bytes)'-[Base, Size] ]. 2182message(git_post_install(PackDir, Pack)) --> 2183 ( { is_foreign_pack(PackDir, _) } 2184 -> [ 'Run post installation scripts for pack "~w"'-[Pack] ] 2185 ; [ 'Activate pack "~w"'-[Pack] ] 2186 ). 2187message(no_meta_data(BaseDir)) --> 2188 [ 'Cannot find pack.pl inside directory ~q. Not a package?'-[BaseDir] ]. 2189message(inquiry(Server)) --> 2190 [ 'Verify package status (anonymously)', nl, 2191 '\tat "~w"'-[Server] 2192 ]. 2193message(search_no_matches(Name)) --> 2194 [ 'Search for "~w", returned no matching packages'-[Name] ]. 2195message(rebuild(Pack)) --> 2196 [ 'Checking pack "~w" for rebuild ...'-[Pack] ]. 2197message(upgrade(Pack, From, To)) --> 2198 [ 'Upgrade "~w" from '-[Pack] ], 2199 msg_version(From), [' to '-[]], msg_version(To). 2200message(up_to_date(Pack)) --> 2201 [ 'Package "~w" is up-to-date'-[Pack] ]. 2202message(query_versions(URL)) --> 2203 [ 'Querying "~w" to find new versions ...'-[URL] ]. 2204message(no_matching_urls(URL)) --> 2205 [ 'Could not find any matching URL: ~q'-[URL] ]. 2206message(found_versions([Latest-_URL|More])) --> 2207 { length(More, Len), 2208 atom_version(VLatest, Latest) 2209 }, 2210 [ ' Latest version: ~w (~D older)'-[VLatest, Len] ]. 2211message(process_output(Codes)) --> 2212 { split_lines(Codes, Lines) }, 2213 process_lines(Lines). 2214message(contacting_server(Server)) --> 2215 [ 'Contacting server at ~w ...'-[Server], flush ]. 2216message(server_reply(true(_))) --> 2217 [ at_same_line, ' ok'-[] ]. 2218message(server_reply(false)) --> 2219 [ at_same_line, ' done'-[] ]. 2220message(server_reply(exception(E))) --> 2221 [ 'Server reported the following error:'-[], nl ], 2222 '$messages':translate_message(E). 2223message(cannot_create_dir(Alias)) --> 2224 { findall(PackDir, 2225 absolute_file_name(Alias, PackDir, [solutions(all)]), 2226 PackDirs0), 2227 sort(PackDirs0, PackDirs) 2228 }, 2229 [ 'Cannot find a place to create a package directory.'-[], 2230 'Considered:'-[] 2231 ], 2232 candidate_dirs(PackDirs). 2233message(no_match(Name)) --> 2234 [ 'No registered pack matches "~w"'-[Name] ]. 2235message(conflict(version, [PackV, FileV])) --> 2236 ['Version mismatch: pack.pl: '-[]], msg_version(PackV), 2237 [', file claims version '-[]], msg_version(FileV). 2238message(conflict(name, [PackInfo, FileInfo])) --> 2239 ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]], 2240 [', file claims ~w: ~p'-[FileInfo]]. 2241message(no_prolog_response(ContentType, String)) --> 2242 [ 'Expected Prolog response. Got content of type ~p'-[ContentType], nl, 2243 '~s'-[String] 2244 ]. 2245message(pack(no_upgrade_info(Pack))) --> 2246 [ '~w: pack meta-data does not provide an upgradable URL'-[Pack] ]. 2247 2248candidate_dirs([]) --> []. 2249candidate_dirs([H|T]) --> [ nl, ' ~w'-[H] ], candidate_dirs(T). 2250 2251 % Questions 2252message(resolve_remove) --> 2253 [ nl, 'Please select an action:', nl, nl ]. 2254message(create_pack_dir) --> 2255 [ nl, 'Create directory for packages', nl ]. 2256message(menu(item(I, Label))) --> 2257 [ '~t(~d)~6| '-[I] ], 2258 label(Label). 2259message(menu(default_item(I, Label))) --> 2260 [ '~t(~d)~6| * '-[I] ], 2261 label(Label). 2262message(menu(select)) --> 2263 [ nl, 'Your choice? ', flush ]. 2264message(confirm(Question, Default)) --> 2265 message(Question), 2266 confirm_default(Default), 2267 [ flush ]. 2268message(menu(reply(Min,Max))) --> 2269 ( { Max =:= Min+1 } 2270 -> [ 'Please enter ~w or ~w'-[Min,Max] ] 2271 ; [ 'Please enter a number between ~w and ~w'-[Min,Max] ] 2272 ). 2273 2274% Alternate hashes for found for the same file 2275 2276message(alt_hashes(URL, _Alts)) --> 2277 { git_url(URL, _) 2278 }, 2279 !, 2280 [ 'GIT repository was updated without updating version' ]. 2281message(alt_hashes(URL, Alts)) --> 2282 { file_base_name(URL, File) 2283 }, 2284 [ 'Found multiple versions of "~w".'-[File], nl, 2285 'This could indicate a compromised or corrupted file', nl 2286 ], 2287 alt_hashes(Alts). 2288message(continue_with_alt_hashes(Count, URL)) --> 2289 [ 'Continue installation from "~w" (downloaded ~D times)'-[URL, Count] ]. 2290message(continue_with_modified_hash(_URL)) --> 2291 [ 'Pack may be compromised. Continue anyway' 2292 ]. 2293message(modified_hash(_SHA1-URL, _SHA2-[URL])) --> 2294 [ 'Content of ~q has changed.'-[URL] 2295 ]. 2296 2297alt_hashes([]) --> []. 2298alt_hashes([H|T]) --> alt_hash(H), ( {T == []} -> [] ; [nl], alt_hashes(T) ). 2299 2300alt_hash(alt_hash(Count, URLs, Hash)) --> 2301 [ '~t~d~8| ~w'-[Count, Hash] ], 2302 alt_urls(URLs). 2303 2304alt_urls([]) --> []. 2305alt_urls([H|T]) --> 2306 [ nl, ' ~w'-[H] ], 2307 alt_urls(T). 2308 2309% Installation dependencies gathered from inquiry server. 2310 2311message(install_dependencies(Resolution)) --> 2312 [ 'Package depends on the following:' ], 2313 msg_res_tokens(Resolution, 1). 2314 2315msg_res_tokens([], _) --> []. 2316msg_res_tokens([H|T], L) --> msg_res_token(H, L), msg_res_tokens(T, L). 2317 2318msg_res_token(Token-unresolved, L) --> 2319 res_indent(L), 2320 [ '"~w" cannot be satisfied'-[Token] ]. 2321msg_res_token(Token-resolve(Pack, Version, [URL|_], SubResolves), L) --> 2322 !, 2323 res_indent(L), 2324 [ '"~w", provided by ~w@~w from ~w'-[Token, Pack, Version, URL] ], 2325 { L2 is L+1 }, 2326 msg_res_tokens(SubResolves, L2). 2327msg_res_token(Token-resolved(Pack), L) --> 2328 !, 2329 res_indent(L), 2330 [ '"~w", provided by installed pack ~w'-[Token,Pack] ]. 2331 2332res_indent(L) --> 2333 { I is L*2 }, 2334 [ nl, '~*c'-[I,0'\s] ]. 2335 2336message(resolve_deps) --> 2337 [ nl, 'What do you wish to do' ]. 2338label(install_deps) --> 2339 [ 'Install proposed dependencies' ]. 2340label(install_no_deps) --> 2341 [ 'Only install requested package' ]. 2342 2343 2344message(git_fetch(Dir)) --> 2345 [ 'Running "git fetch" in ~q'-[Dir] ]. 2346 2347% inquiry is blank 2348 2349message(inquiry_ok(Reply, File)) --> 2350 { memberchk(downloads(Count), Reply), 2351 memberchk(rating(VoteCount, Rating), Reply), 2352 !, 2353 length(Stars, Rating), 2354 maplist(=(0'*), Stars) 2355 }, 2356 [ '"~w" was downloaded ~D times. Package rated ~s (~D votes)'- 2357 [ File, Count, Stars, VoteCount ] 2358 ]. 2359message(inquiry_ok(Reply, File)) --> 2360 { memberchk(downloads(Count), Reply) 2361 }, 2362 [ '"~w" was downloaded ~D times'-[ File, Count ] ]. 2363 2364 % support predicates 2365unsatisfied([]) --> []. 2366unsatisfied([Needed-[By]|T]) --> 2367 [ ' - "~w" is needed by package "~w"'-[Needed, By], nl ], 2368 unsatisfied(T). 2369unsatisfied([Needed-By|T]) --> 2370 [ ' - "~w" is needed by the following packages:'-[Needed], nl ], 2371 pack_list(By), 2372 unsatisfied(T). 2373 2374pack_list([]) --> []. 2375pack_list([H|T]) --> 2376 [ ' - Package "~w"'-[H], nl ], 2377 pack_list(T). 2378 2379process_lines([]) --> []. 2380process_lines([H|T]) --> 2381 [ '~s'-[H] ], 2382 ( {T==[]} 2383 -> [] 2384 ; [nl], process_lines(T) 2385 ). 2386 2387split_lines([], []) :- !. 2388split_lines(All, [Line1|More]) :- 2389 append(Line1, [0'\n|Rest], All), 2390 !, 2391 split_lines(Rest, More). 2392split_lines(Line, [Line]). 2393 2394label(remove_only(Pack)) --> 2395 [ 'Only remove package ~w (break dependencies)'-[Pack] ]. 2396label(remove_deps(Pack, Deps)) --> 2397 { length(Deps, Count) }, 2398 [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ]. 2399label(create_dir(Dir)) --> 2400 [ '~w'-[Dir] ]. 2401label(install_from(git(URL))) --> 2402 !, 2403 [ 'GIT repository at ~w'-[URL] ]. 2404label(install_from(URL)) --> 2405 [ '~w'-[URL] ]. 2406label(cancel) --> 2407 [ 'Cancel' ]. 2408 2409confirm_default(yes) --> 2410 [ ' Y/n? ' ]. 2411confirm_default(no) --> 2412 [ ' y/N? ' ]. 2413confirm_default(none) --> 2414 [ ' y/n? ' ]. 2415 2416msg_version(Version) --> 2417 { atom(Version) }, 2418 !, 2419 [ '~w'-[Version] ]. 2420msg_version(VersionData) --> 2421 !, 2422 { atom_version(Atom, VersionData) }, 2423 [ '~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.
To make changes to a package:
?- pack_install(.).
This builds the pack locally and creates a symlink to make it available.?- pack_rebuild(package_name).
This runs `make distcleanand
make` with the right environment. It will also write a filebuildendv.sh
that you can source to get the environment for running a normalmake
(this is done only if there is aconfigure
step; i.e., if there is aconfigure.in
orconfigure
.cmake
.Once you have made the changes, you should edit the
pack.pl
file to change theversion
item. After updating the git repo, issue apack_install(package_name, [upgrade(true), test(true), rebuild(make)])
to cause the repository to refresh.?- doc_browser.