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