34
35:- module(prolog_pack,
36 [ pack_list_installed/0,
37 pack_info/1, 38 pack_list/1, 39 pack_search/1, 40 pack_install/1, 41 pack_install/2, 42 pack_upgrade/1, 43 pack_rebuild/1, 44 pack_rebuild/0, 45 pack_remove/1, 46 pack_property/2, 47
48 pack_url_file/2 49 ]). 50:- use_module(library(apply)). 51:- use_module(library(error)). 52:- use_module(library(process)). 53:- use_module(library(option)). 54:- use_module(library(readutil)). 55:- use_module(library(lists)). 56:- use_module(library(filesex)). 57:- use_module(library(xpath)). 58:- use_module(library(settings)). 59:- use_module(library(uri)). 60:- use_module(library(http/http_open)). 61:- use_module(library(http/json)). 62:- use_module(library(http/http_client), []). 63:- if(exists_source(library(archive))). 64:- use_module(library(archive)). 65:- endif. 66
67
82
83:- multifile
84 environment/2. 85
86:- dynamic
87 pack_requires/2, 88 pack_provides_db/2. 89
90
91 94
95:- setting(server, atom, 'http://www.swi-prolog.org/pack/',
96 'Server to exchange pack information'). 97
98
99 102
106
107current_pack(Pack) :-
108 '$pack':pack(Pack, _).
109
117
118pack_list_installed :-
119 findall(Pack, current_pack(Pack), Packages0),
120 Packages0 \== [],
121 !,
122 sort(Packages0, Packages),
123 length(Packages, Count),
124 format('Installed packages (~D):~n~n', [Count]),
125 maplist(pack_info(list), Packages),
126 validate_dependencies.
127pack_list_installed :-
128 print_message(informational, pack(no_packages_installed)).
129
133
134pack_info(Name) :-
135 pack_info(info, Name).
136
137pack_info(Level, Name) :-
138 must_be(atom, Name),
139 findall(Info, pack_info(Name, Level, Info), Infos0),
140 ( Infos0 == []
141 -> print_message(warning, pack(no_pack_installed(Name))),
142 fail
143 ; true
144 ),
145 update_dependency_db(Name, Infos0),
146 findall(Def, pack_default(Level, Infos, Def), Defs),
147 append(Infos0, Defs, Infos1),
148 sort(Infos1, Infos),
149 show_info(Name, Infos, [info(Level)]).
150
151
152show_info(_Name, _Properties, Options) :-
153 option(silent(true), Options),
154 !.
155show_info(Name, Properties, Options) :-
156 option(info(list), Options),
157 !,
158 memberchk(title(Title), Properties),
159 memberchk(version(Version), Properties),
160 format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
161show_info(Name, Properties, _) :-
162 !,
163 print_property_value('Package'-'~w', [Name]),
164 findall(Term, pack_level_info(info, Term, _, _), Terms),
165 maplist(print_property(Properties), Terms).
166
167print_property(_, nl) :-
168 !,
169 format('~n').
170print_property(Properties, Term) :-
171 findall(Term, member(Term, Properties), Terms),
172 Terms \== [],
173 !,
174 pack_level_info(_, Term, LabelFmt, _Def),
175 ( LabelFmt = Label-FmtElem
176 -> true
177 ; Label = LabelFmt,
178 FmtElem = '~w'
179 ),
180 multi_valued(Terms, FmtElem, FmtList, Values),
181 atomic_list_concat(FmtList, ', ', Fmt),
182 print_property_value(Label-Fmt, Values).
183print_property(_, _).
184
185multi_valued([H], LabelFmt, [LabelFmt], Values) :-
186 !,
187 H =.. [_|Values].
188multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
189 H =.. [_|VH],
190 append(VH, MoreValues, Values),
191 multi_valued(T, LabelFmt, LT, MoreValues).
192
193
194pvalue_column(24).
195print_property_value(Prop-Fmt, Values) :-
196 !,
197 pvalue_column(C),
198 atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
199 format(Format, [Prop,C|Values]).
200
201pack_info(Name, Level, Info) :-
202 '$pack':pack(Name, BaseDir),
203 ( Info = directory(BaseDir)
204 ; pack_info_term(BaseDir, Info)
205 ),
206 pack_level_info(Level, Info, _Format, _Default).
207
208:- public pack_level_info/4. 209
210pack_level_info(_, title(_), 'Title', '<no title>').
211pack_level_info(_, version(_), 'Installed version', '<unknown>').
212pack_level_info(info, directory(_), 'Installed in directory', -).
213pack_level_info(info, author(_, _), 'Author'-'~w <~w>', -).
214pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>', -).
215pack_level_info(info, packager(_, _), 'Packager'-'~w <~w>', -).
216pack_level_info(info, home(_), 'Home page', -).
217pack_level_info(info, download(_), 'Download URL', -).
218pack_level_info(_, provides(_), 'Provides', -).
219pack_level_info(_, requires(_), 'Requires', -).
220pack_level_info(_, conflicts(_), 'Conflicts with', -).
221pack_level_info(_, replaces(_), 'Replaces packages', -).
222pack_level_info(info, library(_), 'Provided libraries', -).
223
224pack_default(Level, Infos, Def) :-
225 pack_level_info(Level, ITerm, _Format, Def),
226 Def \== (-),
227 \+ memberchk(ITerm, Infos).
228
232
233pack_info_term(BaseDir, Info) :-
234 directory_file_path(BaseDir, 'pack.pl', InfoFile),
235 catch(
236 setup_call_cleanup(
237 open(InfoFile, read, In),
238 term_in_stream(In, Info),
239 close(In)),
240 error(existence_error(source_sink, InfoFile), _),
241 ( print_message(error, pack(no_meta_data(BaseDir))),
242 fail
243 )).
244pack_info_term(BaseDir, library(Lib)) :-
245 atom_concat(BaseDir, '/prolog/', LibDir),
246 atom_concat(LibDir, '*.pl', Pattern),
247 expand_file_name(Pattern, Files),
248 maplist(atom_concat(LibDir), Plain, Files),
249 convlist(base_name, Plain, Libs),
250 member(Lib, Libs).
251
252base_name(File, Base) :-
253 file_name_extension(Base, pl, File).
254
255term_in_stream(In, Term) :-
256 repeat,
257 read_term(In, Term0, []),
258 ( Term0 == end_of_file
259 -> !, fail
260 ; Term = Term0,
261 valid_info_term(Term0)
262 ).
263
264valid_info_term(Term) :-
265 Term =.. [Name|Args],
266 same_length(Args, Types),
267 Decl =.. [Name|Types],
268 ( pack_info_term(Decl)
269 -> maplist(valid_info_arg, Types, Args)
270 ; print_message(warning, pack(invalid_info(Term))),
271 fail
272 ).
273
274valid_info_arg(Type, Arg) :-
275 must_be(Type, Arg).
276
281
282pack_info_term(name(atom)). 283pack_info_term(title(atom)).
284pack_info_term(keywords(list(atom))).
285pack_info_term(description(list(atom))).
286pack_info_term(version(version)).
287pack_info_term(author(atom, email_or_url)). 288pack_info_term(maintainer(atom, email_or_url)).
289pack_info_term(packager(atom, email_or_url)).
290pack_info_term(home(atom)). 291pack_info_term(download(atom)). 292pack_info_term(provides(atom)). 293pack_info_term(requires(dependency)).
294pack_info_term(conflicts(dependency)). 295pack_info_term(replaces(atom)). 296pack_info_term(autoload(boolean)). 297
298:- multifile
299 error:has_type/2. 300
301error:has_type(version, Version) :-
302 atom(Version),
303 version_data(Version, _Data).
304error:has_type(email_or_url, Address) :-
305 atom(Address),
306 ( sub_atom(Address, _, _, _, @)
307 -> true
308 ; uri_is_global(Address)
309 ).
310error:has_type(dependency, Value) :-
311 is_dependency(Value, _Token, _Version).
312
313version_data(Version, version(Data)) :-
314 atomic_list_concat(Parts, '.', Version),
315 maplist(atom_number, Parts, Data).
316
317is_dependency(Token, Token, *) :-
318 atom(Token).
319is_dependency(Term, Token, VersionCmp) :-
320 Term =.. [Op,Token,Version],
321 cmp(Op, _),
322 version_data(Version, _),
323 VersionCmp =.. [Op,Version].
324
325cmp(<, @<).
326cmp(=<, @=<).
327cmp(==, ==).
328cmp(>=, @>=).
329cmp(>, @>).
330
331
332 335
362
363pack_list(Query) :-
364 pack_search(Query).
365
366pack_search(Query) :-
367 query_pack_server(search(Query), Result, []),
368 ( Result == false
369 -> ( local_search(Query, Packs),
370 Packs \== []
371 -> forall(member(pack(Pack, Stat, Title, Version, _), Packs),
372 format('~w ~w@~w ~28|- ~w~n',
373 [Stat, Pack, Version, Title]))
374 ; print_message(warning, pack(search_no_matches(Query)))
375 )
376 ; Result = true(Hits),
377 local_search(Query, Local),
378 append(Hits, Local, All),
379 sort(All, Sorted),
380 list_hits(Sorted)
381 ).
382
383list_hits([]).
384list_hits([ pack(Pack, i, Title, Version, _),
385 pack(Pack, p, Title, Version, _)
386 | More
387 ]) :-
388 !,
389 format('i ~w@~w ~28|- ~w~n', [Pack, Version, Title]),
390 list_hits(More).
391list_hits([ pack(Pack, i, Title, VersionI, _),
392 pack(Pack, p, _, VersionS, _)
393 | More
394 ]) :-
395 !,
396 version_data(VersionI, VDI),
397 version_data(VersionS, VDS),
398 ( VDI @< VDS
399 -> Tag = ('U')
400 ; Tag = ('A')
401 ),
402 format('~w ~w@~w(~w) ~28|- ~w~n', [Tag, Pack, VersionI, VersionS, Title]),
403 list_hits(More).
404list_hits([ pack(Pack, i, Title, VersionI, _)
405 | More
406 ]) :-
407 !,
408 format('l ~w@~w ~28|- ~w~n', [Pack, VersionI, Title]),
409 list_hits(More).
410list_hits([pack(Pack, Stat, Title, Version, _)|More]) :-
411 format('~w ~w@~w ~28|- ~w~n', [Stat, Pack, Version, Title]),
412 list_hits(More).
413
414
415local_search(Query, Packs) :-
416 findall(Pack, matching_installed_pack(Query, Pack), Packs).
417
418matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
419 current_pack(Pack),
420 findall(Term,
421 ( pack_info(Pack, _, Term),
422 search_info(Term)
423 ), Info),
424 ( sub_atom_icasechk(Pack, _, Query)
425 -> true
426 ; memberchk(title(Title), Info),
427 sub_atom_icasechk(Title, _, Query)
428 ),
429 option(title(Title), Info, '<no title>'),
430 option(version(Version), Info, '<no version>'),
431 option(download(URL), Info, '<no download url>').
432
433search_info(title(_)).
434search_info(version(_)).
435search_info(download(_)).
436
437
438 441
457
458pack_install(Spec) :-
459 pack_default_options(Spec, Pack, [], Options),
460 pack_install(Pack, [pack(Pack)|Options]).
461
466
467pack_default_options(_Spec, Pack, OptsIn, Options) :-
468 option(already_installed(pack(Pack,_Version)), OptsIn),
469 !,
470 Options = OptsIn.
471pack_default_options(_Spec, Pack, OptsIn, Options) :-
472 option(url(URL), OptsIn),
473 !,
474 ( option(git(_), OptsIn)
475 -> Options = OptsIn
476 ; git_url(URL, Pack)
477 -> Options = [git(true)|OptsIn]
478 ; Options = OptsIn
479 ),
480 ( nonvar(Pack)
481 -> true
482 ; option(pack(Pack), Options)
483 -> true
484 ; pack_version_file(Pack, _Version, URL)
485 ).
486pack_default_options(Archive, Pack, _, Options) :- 487 must_be(atom, Archive),
488 expand_file_name(Archive, [File]),
489 exists_file(File),
490 !,
491 pack_version_file(Pack, Version, File),
492 uri_file_name(FileURL, File),
493 Options = [url(FileURL), version(Version)].
494pack_default_options(URL, Pack, _, Options) :-
495 git_url(URL, Pack),
496 !,
497 Options = [git(true), url(URL)].
498pack_default_options(FileURL, Pack, _, Options) :- 499 uri_file_name(FileURL, Dir),
500 exists_directory(Dir),
501 pack_info_term(Dir, name(Pack)),
502 !,
503 ( pack_info_term(Dir, version(Version))
504 -> uri_file_name(DirURL, Dir),
505 Options = [url(DirURL), version(Version)]
506 ; throw(error(existence_error(key, version, Dir),_))
507 ).
508pack_default_options(URL, Pack, _, Options) :- 509 pack_version_file(Pack, Version, URL),
510 download_url(URL),
511 !,
512 available_download_versions(URL, [URLVersion-LatestURL|_]),
513 Options = [url(LatestURL)|VersionOptions],
514 version_options(Version, URLVersion, VersionOptions).
515pack_default_options(Pack, Pack, OptsIn, Options) :- 516 \+ uri_is_global(Pack), 517 query_pack_server(locate(Pack), Reply, OptsIn),
518 ( Reply = true(Results)
519 -> pack_select_candidate(Pack, Results, OptsIn, Options)
520 ; print_message(warning, pack(no_match(Pack))),
521 fail
522 ).
523
524version_options(Version, Version, [version(Version)]) :- !.
525version_options(Version, _, [version(Version)]) :-
526 Version = version(List),
527 maplist(integer, List),
528 !.
529version_options(_, _, []).
530
534
535pack_select_candidate(Pack, [Version-_|_], Options,
536 [already_installed(pack(Pack, Installed))|Options]) :-
537 current_pack(Pack),
538 pack_info(Pack, _, version(InstalledAtom)),
539 atom_version(InstalledAtom, Installed),
540 Installed @>= Version,
541 !.
542pack_select_candidate(Pack, Available, Options, OptsOut) :-
543 option(url(URL), Options),
544 memberchk(_Version-URLs, Available),
545 memberchk(URL, URLs),
546 !,
547 ( git_url(URL, Pack)
548 -> Extra = [git(true)]
549 ; Extra = []
550 ),
551 OptsOut = [url(URL), inquiry(true) | Extra].
552pack_select_candidate(Pack, [Version-[URL]|_], Options,
553 [url(URL), git(true), inquiry(true)]) :-
554 git_url(URL, Pack),
555 !,
556 confirm(install_from(Pack, Version, git(URL)), yes, Options).
557pack_select_candidate(Pack, [Version-[URL]|More], Options,
558 [url(URL), inquiry(true)]) :-
559 ( More == []
560 -> !
561 ; true
562 ),
563 confirm(install_from(Pack, Version, URL), yes, Options),
564 !.
565pack_select_candidate(Pack, [Version-URLs|_], Options,
566 [url(URL), inquiry(true)|Rest]) :-
567 maplist(url_menu_item, URLs, Tagged),
568 append(Tagged, [cancel=cancel], Menu),
569 Menu = [Default=_|_],
570 menu(pack(select_install_from(Pack, Version)),
571 Menu, Default, Choice, Options),
572 ( Choice == cancel
573 -> fail
574 ; Choice = git(URL)
575 -> Rest = [git(true)]
576 ; Choice = URL,
577 Rest = []
578 ).
579
(URL, git(URL)=install_from(git(URL))) :-
581 git_url(URL, _),
582 !.
583url_menu_item(URL, URL=install_from(URL)).
584
585
613
614pack_install(Spec, Options) :-
615 pack_default_options(Spec, Pack, Options, DefOptions),
616 ( option(already_installed(Installed), DefOptions)
617 -> print_message(informational, pack(already_installed(Installed)))
618 ; merge_options(Options, DefOptions, PackOptions),
619 update_dependency_db,
620 pack_install_dir(PackDir, PackOptions),
621 pack_install(Pack, PackDir, PackOptions)
622 ).
623
624pack_install_dir(PackDir, Options) :-
625 option(package_directory(PackDir), Options),
626 !.
627pack_install_dir(PackDir, _Options) :- 628 absolute_file_name(pack(.), PackDir,
629 [ file_type(directory),
630 access(write),
631 file_errors(fail)
632 ]),
633 !.
634pack_install_dir(PackDir, Options) :- 635 pack_create_install_dir(PackDir, Options).
636
637pack_create_install_dir(PackDir, Options) :-
638 findall(Candidate = create_dir(Candidate),
639 ( absolute_file_name(pack(.), Candidate, [solutions(all)]),
640 \+ exists_file(Candidate),
641 \+ exists_directory(Candidate),
642 file_directory_name(Candidate, Super),
643 ( exists_directory(Super)
644 -> access_file(Super, write)
645 ; true
646 )
647 ),
648 Candidates0),
649 list_to_set(Candidates0, Candidates), 650 pack_create_install_dir(Candidates, PackDir, Options).
651
652pack_create_install_dir(Candidates, PackDir, Options) :-
653 Candidates = [Default=_|_],
654 !,
655 append(Candidates, [cancel=cancel], Menu),
656 menu(pack(create_pack_dir), Menu, Default, Selected, Options),
657 Selected \== cancel,
658 ( catch(make_directory_path(Selected), E,
659 (print_message(warning, E), fail))
660 -> PackDir = Selected
661 ; delete(Candidates, PackDir=create_dir(PackDir), Remaining),
662 pack_create_install_dir(Remaining, PackDir, Options)
663 ).
664pack_create_install_dir(_, _, _) :-
665 print_message(error, pack(cannot_create_dir(pack(.)))),
666 fail.
667
668
680
681pack_install(Name, _, Options) :-
682 current_pack(Name),
683 option(upgrade(false), Options, false),
684 print_message(error, pack(already_installed(Name))),
685 pack_info(Name),
686 print_message(information, pack(remove_with(Name))),
687 !,
688 fail.
689pack_install(Name, PackDir, Options) :-
690 option(url(URL), Options),
691 uri_file_name(URL, Source),
692 !,
693 pack_install_from_local(Source, PackDir, Name, Options).
694pack_install(Name, PackDir, Options) :-
695 option(url(URL), Options),
696 uri_components(URL, Components),
697 uri_data(scheme, Components, Scheme),
698 pack_install_from_url(Scheme, URL, PackDir, Name, Options).
699
706
707pack_install_from_local(Source, PackTopDir, Name, Options) :-
708 exists_directory(Source),
709 !,
710 directory_file_path(PackTopDir, Name, PackDir),
711 prepare_pack_dir(PackDir, Options),
712 copy_directory(Source, PackDir),
713 pack_post_install(Name, PackDir, Options).
714pack_install_from_local(Source, PackTopDir, Name, Options) :-
715 exists_file(Source),
716 directory_file_path(PackTopDir, Name, PackDir),
717 prepare_pack_dir(PackDir, Options),
718 pack_unpack(Source, PackDir, Name, Options),
719 pack_post_install(Name, PackDir, Options).
720
721
725
726:- if(current_predicate(archive_extract/3)). 727pack_unpack(Source, PackDir, Pack, Options) :-
728 pack_archive_info(Source, Pack, _Info, StripOptions),
729 prepare_pack_dir(PackDir, Options),
730 archive_extract(Source, PackDir,
731 [ exclude(['._*']) 732 | StripOptions
733 ]).
734:- else. 735pack_unpack(_,_,_,_) :-
736 existence_error(library, archive).
737:- endif. 738
739 742
752
753:- if(current_predicate(archive_open/3)). 754pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
755 size_file(Archive, Bytes),
756 setup_call_cleanup(
757 archive_open(Archive, Handle, []),
758 ( repeat,
759 ( archive_next_header(Handle, InfoFile)
760 -> true
761 ; !, fail
762 )
763 ),
764 archive_close(Handle)),
765 file_base_name(InfoFile, 'pack.pl'),
766 atom_concat(Prefix, 'pack.pl', InfoFile),
767 strip_option(Prefix, Pack, Strip),
768 setup_call_cleanup(
769 archive_open_entry(Handle, Stream),
770 read_stream_to_terms(Stream, Info),
771 close(Stream)),
772 !,
773 must_be(ground, Info),
774 maplist(valid_info_term, Info).
775:- else. 776pack_archive_info(_, _, _, _) :-
777 existence_error(library, archive).
778:- endif. 779pack_archive_info(_, _, _, _) :-
780 existence_error(pack_file, 'pack.pl').
781
782strip_option('', _, []) :- !.
783strip_option('./', _, []) :- !.
784strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
785 atom_concat(PrefixDir, /, Prefix),
786 file_base_name(PrefixDir, Base),
787 ( Base == Pack
788 -> true
789 ; pack_version_file(Pack, _, Base)
790 -> true
791 ; \+ sub_atom(PrefixDir, _, _, _, /)
792 ).
793
794read_stream_to_terms(Stream, Terms) :-
795 read(Stream, Term0),
796 read_stream_to_terms(Term0, Stream, Terms).
797
798read_stream_to_terms(end_of_file, _, []) :- !.
799read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
800 read(Stream, Term1),
801 read_stream_to_terms(Term1, Stream, Terms).
802
803
808
809pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
810 exists_directory(GitDir),
811 !,
812 git_ls_tree(Entries, [directory(GitDir)]),
813 git_hash(Hash, [directory(GitDir)]),
814 maplist(arg(4), Entries, Sizes),
815 sum_list(Sizes, Bytes),
816 directory_file_path(GitDir, 'pack.pl', InfoFile),
817 read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
818 must_be(ground, Info),
819 maplist(valid_info_term, Info).
820
824
825download_file_sanity_check(Archive, Pack, Info) :-
826 info_field(name(Name), Info),
827 info_field(version(VersionAtom), Info),
828 atom_version(VersionAtom, Version),
829 pack_version_file(PackA, VersionA, Archive),
830 must_match([Pack, PackA, Name], name),
831 must_match([Version, VersionA], version).
832
833info_field(Field, Info) :-
834 memberchk(Field, Info),
835 ground(Field),
836 !.
837info_field(Field, _Info) :-
838 functor(Field, FieldName, _),
839 print_message(error, pack(missing(FieldName))),
840 fail.
841
842must_match(Values, _Field) :-
843 sort(Values, [_]),
844 !.
845must_match(Values, Field) :-
846 print_message(error, pack(conflict(Field, Values))),
847 fail.
848
849
850 853
859
860prepare_pack_dir(Dir, Options) :-
861 exists_directory(Dir),
862 !,
863 ( empty_directory(Dir)
864 -> true
865 ; option(upgrade(true), Options)
866 -> delete_directory_contents(Dir)
867 ; confirm(remove_existing_pack(Dir), yes, Options),
868 delete_directory_contents(Dir)
869 ).
870prepare_pack_dir(Dir, _) :-
871 make_directory(Dir).
872
876
877empty_directory(Dir) :-
878 \+ ( directory_files(Dir, Entries),
879 member(Entry, Entries),
880 \+ special(Entry)
881 ).
882
883special(.).
884special(..).
885
886
893
894pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
895 option(git(true), Options),
896 !,
897 directory_file_path(PackTopDir, Pack, PackDir),
898 prepare_pack_dir(PackDir, Options),
899 run_process(path(git), [clone, URL, PackDir], []),
900 pack_git_info(PackDir, Hash, Info),
901 pack_inquiry(URL, git(Hash), Info, Options),
902 show_info(Pack, Info, Options),
903 confirm(git_post_install(PackDir, Pack), yes, Options),
904 pack_post_install(Pack, PackDir, Options).
905pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
906 download_scheme(Scheme),
907 directory_file_path(PackTopDir, Pack, PackDir),
908 prepare_pack_dir(PackDir, Options),
909 pack_download_dir(PackTopDir, DownLoadDir),
910 download_file(URL, Pack, DownloadBase, Options),
911 directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
912 setup_call_cleanup(
913 http_open(URL, In,
914 [ cert_verify_hook(ssl_verify)
915 ]),
916 setup_call_cleanup(
917 open(DownloadFile, write, Out, [type(binary)]),
918 copy_stream_data(In, Out),
919 close(Out)),
920 close(In)),
921 pack_archive_info(DownloadFile, Pack, Info, _),
922 download_file_sanity_check(DownloadFile, Pack, Info),
923 pack_inquiry(URL, DownloadFile, Info, Options),
924 show_info(Pack, Info, Options),
925 confirm(install_downloaded(DownloadFile), yes, Options),
926 pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).
927
929
930download_file(URL, Pack, File, Options) :-
931 option(version(Version), Options),
932 !,
933 atom_version(VersionA, Version),
934 file_name_extension(_, Ext, URL),
935 format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
936download_file(URL, Pack, File, _) :-
937 file_base_name(URL,Basename),
938 no_int_file_name_extension(Tag,Ext,Basename),
939 tag_version(Tag,Version),
940 !,
941 atom_version(VersionA,Version),
942 format(atom(File0), '~w-~w', [Pack, VersionA]),
943 file_name_extension(File0, Ext, File).
944download_file(URL, _, File, _) :-
945 file_base_name(URL, File).
946
952
953pack_url_file(URL, FileID) :-
954 github_release_url(URL, Pack, Version),
955 !,
956 download_file(URL, Pack, FileID, [version(Version)]).
957pack_url_file(URL, FileID) :-
958 file_base_name(URL, FileID).
959
960
961:- public ssl_verify/5. 962
968
969ssl_verify(_SSL,
970 _ProblemCertificate, _AllCertificates, _FirstCertificate,
971 _Error).
972
973pack_download_dir(PackTopDir, DownLoadDir) :-
974 directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
975 ( exists_directory(DownLoadDir)
976 -> true
977 ; make_directory(DownLoadDir)
978 ),
979 ( access_file(DownLoadDir, write)
980 -> true
981 ; permission_error(write, directory, DownLoadDir)
982 ).
983
987
988download_url(URL) :-
989 atom(URL),
990 uri_components(URL, Components),
991 uri_data(scheme, Components, Scheme),
992 download_scheme(Scheme).
993
994download_scheme(http).
995download_scheme(https) :-
996 catch(use_module(library(http/http_ssl_plugin)),
997 E, (print_message(warning, E), fail)).
998
1006
1007pack_post_install(Pack, PackDir, Options) :-
1008 post_install_foreign(Pack, PackDir,
1009 [ build_foreign(if_absent)
1010 | Options
1011 ]),
1012 post_install_autoload(PackDir, Options),
1013 '$pack_attach'(PackDir).
1014
1018
1019pack_rebuild(Pack) :-
1020 '$pack':pack(Pack, BaseDir),
1021 !,
1022 catch(pack_make(BaseDir, [distclean], []), E,
1023 print_message(warning, E)),
1024 post_install_foreign(Pack, BaseDir, []).
1025pack_rebuild(Pack) :-
1026 existence_error(pack, Pack).
1027
1031
1032pack_rebuild :-
1033 forall(current_pack(Pack),
1034 ( print_message(informational, pack(rebuild(Pack))),
1035 pack_rebuild(Pack)
1036 )).
1037
1038
1042
1043post_install_foreign(Pack, PackDir, Options) :-
1044 is_foreign_pack(PackDir),
1045 !,
1046 ( option(build_foreign(if_absent), Options),
1047 foreign_present(PackDir)
1048 -> print_message(informational, pack(kept_foreign(Pack)))
1049 ; setup_path,
1050 save_build_environment(PackDir),
1051 configure_foreign(PackDir, Options),
1052 make_foreign(PackDir, Options)
1053 ).
1054post_install_foreign(_, _, _).
1055
1056foreign_present(PackDir) :-
1057 current_prolog_flag(arch, Arch),
1058 atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
1059 exists_directory(ForeignBaseDir),
1060 !,
1061 atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
1062 exists_directory(ForeignDir),
1063 current_prolog_flag(shared_object_extension, Ext),
1064 atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
1065 expand_file_name(Pattern, Files),
1066 Files \== [].
1067
1068is_foreign_pack(PackDir) :-
1069 foreign_file(File),
1070 directory_file_path(PackDir, File, Path),
1071 exists_file(Path),
1072 !.
1073
1074foreign_file('configure.in').
1075foreign_file('configure.ac').
1076foreign_file('configure').
1077foreign_file('Makefile').
1078foreign_file('makefile').
1079
1080
1085
1086configure_foreign(PackDir, Options) :-
1087 make_configure(PackDir, Options),
1088 directory_file_path(PackDir, configure, Configure),
1089 exists_file(Configure),
1090 !,
1091 build_environment(BuildEnv),
1092 run_process(path(bash), [Configure],
1093 [ env(BuildEnv),
1094 directory(PackDir)
1095 ]).
1096configure_foreign(_, _).
1097
1098make_configure(PackDir, _Options) :-
1099 directory_file_path(PackDir, 'configure', Configure),
1100 exists_file(Configure),
1101 !.
1102make_configure(PackDir, _Options) :-
1103 autoconf_master(ConfigMaster),
1104 directory_file_path(PackDir, ConfigMaster, ConfigureIn),
1105 exists_file(ConfigureIn),
1106 !,
1107 run_process(path(autoheader), [], [directory(PackDir)]),
1108 run_process(path(autoconf), [], [directory(PackDir)]).
1109make_configure(_, _).
1110
1111autoconf_master('configure.ac').
1112autoconf_master('configure.in').
1113
1114
1118
1119make_foreign(PackDir, Options) :-
1120 pack_make(PackDir, [all, check, install], Options).
1121
1122pack_make(PackDir, Targets, _Options) :-
1123 directory_file_path(PackDir, 'Makefile', Makefile),
1124 exists_file(Makefile),
1125 !,
1126 build_environment(BuildEnv),
1127 ProcessOptions = [ directory(PackDir), env(BuildEnv) ],
1128 forall(member(Target, Targets),
1129 run_process(path(make), [Target], ProcessOptions)).
1130pack_make(_, _, _).
1131
1136
1137save_build_environment(PackDir) :-
1138 directory_file_path(PackDir, 'buildenv.sh', EnvFile),
1139 build_environment(Env),
1140 setup_call_cleanup(
1141 open(EnvFile, write, Out),
1142 write_env_script(Out, Env),
1143 close(Out)).
1144
1145write_env_script(Out, Env) :-
1146 format(Out,
1147 '# This file contains the environment that can be used to\n\c
1148 # build the foreign pack outside Prolog. This file must\n\c
1149 # be loaded into a bourne-compatible shell using\n\c
1150 #\n\c
1151 # $ source buildenv.sh\n\n',
1152 []),
1153 forall(member(Var=Value, Env),
1154 format(Out, '~w=\'~w\'\n', [Var, Value])),
1155 format(Out, '\nexport ', []),
1156 forall(member(Var=_, Env),
1157 format(Out, ' ~w', [Var])),
1158 format(Out, '\n', []).
1159
1160build_environment(Env) :-
1161 findall(Name=Value, environment(Name, Value), UserEnv),
1162 findall(Name=Value,
1163 ( def_environment(Name, Value),
1164 \+ memberchk(Name=_, UserEnv)
1165 ),
1166 DefEnv),
1167 append(UserEnv, DefEnv, Env).
1168
1169
1187
1188
1193
1194def_environment('PATH', Value) :-
1195 getenv('PATH', PATH),
1196 current_prolog_flag(executable, Exe),
1197 file_directory_name(Exe, ExeDir),
1198 prolog_to_os_filename(ExeDir, OsExeDir),
1199 ( current_prolog_flag(windows, true)
1200 -> Sep = (;)
1201 ; Sep = (:)
1202 ),
1203 atomic_list_concat([OsExeDir, Sep, PATH], Value).
1204def_environment('SWIPL', Value) :-
1205 current_prolog_flag(executable, Value).
1206def_environment('SWIPLVERSION', Value) :-
1207 current_prolog_flag(version, Value).
1208def_environment('SWIHOME', Value) :-
1209 current_prolog_flag(home, Value).
1210def_environment('SWIARCH', Value) :-
1211 current_prolog_flag(arch, Value).
1212def_environment('PACKSODIR', Value) :-
1213 current_prolog_flag(arch, Arch),
1214 atom_concat('lib/', Arch, Value).
1215def_environment('SWISOLIB', Value) :-
1216 current_prolog_flag(c_libplso, Value).
1217def_environment('SWILIB', '-lswipl').
1218def_environment('CC', Value) :-
1219 ( getenv('CC', value)
1220 -> true
1221 ; current_prolog_flag(c_cc, Value)
1222 ).
1223def_environment('LD', Value) :-
1224 ( getenv('LD', Value)
1225 -> true
1226 ; current_prolog_flag(c_cc, Value)
1227 ).
1228def_environment('CFLAGS', Value) :-
1229 ( getenv('CFLAGS', SystemFlags)
1230 -> Extra = [' ', SystemFlags]
1231 ; Extra = []
1232 ),
1233 current_prolog_flag(c_cflags, Value0),
1234 current_prolog_flag(home, Home),
1235 atomic_list_concat([Value0, ' -I"', Home, '/include"' | Extra], Value).
1236def_environment('LDSOFLAGS', Value) :-
1237 ( getenv('LDFLAGS', SystemFlags)
1238 -> Extra = [' ', SystemFlags|System]
1239 ; Extra = System
1240 ),
1241 ( current_prolog_flag(windows, true)
1242 -> current_prolog_flag(home, Home),
1243 atomic_list_concat([' -L"', Home, '/bin"'], SystemLib),
1244 System = [SystemLib]
1245 ; current_prolog_flag(shared_object_extension, so)
1246 -> System = [] 1247 ; current_prolog_flag(home, Home),
1248 current_prolog_flag(arch, Arch),
1249 atomic_list_concat([' -L"', Home, '/lib/', Arch, '"'], SystemLib),
1250 System = [SystemLib]
1251 ),
1252 current_prolog_flag(c_ldflags, LDFlags),
1253 atomic_list_concat([LDFlags, ' -shared' | Extra], Value).
1254def_environment('SOEXT', Value) :-
1255 current_prolog_flag(shared_object_extension, Value).
1256def_environment(Pass, Value) :-
1257 pass_env(Pass),
1258 getenv(Pass, Value).
1259
1260pass_env('TMP').
1261pass_env('TEMP').
1262pass_env('USER').
1263pass_env('HOME').
1264
1265 1268
1269setup_path :-
1270 has_program(path(make), _),
1271 has_program(path(gcc), _),
1272 !.
1273setup_path :-
1274 current_prolog_flag(windows, true),
1275 !,
1276 ( mingw_extend_path
1277 -> true
1278 ; print_message(error, pack(no_mingw))
1279 ).
1280setup_path.
1281
1282has_program(Program, Path) :-
1283 exe_options(ExeOptions),
1284 absolute_file_name(Program, Path,
1285 [ file_errors(fail)
1286 | ExeOptions
1287 ]).
1288
1289exe_options(Options) :-
1290 current_prolog_flag(windows, true),
1291 !,
1292 Options = [ extensions(['',exe,com]), access(read) ].
1293exe_options(Options) :-
1294 Options = [ access(execute) ].
1295
1296mingw_extend_path :-
1297 mingw_root(MinGW),
1298 directory_file_path(MinGW, bin, MinGWBinDir),
1299 atom_concat(MinGW, '/msys/*/bin', Pattern),
1300 expand_file_name(Pattern, MsysDirs),
1301 last(MsysDirs, MSysBinDir),
1302 prolog_to_os_filename(MinGWBinDir, WinDirMinGW),
1303 prolog_to_os_filename(MSysBinDir, WinDirMSYS),
1304 getenv('PATH', Path0),
1305 atomic_list_concat([WinDirMSYS, WinDirMinGW, Path0], ';', Path),
1306 setenv('PATH', Path).
1307
1308mingw_root(MinGwRoot) :-
1309 current_prolog_flag(executable, Exe),
1310 sub_atom(Exe, 1, _, _, :),
1311 sub_atom(Exe, 0, 1, _, PlDrive),
1312 Drives = [PlDrive,c,d],
1313 member(Drive, Drives),
1314 format(atom(MinGwRoot), '~a:/MinGW', [Drive]),
1315 exists_directory(MinGwRoot),
1316 !.
1317
1318
1319 1322
1326
1327post_install_autoload(PackDir, Options) :-
1328 option(autoload(true), Options, true),
1329 pack_info_term(PackDir, autoload(true)),
1330 !,
1331 directory_file_path(PackDir, prolog, PrologLibDir),
1332 make_library_index(PrologLibDir).
1333post_install_autoload(_, _).
1334
1335
1336 1339
1345
1346pack_upgrade(Pack) :-
1347 pack_info(Pack, _, directory(Dir)),
1348 directory_file_path(Dir, '.git', GitDir),
1349 exists_directory(GitDir),
1350 !,
1351 print_message(informational, pack(git_fetch(Dir))),
1352 git([fetch], [ directory(Dir) ]),
1353 git_describe(V0, [ directory(Dir) ]),
1354 git_describe(V1, [ directory(Dir), commit('origin/master') ]),
1355 ( V0 == V1
1356 -> print_message(informational, pack(up_to_date(Pack)))
1357 ; confirm(upgrade(Pack, V0, V1), yes, []),
1358 git([merge, 'origin/master'], [ directory(Dir) ]),
1359 pack_rebuild(Pack)
1360 ).
1361pack_upgrade(Pack) :-
1362 once(pack_info(Pack, _, version(VersionAtom))),
1363 atom_version(VersionAtom, Version),
1364 pack_info(Pack, _, download(URL)),
1365 ( wildcard_pattern(URL)
1366 -> true
1367 ; github_url(URL, _User, _Repo)
1368 ),
1369 !,
1370 available_download_versions(URL, [Latest-LatestURL|_Versions]),
1371 ( Latest @> Version
1372 -> confirm(upgrade(Pack, Version, Latest), yes, []),
1373 pack_install(Pack,
1374 [ url(LatestURL),
1375 upgrade(true),
1376 pack(Pack)
1377 ])
1378 ; print_message(informational, pack(up_to_date(Pack)))
1379 ).
1380pack_upgrade(Pack) :-
1381 print_message(warning, pack(no_upgrade_info(Pack))).
1382
1383
1384 1387
1391
1392pack_remove(Pack) :-
1393 update_dependency_db,
1394 ( setof(Dep, pack_depends_on(Dep, Pack), Deps)
1395 -> confirm_remove(Pack, Deps, Delete),
1396 forall(member(P, Delete), pack_remove_forced(P))
1397 ; pack_remove_forced(Pack)
1398 ).
1399
1400pack_remove_forced(Pack) :-
1401 '$pack_detach'(Pack, BaseDir),
1402 print_message(informational, pack(remove(BaseDir))),
1403 delete_directory_and_contents(BaseDir).
1404
1405confirm_remove(Pack, Deps, Delete) :-
1406 print_message(warning, pack(depends(Pack, Deps))),
1407 menu(pack(resolve_remove),
1408 [ [Pack] = remove_only(Pack),
1409 [Pack|Deps] = remove_deps(Pack, Deps),
1410 [] = cancel
1411 ], [], Delete, []),
1412 Delete \== [].
1413
1414
1415 1418
1439
1440pack_property(Pack, Property) :-
1441 findall(Pack-Property, pack_property_(Pack, Property), List),
1442 member(Pack-Property, List). 1443
1444pack_property_(Pack, Property) :-
1445 pack_info(Pack, _, Property).
1446pack_property_(Pack, Property) :-
1447 \+ \+ info_file(Property, _),
1448 '$pack':pack(Pack, BaseDir),
1449 access_file(BaseDir, read),
1450 directory_files(BaseDir, Files),
1451 member(File, Files),
1452 info_file(Property, Pattern),
1453 downcase_atom(File, Pattern),
1454 directory_file_path(BaseDir, File, InfoFile),
1455 arg(1, Property, InfoFile).
1456
1457info_file(readme(_), 'readme.txt').
1458info_file(readme(_), 'readme').
1459info_file(todo(_), 'todo.txt').
1460info_file(todo(_), 'todo').
1461
1462
1463 1466
1470
1471git_url(URL, Pack) :-
1472 uri_components(URL, Components),
1473 uri_data(scheme, Components, Scheme),
1474 uri_data(path, Components, Path),
1475 ( Scheme == git
1476 -> true
1477 ; git_download_scheme(Scheme),
1478 file_name_extension(_, git, Path)
1479 ),
1480 file_base_name(Path, PackExt),
1481 ( file_name_extension(Pack, git, PackExt)
1482 -> true
1483 ; Pack = PackExt
1484 ),
1485 ( safe_pack_name(Pack)
1486 -> true
1487 ; domain_error(pack_name, Pack)
1488 ).
1489
1490git_download_scheme(http).
1491git_download_scheme(https).
1492
1497
1498safe_pack_name(Name) :-
1499 atom_length(Name, Len),
1500 Len >= 3, 1501 atom_codes(Name, Codes),
1502 maplist(safe_pack_char, Codes),
1503 !.
1504
1505safe_pack_char(C) :- between(0'a, 0'z, C), !.
1506safe_pack_char(C) :- between(0'A, 0'Z, C), !.
1507safe_pack_char(C) :- between(0'0, 0'9, C), !.
1508safe_pack_char(0'_).
1509
1510
1511 1514
1521
1522pack_version_file(Pack, Version, GitHubRelease) :-
1523 atomic(GitHubRelease),
1524 github_release_url(GitHubRelease, Pack, Version),
1525 !.
1526pack_version_file(Pack, Version, Path) :-
1527 atomic(Path),
1528 file_base_name(Path, File),
1529 no_int_file_name_extension(Base, _Ext, File),
1530 atom_codes(Base, Codes),
1531 ( phrase(pack_version(Pack, Version), Codes),
1532 safe_pack_name(Pack)
1533 -> true
1534 ).
1535
1536no_int_file_name_extension(Base, Ext, File) :-
1537 file_name_extension(Base0, Ext0, File),
1538 \+ atom_number(Ext0, _),
1539 !,
1540 Base = Base0,
1541 Ext = Ext0.
1542no_int_file_name_extension(File, '', File).
1543
1544
1545
1554
1555github_release_url(URL, Pack, Version) :-
1556 uri_components(URL, Components),
1557 uri_data(authority, Components, 'github.com'),
1558 uri_data(scheme, Components, Scheme),
1559 download_scheme(Scheme),
1560 uri_data(path, Components, Path),
1561 atomic_list_concat(['',_Project,Pack,archive,File], /, Path),
1562 file_name_extension(Tag, Ext, File),
1563 github_archive_extension(Ext),
1564 tag_version(Tag, Version),
1565 !.
1566
1567github_archive_extension(tgz).
1568github_archive_extension(zip).
1569
1570tag_version(Tag, Version) :-
1571 version_tag_prefix(Prefix),
1572 atom_concat(Prefix, AtomVersion, Tag),
1573 atom_version(AtomVersion, Version).
1574
1575version_tag_prefix(v).
1576version_tag_prefix('V').
1577version_tag_prefix('').
1578
1579
1580:- public
1581 atom_version/2. 1582
1588
1589atom_version(Atom, version(Parts)) :-
1590 ( atom(Atom)
1591 -> atom_codes(Atom, Codes),
1592 phrase(version(Parts), Codes)
1593 ; atomic_list_concat(Parts, '.', Atom)
1594 ).
1595
1596pack_version(Pack, version(Parts)) -->
1597 string(Codes), "-",
1598 version(Parts),
1599 !,
1600 { atom_codes(Pack, Codes)
1601 }.
1602
1603version([_|T]) -->
1604 "*",
1605 !,
1606 ( "."
1607 -> version(T)
1608 ; []
1609 ).
1610version([H|T]) -->
1611 integer(H),
1612 ( "."
1613 -> version(T)
1614 ; { T = [] }
1615 ).
1616
1617integer(H) --> digit(D0), digits(L), { number_codes(H, [D0|L]) }.
1618digit(D) --> [D], { code_type(D, digit) }.
1619digits([H|T]) --> digit(H), !, digits(T).
1620digits([]) --> [].
1621
1622
1623 1626
1644
1645pack_inquiry(_, _, _, Options) :-
1646 option(inquiry(false), Options),
1647 !.
1648pack_inquiry(URL, DownloadFile, Info, Options) :-
1649 setting(server, ServerBase),
1650 ServerBase \== '',
1651 atom_concat(ServerBase, query, Server),
1652 ( option(inquiry(true), Options)
1653 -> true
1654 ; confirm(inquiry(Server), yes, Options)
1655 ),
1656 !,
1657 ( DownloadFile = git(SHA1)
1658 -> true
1659 ; file_sha1(DownloadFile, SHA1)
1660 ),
1661 query_pack_server(install(URL, SHA1, Info), Reply, Options),
1662 inquiry_result(Reply, URL, Options).
1663pack_inquiry(_, _, _, _).
1664
1665
1670
1671query_pack_server(Query, Result, Options) :-
1672 setting(server, ServerBase),
1673 ServerBase \== '',
1674 atom_concat(ServerBase, query, Server),
1675 format(codes(Data), '~q.~n', Query),
1676 info_level(Informational, Options),
1677 print_message(Informational, pack(contacting_server(Server))),
1678 setup_call_cleanup(
1679 http_open(Server, In,
1680 [ post(codes(application/'x-prolog', Data)),
1681 header(content_type, ContentType)
1682 ]),
1683 read_reply(ContentType, In, Result),
1684 close(In)),
1685 message_severity(Result, Level, Informational),
1686 print_message(Level, pack(server_reply(Result))).
1687
1688read_reply(ContentType, In, Result) :-
1689 sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
1690 !,
1691 set_stream(In, encoding(utf8)),
1692 read(In, Result).
1693read_reply(ContentType, In, _Result) :-
1694 read_string(In, 500, String),
1695 print_message(error, pack(no_prolog_response(ContentType, String))),
1696 fail.
1697
1698info_level(Level, Options) :-
1699 option(silent(true), Options),
1700 !,
1701 Level = silent.
1702info_level(informational, _).
1703
1704message_severity(true(_), Informational, Informational).
1705message_severity(false, warning, _).
1706message_severity(exception(_), error, _).
1707
1708
1713
1714inquiry_result(Reply, File, Options) :-
1715 findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation),
1716 \+ member(cancel, Evaluation),
1717 select_option(git(_), Options, Options1, _),
1718 forall(member(install_dependencies(Resolution), Evaluation),
1719 maplist(install_dependency(Options1), Resolution)).
1720
1721eval_inquiry(true(Reply), URL, Eval, _) :-
1722 include(alt_hash, Reply, Alts),
1723 Alts \== [],
1724 print_message(warning, pack(alt_hashes(URL, Alts))),
1725 ( memberchk(downloads(Count), Reply),
1726 ( git_url(URL, _)
1727 -> Default = yes,
1728 Eval = with_git_commits_in_same_version
1729 ; Default = no,
1730 Eval = with_alt_hashes
1731 ),
1732 confirm(continue_with_alt_hashes(Count, URL), Default, [])
1733 -> true
1734 ; !, 1735 Eval = cancel
1736 ).
1737eval_inquiry(true(Reply), _, Eval, Options) :-
1738 include(dependency, Reply, Deps),
1739 Deps \== [],
1740 select_dependency_resolution(Deps, Eval, Options),
1741 ( Eval == cancel
1742 -> !
1743 ; true
1744 ).
1745eval_inquiry(true(Reply), URL, true, Options) :-
1746 file_base_name(URL, File),
1747 info_level(Informational, Options),
1748 print_message(Informational, pack(inquiry_ok(Reply, File))).
1749eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))),
1750 URL, Eval, Options) :-
1751 ( confirm(continue_with_modified_hash(URL), no, Options)
1752 -> Eval = true
1753 ; Eval = cancel
1754 ).
1755
1756alt_hash(alt_hash(_,_,_)).
1757dependency(dependency(_,_,_,_,_)).
1758
1759
1765
1766select_dependency_resolution(Deps, Eval, Options) :-
1767 resolve_dependencies(Deps, Resolution),
1768 exclude(local_dep, Resolution, ToBeDone),
1769 ( ToBeDone == []
1770 -> !, Eval = true
1771 ; print_message(warning, pack(install_dependencies(Resolution))),
1772 ( memberchk(_-unresolved, Resolution)
1773 -> Default = cancel
1774 ; Default = install_deps
1775 ),
1776 menu(pack(resolve_deps),
1777 [ install_deps = install_deps,
1778 install_no_deps = install_no_deps,
1779 cancel = cancel
1780 ], Default, Choice, Options),
1781 ( Choice == cancel
1782 -> !, Eval = cancel
1783 ; Choice == install_no_deps
1784 -> !, Eval = install_no_deps
1785 ; !, Eval = install_dependencies(Resolution)
1786 )
1787 ).
1788
1789local_dep(_-resolved(_)).
1790
1791
1797
1798install_dependency(Options,
1799 _Token-resolve(Pack, VersionAtom, [_URL|_], SubResolve)) :-
1800 atom_version(VersionAtom, Version),
1801 current_pack(Pack),
1802 pack_info(Pack, _, version(InstalledAtom)),
1803 atom_version(InstalledAtom, Installed),
1804 Installed == Version, 1805 !,
1806 maplist(install_dependency(Options), SubResolve).
1807install_dependency(Options,
1808 _Token-resolve(Pack, VersionAtom, [URL|_], SubResolve)) :-
1809 !,
1810 atom_version(VersionAtom, Version),
1811 merge_options([ url(URL),
1812 version(Version),
1813 interactive(false),
1814 inquiry(false),
1815 info(list),
1816 pack(Pack)
1817 ], Options, InstallOptions),
1818 pack_install(Pack, InstallOptions),
1819 maplist(install_dependency(Options), SubResolve).
1820install_dependency(_, _-_).
1821
1822
1823 1826
1833
1834available_download_versions(URL, Versions) :-
1835 wildcard_pattern(URL),
1836 github_url(URL, User, Repo),
1837 !,
1838 findall(Version-VersionURL,
1839 github_version(User, Repo, Version, VersionURL),
1840 Versions).
1841available_download_versions(URL, Versions) :-
1842 wildcard_pattern(URL),
1843 !,
1844 file_directory_name(URL, DirURL0),
1845 ensure_slash(DirURL0, DirURL),
1846 print_message(informational, pack(query_versions(DirURL))),
1847 setup_call_cleanup(
1848 http_open(DirURL, In, []),
1849 load_html(stream(In), DOM,
1850 [ syntax_errors(quiet)
1851 ]),
1852 close(In)),
1853 findall(MatchingURL,
1854 absolute_matching_href(DOM, URL, MatchingURL),
1855 MatchingURLs),
1856 ( MatchingURLs == []
1857 -> print_message(warning, pack(no_matching_urls(URL)))
1858 ; true
1859 ),
1860 versioned_urls(MatchingURLs, VersionedURLs),
1861 keysort(VersionedURLs, SortedVersions),
1862 reverse(SortedVersions, Versions),
1863 print_message(informational, pack(found_versions(Versions))).
1864available_download_versions(URL, [Version-URL]) :-
1865 ( pack_version_file(_Pack, Version0, URL)
1866 -> Version = Version0
1867 ; Version = unknown
1868 ).
1869
1873
1874github_url(URL, User, Repo) :-
1875 uri_components(URL, uri_components(https,'github.com',Path,_,_)),
1876 atomic_list_concat(['',User,Repo|_], /, Path).
1877
1878
1883
1884github_version(User, Repo, Version, VersionURI) :-
1885 atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
1886 uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
1887 setup_call_cleanup(
1888 http_open(ApiUri, In,
1889 [ request_header('Accept'='application/vnd.github.v3+json')
1890 ]),
1891 json_read_dict(In, Dicts),
1892 close(In)),
1893 member(Dict, Dicts),
1894 atom_string(Tag, Dict.name),
1895 tag_version(Tag, Version),
1896 atom_string(VersionURI, Dict.zipball_url).
1897
1898wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
1899wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
1900
1901ensure_slash(Dir, DirS) :-
1902 ( sub_atom(Dir, _, _, 0, /)
1903 -> DirS = Dir
1904 ; atom_concat(Dir, /, DirS)
1905 ).
1906
1907absolute_matching_href(DOM, Pattern, Match) :-
1908 xpath(DOM, //a(@href), HREF),
1909 uri_normalized(HREF, Pattern, Match),
1910 wildcard_match(Pattern, Match).
1911
1912versioned_urls([], []).
1913versioned_urls([H|T0], List) :-
1914 file_base_name(H, File),
1915 ( pack_version_file(_Pack, Version, File)
1916 -> List = [Version-H|T]
1917 ; List = T
1918 ),
1919 versioned_urls(T0, T).
1920
1921
1922 1925
1929
1930update_dependency_db :-
1931 retractall(pack_requires(_,_)),
1932 retractall(pack_provides_db(_,_)),
1933 forall(current_pack(Pack),
1934 ( findall(Info, pack_info(Pack, dependency, Info), Infos),
1935 update_dependency_db(Pack, Infos)
1936 )).
1937
1938update_dependency_db(Name, Info) :-
1939 retractall(pack_requires(Name, _)),
1940 retractall(pack_provides_db(Name, _)),
1941 maplist(assert_dep(Name), Info).
1942
1943assert_dep(Pack, provides(Token)) :-
1944 !,
1945 assertz(pack_provides_db(Pack, Token)).
1946assert_dep(Pack, requires(Token)) :-
1947 !,
1948 assertz(pack_requires(Pack, Token)).
1949assert_dep(_, _).
1950
1954
1955validate_dependencies :-
1956 unsatisfied_dependencies(Unsatisfied),
1957 !,
1958 print_message(warning, pack(unsatisfied(Unsatisfied))).
1959validate_dependencies.
1960
1961
1962unsatisfied_dependencies(Unsatisfied) :-
1963 findall(Req-Pack, pack_requires(Pack, Req), Reqs0),
1964 keysort(Reqs0, Reqs1),
1965 group_pairs_by_key(Reqs1, GroupedReqs),
1966 exclude(satisfied_dependency, GroupedReqs, Unsatisfied),
1967 Unsatisfied \== [].
1968
1969satisfied_dependency(Needed-_By) :-
1970 pack_provides(_, Needed),
1971 !.
1972satisfied_dependency(Needed-_By) :-
1973 compound(Needed),
1974 Needed =.. [Op, Pack, ReqVersion],
1975 ( pack_provides(Pack, Pack)
1976 -> pack_info(Pack, _, version(PackVersion)),
1977 version_data(PackVersion, PackData)
1978 ; Pack == prolog
1979 -> current_prolog_flag(version_data, swi(Major,Minor,Patch,_)),
1980 PackData = [Major,Minor,Patch]
1981 ),
1982 version_data(ReqVersion, ReqData),
1983 cmp(Op, Cmp),
1984 call(Cmp, PackData, ReqData).
1985
1989
1990pack_provides(Pack, Pack) :-
1991 current_pack(Pack).
1992pack_provides(Pack, Token) :-
1993 pack_provides_db(Pack, Token).
1994
1998
1999pack_depends_on(Pack, Dependency) :-
2000 ( atom(Pack)
2001 -> pack_depends_on_fwd(Pack, Dependency, [Pack])
2002 ; pack_depends_on_bwd(Pack, Dependency, [Dependency])
2003 ).
2004
2005pack_depends_on_fwd(Pack, Dependency, Visited) :-
2006 pack_depends_on_1(Pack, Dep1),
2007 \+ memberchk(Dep1, Visited),
2008 ( Dependency = Dep1
2009 ; pack_depends_on_fwd(Dep1, Dependency, [Dep1|Visited])
2010 ).
2011
2012pack_depends_on_bwd(Pack, Dependency, Visited) :-
2013 pack_depends_on_1(Dep1, Dependency),
2014 \+ memberchk(Dep1, Visited),
2015 ( Pack = Dep1
2016 ; pack_depends_on_bwd(Pack, Dep1, [Dep1|Visited])
2017 ).
2018
2019pack_depends_on_1(Pack, Dependency) :-
2020 atom(Dependency),
2021 !,
2022 pack_provides(Dependency, Token),
2023 pack_requires(Pack, Token).
2024pack_depends_on_1(Pack, Dependency) :-
2025 pack_requires(Pack, Token),
2026 pack_provides(Dependency, Token).
2027
2028
2042
2043resolve_dependencies(Dependencies, Resolution) :-
2044 maplist(dependency_pair, Dependencies, Pairs0),
2045 keysort(Pairs0, Pairs1),
2046 group_pairs_by_key(Pairs1, ByToken),
2047 maplist(resolve_dep, ByToken, Resolution).
2048
2049dependency_pair(dependency(Token, Pack, Version, URLs, SubDeps),
2050 Token-(Pack-pack(Version,URLs, SubDeps))).
2051
2052resolve_dep(Token-Pairs, Token-Resolution) :-
2053 ( resolve_dep2(Token-Pairs, Resolution)
2054 *-> true
2055 ; Resolution = unresolved
2056 ).
2057
2058resolve_dep2(Token-_, resolved(Pack)) :-
2059 pack_provides(Pack, Token).
2060resolve_dep2(_-Pairs, resolve(Pack, VersionAtom, URLs, SubResolves)) :-
2061 keysort(Pairs, Sorted),
2062 group_pairs_by_key(Sorted, ByPack),
2063 member(Pack-Versions, ByPack),
2064 Pack \== (-),
2065 maplist(version_pack, Versions, VersionData),
2066 sort(VersionData, ByVersion),
2067 reverse(ByVersion, ByVersionLatest),
2068 member(pack(Version,URLs,SubDeps), ByVersionLatest),
2069 atom_version(VersionAtom, Version),
2070 include(dependency, SubDeps, Deps),
2071 resolve_dependencies(Deps, SubResolves).
2072
2073version_pack(pack(VersionAtom,URLs,SubDeps),
2074 pack(Version,URLs,SubDeps)) :-
2075 atom_version(VersionAtom, Version).
2076
2077
2078 2081
2096
2097run_process(Executable, Argv, Options) :-
2098 \+ option(output(_), Options),
2099 \+ option(error(_), Options),
2100 current_prolog_flag(unix, true),
2101 current_prolog_flag(threads, true),
2102 !,
2103 process_create_options(Options, Extra),
2104 process_create(Executable, Argv,
2105 [ stdout(pipe(Out)),
2106 stderr(pipe(Error)),
2107 process(PID)
2108 | Extra
2109 ]),
2110 thread_create(relay_output([output-Out, error-Error]), Id, []),
2111 process_wait(PID, Status),
2112 thread_join(Id, _),
2113 ( Status == exit(0)
2114 -> true
2115 ; throw(error(process_error(process(Executable, Argv), Status), _))
2116 ).
2117run_process(Executable, Argv, Options) :-
2118 process_create_options(Options, Extra),
2119 setup_call_cleanup(
2120 process_create(Executable, Argv,
2121 [ stdout(pipe(Out)),
2122 stderr(pipe(Error)),
2123 process(PID)
2124 | Extra
2125 ]),
2126 ( read_stream_to_codes(Out, OutCodes, []),
2127 read_stream_to_codes(Error, ErrorCodes, []),
2128 process_wait(PID, Status)
2129 ),
2130 ( close(Out),
2131 close(Error)
2132 )),
2133 print_error(ErrorCodes, Options),
2134 print_output(OutCodes, Options),
2135 ( Status == exit(0)
2136 -> true
2137 ; throw(error(process_error(process(Executable, Argv), Status), _))
2138 ).
2139
2140process_create_options(Options, Extra) :-
2141 option(directory(Dir), Options, .),
2142 ( option(env(Env), Options)
2143 -> Extra = [cwd(Dir), env(Env)]
2144 ; Extra = [cwd(Dir)]
2145 ).
2146
2147relay_output([]) :- !.
2148relay_output(Output) :-
2149 pairs_values(Output, Streams),
2150 wait_for_input(Streams, Ready, infinite),
2151 relay(Ready, Output, NewOutputs),
2152 relay_output(NewOutputs).
2153
2154relay([], Outputs, Outputs).
2155relay([H|T], Outputs0, Outputs) :-
2156 selectchk(Type-H, Outputs0, Outputs1),
2157 ( at_end_of_stream(H)
2158 -> close(H),
2159 relay(T, Outputs1, Outputs)
2160 ; read_pending_codes(H, Codes, []),
2161 relay(Type, Codes),
2162 relay(T, Outputs0, Outputs)
2163 ).
2164
2165relay(error, Codes) :-
2166 set_prolog_flag(thread_message_prefix, false),
2167 print_error(Codes, []).
2168relay(output, Codes) :-
2169 print_output(Codes, []).
2170
2171print_output(OutCodes, Options) :-
2172 option(output(Codes), Options),
2173 !,
2174 Codes = OutCodes.
2175print_output(OutCodes, _) :-
2176 print_message(informational, pack(process_output(OutCodes))).
2177
2178print_error(OutCodes, Options) :-
2179 option(error(Codes), Options),
2180 !,
2181 Codes = OutCodes.
2182print_error(OutCodes, _) :-
2183 phrase(classify_message(Level), OutCodes, _),
2184 print_message(Level, pack(process_output(OutCodes))).
2185
2186classify_message(error) -->
2187 string(_), "fatal:",
2188 !.
2189classify_message(error) -->
2190 string(_), "error:",
2191 !.
2192classify_message(warning) -->
2193 string(_), "warning:",
2194 !.
2195classify_message(informational) -->
2196 [].
2197
2198string([]) --> [].
2199string([H|T]) --> [H], string(T).
2200
2201
2202 2205
2206:- multifile prolog:message//1. 2207
2209
(_Question, _Alternatives, Default, Selection, Options) :-
2211 option(interactive(false), Options),
2212 !,
2213 Selection = Default.
2214menu(Question, Alternatives, Default, Selection, _) :-
2215 length(Alternatives, N),
2216 between(1, 5, _),
2217 print_message(query, Question),
2218 print_menu(Alternatives, Default, 1),
2219 print_message(query, pack(menu(select))),
2220 read_selection(N, Choice),
2221 !,
2222 ( Choice == default
2223 -> Selection = Default
2224 ; nth1(Choice, Alternatives, Selection=_)
2225 -> true
2226 ).
2227
([], _, _).
2229print_menu([Value=Label|T], Default, I) :-
2230 ( Value == Default
2231 -> print_message(query, pack(menu(default_item(I, Label))))
2232 ; print_message(query, pack(menu(item(I, Label))))
2233 ),
2234 I2 is I + 1,
2235 print_menu(T, Default, I2).
2236
2237read_selection(Max, Choice) :-
2238 get_single_char(Code),
2239 ( answered_default(Code)
2240 -> Choice = default
2241 ; code_type(Code, digit(Choice)),
2242 between(1, Max, Choice)
2243 -> true
2244 ; print_message(warning, pack(menu(reply(1,Max)))),
2245 fail
2246 ).
2247
2253
2254confirm(_Question, Default, Options) :-
2255 Default \== none,
2256 option(interactive(false), Options, true),
2257 !,
2258 Default == yes.
2259confirm(Question, Default, _) :-
2260 between(1, 5, _),
2261 print_message(query, pack(confirm(Question, Default))),
2262 read_yes_no(YesNo, Default),
2263 !,
2264 format(user_error, '~N', []),
2265 YesNo == yes.
2266
2267read_yes_no(YesNo, Default) :-
2268 get_single_char(Code),
2269 code_yes_no(Code, Default, YesNo),
2270 !.
2271
2272code_yes_no(0'y, _, yes).
2273code_yes_no(0'Y, _, yes).
2274code_yes_no(0'n, _, no).
2275code_yes_no(0'N, _, no).
2276code_yes_no(_, none, _) :- !, fail.
2277code_yes_no(C, Default, Default) :-
2278 answered_default(C).
2279
2280answered_default(0'\r).
2281answered_default(0'\n).
2282answered_default(0'\s).
2283
2284
2285 2288
2289:- multifile prolog:message//1. 2290
2291prolog:message(pack(Message)) -->
2292 message(Message).
2293
2294:- discontiguous
2295 message//1,
2296 label//1. 2297
2298message(invalid_info(Term)) -->
2299 [ 'Invalid package description: ~q'-[Term] ].
2300message(directory_exists(Dir)) -->
2301 [ 'Package target directory exists and is not empty:', nl,
2302 '\t~q'-[Dir]
2303 ].
2304message(already_installed(pack(Pack, Version))) -->
2305 { atom_version(AVersion, Version) },
2306 [ 'Pack `~w'' is already installed @~w'-[Pack, AVersion] ].
2307message(already_installed(Pack)) -->
2308 [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
2309message(invalid_name(File)) -->
2310 [ '~w: A package archive must be named <pack>-<version>.<ext>'-[File] ],
2311 no_tar_gz(File).
2312
2313no_tar_gz(File) -->
2314 { sub_atom(File, _, _, 0, '.tar.gz') },
2315 !,
2316 [ nl,
2317 'Package archive files must have a single extension. E.g., \'.tgz\''-[]
2318 ].
2319no_tar_gz(_) --> [].
2320
2321message(kept_foreign(Pack)) -->
2322 [ 'Found foreign libraries for target platform.'-[], nl,
2323 'Use ?- pack_rebuild(~q). to rebuild from sources'-[Pack]
2324 ].
2325message(no_pack_installed(Pack)) -->
2326 [ 'No pack ~q installed. Use ?- pack_list(Pattern) to search'-[Pack] ].
2327message(no_packages_installed) -->
2328 { setting(server, ServerBase) },
2329 [ 'There are no extra packages installed.', nl,
2330 'Please visit ~wlist.'-[ServerBase]
2331 ].
2332message(remove_with(Pack)) -->
2333 [ 'The package can be removed using: ?- ~q.'-[pack_remove(Pack)]
2334 ].
2335message(unsatisfied(Packs)) -->
2336 [ 'The following dependencies are not satisfied:', nl ],
2337 unsatisfied(Packs).
2338message(depends(Pack, Deps)) -->
2339 [ 'The following packages depend on `~w\':'-[Pack], nl ],
2340 pack_list(Deps).
2341message(remove(PackDir)) -->
2342 [ 'Removing ~q and contents'-[PackDir] ].
2343message(remove_existing_pack(PackDir)) -->
2344 [ 'Remove old installation in ~q'-[PackDir] ].
2345message(install_from(Pack, Version, git(URL))) -->
2346 [ 'Install ~w@~w from GIT at ~w'-[Pack, Version, URL] ].
2347message(install_from(Pack, Version, URL)) -->
2348 [ 'Install ~w@~w from ~w'-[Pack, Version, URL] ].
2349message(select_install_from(Pack, Version)) -->
2350 [ 'Select download location for ~w@~w'-[Pack, Version] ].
2351message(install_downloaded(File)) -->
2352 { file_base_name(File, Base),
2353 size_file(File, Size) },
2354 [ 'Install "~w" (~D bytes)'-[Base, Size] ].
2355message(git_post_install(PackDir, Pack)) -->
2356 ( { is_foreign_pack(PackDir) }
2357 -> [ 'Run post installation scripts for pack "~w"'-[Pack] ]
2358 ; [ 'Activate pack "~w"'-[Pack] ]
2359 ).
2360message(no_meta_data(BaseDir)) -->
2361 [ 'Cannot find pack.pl inside directory ~q. Not a package?'-[BaseDir] ].
2362message(inquiry(Server)) -->
2363 [ 'Verify package status (anonymously)', nl,
2364 '\tat "~w"'-[Server]
2365 ].
2366message(search_no_matches(Name)) -->
2367 [ 'Search for "~w", returned no matching packages'-[Name] ].
2368message(rebuild(Pack)) -->
2369 [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
2370message(upgrade(Pack, From, To)) -->
2371 [ 'Upgrade "~w" from '-[Pack] ],
2372 msg_version(From), [' to '-[]], msg_version(To).
2373message(up_to_date(Pack)) -->
2374 [ 'Package "~w" is up-to-date'-[Pack] ].
2375message(query_versions(URL)) -->
2376 [ 'Querying "~w" to find new versions ...'-[URL] ].
2377message(no_matching_urls(URL)) -->
2378 [ 'Could not find any matching URL: ~q'-[URL] ].
2379message(found_versions([Latest-_URL|More])) -->
2380 { length(More, Len),
2381 atom_version(VLatest, Latest)
2382 },
2383 [ ' Latest version: ~w (~D older)'-[VLatest, Len] ].
2384message(process_output(Codes)) -->
2385 { split_lines(Codes, Lines) },
2386 process_lines(Lines).
2387message(contacting_server(Server)) -->
2388 [ 'Contacting server at ~w ...'-[Server], flush ].
2389message(server_reply(true(_))) -->
2390 [ at_same_line, ' ok'-[] ].
2391message(server_reply(false)) -->
2392 [ at_same_line, ' done'-[] ].
2393message(server_reply(exception(E))) -->
2394 [ 'Server reported the following error:'-[], nl ],
2395 '$messages':translate_message(E).
2396message(cannot_create_dir(Alias)) -->
2397 { setof(PackDir,
2398 absolute_file_name(Alias, PackDir, [solutions(all)]),
2399 PackDirs)
2400 },
2401 [ 'Cannot find a place to create a package directory.'-[],
2402 'Considered:'-[]
2403 ],
2404 candidate_dirs(PackDirs).
2405message(no_match(Name)) -->
2406 [ 'No registered pack matches "~w"'-[Name] ].
2407message(conflict(version, [PackV, FileV])) -->
2408 ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
2409 [', file claims version '-[]], msg_version(FileV).
2410message(conflict(name, [PackInfo, FileInfo])) -->
2411 ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
2412 [', file claims ~w: ~p'-[FileInfo]].
2413message(no_prolog_response(ContentType, String)) -->
2414 [ 'Expected Prolog response. Got content of type ~p'-[ContentType], nl,
2415 '~s'-[String]
2416 ].
2417message(pack(no_upgrade_info(Pack))) -->
2418 [ '~w: pack meta-data does not provide an upgradable URL'-[Pack] ].
2419
2420candidate_dirs([]) --> [].
2421candidate_dirs([H|T]) --> [ nl, ' ~w'-[H] ], candidate_dirs(T).
2422
2423message(no_mingw) -->
2424 [ 'Cannot find MinGW and/or MSYS.'-[] ].
2425
2426 2427message(resolve_remove) -->
2428 [ nl, 'Please select an action:', nl, nl ].
2429message(create_pack_dir) -->
2430 [ nl, 'Create directory for packages', nl ].
2431message(menu(item(I, Label))) -->
2432 [ '~t(~d)~6| '-[I] ],
2433 label(Label).
2434message(menu(default_item(I, Label))) -->
2435 [ '~t(~d)~6| * '-[I] ],
2436 label(Label).
2437message(menu(select)) -->
2438 [ nl, 'Your choice? ', flush ].
2439message(confirm(Question, Default)) -->
2440 message(Question),
2441 confirm_default(Default),
2442 [ flush ].
2443message(menu(reply(Min,Max))) -->
2444 ( { Max =:= Min+1 }
2445 -> [ 'Please enter ~w or ~w'-[Min,Max] ]
2446 ; [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
2447 ).
2448
2450
2451message(alt_hashes(URL, _Alts)) -->
2452 { git_url(URL, _)
2453 },
2454 !,
2455 [ 'GIT repository was updated without updating version' ].
2456message(alt_hashes(URL, Alts)) -->
2457 { file_base_name(URL, File)
2458 },
2459 [ 'Found multiple versions of "~w".'-[File], nl,
2460 'This could indicate a compromised or corrupted file', nl
2461 ],
2462 alt_hashes(Alts).
2463message(continue_with_alt_hashes(Count, URL)) -->
2464 [ 'Continue installation from "~w" (downloaded ~D times)'-[URL, Count] ].
2465message(continue_with_modified_hash(_URL)) -->
2466 [ 'Pack may be compromised. Continue anyway'
2467 ].
2468message(modified_hash(_SHA1-URL, _SHA2-[URL])) -->
2469 [ 'Content of ~q has changed.'-[URL]
2470 ].
2471
2472alt_hashes([]) --> [].
2473alt_hashes([H|T]) --> alt_hash(H), ( {T == []} -> [] ; [nl], alt_hashes(T) ).
2474
2475alt_hash(alt_hash(Count, URLs, Hash)) -->
2476 [ '~t~d~8| ~w'-[Count, Hash] ],
2477 alt_urls(URLs).
2478
2479alt_urls([]) --> [].
2480alt_urls([H|T]) -->
2481 [ nl, ' ~w'-[H] ],
2482 alt_urls(T).
2483
2485
2486message(install_dependencies(Resolution)) -->
2487 [ 'Package depends on the following:' ],
2488 msg_res_tokens(Resolution, 1).
2489
2490msg_res_tokens([], _) --> [].
2491msg_res_tokens([H|T], L) --> msg_res_token(H, L), msg_res_tokens(T, L).
2492
2493msg_res_token(Token-unresolved, L) -->
2494 res_indent(L),
2495 [ '"~w" cannot be satisfied'-[Token] ].
2496msg_res_token(Token-resolve(Pack, Version, [URL|_], SubResolves), L) -->
2497 !,
2498 res_indent(L),
2499 [ '"~w", provided by ~w@~w from ~w'-[Token, Pack, Version, URL] ],
2500 { L2 is L+1 },
2501 msg_res_tokens(SubResolves, L2).
2502msg_res_token(Token-resolved(Pack), L) -->
2503 !,
2504 res_indent(L),
2505 [ '"~w", provided by installed pack ~w'-[Token,Pack] ].
2506
2507res_indent(L) -->
2508 { I is L*2 },
2509 [ nl, '~*c'-[I,0'\s] ].
2510
2511message(resolve_deps) -->
2512 [ nl, 'What do you wish to do' ].
2513label(install_deps) -->
2514 [ 'Install proposed dependencies' ].
2515label(install_no_deps) -->
2516 [ 'Only install requested package' ].
2517
2518
2519message(git_fetch(Dir)) -->
2520 [ 'Running "git fetch" in ~q'-[Dir] ].
2521
2523
2524message(inquiry_ok(Reply, File)) -->
2525 { memberchk(downloads(Count), Reply),
2526 memberchk(rating(VoteCount, Rating), Reply),
2527 !,
2528 length(Stars, Rating),
2529 maplist(=(0'*), Stars)
2530 },
2531 [ '"~w" was downloaded ~D times. Package rated ~s (~D votes)'-
2532 [ File, Count, Stars, VoteCount ]
2533 ].
2534message(inquiry_ok(Reply, File)) -->
2535 { memberchk(downloads(Count), Reply)
2536 },
2537 [ '"~w" was downloaded ~D times'-[ File, Count ] ].
2538
2539 2540unsatisfied([]) --> [].
2541unsatisfied([Needed-[By]|T]) -->
2542 [ '\t`~q\', needed by package `~w\''-[Needed, By] ],
2543 unsatisfied(T).
2544unsatisfied([Needed-By|T]) -->
2545 [ '\t`~q\', needed by packages'-[Needed], nl ],
2546 pack_list(By),
2547 unsatisfied(T).
2548
2549pack_list([]) --> [].
2550pack_list([H|T]) -->
2551 [ '\t\tPackage `~w\''-[H], nl ],
2552 pack_list(T).
2553
2554process_lines([]) --> [].
2555process_lines([H|T]) -->
2556 [ '~s'-[H] ],
2557 ( {T==[]}
2558 -> []
2559 ; [nl], process_lines(T)
2560 ).
2561
2562split_lines([], []) :- !.
2563split_lines(All, [Line1|More]) :-
2564 append(Line1, [0'\n|Rest], All),
2565 !,
2566 split_lines(Rest, More).
2567split_lines(Line, [Line]).
2568
2569label(remove_only(Pack)) -->
2570 [ 'Only remove package ~w (break dependencies)'-[Pack] ].
2571label(remove_deps(Pack, Deps)) -->
2572 { length(Deps, Count) },
2573 [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
2574label(create_dir(Dir)) -->
2575 [ '~w'-[Dir] ].
2576label(install_from(git(URL))) -->
2577 !,
2578 [ 'GIT repository at ~w'-[URL] ].
2579label(install_from(URL)) -->
2580 [ '~w'-[URL] ].
2581label(cancel) -->
2582 [ 'Cancel' ].
2583
2584confirm_default(yes) -->
2585 [ ' Y/n? ' ].
2586confirm_default(no) -->
2587 [ ' y/N? ' ].
2588confirm_default(none) -->
2589 [ ' y/n? ' ].
2590
2591msg_version(Version) -->
2592 { atom(Version) },
2593 !,
2594 [ '~w'-[Version] ].
2595msg_version(VersionData) -->
2596 !,
2597 { atom_version(Atom, VersionData) },
2598 [ '~w'-[Atom] ]