35
36:- module(prolog_pack,
37 [ pack_list_installed/0,
38 pack_info/1, 39 pack_list/1, 40 pack_search/1, 41 pack_install/1, 42 pack_install/2, 43 pack_upgrade/1, 44 pack_rebuild/1, 45 pack_rebuild/0, 46 pack_remove/1, 47 pack_property/2, 48 pack_attach/2, 49
50 pack_url_file/2 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), []). 65:- use_module(library(prolog_config)). 66
81
82:- multifile
83 environment/2. 84
85:- dynamic
86 pack_requires/2, 87 pack_provides_db/2. 88
89
90 93
94:- setting(server, atom, 'https://www.swi-prolog.org/pack/',
95 'Server to exchange pack information'). 96
97
98 101
105
106current_pack(Pack) :-
107 '$pack':pack(Pack, _).
108
116
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)).
128
132
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. 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).
227
231
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).
275
280
281pack_info_term(name(atom)). 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_or_empty)). 287pack_info_term(maintainer(atom, email_or_url)).
288pack_info_term(packager(atom, email_or_url)).
289pack_info_term(home(atom)). 290pack_info_term(download(atom)). 291pack_info_term(provides(atom)). 292pack_info_term(requires(dependency)).
293pack_info_term(conflicts(dependency)). 294pack_info_term(replaces(atom)). 295pack_info_term(autoload(boolean)). 296
297:- multifile
298 error:has_type/2. 299
300error:has_type(version, Version) :-
301 atom(Version),
302 version_data(Version, _Data).
303error:has_type(email_or_url, Address) :-
304 atom(Address),
305 ( sub_atom(Address, _, _, _, @)
306 -> true
307 ; uri_is_global(Address)
308 ).
309error:has_type(email_or_url_or_empty, Address) :-
310 ( Address == ''
311 -> true
312 ; error:has_type(email_or_url, Address)
313 ).
314error:has_type(dependency, Value) :-
315 is_dependency(Value, _Token, _Version).
316
317version_data(Version, version(Data)) :-
318 atomic_list_concat(Parts, '.', Version),
319 maplist(atom_number, Parts, Data).
320
321is_dependency(Token, Token, *) :-
322 atom(Token).
323is_dependency(Term, Token, VersionCmp) :-
324 Term =.. [Op,Token,Version],
325 cmp(Op, _),
326 version_data(Version, _),
327 VersionCmp =.. [Op,Version].
328
329cmp(<, @<).
330cmp(=<, @=<).
331cmp(==, ==).
332cmp(>=, @>=).
333cmp(>, @>).
334
335
336 339
366
367pack_list(Query) :-
368 pack_search(Query).
369
370pack_search(Query) :-
371 query_pack_server(search(Query), Result, []),
372 ( Result == false
373 -> ( local_search(Query, Packs),
374 Packs \== []
375 -> forall(member(pack(Pack, Stat, Title, Version, _), Packs),
376 format('~w ~w@~w ~28|- ~w~n',
377 [Stat, Pack, Version, Title]))
378 ; print_message(warning, pack(search_no_matches(Query)))
379 )
380 ; Result = true(Hits),
381 local_search(Query, Local),
382 append(Hits, Local, All),
383 sort(All, Sorted),
384 list_hits(Sorted)
385 ).
386
387list_hits([]).
388list_hits([ pack(Pack, i, Title, Version, _),
389 pack(Pack, p, Title, Version, _)
390 | More
391 ]) :-
392 !,
393 format('i ~w@~w ~28|- ~w~n', [Pack, Version, Title]),
394 list_hits(More).
395list_hits([ pack(Pack, i, Title, VersionI, _),
396 pack(Pack, p, _, VersionS, _)
397 | More
398 ]) :-
399 !,
400 version_data(VersionI, VDI),
401 version_data(VersionS, VDS),
402 ( VDI @< VDS
403 -> Tag = ('U')
404 ; Tag = ('A')
405 ),
406 format('~w ~w@~w(~w) ~28|- ~w~n', [Tag, Pack, VersionI, VersionS, Title]),
407 list_hits(More).
408list_hits([ pack(Pack, i, Title, VersionI, _)
409 | More
410 ]) :-
411 !,
412 format('l ~w@~w ~28|- ~w~n', [Pack, VersionI, Title]),
413 list_hits(More).
414list_hits([pack(Pack, Stat, Title, Version, _)|More]) :-
415 format('~w ~w@~w ~28|- ~w~n', [Stat, Pack, Version, Title]),
416 list_hits(More).
417
418
419local_search(Query, Packs) :-
420 findall(Pack, matching_installed_pack(Query, Pack), Packs).
421
422matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
423 current_pack(Pack),
424 findall(Term,
425 ( pack_info(Pack, _, Term),
426 search_info(Term)
427 ), Info),
428 ( sub_atom_icasechk(Pack, _, Query)
429 -> true
430 ; memberchk(title(Title), Info),
431 sub_atom_icasechk(Title, _, Query)
432 ),
433 option(title(Title), Info, '<no title>'),
434 option(version(Version), Info, '<no version>'),
435 option(download(URL), Info, '<no download url>').
436
437search_info(title(_)).
438search_info(version(_)).
439search_info(download(_)).
440
441
442 445
461
462pack_install(Spec) :-
463 pack_default_options(Spec, Pack, [], Options),
464 pack_install(Pack, [pack(Pack)|Options]).
465
470
471pack_default_options(_Spec, Pack, OptsIn, Options) :-
472 option(already_installed(pack(Pack,_Version)), OptsIn),
473 !,
474 Options = OptsIn.
475pack_default_options(_Spec, Pack, OptsIn, Options) :-
476 option(url(URL), OptsIn),
477 !,
478 ( option(git(_), OptsIn)
479 -> Options = OptsIn
480 ; git_url(URL, Pack)
481 -> Options = [git(true)|OptsIn]
482 ; Options = OptsIn
483 ),
484 ( nonvar(Pack)
485 -> true
486 ; option(pack(Pack), Options)
487 -> true
488 ; pack_version_file(Pack, _Version, URL)
489 ).
490pack_default_options(Archive, Pack, _, Options) :- 491 must_be(atom, Archive),
492 \+ uri_is_global(Archive),
493 expand_file_name(Archive, [File]),
494 exists_file(File),
495 !,
496 pack_version_file(Pack, Version, File),
497 uri_file_name(FileURL, File),
498 Options = [url(FileURL), version(Version)].
499pack_default_options(URL, Pack, _, Options) :-
500 git_url(URL, Pack),
501 !,
502 Options = [git(true), url(URL)].
503pack_default_options(FileURL, Pack, _, Options) :- 504 uri_file_name(FileURL, Dir),
505 exists_directory(Dir),
506 pack_info_term(Dir, name(Pack)),
507 !,
508 ( pack_info_term(Dir, version(Version))
509 -> uri_file_name(DirURL, Dir),
510 Options = [url(DirURL), version(Version)]
511 ; throw(error(existence_error(key, version, Dir),_))
512 ).
513pack_default_options(URL, Pack, _, Options) :- 514 pack_version_file(Pack, Version, URL),
515 download_url(URL),
516 !,
517 available_download_versions(URL, [URLVersion-LatestURL|_]),
518 Options = [url(LatestURL)|VersionOptions],
519 version_options(Version, URLVersion, VersionOptions).
520pack_default_options(Pack, Pack, OptsIn, Options) :- 521 \+ uri_is_global(Pack), 522 query_pack_server(locate(Pack), Reply, OptsIn),
523 ( Reply = true(Results)
524 -> pack_select_candidate(Pack, Results, OptsIn, Options)
525 ; print_message(warning, pack(no_match(Pack))),
526 fail
527 ).
528
529version_options(Version, Version, [version(Version)]) :- !.
530version_options(Version, _, [version(Version)]) :-
531 Version = version(List),
532 maplist(integer, List),
533 !.
534version_options(_, _, []).
535
539
540pack_select_candidate(Pack, [Version-_|_], Options,
541 [already_installed(pack(Pack, Installed))|Options]) :-
542 current_pack(Pack),
543 pack_info(Pack, _, version(InstalledAtom)),
544 atom_version(InstalledAtom, Installed),
545 Installed @>= Version,
546 !.
547pack_select_candidate(Pack, Available, Options, OptsOut) :-
548 option(url(URL), Options),
549 memberchk(_Version-URLs, Available),
550 memberchk(URL, URLs),
551 !,
552 ( git_url(URL, Pack)
553 -> Extra = [git(true)]
554 ; Extra = []
555 ),
556 OptsOut = [url(URL), inquiry(true) | Extra].
557pack_select_candidate(Pack, [Version-[URL]|_], Options,
558 [url(URL), git(true), inquiry(true)]) :-
559 git_url(URL, Pack),
560 !,
561 confirm(install_from(Pack, Version, git(URL)), yes, Options).
562pack_select_candidate(Pack, [Version-[URL]|More], Options,
563 [url(URL), inquiry(true)]) :-
564 ( More == []
565 -> !
566 ; true
567 ),
568 confirm(install_from(Pack, Version, URL), yes, Options),
569 !.
570pack_select_candidate(Pack, [Version-URLs|_], Options,
571 [url(URL), inquiry(true)|Rest]) :-
572 maplist(url_menu_item, URLs, Tagged),
573 append(Tagged, [cancel=cancel], Menu),
574 Menu = [Default=_|_],
575 menu(pack(select_install_from(Pack, Version)),
576 Menu, Default, Choice, Options),
577 ( Choice == cancel
578 -> fail
579 ; Choice = git(URL)
580 -> Rest = [git(true)]
581 ; Choice = URL,
582 Rest = []
583 ).
584
(URL, git(URL)=install_from(git(URL))) :-
586 git_url(URL, _),
587 !.
588url_menu_item(URL, URL=install_from(URL)).
589
590
618
619pack_install(Spec, Options) :-
620 pack_default_options(Spec, Pack, Options, DefOptions),
621 ( option(already_installed(Installed), DefOptions)
622 -> print_message(informational, pack(already_installed(Installed)))
623 ; merge_options(Options, DefOptions, PackOptions),
624 update_dependency_db,
625 pack_install_dir(PackDir, PackOptions),
626 pack_install(Pack, PackDir, PackOptions)
627 ).
628
629pack_install_dir(PackDir, Options) :-
630 option(package_directory(PackDir), Options),
631 !.
632pack_install_dir(PackDir, _Options) :- 633 absolute_file_name(pack(.), PackDir,
634 [ file_type(directory),
635 access(write),
636 file_errors(fail)
637 ]),
638 !.
639pack_install_dir(PackDir, Options) :- 640 pack_create_install_dir(PackDir, Options).
641
642pack_create_install_dir(PackDir, Options) :-
643 findall(Candidate = create_dir(Candidate),
644 ( absolute_file_name(pack(.), Candidate, [solutions(all)]),
645 \+ exists_file(Candidate),
646 \+ exists_directory(Candidate),
647 file_directory_name(Candidate, Super),
648 ( exists_directory(Super)
649 -> access_file(Super, write)
650 ; true
651 )
652 ),
653 Candidates0),
654 list_to_set(Candidates0, Candidates), 655 pack_create_install_dir(Candidates, PackDir, Options).
656
657pack_create_install_dir(Candidates, PackDir, Options) :-
658 Candidates = [Default=_|_],
659 !,
660 append(Candidates, [cancel=cancel], Menu),
661 menu(pack(create_pack_dir), Menu, Default, Selected, Options),
662 Selected \== cancel,
663 ( catch(make_directory_path(Selected), E,
664 (print_message(warning, E), fail))
665 -> PackDir = Selected
666 ; delete(Candidates, PackDir=create_dir(PackDir), Remaining),
667 pack_create_install_dir(Remaining, PackDir, Options)
668 ).
669pack_create_install_dir(_, _, _) :-
670 print_message(error, pack(cannot_create_dir(pack(.)))),
671 fail.
672
673
685
686pack_install(Name, _, Options) :-
687 current_pack(Name),
688 option(upgrade(false), Options, false),
689 print_message(error, pack(already_installed(Name))),
690 pack_info(Name),
691 print_message(information, pack(remove_with(Name))),
692 !,
693 fail.
694pack_install(Name, PackDir, Options) :-
695 option(url(URL), Options),
696 uri_file_name(URL, Source),
697 !,
698 pack_install_from_local(Source, PackDir, Name, Options).
699pack_install(Name, PackDir, Options) :-
700 option(url(URL), Options),
701 uri_components(URL, Components),
702 uri_data(scheme, Components, Scheme),
703 pack_install_from_url(Scheme, URL, PackDir, Name, Options).
704
711
712pack_install_from_local(Source, PackTopDir, Name, Options) :-
713 exists_directory(Source),
714 !,
715 directory_file_path(PackTopDir, Name, PackDir),
716 prepare_pack_dir(PackDir, Options),
717 copy_directory(Source, PackDir),
718 pack_post_install(Name, PackDir, Options).
719pack_install_from_local(Source, PackTopDir, Name, Options) :-
720 exists_file(Source),
721 directory_file_path(PackTopDir, Name, PackDir),
722 prepare_pack_dir(PackDir, Options),
723 pack_unpack(Source, PackDir, Name, Options),
724 pack_post_install(Name, PackDir, Options).
725
726
730
731:- if(exists_source(library(archive))). 732pack_unpack(Source, PackDir, Pack, Options) :-
733 ensure_loaded_archive,
734 pack_archive_info(Source, Pack, _Info, StripOptions),
735 prepare_pack_dir(PackDir, Options),
736 archive_extract(Source, PackDir,
737 [ exclude(['._*']) 738 | StripOptions
739 ]).
740:- else. 741pack_unpack(_,_,_,_) :-
742 existence_error(library, archive).
743:- endif. 744
745 748
760
761:- if(exists_source(library(archive))). 762ensure_loaded_archive :-
763 current_predicate(archive_open/3),
764 !.
765ensure_loaded_archive :-
766 use_module(library(archive)).
767
768pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
769 ensure_loaded_archive,
770 size_file(Archive, Bytes),
771 setup_call_cleanup(
772 archive_open(Archive, Handle, []),
773 ( repeat,
774 ( archive_next_header(Handle, InfoFile)
775 -> true
776 ; !, fail
777 )
778 ),
779 archive_close(Handle)),
780 file_base_name(InfoFile, 'pack.pl'),
781 atom_concat(Prefix, 'pack.pl', InfoFile),
782 strip_option(Prefix, Pack, Strip),
783 setup_call_cleanup(
784 archive_open_entry(Handle, Stream),
785 read_stream_to_terms(Stream, Info),
786 close(Stream)),
787 !,
788 must_be(ground, Info),
789 maplist(valid_info_term, Info).
790:- else. 791pack_archive_info(_, _, _, _) :-
792 existence_error(library, archive).
793:- endif. 794pack_archive_info(_, _, _, _) :-
795 existence_error(pack_file, 'pack.pl').
796
797strip_option('', _, []) :- !.
798strip_option('./', _, []) :- !.
799strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
800 atom_concat(PrefixDir, /, Prefix),
801 file_base_name(PrefixDir, Base),
802 ( Base == Pack
803 -> true
804 ; pack_version_file(Pack, _, Base)
805 -> true
806 ; \+ sub_atom(PrefixDir, _, _, _, /)
807 ).
808
809read_stream_to_terms(Stream, Terms) :-
810 read(Stream, Term0),
811 read_stream_to_terms(Term0, Stream, Terms).
812
813read_stream_to_terms(end_of_file, _, []) :- !.
814read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
815 read(Stream, Term1),
816 read_stream_to_terms(Term1, Stream, Terms).
817
818
823
824pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
825 exists_directory(GitDir),
826 !,
827 git_ls_tree(Entries, [directory(GitDir)]),
828 git_hash(Hash, [directory(GitDir)]),
829 maplist(arg(4), Entries, Sizes),
830 sum_list(Sizes, Bytes),
831 directory_file_path(GitDir, 'pack.pl', InfoFile),
832 read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
833 must_be(ground, Info),
834 maplist(valid_info_term, Info).
835
839
840download_file_sanity_check(Archive, Pack, Info) :-
841 info_field(name(Name), Info),
842 info_field(version(VersionAtom), Info),
843 atom_version(VersionAtom, Version),
844 pack_version_file(PackA, VersionA, Archive),
845 must_match([Pack, PackA, Name], name),
846 must_match([Version, VersionA], version).
847
848info_field(Field, Info) :-
849 memberchk(Field, Info),
850 ground(Field),
851 !.
852info_field(Field, _Info) :-
853 functor(Field, FieldName, _),
854 print_message(error, pack(missing(FieldName))),
855 fail.
856
857must_match(Values, _Field) :-
858 sort(Values, [_]),
859 !.
860must_match(Values, Field) :-
861 print_message(error, pack(conflict(Field, Values))),
862 fail.
863
864
865 868
874
875prepare_pack_dir(Dir, Options) :-
876 exists_directory(Dir),
877 !,
878 ( empty_directory(Dir)
879 -> true
880 ; option(upgrade(true), Options)
881 -> delete_directory_contents(Dir)
882 ; confirm(remove_existing_pack(Dir), yes, Options),
883 delete_directory_contents(Dir)
884 ).
885prepare_pack_dir(Dir, _) :-
886 make_directory(Dir).
887
891
892empty_directory(Dir) :-
893 \+ ( directory_files(Dir, Entries),
894 member(Entry, Entries),
895 \+ special(Entry)
896 ).
897
898special(.).
899special(..).
900
901
908
909pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
910 option(git(true), Options),
911 !,
912 directory_file_path(PackTopDir, Pack, PackDir),
913 prepare_pack_dir(PackDir, Options),
914 run_process(path(git), [clone, URL, PackDir], []),
915 pack_git_info(PackDir, Hash, Info),
916 pack_inquiry(URL, git(Hash), Info, Options),
917 show_info(Pack, Info, Options),
918 confirm(git_post_install(PackDir, Pack), yes, Options),
919 pack_post_install(Pack, PackDir, Options).
920pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
921 download_scheme(Scheme),
922 directory_file_path(PackTopDir, Pack, PackDir),
923 prepare_pack_dir(PackDir, Options),
924 pack_download_dir(PackTopDir, DownLoadDir),
925 download_file(URL, Pack, DownloadBase, Options),
926 directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
927 setup_call_cleanup(
928 http_open(URL, In,
929 [ cert_verify_hook(ssl_verify)
930 ]),
931 setup_call_cleanup(
932 open(DownloadFile, write, Out, [type(binary)]),
933 copy_stream_data(In, Out),
934 close(Out)),
935 close(In)),
936 pack_archive_info(DownloadFile, Pack, Info, _),
937 download_file_sanity_check(DownloadFile, Pack, Info),
938 pack_inquiry(URL, DownloadFile, Info, Options),
939 show_info(Pack, Info, Options),
940 confirm(install_downloaded(DownloadFile), yes, Options),
941 pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).
942
944
945download_file(URL, Pack, File, Options) :-
946 option(version(Version), Options),
947 !,
948 atom_version(VersionA, Version),
949 file_name_extension(_, Ext, URL),
950 format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
951download_file(URL, Pack, File, _) :-
952 file_base_name(URL,Basename),
953 no_int_file_name_extension(Tag,Ext,Basename),
954 tag_version(Tag,Version),
955 !,
956 atom_version(VersionA,Version),
957 format(atom(File0), '~w-~w', [Pack, VersionA]),
958 file_name_extension(File0, Ext, File).
959download_file(URL, _, File, _) :-
960 file_base_name(URL, File).
961
967
968pack_url_file(URL, FileID) :-
969 github_release_url(URL, Pack, Version),
970 !,
971 download_file(URL, Pack, FileID, [version(Version)]).
972pack_url_file(URL, FileID) :-
973 file_base_name(URL, FileID).
974
975
976:- public ssl_verify/5. 977
983
984ssl_verify(_SSL,
985 _ProblemCertificate, _AllCertificates, _FirstCertificate,
986 _Error).
987
988pack_download_dir(PackTopDir, DownLoadDir) :-
989 directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
990 ( exists_directory(DownLoadDir)
991 -> true
992 ; make_directory(DownLoadDir)
993 ),
994 ( access_file(DownLoadDir, write)
995 -> true
996 ; permission_error(write, directory, DownLoadDir)
997 ).
998
1002
1003download_url(URL) :-
1004 atom(URL),
1005 uri_components(URL, Components),
1006 uri_data(scheme, Components, Scheme),
1007 download_scheme(Scheme).
1008
1009download_scheme(http).
1010download_scheme(https) :-
1011 catch(use_module(library(http/http_ssl_plugin)),
1012 E, (print_message(warning, E), fail)).
1013
1021
1022pack_post_install(Pack, PackDir, Options) :-
1023 post_install_foreign(Pack, PackDir,
1024 [ build_foreign(if_absent)
1025 | Options
1026 ]),
1027 post_install_autoload(PackDir, Options),
1028 '$pack_attach'(PackDir).
1029
1033
1034pack_rebuild(Pack) :-
1035 '$pack':pack(Pack, BaseDir),
1036 !,
1037 catch(pack_make(BaseDir, [distclean], []), E,
1038 print_message(warning, E)),
1039 post_install_foreign(Pack, BaseDir, []).
1040pack_rebuild(Pack) :-
1041 existence_error(pack, Pack).
1042
1046
1047pack_rebuild :-
1048 forall(current_pack(Pack),
1049 ( print_message(informational, pack(rebuild(Pack))),
1050 pack_rebuild(Pack)
1051 )).
1052
1053
1057
1058post_install_foreign(Pack, PackDir, Options) :-
1059 is_foreign_pack(PackDir),
1060 !,
1061 ( option(build_foreign(if_absent), Options),
1062 foreign_present(PackDir)
1063 -> print_message(informational, pack(kept_foreign(Pack)))
1064 ; setup_path,
1065 save_build_environment(PackDir),
1066 configure_foreign(PackDir, Options),
1067 make_foreign(PackDir, Options)
1068 ).
1069post_install_foreign(_, _, _).
1070
1071foreign_present(PackDir) :-
1072 current_prolog_flag(arch, Arch),
1073 atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
1074 exists_directory(ForeignBaseDir),
1075 !,
1076 atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
1077 exists_directory(ForeignDir),
1078 current_prolog_flag(shared_object_extension, Ext),
1079 atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
1080 expand_file_name(Pattern, Files),
1081 Files \== [].
1082
1083is_foreign_pack(PackDir) :-
1084 foreign_file(File),
1085 directory_file_path(PackDir, File, Path),
1086 exists_file(Path),
1087 !.
1088
1089foreign_file('configure.in').
1090foreign_file('configure.ac').
1091foreign_file('configure').
1092foreign_file('Makefile').
1093foreign_file('makefile').
1094foreign_file('CMakeLists.txt').
1095
1096
1101
1102configure_foreign(PackDir, Options) :-
1103 directory_file_path(PackDir, 'CMakeLists.txt', CMakeFile),
1104 exists_file(CMakeFile),
1105 !,
1106 cmake_configure_foreign(PackDir, Options).
1107configure_foreign(PackDir, Options) :-
1108 make_configure(PackDir, Options),
1109 directory_file_path(PackDir, configure, Configure),
1110 exists_file(Configure),
1111 !,
1112 build_environment(BuildEnv),
1113 findall(Opt, configure_option(Opt), Opts),
1114 run_process(path(bash), [Configure|Opts],
1115 [ env(BuildEnv),
1116 directory(PackDir)
1117 ]).
1118configure_foreign(_, _).
1119
1120configure_option(Opt) :-
1121 prolog_prefix(Prefix),
1122 format(atom(Opt), '--prefix=~w', [Prefix]).
1123
1124make_configure(PackDir, _Options) :-
1125 directory_file_path(PackDir, 'configure', Configure),
1126 exists_file(Configure),
1127 !.
1128make_configure(PackDir, _Options) :-
1129 autoconf_master(ConfigMaster),
1130 directory_file_path(PackDir, ConfigMaster, ConfigureIn),
1131 exists_file(ConfigureIn),
1132 !,
1133 run_process(path(autoheader), [], [directory(PackDir)]),
1134 run_process(path(autoconf), [], [directory(PackDir)]).
1135make_configure(_, _).
1136
1137autoconf_master('configure.ac').
1138autoconf_master('configure.in').
1139
1143
1144cmake_configure_foreign(PackDir, _Options) :-
1145 directory_file_path(PackDir, build, BuildDir),
1146 make_directory_path(BuildDir),
1147 findall(Opt, cmake_option(Opt), Argv, [..]),
1148 run_process(path(cmake), Argv,
1149 [directory(BuildDir)]).
1150
1151cmake_option(CDEF) :-
1152 current_prolog_flag(executable, Exe),
1153 format(atom(CDEF), '-DSWIPL=~w', [Exe]).
1154cmake_option(CDEF) :-
1155 prolog_prefix(Prefix),
1156 format(atom(CDEF), '-DCMAKE_INSTALL_PREFIX=~w', [Prefix]).
1157
1161
1162make_foreign(PackDir, Options) :-
1163 pack_make(PackDir, [all, check, install], Options).
1164
1165pack_make(PackDir, Targets, _Options) :-
1166 directory_file_path(PackDir, 'Makefile', Makefile),
1167 exists_file(Makefile),
1168 !,
1169 build_environment(BuildEnv),
1170 ProcessOptions = [ directory(PackDir), env(BuildEnv) ],
1171 forall(member(Target, Targets),
1172 run_process(path(make), [Target], ProcessOptions)).
1173pack_make(PackDir, Targets, _Options) :-
1174 directory_file_path(PackDir, 'CMakeLists.txt', CMakefile),
1175 exists_file(CMakefile),
1176 directory_file_path(PackDir, 'build', BuildDir),
1177 exists_directory(BuildDir),
1178 !,
1179 ( Targets == [distclean]
1180 -> delete_directory_contents(BuildDir)
1181 ; build_environment(BuildEnv),
1182 ProcessOptions = [ directory(BuildDir), env(BuildEnv) ],
1183 forall(member(Target, Targets),
1184 run_cmake_target(Target, BuildDir, ProcessOptions))
1185 ).
1186pack_make(_, _, _).
1187
1188run_cmake_target(check, BuildDir, ProcessOptions) :-
1189 !,
1190 ( directory_file_path(BuildDir, 'CTestTestfile.cmake', TestFile),
1191 exists_file(TestFile)
1192 -> run_process(path(ctest), [], ProcessOptions)
1193 ; true
1194 ).
1195run_cmake_target(Target, _, ProcessOptions) :-
1196 run_process(path(make), [Target], ProcessOptions).
1197
1202
1203save_build_environment(PackDir) :-
1204 directory_file_path(PackDir, 'buildenv.sh', EnvFile),
1205 build_environment(Env),
1206 setup_call_cleanup(
1207 open(EnvFile, write, Out),
1208 write_env_script(Out, Env),
1209 close(Out)).
1210
1211write_env_script(Out, Env) :-
1212 format(Out,
1213 '# This file contains the environment that can be used to\n\c
1214 # build the foreign pack outside Prolog. This file must\n\c
1215 # be loaded into a bourne-compatible shell using\n\c
1216 #\n\c
1217 # $ source buildenv.sh\n\n',
1218 []),
1219 forall(member(Var=Value, Env),
1220 format(Out, '~w=\'~w\'\n', [Var, Value])),
1221 format(Out, '\nexport ', []),
1222 forall(member(Var=_, Env),
1223 format(Out, ' ~w', [Var])),
1224 format(Out, '\n', []).
1225
1226build_environment(Env) :-
1227 findall(Name=Value, environment(Name, Value), UserEnv),
1228 findall(Name=Value,
1229 ( def_environment(Name, Value),
1230 \+ memberchk(Name=_, UserEnv)
1231 ),
1232 DefEnv),
1233 append(UserEnv, DefEnv, Env).
1234
1235
1253
1254
1259
1260def_environment('PATH', Value) :-
1261 getenv('PATH', PATH),
1262 current_prolog_flag(executable, Exe),
1263 file_directory_name(Exe, ExeDir),
1264 prolog_to_os_filename(ExeDir, OsExeDir),
1265 ( current_prolog_flag(windows, true)
1266 -> Sep = (;)
1267 ; Sep = (:)
1268 ),
1269 atomic_list_concat([OsExeDir, Sep, PATH], Value).
1270def_environment('SWIPL', Value) :-
1271 current_prolog_flag(executable, Value).
1272def_environment('SWIPLVERSION', Value) :-
1273 current_prolog_flag(version, Value).
1274def_environment('SWIHOME', Value) :-
1275 current_prolog_flag(home, Value).
1276def_environment('SWIARCH', Value) :-
1277 current_prolog_flag(arch, Value).
1278def_environment('PACKSODIR', Value) :-
1279 current_prolog_flag(arch, Arch),
1280 atom_concat('lib/', Arch, Value).
1281def_environment('SWISOLIB', Value) :-
1282 current_prolog_flag(c_libplso, Value).
1283def_environment('SWILIB', '-lswipl').
1284def_environment('CC', Value) :-
1285 ( getenv('CC', Value)
1286 -> true
1287 ; default_c_compiler(Value)
1288 -> true
1289 ; current_prolog_flag(c_cc, Value)
1290 ).
1291def_environment('LD', Value) :-
1292 ( getenv('LD', Value)
1293 -> true
1294 ; current_prolog_flag(c_cc, Value)
1295 ).
1296def_environment('CFLAGS', Value) :-
1297 ( getenv('CFLAGS', SystemFlags)
1298 -> Extra = [' ', SystemFlags]
1299 ; Extra = []
1300 ),
1301 current_prolog_flag(c_cflags, Value0),
1302 current_prolog_flag(home, Home),
1303 atomic_list_concat([Value0, ' -I"', Home, '/include"' | Extra], Value).
1304def_environment('LDSOFLAGS', Value) :-
1305 ( getenv('LDFLAGS', SystemFlags)
1306 -> Extra = [SystemFlags|System]
1307 ; Extra = System
1308 ),
1309 ( current_prolog_flag(windows, true)
1310 -> current_prolog_flag(home, Home),
1311 atomic_list_concat(['-L"', Home, '/bin"'], SystemLib),
1312 System = [SystemLib]
1313 ; apple_bundle_libdir(LibDir)
1314 -> atomic_list_concat(['-L"', LibDir, '"'], SystemLib),
1315 System = [SystemLib]
1316 ; current_prolog_flag(c_libplso, '')
1317 -> System = [] 1318 ; prolog_library_dir(SystemLibDir),
1319 atomic_list_concat(['-L"',SystemLibDir,'"'], SystemLib),
1320 System = [SystemLib]
1321 ),
1322 current_prolog_flag(c_ldflags, LDFlags),
1323 atomic_list_concat([LDFlags, '-shared' | Extra], ' ', Value).
1324def_environment('SOEXT', Value) :-
1325 current_prolog_flag(shared_object_extension, Value).
1326def_environment(Pass, Value) :-
1327 pass_env(Pass),
1328 getenv(Pass, Value).
1329
1330pass_env('TMP').
1331pass_env('TEMP').
1332pass_env('USER').
1333pass_env('HOME').
1334
1335:- multifile
1336 prolog:runtime_config/2. 1337
1338prolog_library_dir(Dir) :-
1339 prolog:runtime_config(c_libdir, Dir),
1340 !.
1341prolog_library_dir(Dir) :-
1342 current_prolog_flag(home, Home),
1343 ( current_prolog_flag(c_libdir, Rel)
1344 -> atomic_list_concat([Home, Rel], /, Dir)
1345 ; current_prolog_flag(arch, Arch)
1346 -> atomic_list_concat([Home, lib, Arch], /, Dir)
1347 ).
1348
1355
1356default_c_compiler(CC) :-
1357 preferred_c_compiler(CC),
1358 has_program(path(CC), _),
1359 !.
1360
1361preferred_c_compiler(gcc).
1362preferred_c_compiler(clang).
1363preferred_c_compiler(cc).
1364
1365
1366 1369
1370setup_path :-
1371 has_program(path(make), _),
1372 has_program(path(gcc), _),
1373 !.
1374setup_path :-
1375 current_prolog_flag(windows, true),
1376 !,
1377 ( mingw_extend_path
1378 -> true
1379 ; print_message(error, pack(no_mingw))
1380 ).
1381setup_path.
1382
1383has_program(Program, Path) :-
1384 exe_options(ExeOptions),
1385 absolute_file_name(Program, Path,
1386 [ file_errors(fail)
1387 | ExeOptions
1388 ]).
1389
1390exe_options(Options) :-
1391 current_prolog_flag(windows, true),
1392 !,
1393 Options = [ extensions(['',exe,com]), access(read) ].
1394exe_options(Options) :-
1395 Options = [ access(execute) ].
1396
1397mingw_extend_path :-
1398 mingw_root(MinGW),
1399 directory_file_path(MinGW, bin, MinGWBinDir),
1400 atom_concat(MinGW, '/msys/*/bin', Pattern),
1401 expand_file_name(Pattern, MsysDirs),
1402 last(MsysDirs, MSysBinDir),
1403 prolog_to_os_filename(MinGWBinDir, WinDirMinGW),
1404 prolog_to_os_filename(MSysBinDir, WinDirMSYS),
1405 getenv('PATH', Path0),
1406 atomic_list_concat([WinDirMSYS, WinDirMinGW, Path0], ';', Path),
1407 setenv('PATH', Path).
1408
1409mingw_root(MinGwRoot) :-
1410 current_prolog_flag(executable, Exe),
1411 sub_atom(Exe, 1, _, _, :),
1412 sub_atom(Exe, 0, 1, _, PlDrive),
1413 Drives = [PlDrive,c,d],
1414 member(Drive, Drives),
1415 format(atom(MinGwRoot), '~a:/MinGW', [Drive]),
1416 exists_directory(MinGwRoot),
1417 !.
1418
1430
1431prolog_prefix(Prefix) :-
1432 current_prolog_flag(pack_prefix, Prefix),
1433 access_file(Prefix, write),
1434 !.
1435prolog_prefix(Prefix) :-
1436 current_prolog_flag(os_argv, [Name|_]),
1437 has_program(path(Name), EXE),
1438 file_directory_name(EXE, Bin),
1439 file_directory_name(Bin, Prefix0),
1440 ( local_prefix(Prefix0, Prefix1)
1441 -> Prefix = Prefix1
1442 ; Prefix = Prefix0
1443 ),
1444 access_file(Prefix, write),
1445 !.
1446prolog_prefix(Prefix) :-
1447 expand_file_name(~, UserHome),
1448 directory_file_path(UserHome, bin, BinDir),
1449 exists_directory(BinDir),
1450 access_file(BinDir, write),
1451 !,
1452 Prefix = UserHome.
1453
1454local_prefix('/usr', '/usr/local').
1455
1456
1457 1460
1464
1465post_install_autoload(PackDir, Options) :-
1466 option(autoload(true), Options, true),
1467 pack_info_term(PackDir, autoload(true)),
1468 !,
1469 directory_file_path(PackDir, prolog, PrologLibDir),
1470 make_library_index(PrologLibDir).
1471post_install_autoload(_, _).
1472
1473
1474 1477
1483
1484pack_upgrade(Pack) :-
1485 pack_info(Pack, _, directory(Dir)),
1486 directory_file_path(Dir, '.git', GitDir),
1487 exists_directory(GitDir),
1488 !,
1489 print_message(informational, pack(git_fetch(Dir))),
1490 git([fetch], [ directory(Dir) ]),
1491 git_describe(V0, [ directory(Dir) ]),
1492 git_describe(V1, [ directory(Dir), commit('origin/master') ]),
1493 ( V0 == V1
1494 -> print_message(informational, pack(up_to_date(Pack)))
1495 ; confirm(upgrade(Pack, V0, V1), yes, []),
1496 git([merge, 'origin/master'], [ directory(Dir) ]),
1497 pack_rebuild(Pack)
1498 ).
1499pack_upgrade(Pack) :-
1500 once(pack_info(Pack, _, version(VersionAtom))),
1501 atom_version(VersionAtom, Version),
1502 pack_info(Pack, _, download(URL)),
1503 ( wildcard_pattern(URL)
1504 -> true
1505 ; github_url(URL, _User, _Repo)
1506 ),
1507 !,
1508 available_download_versions(URL, [Latest-LatestURL|_Versions]),
1509 ( Latest @> Version
1510 -> confirm(upgrade(Pack, Version, Latest), yes, []),
1511 pack_install(Pack,
1512 [ url(LatestURL),
1513 upgrade(true),
1514 pack(Pack)
1515 ])
1516 ; print_message(informational, pack(up_to_date(Pack)))
1517 ).
1518pack_upgrade(Pack) :-
1519 print_message(warning, pack(no_upgrade_info(Pack))).
1520
1521
1522 1525
1529
1530pack_remove(Pack) :-
1531 update_dependency_db,
1532 ( setof(Dep, pack_depends_on(Dep, Pack), Deps)
1533 -> confirm_remove(Pack, Deps, Delete),
1534 forall(member(P, Delete), pack_remove_forced(P))
1535 ; pack_remove_forced(Pack)
1536 ).
1537
1538pack_remove_forced(Pack) :-
1539 catch('$pack_detach'(Pack, BaseDir),
1540 error(existence_error(pack, Pack), _),
1541 fail),
1542 !,
1543 print_message(informational, pack(remove(BaseDir))),
1544 delete_directory_and_contents(BaseDir).
1545pack_remove_forced(Pack) :-
1546 directory_file_path(Pack, 'pack.pl', PackFile),
1547 absolute_file_name(pack(PackFile), PackPath,
1548 [ access(read),
1549 file_errors(fail)
1550 ]),
1551 !,
1552 file_directory_name(PackPath, BaseDir),
1553 delete_directory_and_contents(BaseDir).
1554pack_remove_forced(Pack) :-
1555 print_message(informational, error(existence_error(pack, Pack),_)).
1556
1557confirm_remove(Pack, Deps, Delete) :-
1558 print_message(warning, pack(depends(Pack, Deps))),
1559 menu(pack(resolve_remove),
1560 [ [Pack] = remove_only(Pack),
1561 [Pack|Deps] = remove_deps(Pack, Deps),
1562 [] = cancel
1563 ], [], Delete, []),
1564 Delete \== [].
1565
1566
1567 1570
1591
1592pack_property(Pack, Property) :-
1593 findall(Pack-Property, pack_property_(Pack, Property), List),
1594 member(Pack-Property, List). 1595
1596pack_property_(Pack, Property) :-
1597 pack_info(Pack, _, Property).
1598pack_property_(Pack, Property) :-
1599 \+ \+ info_file(Property, _),
1600 '$pack':pack(Pack, BaseDir),
1601 access_file(BaseDir, read),
1602 directory_files(BaseDir, Files),
1603 member(File, Files),
1604 info_file(Property, Pattern),
1605 downcase_atom(File, Pattern),
1606 directory_file_path(BaseDir, File, InfoFile),
1607 arg(1, Property, InfoFile).
1608
1609info_file(readme(_), 'readme.txt').
1610info_file(readme(_), 'readme').
1611info_file(todo(_), 'todo.txt').
1612info_file(todo(_), 'todo').
1613
1614
1615 1618
1622
1623git_url(URL, Pack) :-
1624 uri_components(URL, Components),
1625 uri_data(scheme, Components, Scheme),
1626 uri_data(path, Components, Path),
1627 ( Scheme == git
1628 -> true
1629 ; git_download_scheme(Scheme),
1630 file_name_extension(_, git, Path)
1631 ),
1632 file_base_name(Path, PackExt),
1633 ( file_name_extension(Pack, git, PackExt)
1634 -> true
1635 ; Pack = PackExt
1636 ),
1637 ( safe_pack_name(Pack)
1638 -> true
1639 ; domain_error(pack_name, Pack)
1640 ).
1641
1642git_download_scheme(http).
1643git_download_scheme(https).
1644
1649
1650safe_pack_name(Name) :-
1651 atom_length(Name, Len),
1652 Len >= 3, 1653 atom_codes(Name, Codes),
1654 maplist(safe_pack_char, Codes),
1655 !.
1656
1657safe_pack_char(C) :- between(0'a, 0'z, C), !.
1658safe_pack_char(C) :- between(0'A, 0'Z, C), !.
1659safe_pack_char(C) :- between(0'0, 0'9, C), !.
1660safe_pack_char(0'_).
1661
1662
1663 1666
1673
1674pack_version_file(Pack, Version, GitHubRelease) :-
1675 atomic(GitHubRelease),
1676 github_release_url(GitHubRelease, Pack, Version),
1677 !.
1678pack_version_file(Pack, Version, Path) :-
1679 atomic(Path),
1680 file_base_name(Path, File),
1681 no_int_file_name_extension(Base, _Ext, File),
1682 atom_codes(Base, Codes),
1683 ( phrase(pack_version(Pack, Version), Codes),
1684 safe_pack_name(Pack)
1685 -> true
1686 ).
1687
1688no_int_file_name_extension(Base, Ext, File) :-
1689 file_name_extension(Base0, Ext0, File),
1690 \+ atom_number(Ext0, _),
1691 !,
1692 Base = Base0,
1693 Ext = Ext0.
1694no_int_file_name_extension(File, '', File).
1695
1696
1697
1706
1707github_release_url(URL, Pack, Version) :-
1708 uri_components(URL, Components),
1709 uri_data(authority, Components, 'github.com'),
1710 uri_data(scheme, Components, Scheme),
1711 download_scheme(Scheme),
1712 uri_data(path, Components, Path),
1713 atomic_list_concat(['',_Project,Pack,archive,File], /, Path),
1714 file_name_extension(Tag, Ext, File),
1715 github_archive_extension(Ext),
1716 tag_version(Tag, Version),
1717 !.
1718
1719github_archive_extension(tgz).
1720github_archive_extension(zip).
1721
1722tag_version(Tag, Version) :-
1723 version_tag_prefix(Prefix),
1724 atom_concat(Prefix, AtomVersion, Tag),
1725 atom_version(AtomVersion, Version).
1726
1727version_tag_prefix(v).
1728version_tag_prefix('V').
1729version_tag_prefix('').
1730
1731
1732:- public
1733 atom_version/2. 1734
1740
1741atom_version(Atom, version(Parts)) :-
1742 ( atom(Atom)
1743 -> atom_codes(Atom, Codes),
1744 phrase(version(Parts), Codes)
1745 ; atomic_list_concat(Parts, '.', Atom)
1746 ).
1747
1748pack_version(Pack, version(Parts)) -->
1749 string(Codes), "-",
1750 version(Parts),
1751 !,
1752 { atom_codes(Pack, Codes)
1753 }.
1754
1755version([_|T]) -->
1756 "*",
1757 !,
1758 ( "."
1759 -> version(T)
1760 ; []
1761 ).
1762version([H|T]) -->
1763 integer(H),
1764 ( "."
1765 -> version(T)
1766 ; { T = [] }
1767 ).
1768
1769integer(H) --> digit(D0), digits(L), { number_codes(H, [D0|L]) }.
1770digit(D) --> [D], { code_type(D, digit) }.
1771digits([H|T]) --> digit(H), !, digits(T).
1772digits([]) --> [].
1773
1774
1775 1778
1796
1797pack_inquiry(_, _, _, Options) :-
1798 option(inquiry(false), Options),
1799 !.
1800pack_inquiry(URL, DownloadFile, Info, Options) :-
1801 setting(server, ServerBase),
1802 ServerBase \== '',
1803 atom_concat(ServerBase, query, Server),
1804 ( option(inquiry(true), Options)
1805 -> true
1806 ; confirm(inquiry(Server), yes, Options)
1807 ),
1808 !,
1809 ( DownloadFile = git(SHA1)
1810 -> true
1811 ; file_sha1(DownloadFile, SHA1)
1812 ),
1813 query_pack_server(install(URL, SHA1, Info), Reply, Options),
1814 inquiry_result(Reply, URL, Options).
1815pack_inquiry(_, _, _, _).
1816
1817
1822
1823query_pack_server(Query, Result, Options) :-
1824 setting(server, ServerBase),
1825 ServerBase \== '',
1826 atom_concat(ServerBase, query, Server),
1827 format(codes(Data), '~q.~n', Query),
1828 info_level(Informational, Options),
1829 print_message(Informational, pack(contacting_server(Server))),
1830 setup_call_cleanup(
1831 http_open(Server, In,
1832 [ post(codes(application/'x-prolog', Data)),
1833 header(content_type, ContentType)
1834 ]),
1835 read_reply(ContentType, In, Result),
1836 close(In)),
1837 message_severity(Result, Level, Informational),
1838 print_message(Level, pack(server_reply(Result))).
1839
1840read_reply(ContentType, In, Result) :-
1841 sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
1842 !,
1843 set_stream(In, encoding(utf8)),
1844 read(In, Result).
1845read_reply(ContentType, In, _Result) :-
1846 read_string(In, 500, String),
1847 print_message(error, pack(no_prolog_response(ContentType, String))),
1848 fail.
1849
1850info_level(Level, Options) :-
1851 option(silent(true), Options),
1852 !,
1853 Level = silent.
1854info_level(informational, _).
1855
1856message_severity(true(_), Informational, Informational).
1857message_severity(false, warning, _).
1858message_severity(exception(_), error, _).
1859
1860
1865
1866inquiry_result(Reply, File, Options) :-
1867 findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation),
1868 \+ member(cancel, Evaluation),
1869 select_option(git(_), Options, Options1, _),
1870 forall(member(install_dependencies(Resolution), Evaluation),
1871 maplist(install_dependency(Options1), Resolution)).
1872
1873eval_inquiry(true(Reply), URL, Eval, _) :-
1874 include(alt_hash, Reply, Alts),
1875 Alts \== [],
1876 print_message(warning, pack(alt_hashes(URL, Alts))),
1877 ( memberchk(downloads(Count), Reply),
1878 ( git_url(URL, _)
1879 -> Default = yes,
1880 Eval = with_git_commits_in_same_version
1881 ; Default = no,
1882 Eval = with_alt_hashes
1883 ),
1884 confirm(continue_with_alt_hashes(Count, URL), Default, [])
1885 -> true
1886 ; !, 1887 Eval = cancel
1888 ).
1889eval_inquiry(true(Reply), _, Eval, Options) :-
1890 include(dependency, Reply, Deps),
1891 Deps \== [],
1892 select_dependency_resolution(Deps, Eval, Options),
1893 ( Eval == cancel
1894 -> !
1895 ; true
1896 ).
1897eval_inquiry(true(Reply), URL, true, Options) :-
1898 file_base_name(URL, File),
1899 info_level(Informational, Options),
1900 print_message(Informational, pack(inquiry_ok(Reply, File))).
1901eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))),
1902 URL, Eval, Options) :-
1903 ( confirm(continue_with_modified_hash(URL), no, Options)
1904 -> Eval = true
1905 ; Eval = cancel
1906 ).
1907
1908alt_hash(alt_hash(_,_,_)).
1909dependency(dependency(_,_,_,_,_)).
1910
1911
1917
1918select_dependency_resolution(Deps, Eval, Options) :-
1919 resolve_dependencies(Deps, Resolution),
1920 exclude(local_dep, Resolution, ToBeDone),
1921 ( ToBeDone == []
1922 -> !, Eval = true
1923 ; print_message(warning, pack(install_dependencies(Resolution))),
1924 ( memberchk(_-unresolved, Resolution)
1925 -> Default = cancel
1926 ; Default = install_deps
1927 ),
1928 menu(pack(resolve_deps),
1929 [ install_deps = install_deps,
1930 install_no_deps = install_no_deps,
1931 cancel = cancel
1932 ], Default, Choice, Options),
1933 ( Choice == cancel
1934 -> !, Eval = cancel
1935 ; Choice == install_no_deps
1936 -> !, Eval = install_no_deps
1937 ; !, Eval = install_dependencies(Resolution)
1938 )
1939 ).
1940
1941local_dep(_-resolved(_)).
1942
1943
1949
1950install_dependency(Options,
1951 _Token-resolve(Pack, VersionAtom, [_URL|_], SubResolve)) :-
1952 atom_version(VersionAtom, Version),
1953 current_pack(Pack),
1954 pack_info(Pack, _, version(InstalledAtom)),
1955 atom_version(InstalledAtom, Installed),
1956 Installed == Version, 1957 !,
1958 maplist(install_dependency(Options), SubResolve).
1959install_dependency(Options,
1960 _Token-resolve(Pack, VersionAtom, [URL|_], SubResolve)) :-
1961 !,
1962 atom_version(VersionAtom, Version),
1963 merge_options([ url(URL),
1964 version(Version),
1965 interactive(false),
1966 inquiry(false),
1967 info(list),
1968 pack(Pack)
1969 ], Options, InstallOptions),
1970 pack_install(Pack, InstallOptions),
1971 maplist(install_dependency(Options), SubResolve).
1972install_dependency(_, _-_).
1973
1974
1975 1978
1985
1986available_download_versions(URL, Versions) :-
1987 wildcard_pattern(URL),
1988 github_url(URL, User, Repo),
1989 !,
1990 findall(Version-VersionURL,
1991 github_version(User, Repo, Version, VersionURL),
1992 Versions).
1993available_download_versions(URL, Versions) :-
1994 wildcard_pattern(URL),
1995 !,
1996 file_directory_name(URL, DirURL0),
1997 ensure_slash(DirURL0, DirURL),
1998 print_message(informational, pack(query_versions(DirURL))),
1999 setup_call_cleanup(
2000 http_open(DirURL, In, []),
2001 load_html(stream(In), DOM,
2002 [ syntax_errors(quiet)
2003 ]),
2004 close(In)),
2005 findall(MatchingURL,
2006 absolute_matching_href(DOM, URL, MatchingURL),
2007 MatchingURLs),
2008 ( MatchingURLs == []
2009 -> print_message(warning, pack(no_matching_urls(URL)))
2010 ; true
2011 ),
2012 versioned_urls(MatchingURLs, VersionedURLs),
2013 keysort(VersionedURLs, SortedVersions),
2014 reverse(SortedVersions, Versions),
2015 print_message(informational, pack(found_versions(Versions))).
2016available_download_versions(URL, [Version-URL]) :-
2017 ( pack_version_file(_Pack, Version0, URL)
2018 -> Version = Version0
2019 ; Version = unknown
2020 ).
2021
2025
2026github_url(URL, User, Repo) :-
2027 uri_components(URL, uri_components(https,'github.com',Path,_,_)),
2028 atomic_list_concat(['',User,Repo|_], /, Path).
2029
2030
2035
2036github_version(User, Repo, Version, VersionURI) :-
2037 atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
2038 uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
2039 setup_call_cleanup(
2040 http_open(ApiUri, In,
2041 [ request_header('Accept'='application/vnd.github.v3+json')
2042 ]),
2043 json_read_dict(In, Dicts),
2044 close(In)),
2045 member(Dict, Dicts),
2046 atom_string(Tag, Dict.name),
2047 tag_version(Tag, Version),
2048 atom_string(VersionURI, Dict.zipball_url).
2049
2050wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
2051wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
2052
2053ensure_slash(Dir, DirS) :-
2054 ( sub_atom(Dir, _, _, 0, /)
2055 -> DirS = Dir
2056 ; atom_concat(Dir, /, DirS)
2057 ).
2058
2059absolute_matching_href(DOM, Pattern, Match) :-
2060 xpath(DOM, //a(@href), HREF),
2061 uri_normalized(HREF, Pattern, Match),
2062 wildcard_match(Pattern, Match).
2063
2064versioned_urls([], []).
2065versioned_urls([H|T0], List) :-
2066 file_base_name(H, File),
2067 ( pack_version_file(_Pack, Version, File)
2068 -> List = [Version-H|T]
2069 ; List = T
2070 ),
2071 versioned_urls(T0, T).
2072
2073
2074 2077
2081
2082update_dependency_db :-
2083 retractall(pack_requires(_,_)),
2084 retractall(pack_provides_db(_,_)),
2085 forall(current_pack(Pack),
2086 ( findall(Info, pack_info(Pack, dependency, Info), Infos),
2087 update_dependency_db(Pack, Infos)
2088 )).
2089
2090update_dependency_db(Name, Info) :-
2091 retractall(pack_requires(Name, _)),
2092 retractall(pack_provides_db(Name, _)),
2093 maplist(assert_dep(Name), Info).
2094
2095assert_dep(Pack, provides(Token)) :-
2096 !,
2097 assertz(pack_provides_db(Pack, Token)).
2098assert_dep(Pack, requires(Token)) :-
2099 !,
2100 assertz(pack_requires(Pack, Token)).
2101assert_dep(_, _).
2102
2106
2107validate_dependencies :-
2108 unsatisfied_dependencies(Unsatisfied),
2109 !,
2110 print_message(warning, pack(unsatisfied(Unsatisfied))).
2111validate_dependencies.
2112
2113
2114unsatisfied_dependencies(Unsatisfied) :-
2115 findall(Req-Pack, pack_requires(Pack, Req), Reqs0),
2116 keysort(Reqs0, Reqs1),
2117 group_pairs_by_key(Reqs1, GroupedReqs),
2118 exclude(satisfied_dependency, GroupedReqs, Unsatisfied),
2119 Unsatisfied \== [].
2120
2121satisfied_dependency(Needed-_By) :-
2122 pack_provides(_, Needed),
2123 !.
2124satisfied_dependency(Needed-_By) :-
2125 compound(Needed),
2126 Needed =.. [Op, Pack, ReqVersion],
2127 ( pack_provides(Pack, Pack)
2128 -> pack_info(Pack, _, version(PackVersion)),
2129 version_data(PackVersion, PackData)
2130 ; Pack == prolog
2131 -> current_prolog_flag(version_data, swi(Major,Minor,Patch,_)),
2132 PackData = [Major,Minor,Patch]
2133 ),
2134 version_data(ReqVersion, ReqData),
2135 cmp(Op, Cmp),
2136 call(Cmp, PackData, ReqData).
2137
2141
2142pack_provides(Pack, Pack) :-
2143 current_pack(Pack).
2144pack_provides(Pack, Token) :-
2145 pack_provides_db(Pack, Token).
2146
2150
2151pack_depends_on(Pack, Dependency) :-
2152 ( atom(Pack)
2153 -> pack_depends_on_fwd(Pack, Dependency, [Pack])
2154 ; pack_depends_on_bwd(Pack, Dependency, [Dependency])
2155 ).
2156
2157pack_depends_on_fwd(Pack, Dependency, Visited) :-
2158 pack_depends_on_1(Pack, Dep1),
2159 \+ memberchk(Dep1, Visited),
2160 ( Dependency = Dep1
2161 ; pack_depends_on_fwd(Dep1, Dependency, [Dep1|Visited])
2162 ).
2163
2164pack_depends_on_bwd(Pack, Dependency, Visited) :-
2165 pack_depends_on_1(Dep1, Dependency),
2166 \+ memberchk(Dep1, Visited),
2167 ( Pack = Dep1
2168 ; pack_depends_on_bwd(Pack, Dep1, [Dep1|Visited])
2169 ).
2170
2171pack_depends_on_1(Pack, Dependency) :-
2172 atom(Dependency),
2173 !,
2174 pack_provides(Dependency, Token),
2175 pack_requires(Pack, Token).
2176pack_depends_on_1(Pack, Dependency) :-
2177 pack_requires(Pack, Token),
2178 pack_provides(Dependency, Token).
2179
2180
2194
2195resolve_dependencies(Dependencies, Resolution) :-
2196 maplist(dependency_pair, Dependencies, Pairs0),
2197 keysort(Pairs0, Pairs1),
2198 group_pairs_by_key(Pairs1, ByToken),
2199 maplist(resolve_dep, ByToken, Resolution).
2200
2201dependency_pair(dependency(Token, Pack, Version, URLs, SubDeps),
2202 Token-(Pack-pack(Version,URLs, SubDeps))).
2203
2204resolve_dep(Token-Pairs, Token-Resolution) :-
2205 ( resolve_dep2(Token-Pairs, Resolution)
2206 *-> true
2207 ; Resolution = unresolved
2208 ).
2209
2210resolve_dep2(Token-_, resolved(Pack)) :-
2211 pack_provides(Pack, Token).
2212resolve_dep2(_-Pairs, resolve(Pack, VersionAtom, URLs, SubResolves)) :-
2213 keysort(Pairs, Sorted),
2214 group_pairs_by_key(Sorted, ByPack),
2215 member(Pack-Versions, ByPack),
2216 Pack \== (-),
2217 maplist(version_pack, Versions, VersionData),
2218 sort(VersionData, ByVersion),
2219 reverse(ByVersion, ByVersionLatest),
2220 member(pack(Version,URLs,SubDeps), ByVersionLatest),
2221 atom_version(VersionAtom, Version),
2222 include(dependency, SubDeps, Deps),
2223 resolve_dependencies(Deps, SubResolves).
2224
2225version_pack(pack(VersionAtom,URLs,SubDeps),
2226 pack(Version,URLs,SubDeps)) :-
2227 atom_version(VersionAtom, Version).
2228
2229
2230 2233
2248
2249run_process(Executable, Argv, Options) :-
2250 \+ option(output(_), Options),
2251 \+ option(error(_), Options),
2252 current_prolog_flag(unix, true),
2253 current_prolog_flag(threads, true),
2254 !,
2255 process_create_options(Options, Extra),
2256 process_create(Executable, Argv,
2257 [ stdout(pipe(Out)),
2258 stderr(pipe(Error)),
2259 process(PID)
2260 | Extra
2261 ]),
2262 thread_create(relay_output([output-Out, error-Error]), Id, []),
2263 process_wait(PID, Status),
2264 thread_join(Id, _),
2265 ( Status == exit(0)
2266 -> true
2267 ; throw(error(process_error(process(Executable, Argv), Status), _))
2268 ).
2269run_process(Executable, Argv, Options) :-
2270 process_create_options(Options, Extra),
2271 setup_call_cleanup(
2272 process_create(Executable, Argv,
2273 [ stdout(pipe(Out)),
2274 stderr(pipe(Error)),
2275 process(PID)
2276 | Extra
2277 ]),
2278 ( read_stream_to_codes(Out, OutCodes, []),
2279 read_stream_to_codes(Error, ErrorCodes, []),
2280 process_wait(PID, Status)
2281 ),
2282 ( close(Out),
2283 close(Error)
2284 )),
2285 print_error(ErrorCodes, Options),
2286 print_output(OutCodes, Options),
2287 ( Status == exit(0)
2288 -> true
2289 ; throw(error(process_error(process(Executable, Argv), Status), _))
2290 ).
2291
2292process_create_options(Options, Extra) :-
2293 option(directory(Dir), Options, .),
2294 ( option(env(Env), Options)
2295 -> Extra = [cwd(Dir), env(Env)]
2296 ; Extra = [cwd(Dir)]
2297 ).
2298
2299relay_output([]) :- !.
2300relay_output(Output) :-
2301 pairs_values(Output, Streams),
2302 wait_for_input(Streams, Ready, infinite),
2303 relay(Ready, Output, NewOutputs),
2304 relay_output(NewOutputs).
2305
2306relay([], Outputs, Outputs).
2307relay([H|T], Outputs0, Outputs) :-
2308 selectchk(Type-H, Outputs0, Outputs1),
2309 ( at_end_of_stream(H)
2310 -> close(H),
2311 relay(T, Outputs1, Outputs)
2312 ; read_pending_codes(H, Codes, []),
2313 relay(Type, Codes),
2314 relay(T, Outputs0, Outputs)
2315 ).
2316
2317relay(error, Codes) :-
2318 set_prolog_flag(message_context, []),
2319 print_error(Codes, []).
2320relay(output, Codes) :-
2321 print_output(Codes, []).
2322
2323print_output(OutCodes, Options) :-
2324 option(output(Codes), Options),
2325 !,
2326 Codes = OutCodes.
2327print_output(OutCodes, _) :-
2328 print_message(informational, pack(process_output(OutCodes))).
2329
2330print_error(OutCodes, Options) :-
2331 option(error(Codes), Options),
2332 !,
2333 Codes = OutCodes.
2334print_error(OutCodes, _) :-
2335 phrase(classify_message(Level), OutCodes, _),
2336 print_message(Level, pack(process_output(OutCodes))).
2337
2338classify_message(error) -->
2339 string(_), "fatal:",
2340 !.
2341classify_message(error) -->
2342 string(_), "error:",
2343 !.
2344classify_message(warning) -->
2345 string(_), "warning:",
2346 !.
2347classify_message(informational) -->
2348 [].
2349
2350string([]) --> [].
2351string([H|T]) --> [H], string(T).
2352
2353
2373
2374pack_attach(Dir, Options) :-
2375 '$pack_attach'(Dir, Options).
2376
2377
2378 2381
2382:- multifile prolog:message//1. 2383
2385
(_Question, _Alternatives, Default, Selection, Options) :-
2387 option(interactive(false), Options),
2388 !,
2389 Selection = Default.
2390menu(Question, Alternatives, Default, Selection, _) :-
2391 length(Alternatives, N),
2392 between(1, 5, _),
2393 print_message(query, Question),
2394 print_menu(Alternatives, Default, 1),
2395 print_message(query, pack(menu(select))),
2396 read_selection(N, Choice),
2397 !,
2398 ( Choice == default
2399 -> Selection = Default
2400 ; nth1(Choice, Alternatives, Selection=_)
2401 -> true
2402 ).
2403
([], _, _).
2405print_menu([Value=Label|T], Default, I) :-
2406 ( Value == Default
2407 -> print_message(query, pack(menu(default_item(I, Label))))
2408 ; print_message(query, pack(menu(item(I, Label))))
2409 ),
2410 I2 is I + 1,
2411 print_menu(T, Default, I2).
2412
2413read_selection(Max, Choice) :-
2414 get_single_char(Code),
2415 ( answered_default(Code)
2416 -> Choice = default
2417 ; code_type(Code, digit(Choice)),
2418 between(1, Max, Choice)
2419 -> true
2420 ; print_message(warning, pack(menu(reply(1,Max)))),
2421 fail
2422 ).
2423
2429
2430confirm(_Question, Default, Options) :-
2431 Default \== none,
2432 option(interactive(false), Options, true),
2433 !,
2434 Default == yes.
2435confirm(Question, Default, _) :-
2436 between(1, 5, _),
2437 print_message(query, pack(confirm(Question, Default))),
2438 read_yes_no(YesNo, Default),
2439 !,
2440 format(user_error, '~N', []),
2441 YesNo == yes.
2442
2443read_yes_no(YesNo, Default) :-
2444 get_single_char(Code),
2445 code_yes_no(Code, Default, YesNo),
2446 !.
2447
2448code_yes_no(0'y, _, yes).
2449code_yes_no(0'Y, _, yes).
2450code_yes_no(0'n, _, no).
2451code_yes_no(0'N, _, no).
2452code_yes_no(_, none, _) :- !, fail.
2453code_yes_no(C, Default, Default) :-
2454 answered_default(C).
2455
2456answered_default(0'\r).
2457answered_default(0'\n).
2458answered_default(0'\s).
2459
2460
2461 2464
2465:- multifile prolog:message//1. 2466
2467prolog:message(pack(Message)) -->
2468 message(Message).
2469
2470:- discontiguous
2471 message//1,
2472 label//1. 2473
2474message(invalid_info(Term)) -->
2475 [ 'Invalid package description: ~q'-[Term] ].
2476message(directory_exists(Dir)) -->
2477 [ 'Package target directory exists and is not empty:', nl,
2478 '\t~q'-[Dir]
2479 ].
2480message(already_installed(pack(Pack, Version))) -->
2481 { atom_version(AVersion, Version) },
2482 [ 'Pack `~w'' is already installed @~w'-[Pack, AVersion] ].
2483message(already_installed(Pack)) -->
2484 [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
2485message(invalid_name(File)) -->
2486 [ '~w: A package archive must be named <pack>-<version>.<ext>'-[File] ],
2487 no_tar_gz(File).
2488
2489no_tar_gz(File) -->
2490 { sub_atom(File, _, _, 0, '.tar.gz') },
2491 !,
2492 [ nl,
2493 'Package archive files must have a single extension. E.g., \'.tgz\''-[]
2494 ].
2495no_tar_gz(_) --> [].
2496
2497message(kept_foreign(Pack)) -->
2498 [ 'Found foreign libraries for target platform.'-[], nl,
2499 'Use ?- pack_rebuild(~q). to rebuild from sources'-[Pack]
2500 ].
2501message(no_pack_installed(Pack)) -->
2502 [ 'No pack ~q installed. Use ?- pack_list(Pattern) to search'-[Pack] ].
2503message(no_packages_installed) -->
2504 { setting(server, ServerBase) },
2505 [ 'There are no extra packages installed.', nl,
2506 'Please visit ~wlist.'-[ServerBase]
2507 ].
2508message(remove_with(Pack)) -->
2509 [ 'The package can be removed using: ?- ~q.'-[pack_remove(Pack)]
2510 ].
2511message(unsatisfied(Packs)) -->
2512 [ 'The following dependencies are not satisfied:', nl ],
2513 unsatisfied(Packs).
2514message(depends(Pack, Deps)) -->
2515 [ 'The following packages depend on `~w\':'-[Pack], nl ],
2516 pack_list(Deps).
2517message(remove(PackDir)) -->
2518 [ 'Removing ~q and contents'-[PackDir] ].
2519message(remove_existing_pack(PackDir)) -->
2520 [ 'Remove old installation in ~q'-[PackDir] ].
2521message(install_from(Pack, Version, git(URL))) -->
2522 [ 'Install ~w@~w from GIT at ~w'-[Pack, Version, URL] ].
2523message(install_from(Pack, Version, URL)) -->
2524 [ 'Install ~w@~w from ~w'-[Pack, Version, URL] ].
2525message(select_install_from(Pack, Version)) -->
2526 [ 'Select download location for ~w@~w'-[Pack, Version] ].
2527message(install_downloaded(File)) -->
2528 { file_base_name(File, Base),
2529 size_file(File, Size) },
2530 [ 'Install "~w" (~D bytes)'-[Base, Size] ].
2531message(git_post_install(PackDir, Pack)) -->
2532 ( { is_foreign_pack(PackDir) }
2533 -> [ 'Run post installation scripts for pack "~w"'-[Pack] ]
2534 ; [ 'Activate pack "~w"'-[Pack] ]
2535 ).
2536message(no_meta_data(BaseDir)) -->
2537 [ 'Cannot find pack.pl inside directory ~q. Not a package?'-[BaseDir] ].
2538message(inquiry(Server)) -->
2539 [ 'Verify package status (anonymously)', nl,
2540 '\tat "~w"'-[Server]
2541 ].
2542message(search_no_matches(Name)) -->
2543 [ 'Search for "~w", returned no matching packages'-[Name] ].
2544message(rebuild(Pack)) -->
2545 [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
2546message(upgrade(Pack, From, To)) -->
2547 [ 'Upgrade "~w" from '-[Pack] ],
2548 msg_version(From), [' to '-[]], msg_version(To).
2549message(up_to_date(Pack)) -->
2550 [ 'Package "~w" is up-to-date'-[Pack] ].
2551message(query_versions(URL)) -->
2552 [ 'Querying "~w" to find new versions ...'-[URL] ].
2553message(no_matching_urls(URL)) -->
2554 [ 'Could not find any matching URL: ~q'-[URL] ].
2555message(found_versions([Latest-_URL|More])) -->
2556 { length(More, Len),
2557 atom_version(VLatest, Latest)
2558 },
2559 [ ' Latest version: ~w (~D older)'-[VLatest, Len] ].
2560message(process_output(Codes)) -->
2561 { split_lines(Codes, Lines) },
2562 process_lines(Lines).
2563message(contacting_server(Server)) -->
2564 [ 'Contacting server at ~w ...'-[Server], flush ].
2565message(server_reply(true(_))) -->
2566 [ at_same_line, ' ok'-[] ].
2567message(server_reply(false)) -->
2568 [ at_same_line, ' done'-[] ].
2569message(server_reply(exception(E))) -->
2570 [ 'Server reported the following error:'-[], nl ],
2571 '$messages':translate_message(E).
2572message(cannot_create_dir(Alias)) -->
2573 { findall(PackDir,
2574 absolute_file_name(Alias, PackDir, [solutions(all)]),
2575 PackDirs0),
2576 sort(PackDirs0, PackDirs)
2577 },
2578 [ 'Cannot find a place to create a package directory.'-[],
2579 'Considered:'-[]
2580 ],
2581 candidate_dirs(PackDirs).
2582message(no_match(Name)) -->
2583 [ 'No registered pack matches "~w"'-[Name] ].
2584message(conflict(version, [PackV, FileV])) -->
2585 ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
2586 [', file claims version '-[]], msg_version(FileV).
2587message(conflict(name, [PackInfo, FileInfo])) -->
2588 ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
2589 [', file claims ~w: ~p'-[FileInfo]].
2590message(no_prolog_response(ContentType, String)) -->
2591 [ 'Expected Prolog response. Got content of type ~p'-[ContentType], nl,
2592 '~s'-[String]
2593 ].
2594message(pack(no_upgrade_info(Pack))) -->
2595 [ '~w: pack meta-data does not provide an upgradable URL'-[Pack] ].
2596
2597candidate_dirs([]) --> [].
2598candidate_dirs([H|T]) --> [ nl, ' ~w'-[H] ], candidate_dirs(T).
2599
2600message(no_mingw) -->
2601 [ 'Cannot find MinGW and/or MSYS.'-[] ].
2602
2603 2604message(resolve_remove) -->
2605 [ nl, 'Please select an action:', nl, nl ].
2606message(create_pack_dir) -->
2607 [ nl, 'Create directory for packages', nl ].
2608message(menu(item(I, Label))) -->
2609 [ '~t(~d)~6| '-[I] ],
2610 label(Label).
2611message(menu(default_item(I, Label))) -->
2612 [ '~t(~d)~6| * '-[I] ],
2613 label(Label).
2614message(menu(select)) -->
2615 [ nl, 'Your choice? ', flush ].
2616message(confirm(Question, Default)) -->
2617 message(Question),
2618 confirm_default(Default),
2619 [ flush ].
2620message(menu(reply(Min,Max))) -->
2621 ( { Max =:= Min+1 }
2622 -> [ 'Please enter ~w or ~w'-[Min,Max] ]
2623 ; [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
2624 ).
2625
2627
2628message(alt_hashes(URL, _Alts)) -->
2629 { git_url(URL, _)
2630 },
2631 !,
2632 [ 'GIT repository was updated without updating version' ].
2633message(alt_hashes(URL, Alts)) -->
2634 { file_base_name(URL, File)
2635 },
2636 [ 'Found multiple versions of "~w".'-[File], nl,
2637 'This could indicate a compromised or corrupted file', nl
2638 ],
2639 alt_hashes(Alts).
2640message(continue_with_alt_hashes(Count, URL)) -->
2641 [ 'Continue installation from "~w" (downloaded ~D times)'-[URL, Count] ].
2642message(continue_with_modified_hash(_URL)) -->
2643 [ 'Pack may be compromised. Continue anyway'
2644 ].
2645message(modified_hash(_SHA1-URL, _SHA2-[URL])) -->
2646 [ 'Content of ~q has changed.'-[URL]
2647 ].
2648
2649alt_hashes([]) --> [].
2650alt_hashes([H|T]) --> alt_hash(H), ( {T == []} -> [] ; [nl], alt_hashes(T) ).
2651
2652alt_hash(alt_hash(Count, URLs, Hash)) -->
2653 [ '~t~d~8| ~w'-[Count, Hash] ],
2654 alt_urls(URLs).
2655
2656alt_urls([]) --> [].
2657alt_urls([H|T]) -->
2658 [ nl, ' ~w'-[H] ],
2659 alt_urls(T).
2660
2662
2663message(install_dependencies(Resolution)) -->
2664 [ 'Package depends on the following:' ],
2665 msg_res_tokens(Resolution, 1).
2666
2667msg_res_tokens([], _) --> [].
2668msg_res_tokens([H|T], L) --> msg_res_token(H, L), msg_res_tokens(T, L).
2669
2670msg_res_token(Token-unresolved, L) -->
2671 res_indent(L),
2672 [ '"~w" cannot be satisfied'-[Token] ].
2673msg_res_token(Token-resolve(Pack, Version, [URL|_], SubResolves), L) -->
2674 !,
2675 res_indent(L),
2676 [ '"~w", provided by ~w@~w from ~w'-[Token, Pack, Version, URL] ],
2677 { L2 is L+1 },
2678 msg_res_tokens(SubResolves, L2).
2679msg_res_token(Token-resolved(Pack), L) -->
2680 !,
2681 res_indent(L),
2682 [ '"~w", provided by installed pack ~w'-[Token,Pack] ].
2683
2684res_indent(L) -->
2685 { I is L*2 },
2686 [ nl, '~*c'-[I,0'\s] ].
2687
2688message(resolve_deps) -->
2689 [ nl, 'What do you wish to do' ].
2690label(install_deps) -->
2691 [ 'Install proposed dependencies' ].
2692label(install_no_deps) -->
2693 [ 'Only install requested package' ].
2694
2695
2696message(git_fetch(Dir)) -->
2697 [ 'Running "git fetch" in ~q'-[Dir] ].
2698
2700
2701message(inquiry_ok(Reply, File)) -->
2702 { memberchk(downloads(Count), Reply),
2703 memberchk(rating(VoteCount, Rating), Reply),
2704 !,
2705 length(Stars, Rating),
2706 maplist(=(0'*), Stars)
2707 },
2708 [ '"~w" was downloaded ~D times. Package rated ~s (~D votes)'-
2709 [ File, Count, Stars, VoteCount ]
2710 ].
2711message(inquiry_ok(Reply, File)) -->
2712 { memberchk(downloads(Count), Reply)
2713 },
2714 [ '"~w" was downloaded ~D times'-[ File, Count ] ].
2715
2716 2717unsatisfied([]) --> [].
2718unsatisfied([Needed-[By]|T]) -->
2719 [ ' - "~w" is needed by package "~w"'-[Needed, By], nl ],
2720 unsatisfied(T).
2721unsatisfied([Needed-By|T]) -->
2722 [ ' - "~w" is needed by the following packages:'-[Needed], nl ],
2723 pack_list(By),
2724 unsatisfied(T).
2725
2726pack_list([]) --> [].
2727pack_list([H|T]) -->
2728 [ ' - Package "~w"'-[H], nl ],
2729 pack_list(T).
2730
2731process_lines([]) --> [].
2732process_lines([H|T]) -->
2733 [ '~s'-[H] ],
2734 ( {T==[]}
2735 -> []
2736 ; [nl], process_lines(T)
2737 ).
2738
2739split_lines([], []) :- !.
2740split_lines(All, [Line1|More]) :-
2741 append(Line1, [0'\n|Rest], All),
2742 !,
2743 split_lines(Rest, More).
2744split_lines(Line, [Line]).
2745
2746label(remove_only(Pack)) -->
2747 [ 'Only remove package ~w (break dependencies)'-[Pack] ].
2748label(remove_deps(Pack, Deps)) -->
2749 { length(Deps, Count) },
2750 [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
2751label(create_dir(Dir)) -->
2752 [ '~w'-[Dir] ].
2753label(install_from(git(URL))) -->
2754 !,
2755 [ 'GIT repository at ~w'-[URL] ].
2756label(install_from(URL)) -->
2757 [ '~w'-[URL] ].
2758label(cancel) -->
2759 [ 'Cancel' ].
2760
2761confirm_default(yes) -->
2762 [ ' Y/n? ' ].
2763confirm_default(no) -->
2764 [ ' y/N? ' ].
2765confirm_default(none) -->
2766 [ ' y/n? ' ].
2767
2768msg_version(Version) -->
2769 { atom(Version) },
2770 !,
2771 [ '~w'-[Version] ].
2772msg_version(VersionData) -->
2773 !,
2774 { atom_version(Atom, VersionData) },
2775 [ '~w'-[Atom] ]