36
37:- module(prolog_pack,
38 [ pack_list_installed/0,
39 pack_info/1, 40 pack_list/1, 41 pack_search/1, 42 pack_install/1, 43 pack_install/2, 44 pack_upgrade/1, 45 pack_rebuild/1, 46 pack_rebuild/0, 47 pack_remove/1, 48 pack_property/2, 49 pack_attach/2, 50
51 pack_url_file/2 52 ]). 53:- use_module(library(apply)). 54:- use_module(library(error)). 55:- use_module(library(option)). 56:- use_module(library(readutil)). 57:- use_module(library(lists)). 58:- use_module(library(filesex)). 59:- use_module(library(xpath)). 60:- use_module(library(settings)). 61:- use_module(library(uri)). 62:- use_module(library(dcg/basics)). 63:- use_module(library(http/http_open)). 64:- use_module(library(http/json)). 65:- use_module(library(http/http_client), []). 66:- use_module(library(prolog_config)). 67:- use_module(library(debug), [assertion/1]). 68:- use_module(library(pairs), [group_pairs_by_key/2]). 70:- autoload(library(git)). 71:- autoload(library(sgml)). 72:- autoload(library(sha)). 73:- autoload(library(build/tools)). 74
89
90:- multifile
91 environment/2. 92
93:- dynamic
94 pack_requires/2, 95 pack_provides_db/2. 96
97
98 101
102:- setting(server, atom, 'https://www.swi-prolog.org/pack/',
103 'Server to exchange pack information'). 104
105
106 109
114
115current_pack(Pack) :-
116 current_pack(Pack, _).
117
118current_pack(Pack, Dir) :-
119 '$pack':pack(Pack, Dir).
120
128
129pack_list_installed :-
130 findall(Pack, current_pack(Pack), Packages0),
131 Packages0 \== [],
132 !,
133 sort(Packages0, Packages),
134 length(Packages, Count),
135 format('Installed packages (~D):~n~n', [Count]),
136 maplist(pack_info(list), Packages),
137 validate_dependencies.
138pack_list_installed :-
139 print_message(informational, pack(no_packages_installed)).
140
144
145pack_info(Name) :-
146 pack_info(info, Name).
147
148pack_info(Level, Name) :-
149 must_be(atom, Name),
150 findall(Info, pack_info(Name, Level, Info), Infos0),
151 ( Infos0 == []
152 -> print_message(warning, pack(no_pack_installed(Name))),
153 fail
154 ; true
155 ),
156 update_dependency_db(Name, Infos0),
157 findall(Def, pack_default(Level, Infos, Def), Defs),
158 append(Infos0, Defs, Infos1),
159 sort(Infos1, Infos),
160 show_info(Name, Infos, [info(Level)]).
161
162
163show_info(_Name, _Properties, Options) :-
164 option(silent(true), Options),
165 !.
166show_info(Name, Properties, Options) :-
167 option(info(list), Options),
168 !,
169 memberchk(title(Title), Properties),
170 memberchk(version(Version), Properties),
171 format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
172show_info(Name, Properties, _) :-
173 !,
174 print_property_value('Package'-'~w', [Name]),
175 findall(Term, pack_level_info(info, Term, _, _), Terms),
176 maplist(print_property(Properties), Terms).
177
178print_property(_, nl) :-
179 !,
180 format('~n').
181print_property(Properties, Term) :-
182 findall(Term, member(Term, Properties), Terms),
183 Terms \== [],
184 !,
185 pack_level_info(_, Term, LabelFmt, _Def),
186 ( LabelFmt = Label-FmtElem
187 -> true
188 ; Label = LabelFmt,
189 FmtElem = '~w'
190 ),
191 multi_valued(Terms, FmtElem, FmtList, Values),
192 atomic_list_concat(FmtList, ', ', Fmt),
193 print_property_value(Label-Fmt, Values).
194print_property(_, _).
195
196multi_valued([H], LabelFmt, [LabelFmt], Values) :-
197 !,
198 H =.. [_|Values].
199multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
200 H =.. [_|VH],
201 append(VH, MoreValues, Values),
202 multi_valued(T, LabelFmt, LT, MoreValues).
203
204
205pvalue_column(24).
206print_property_value(Prop-Fmt, Values) :-
207 !,
208 pvalue_column(C),
209 atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
210 format(Format, [Prop,C|Values]).
211
212pack_info(Name, Level, Info) :-
213 '$pack':pack(Name, BaseDir),
214 ( Info = directory(BaseDir)
215 ; pack_info_term(BaseDir, Info)
216 ),
217 pack_level_info(Level, Info, _Format, _Default).
218
219:- public pack_level_info/4. 220
221pack_level_info(_, title(_), 'Title', '<no title>').
222pack_level_info(_, version(_), 'Installed version', '<unknown>').
223pack_level_info(info, directory(_), 'Installed in directory', -).
224pack_level_info(info, author(_, _), 'Author'-'~w <~w>', -).
225pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>', -).
226pack_level_info(info, packager(_, _), 'Packager'-'~w <~w>', -).
227pack_level_info(info, home(_), 'Home page', -).
228pack_level_info(info, download(_), 'Download URL', -).
229pack_level_info(_, provides(_), 'Provides', -).
230pack_level_info(_, requires(_), 'Requires', -).
231pack_level_info(_, conflicts(_), 'Conflicts with', -).
232pack_level_info(_, replaces(_), 'Replaces packages', -).
233pack_level_info(info, library(_), 'Provided libraries', -).
234
235pack_default(Level, Infos, Def) :-
236 pack_level_info(Level, ITerm, _Format, Def),
237 Def \== (-),
238 \+ memberchk(ITerm, Infos).
239
243
244pack_info_term(BaseDir, Info) :-
245 directory_file_path(BaseDir, 'pack.pl', InfoFile),
246 catch(
247 setup_call_cleanup(
248 open(InfoFile, read, In),
249 term_in_stream(In, Info),
250 close(In)),
251 error(existence_error(source_sink, InfoFile), _),
252 ( print_message(error, pack(no_meta_data(BaseDir))),
253 fail
254 )).
255pack_info_term(BaseDir, library(Lib)) :-
256 atom_concat(BaseDir, '/prolog/', LibDir),
257 atom_concat(LibDir, '*.pl', Pattern),
258 expand_file_name(Pattern, Files),
259 maplist(atom_concat(LibDir), Plain, Files),
260 convlist(base_name, Plain, Libs),
261 member(Lib, Libs).
262
263base_name(File, Base) :-
264 file_name_extension(Base, pl, File).
265
266term_in_stream(In, Term) :-
267 repeat,
268 read_term(In, Term0, []),
269 ( Term0 == end_of_file
270 -> !, fail
271 ; Term = Term0,
272 valid_info_term(Term0)
273 ).
274
275valid_info_term(Term) :-
276 Term =.. [Name|Args],
277 same_length(Args, Types),
278 Decl =.. [Name|Types],
279 ( pack_info_term(Decl)
280 -> maplist(valid_info_arg, Types, Args)
281 ; print_message(warning, pack(invalid_info(Term))),
282 fail
283 ).
284
285valid_info_arg(Type, Arg) :-
286 must_be(Type, Arg).
287
292
293pack_info_term(name(atom)). 294pack_info_term(title(atom)).
295pack_info_term(keywords(list(atom))).
296pack_info_term(description(list(atom))).
297pack_info_term(version(version)).
298pack_info_term(author(atom, email_or_url_or_empty)). 299pack_info_term(maintainer(atom, email_or_url)).
300pack_info_term(packager(atom, email_or_url)).
301pack_info_term(pack_version(nonneg)). 302pack_info_term(home(atom)). 303pack_info_term(download(atom)). 304pack_info_term(provides(atom)). 305pack_info_term(requires(dependency)).
306pack_info_term(conflicts(dependency)). 307pack_info_term(replaces(atom)). 308pack_info_term(autoload(boolean)). 309
310:- multifile
311 error:has_type/2. 312
313error:has_type(version, Version) :-
314 atom(Version),
315 version_data(Version, _Data).
316error:has_type(email_or_url, Address) :-
317 atom(Address),
318 ( sub_atom(Address, _, _, _, @)
319 -> true
320 ; uri_is_global(Address)
321 ).
322error:has_type(email_or_url_or_empty, Address) :-
323 ( Address == ''
324 -> true
325 ; error:has_type(email_or_url, Address)
326 ).
327error:has_type(dependency, Value) :-
328 is_dependency(Value, _Token, _Version).
329
330version_data(Version, version(Data)) :-
331 atomic_list_concat(Parts, '.', Version),
332 maplist(atom_number, Parts, Data).
333
334is_dependency(Token, Token, *) :-
335 atom(Token).
336is_dependency(Term, Token, VersionCmp) :-
337 Term =.. [Op,Token,Version],
338 cmp(Op, _),
339 version_data(Version, _),
340 VersionCmp =.. [Op,Version].
341
342cmp(<, @<).
343cmp(=<, @=<).
344cmp(==, ==).
345cmp(>=, @>=).
346cmp(>, @>).
347
348
349 352
379
380pack_list(Query) :-
381 pack_search(Query).
382
383pack_search(Query) :-
384 query_pack_server(search(Query), Result, []),
385 ( Result == false
386 -> ( local_search(Query, Packs),
387 Packs \== []
388 -> forall(member(pack(Pack, Stat, Title, Version, _), Packs),
389 format('~w ~w@~w ~28|- ~w~n',
390 [Stat, Pack, Version, Title]))
391 ; print_message(warning, pack(search_no_matches(Query)))
392 )
393 ; Result = true(Hits),
394 local_search(Query, Local),
395 append(Hits, Local, All),
396 sort(All, Sorted),
397 list_hits(Sorted)
398 ).
399
400list_hits([]).
401list_hits([ pack(Pack, i, Title, Version, _),
402 pack(Pack, p, Title, Version, _)
403 | More
404 ]) :-
405 !,
406 format('i ~w@~w ~28|- ~w~n', [Pack, Version, Title]),
407 list_hits(More).
408list_hits([ pack(Pack, i, Title, VersionI, _),
409 pack(Pack, p, _, VersionS, _)
410 | More
411 ]) :-
412 !,
413 version_data(VersionI, VDI),
414 version_data(VersionS, VDS),
415 ( VDI @< VDS
416 -> Tag = ('U')
417 ; Tag = ('A')
418 ),
419 format('~w ~w@~w(~w) ~28|- ~w~n', [Tag, Pack, VersionI, VersionS, Title]),
420 list_hits(More).
421list_hits([ pack(Pack, i, Title, VersionI, _)
422 | More
423 ]) :-
424 !,
425 format('l ~w@~w ~28|- ~w~n', [Pack, VersionI, Title]),
426 list_hits(More).
427list_hits([pack(Pack, Stat, Title, Version, _)|More]) :-
428 format('~w ~w@~w ~28|- ~w~n', [Stat, Pack, Version, Title]),
429 list_hits(More).
430
431
432local_search(Query, Packs) :-
433 findall(Pack, matching_installed_pack(Query, Pack), Packs).
434
435matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
436 current_pack(Pack),
437 findall(Term,
438 ( pack_info(Pack, _, Term),
439 search_info(Term)
440 ), Info),
441 ( sub_atom_icasechk(Pack, _, Query)
442 -> true
443 ; memberchk(title(Title), Info),
444 sub_atom_icasechk(Title, _, Query)
445 ),
446 option(title(Title), Info, '<no title>'),
447 option(version(Version), Info, '<no version>'),
448 option(download(URL), Info, '<no download url>').
449
450search_info(title(_)).
451search_info(version(_)).
452search_info(download(_)).
453
454
455 458
474
475pack_install(Spec) :-
476 pack_default_options(Spec, Pack, [], Options),
477 pack_install(Pack, [pack(Pack)|Options]).
478
483
484pack_default_options(_Spec, Pack, OptsIn, Options) :-
485 option(already_installed(pack(Pack,_Version)), OptsIn),
486 !,
487 Options = OptsIn.
488pack_default_options(_Spec, Pack, OptsIn, Options) :-
489 option(url(URL), OptsIn),
490 !,
491 ( option(git(_), OptsIn)
492 -> Options = OptsIn
493 ; git_url(URL, Pack)
494 -> Options = [git(true)|OptsIn]
495 ; Options = OptsIn
496 ),
497 ( nonvar(Pack)
498 -> true
499 ; option(pack(Pack), Options)
500 -> true
501 ; pack_version_file(Pack, _Version, URL)
502 ).
503pack_default_options(Archive, Pack, _, Options) :- 504 must_be(atom, Archive),
505 \+ uri_is_global(Archive),
506 expand_file_name(Archive, [File]),
507 exists_file(File),
508 !,
509 pack_version_file(Pack, Version, File),
510 uri_file_name(FileURL, File),
511 Options = [url(FileURL), version(Version)].
512pack_default_options(URL, Pack, _, Options) :-
513 git_url(URL, Pack),
514 !,
515 Options = [git(true), url(URL)].
516pack_default_options(FileURL, Pack, _, Options) :- 517 uri_file_name(FileURL, Dir),
518 exists_directory(Dir),
519 pack_info_term(Dir, name(Pack)),
520 !,
521 ( pack_info_term(Dir, version(Version))
522 -> uri_file_name(DirURL, Dir),
523 Options = [url(DirURL), version(Version)]
524 ; throw(error(existence_error(key, version, Dir),_))
525 ).
526pack_default_options('.', Pack, _, Options) :- 527 pack_info_term('.', name(Pack)),
528 !,
529 working_directory(Dir, Dir),
530 ( pack_info_term(Dir, version(Version))
531 -> uri_file_name(DirURL, Dir),
532 Options = [url(DirURL), version(Version) | Options1],
533 ( current_prolog_flag(windows, true)
534 -> Options1 = []
535 ; Options1 = [link(true), rebuild(make)]
536 )
537 ; throw(error(existence_error(key, version, Dir),_))
538 ).
539pack_default_options(URL, Pack, _, Options) :- 540 pack_version_file(Pack, Version, URL),
541 download_url(URL),
542 !,
543 available_download_versions(URL, [URLVersion-LatestURL|_]),
544 Options = [url(LatestURL)|VersionOptions],
545 version_options(Version, URLVersion, VersionOptions).
546pack_default_options(Pack, Pack, OptsIn, Options) :- 547 \+ uri_is_global(Pack), 548 query_pack_server(locate(Pack), Reply, OptsIn),
549 ( Reply = true(Results)
550 -> pack_select_candidate(Pack, Results, OptsIn, Options)
551 ; print_message(warning, pack(no_match(Pack))),
552 fail
553 ).
554
555version_options(Version, Version, [version(Version)]) :- !.
556version_options(Version, _, [version(Version)]) :-
557 Version = version(List),
558 maplist(integer, List),
559 !.
560version_options(_, _, []).
561
565
566pack_select_candidate(Pack, [AtomVersion-_|_], Options,
567 [already_installed(pack(Pack, Installed))|Options]) :-
568 current_pack(Pack),
569 pack_info(Pack, _, version(InstalledAtom)),
570 atom_version(InstalledAtom, Installed),
571 atom_version(AtomVersion, Version),
572 Installed @>= Version,
573 !.
574pack_select_candidate(Pack, Available, Options, OptsOut) :-
575 option(url(URL), Options),
576 memberchk(_Version-URLs, Available),
577 memberchk(URL, URLs),
578 !,
579 ( git_url(URL, Pack)
580 -> Extra = [git(true)]
581 ; Extra = []
582 ),
583 OptsOut = [url(URL), inquiry(true) | Extra].
584pack_select_candidate(Pack, [Version-[URL]|_], Options,
585 [url(URL), git(true), inquiry(true)]) :-
586 git_url(URL, Pack),
587 !,
588 confirm(install_from(Pack, Version, git(URL)), yes, Options).
589pack_select_candidate(Pack, [Version-[URL]|More], Options,
590 [url(URL), inquiry(true) | Upgrade]) :-
591 ( More == []
592 -> !
593 ; true
594 ),
595 confirm(install_from(Pack, Version, URL), yes, Options),
596 !,
597 add_upgrade(Pack, Upgrade).
598pack_select_candidate(Pack, [Version-URLs|_], Options,
599 [url(URL), inquiry(true)|Rest]) :-
600 maplist(url_menu_item, URLs, Tagged),
601 append(Tagged, [cancel=cancel], Menu),
602 Menu = [Default=_|_],
603 menu(pack(select_install_from(Pack, Version)),
604 Menu, Default, Choice, Options),
605 ( Choice == cancel
606 -> fail
607 ; Choice = git(URL)
608 -> Rest = [git(true)|Upgrade]
609 ; Choice = URL,
610 Rest = Upgrade
611 ),
612 add_upgrade(Pack, Upgrade).
613
614add_upgrade(Pack, Options) :-
615 current_pack(Pack),
616 !,
617 Options = [upgrade(true)].
618add_upgrade(_, []).
619
(URL, git(URL)=install_from(git(URL))) :-
621 git_url(URL, _),
622 !.
623url_menu_item(URL, URL=install_from(URL)).
624
625
673
674pack_install(Spec, Options) :-
675 pack_default_options(Spec, Pack, Options, DefOptions),
676 ( option(already_installed(Installed), DefOptions)
677 -> print_message(informational, pack(already_installed(Installed)))
678 ; merge_options(Options, DefOptions, PackOptions),
679 update_dependency_db,
680 pack_install_dir(PackDir, PackOptions),
681 pack_install(Pack, PackDir, PackOptions)
682 ).
683
684pack_install_dir(PackDir, Options) :-
685 option(package_directory(PackDir), Options),
686 !.
687pack_install_dir(PackDir, Options) :-
688 base_alias(Alias, Options),
689 absolute_file_name(Alias, PackDir,
690 [ file_type(directory),
691 access(write),
692 file_errors(fail)
693 ]),
694 !.
695pack_install_dir(PackDir, Options) :-
696 pack_create_install_dir(PackDir, Options).
697
698base_alias(Alias, Options) :-
699 option(global(true), Options),
700 !,
701 Alias = common_app_data(pack).
702base_alias(Alias, Options) :-
703 option(global(false), Options),
704 !,
705 Alias = user_app_data(pack).
706base_alias(Alias, _Options) :-
707 Alias = pack('.').
708
709pack_create_install_dir(PackDir, Options) :-
710 base_alias(Alias, Options),
711 findall(Candidate = create_dir(Candidate),
712 ( absolute_file_name(Alias, Candidate, [solutions(all)]),
713 \+ exists_file(Candidate),
714 \+ exists_directory(Candidate),
715 file_directory_name(Candidate, Super),
716 ( exists_directory(Super)
717 -> access_file(Super, write)
718 ; true
719 )
720 ),
721 Candidates0),
722 list_to_set(Candidates0, Candidates), 723 pack_create_install_dir(Candidates, PackDir, Options).
724
725pack_create_install_dir(Candidates, PackDir, Options) :-
726 Candidates = [Default=_|_],
727 !,
728 append(Candidates, [cancel=cancel], Menu),
729 menu(pack(create_pack_dir), Menu, Default, Selected, Options),
730 Selected \== cancel,
731 ( catch(make_directory_path(Selected), E,
732 (print_message(warning, E), fail))
733 -> PackDir = Selected
734 ; delete(Candidates, PackDir=create_dir(PackDir), Remaining),
735 pack_create_install_dir(Remaining, PackDir, Options)
736 ).
737pack_create_install_dir(_, _, _) :-
738 print_message(error, pack(cannot_create_dir(pack(.)))),
739 fail.
740
741
753
754pack_install(Name, _, Options) :-
755 current_pack(Name, Dir),
756 option(upgrade(false), Options, false),
757 \+ pack_is_in_local_dir(Name, Dir, Options),
758 print_message(error, pack(already_installed(Name))),
759 pack_info(Name),
760 print_message(information, pack(remove_with(Name))),
761 !,
762 fail.
763pack_install(Name, PackDir, Options) :-
764 option(url(URL), Options),
765 uri_file_name(URL, Source),
766 !,
767 pack_install_from_local(Source, PackDir, Name, Options).
768pack_install(Name, PackDir, Options) :-
769 option(url(URL), Options),
770 uri_components(URL, Components),
771 uri_data(scheme, Components, Scheme),
772 pack_install_from_url(Scheme, URL, PackDir, Name, Options).
773
780
781pack_install_from_local(Source, PackTopDir, Name, Options) :-
782 exists_directory(Source),
783 !,
784 directory_file_path(PackTopDir, Name, PackDir),
785 ( option(link(true), Options)
786 -> ( same_file(Source, PackDir)
787 -> true
788 ; atom_concat(PackTopDir, '/', PackTopDirS),
789 relative_file_name(Source, PackTopDirS, RelPath),
790 link_file(RelPath, PackDir, symbolic),
791 assertion(same_file(Source, PackDir))
792 )
793 ; prepare_pack_dir(PackDir, Options),
794 copy_directory(Source, PackDir)
795 ),
796 pack_post_install(Name, PackDir, Options).
797pack_install_from_local(Source, PackTopDir, Name, Options) :-
798 exists_file(Source),
799 directory_file_path(PackTopDir, Name, PackDir),
800 prepare_pack_dir(PackDir, Options),
801 pack_unpack(Source, PackDir, Name, Options),
802 pack_post_install(Name, PackDir, Options).
803
804pack_is_in_local_dir(_Pack, PackDir, Options) :-
805 option(url(DirURL), Options),
806 uri_file_name(DirURL, Dir),
807 same_file(PackDir, Dir).
808
809
813
814:- if(exists_source(library(archive))). 815pack_unpack(Source, PackDir, Pack, Options) :-
816 ensure_loaded_archive,
817 pack_archive_info(Source, Pack, _Info, StripOptions),
818 prepare_pack_dir(PackDir, Options),
819 archive_extract(Source, PackDir,
820 [ exclude(['._*']) 821 | StripOptions
822 ]).
823:- else. 824pack_unpack(_,_,_,_) :-
825 existence_error(library, archive).
826:- endif. 827
828 831
843
844:- if(exists_source(library(archive))). 845ensure_loaded_archive :-
846 current_predicate(archive_open/3),
847 !.
848ensure_loaded_archive :-
849 use_module(library(archive)).
850
851pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
852 ensure_loaded_archive,
853 size_file(Archive, Bytes),
854 setup_call_cleanup(
855 archive_open(Archive, Handle, []),
856 ( repeat,
857 ( archive_next_header(Handle, InfoFile)
858 -> true
859 ; !, fail
860 )
861 ),
862 archive_close(Handle)),
863 file_base_name(InfoFile, 'pack.pl'),
864 atom_concat(Prefix, 'pack.pl', InfoFile),
865 strip_option(Prefix, Pack, Strip),
866 setup_call_cleanup(
867 archive_open_entry(Handle, Stream),
868 read_stream_to_terms(Stream, Info),
869 close(Stream)),
870 !,
871 must_be(ground, Info),
872 maplist(valid_info_term, Info).
873:- else. 874pack_archive_info(_, _, _, _) :-
875 existence_error(library, archive).
876:- endif. 877pack_archive_info(_, _, _, _) :-
878 existence_error(pack_file, 'pack.pl').
879
880strip_option('', _, []) :- !.
881strip_option('./', _, []) :- !.
882strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
883 atom_concat(PrefixDir, /, Prefix),
884 file_base_name(PrefixDir, Base),
885 ( Base == Pack
886 -> true
887 ; pack_version_file(Pack, _, Base)
888 -> true
889 ; \+ sub_atom(PrefixDir, _, _, _, /)
890 ).
891
892read_stream_to_terms(Stream, Terms) :-
893 read(Stream, Term0),
894 read_stream_to_terms(Term0, Stream, Terms).
895
896read_stream_to_terms(end_of_file, _, []) :- !.
897read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
898 read(Stream, Term1),
899 read_stream_to_terms(Term1, Stream, Terms).
900
901
906
907pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
908 exists_directory(GitDir),
909 !,
910 git_ls_tree(Entries, [directory(GitDir)]),
911 git_hash(Hash, [directory(GitDir)]),
912 maplist(arg(4), Entries, Sizes),
913 sum_list(Sizes, Bytes),
914 directory_file_path(GitDir, 'pack.pl', InfoFile),
915 read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
916 must_be(ground, Info),
917 maplist(valid_info_term, Info).
918
922
923download_file_sanity_check(Archive, Pack, Info) :-
924 info_field(name(Name), Info),
925 info_field(version(VersionAtom), Info),
926 atom_version(VersionAtom, Version),
927 pack_version_file(PackA, VersionA, Archive),
928 must_match([Pack, PackA, Name], name),
929 must_match([Version, VersionA], version).
930
931info_field(Field, Info) :-
932 memberchk(Field, Info),
933 ground(Field),
934 !.
935info_field(Field, _Info) :-
936 functor(Field, FieldName, _),
937 print_message(error, pack(missing(FieldName))),
938 fail.
939
940must_match(Values, _Field) :-
941 sort(Values, [_]),
942 !.
943must_match(Values, Field) :-
944 print_message(error, pack(conflict(Field, Values))),
945 fail.
946
947
948 951
961
962prepare_pack_dir(Dir, Options) :-
963 exists_directory(Dir),
964 !,
965 ( empty_directory(Dir)
966 -> true
967 ; ( option(upgrade(true), Options)
968 ; confirm(remove_existing_pack(Dir), yes, Options)
969 )
970 -> delete_directory_and_contents(Dir),
971 make_directory(Dir)
972 ).
973prepare_pack_dir(Dir, _) :-
974 make_directory(Dir).
975
979
980empty_directory(Dir) :-
981 \+ ( directory_files(Dir, Entries),
982 member(Entry, Entries),
983 \+ special(Entry)
984 ).
985
986special(.).
987special(..).
988
989
996
997pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
998 option(git(true), Options),
999 !,
1000 directory_file_path(PackTopDir, Pack, PackDir),
1001 prepare_pack_dir(PackDir, Options),
1002 run_process(path(git), [clone, URL, PackDir], []),
1003 pack_git_info(PackDir, Hash, Info),
1004 pack_inquiry(URL, git(Hash), Info, Options),
1005 show_info(Pack, Info, Options),
1006 confirm(git_post_install(PackDir, Pack), yes, Options),
1007 pack_post_install(Pack, PackDir, Options).
1008pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
1009 download_scheme(Scheme),
1010 directory_file_path(PackTopDir, Pack, PackDir),
1011 prepare_pack_dir(PackDir, Options),
1012 pack_download_dir(PackTopDir, DownLoadDir),
1013 download_file(URL, Pack, DownloadBase, Options),
1014 directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
1015 setup_call_cleanup(
1016 http_open(URL, In,
1017 [ cert_verify_hook(ssl_verify)
1018 ]),
1019 setup_call_cleanup(
1020 open(DownloadFile, write, Out, [type(binary)]),
1021 copy_stream_data(In, Out),
1022 close(Out)),
1023 close(In)),
1024 pack_archive_info(DownloadFile, Pack, Info, _),
1025 download_file_sanity_check(DownloadFile, Pack, Info),
1026 pack_inquiry(URL, DownloadFile, Info, Options),
1027 show_info(Pack, Info, Options),
1028 confirm(install_downloaded(DownloadFile), yes, Options),
1029 pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).
1030
1032
1033download_file(URL, Pack, File, Options) :-
1034 option(version(Version), Options),
1035 !,
1036 atom_version(VersionA, Version),
1037 file_name_extension(_, Ext, URL),
1038 format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
1039download_file(URL, Pack, File, _) :-
1040 file_base_name(URL,Basename),
1041 no_int_file_name_extension(Tag,Ext,Basename),
1042 tag_version(Tag,Version),
1043 !,
1044 atom_version(VersionA,Version),
1045 format(atom(File0), '~w-~w', [Pack, VersionA]),
1046 file_name_extension(File0, Ext, File).
1047download_file(URL, _, File, _) :-
1048 file_base_name(URL, File).
1049
1055
1056pack_url_file(URL, FileID) :-
1057 github_release_url(URL, Pack, Version),
1058 !,
1059 download_file(URL, Pack, FileID, [version(Version)]).
1060pack_url_file(URL, FileID) :-
1061 file_base_name(URL, FileID).
1062
1063
1064:- public ssl_verify/5. 1065
1071
1072ssl_verify(_SSL,
1073 _ProblemCertificate, _AllCertificates, _FirstCertificate,
1074 _Error).
1075
1076pack_download_dir(PackTopDir, DownLoadDir) :-
1077 directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
1078 ( exists_directory(DownLoadDir)
1079 -> true
1080 ; make_directory(DownLoadDir)
1081 ),
1082 ( access_file(DownLoadDir, write)
1083 -> true
1084 ; permission_error(write, directory, DownLoadDir)
1085 ).
1086
1090
1091download_url(URL) :-
1092 atom(URL),
1093 uri_components(URL, Components),
1094 uri_data(scheme, Components, Scheme),
1095 download_scheme(Scheme).
1096
1097download_scheme(http).
1098download_scheme(https) :-
1099 catch(use_module(library(http/http_ssl_plugin)),
1100 E, (print_message(warning, E), fail)).
1101
1109
1110pack_post_install(Pack, PackDir, Options) :-
1111 post_install_foreign(Pack, PackDir, Options),
1112 post_install_autoload(PackDir, Options),
1113 '$pack_attach'(PackDir).
1114
1118
1119pack_rebuild(Pack) :-
1120 current_pack(Pack, PackDir),
1121 !,
1122 post_install_foreign(Pack, PackDir, [rebuild(true)]).
1123pack_rebuild(Pack) :-
1124 unattached_pacth(Pack, PackDir),
1125 !,
1126 post_install_foreign(Pack, PackDir, [rebuild(true)]).
1127pack_rebuild(Pack) :-
1128 existence_error(pack, Pack).
1129
1130unattached_pacth(Pack, BaseDir) :-
1131 directory_file_path(Pack, 'pack.pl', PackFile),
1132 absolute_file_name(pack(PackFile), PackPath,
1133 [ access(read),
1134 file_errors(fail)
1135 ]),
1136 file_directory_name(PackPath, BaseDir).
1137
1141
1142pack_rebuild :-
1143 forall(current_pack(Pack),
1144 ( print_message(informational, pack(rebuild(Pack))),
1145 pack_rebuild(Pack)
1146 )).
1147
1148
1152
1153post_install_foreign(Pack, PackDir, Options) :-
1154 is_foreign_pack(PackDir, _),
1155 !,
1156 ( pack_info_term(PackDir, pack_version(Version))
1157 -> true
1158 ; Version = 1
1159 ),
1160 option(rebuild(Rebuild), Options, if_absent),
1161 ( Rebuild == if_absent,
1162 foreign_present(PackDir)
1163 -> print_message(informational, pack(kept_foreign(Pack)))
1164 ; BuildSteps0 = [[dependencies], [configure], build, [test], install],
1165 ( Rebuild == true
1166 -> BuildSteps1 = [distclean|BuildSteps0]
1167 ; BuildSteps1 = BuildSteps0
1168 ),
1169 ( option(test(false), Options)
1170 -> delete(BuildSteps1, [test], BuildSteps)
1171 ; BuildSteps = BuildSteps1
1172 ),
1173 build_steps(BuildSteps, PackDir, [pack_version(Version)|Options])
1174 ).
1175post_install_foreign(_, _, _).
1176
1177
1183
1184foreign_present(PackDir) :-
1185 current_prolog_flag(arch, Arch),
1186 atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
1187 exists_directory(ForeignBaseDir),
1188 !,
1189 atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
1190 exists_directory(ForeignDir),
1191 current_prolog_flag(shared_object_extension, Ext),
1192 atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
1193 expand_file_name(Pattern, Files),
1194 Files \== [].
1195
1200
1201is_foreign_pack(PackDir, Type) :-
1202 foreign_file(File, Type),
1203 directory_file_path(PackDir, File, Path),
1204 exists_file(Path).
1205
1206foreign_file('CMakeLists.txt', cmake).
1207foreign_file('configure', configure).
1208foreign_file('configure.in', autoconf).
1209foreign_file('configure.ac', autoconf).
1210foreign_file('Makefile.am', automake).
1211foreign_file('Makefile', make).
1212foreign_file('makefile', make).
1213foreign_file('conanfile.txt', conan).
1214foreign_file('conanfile.py', conan).
1215
1216
1217 1220
1224
1225post_install_autoload(PackDir, Options) :-
1226 option(autoload(true), Options, true),
1227 pack_info_term(PackDir, autoload(true)),
1228 !,
1229 directory_file_path(PackDir, prolog, PrologLibDir),
1230 make_library_index(PrologLibDir).
1231post_install_autoload(_, _).
1232
1233
1234 1237
1243
1244pack_upgrade(Pack) :-
1245 pack_info(Pack, _, directory(Dir)),
1246 directory_file_path(Dir, '.git', GitDir),
1247 exists_directory(GitDir),
1248 !,
1249 print_message(informational, pack(git_fetch(Dir))),
1250 git([fetch], [ directory(Dir) ]),
1251 git_describe(V0, [ directory(Dir) ]),
1252 git_describe(V1, [ directory(Dir), commit('origin/master') ]),
1253 ( V0 == V1
1254 -> print_message(informational, pack(up_to_date(Pack)))
1255 ; confirm(upgrade(Pack, V0, V1), yes, []),
1256 git([merge, 'origin/master'], [ directory(Dir) ]),
1257 pack_rebuild(Pack)
1258 ).
1259pack_upgrade(Pack) :-
1260 once(pack_info(Pack, _, version(VersionAtom))),
1261 atom_version(VersionAtom, Version),
1262 pack_info(Pack, _, download(URL)),
1263 ( wildcard_pattern(URL)
1264 -> true
1265 ; github_url(URL, _User, _Repo)
1266 ),
1267 !,
1268 available_download_versions(URL, [Latest-LatestURL|_Versions]),
1269 ( Latest @> Version
1270 -> confirm(upgrade(Pack, Version, Latest), yes, []),
1271 pack_install(Pack,
1272 [ url(LatestURL),
1273 upgrade(true),
1274 pack(Pack)
1275 ])
1276 ; print_message(informational, pack(up_to_date(Pack)))
1277 ).
1278pack_upgrade(Pack) :-
1279 print_message(warning, pack(no_upgrade_info(Pack))).
1280
1281
1282 1285
1289
1290pack_remove(Pack) :-
1291 update_dependency_db,
1292 ( setof(Dep, pack_depends_on(Dep, Pack), Deps)
1293 -> confirm_remove(Pack, Deps, Delete),
1294 forall(member(P, Delete), pack_remove_forced(P))
1295 ; pack_remove_forced(Pack)
1296 ).
1297
1298pack_remove_forced(Pack) :-
1299 catch('$pack_detach'(Pack, BaseDir),
1300 error(existence_error(pack, Pack), _),
1301 fail),
1302 !,
1303 print_message(informational, pack(remove(BaseDir))),
1304 delete_directory_and_contents(BaseDir).
1305pack_remove_forced(Pack) :-
1306 unattached_pacth(Pack, BaseDir),
1307 !,
1308 delete_directory_and_contents(BaseDir).
1309pack_remove_forced(Pack) :-
1310 print_message(informational, error(existence_error(pack, Pack),_)).
1311
1312confirm_remove(Pack, Deps, Delete) :-
1313 print_message(warning, pack(depends(Pack, Deps))),
1314 menu(pack(resolve_remove),
1315 [ [Pack] = remove_only(Pack),
1316 [Pack|Deps] = remove_deps(Pack, Deps),
1317 [] = cancel
1318 ], [], Delete, []),
1319 Delete \== [].
1320
1321
1322 1325
1346
1347pack_property(Pack, Property) :-
1348 findall(Pack-Property, pack_property_(Pack, Property), List),
1349 member(Pack-Property, List). 1350
1351pack_property_(Pack, Property) :-
1352 pack_info(Pack, _, Property).
1353pack_property_(Pack, Property) :-
1354 \+ \+ info_file(Property, _),
1355 '$pack':pack(Pack, BaseDir),
1356 access_file(BaseDir, read),
1357 directory_files(BaseDir, Files),
1358 member(File, Files),
1359 info_file(Property, Pattern),
1360 downcase_atom(File, Pattern),
1361 directory_file_path(BaseDir, File, InfoFile),
1362 arg(1, Property, InfoFile).
1363
1364info_file(readme(_), 'readme.txt').
1365info_file(readme(_), 'readme').
1366info_file(todo(_), 'todo.txt').
1367info_file(todo(_), 'todo').
1368
1369
1370 1373
1377
1378git_url(URL, Pack) :-
1379 uri_components(URL, Components),
1380 uri_data(scheme, Components, Scheme),
1381 nonvar(Scheme), 1382 uri_data(path, Components, Path),
1383 ( Scheme == git
1384 -> true
1385 ; git_download_scheme(Scheme),
1386 file_name_extension(_, git, Path)
1387 ; git_download_scheme(Scheme),
1388 catch(git_ls_remote(URL, _, [refs(['HEAD']), error(_)]), _, fail)
1389 -> true
1390 ),
1391 file_base_name(Path, PackExt),
1392 ( file_name_extension(Pack, git, PackExt)
1393 -> true
1394 ; Pack = PackExt
1395 ),
1396 ( safe_pack_name(Pack)
1397 -> true
1398 ; domain_error(pack_name, Pack)
1399 ).
1400
1401git_download_scheme(http).
1402git_download_scheme(https).
1403
1408
1409safe_pack_name(Name) :-
1410 atom_length(Name, Len),
1411 Len >= 3, 1412 atom_codes(Name, Codes),
1413 maplist(safe_pack_char, Codes),
1414 !.
1415
1416safe_pack_char(C) :- between(0'a, 0'z, C), !.
1417safe_pack_char(C) :- between(0'A, 0'Z, C), !.
1418safe_pack_char(C) :- between(0'0, 0'9, C), !.
1419safe_pack_char(0'_).
1420
1421
1422 1425
1432
1433pack_version_file(Pack, Version, GitHubRelease) :-
1434 atomic(GitHubRelease),
1435 github_release_url(GitHubRelease, Pack, Version),
1436 !.
1437pack_version_file(Pack, Version, Path) :-
1438 atomic(Path),
1439 file_base_name(Path, File),
1440 no_int_file_name_extension(Base, _Ext, File),
1441 atom_codes(Base, Codes),
1442 ( phrase(pack_version(Pack, Version), Codes),
1443 safe_pack_name(Pack)
1444 -> true
1445 ).
1446
1447no_int_file_name_extension(Base, Ext, File) :-
1448 file_name_extension(Base0, Ext0, File),
1449 \+ atom_number(Ext0, _),
1450 !,
1451 Base = Base0,
1452 Ext = Ext0.
1453no_int_file_name_extension(File, '', File).
1454
1455
1456
1465
1466github_release_url(URL, Pack, Version) :-
1467 uri_components(URL, Components),
1468 uri_data(authority, Components, 'github.com'),
1469 uri_data(scheme, Components, Scheme),
1470 download_scheme(Scheme),
1471 uri_data(path, Components, Path),
1472 github_archive_path(Archive,Pack,File),
1473 atomic_list_concat(Archive, /, Path),
1474 file_name_extension(Tag, Ext, File),
1475 github_archive_extension(Ext),
1476 tag_version(Tag, Version),
1477 !.
1478
1479github_archive_path(['',_User,Pack,archive,File],Pack,File).
1480github_archive_path(['',_User,Pack,archive,refs,tags,File],Pack,File).
1481
1482github_archive_extension(tgz).
1483github_archive_extension(zip).
1484
1485tag_version(Tag, Version) :-
1486 version_tag_prefix(Prefix),
1487 atom_concat(Prefix, AtomVersion, Tag),
1488 atom_version(AtomVersion, Version).
1489
1490version_tag_prefix(v).
1491version_tag_prefix('V').
1492version_tag_prefix('').
1493
1494
1495:- public
1496 atom_version/2. 1497
1503
1504atom_version(Atom, version(Parts)) :-
1505 ( atom(Atom)
1506 -> atom_codes(Atom, Codes),
1507 phrase(version(Parts), Codes)
1508 ; atomic_list_concat(Parts, '.', Atom)
1509 ).
1510
1511pack_version(Pack, version(Parts)) -->
1512 string(Codes), "-",
1513 version(Parts),
1514 !,
1515 { atom_codes(Pack, Codes)
1516 }.
1517
1518version([_|T]) -->
1519 "*",
1520 !,
1521 ( "."
1522 -> version(T)
1523 ; []
1524 ).
1525version([H|T]) -->
1526 integer(H),
1527 ( "."
1528 -> version(T)
1529 ; { T = [] }
1530 ).
1531
1532 1535
1553
1554pack_inquiry(_, _, _, Options) :-
1555 option(inquiry(false), Options),
1556 !.
1557pack_inquiry(URL, DownloadFile, Info, Options) :-
1558 setting(server, ServerBase),
1559 ServerBase \== '',
1560 atom_concat(ServerBase, query, Server),
1561 ( option(inquiry(true), Options)
1562 -> true
1563 ; confirm(inquiry(Server), yes, Options)
1564 ),
1565 !,
1566 ( DownloadFile = git(SHA1)
1567 -> true
1568 ; file_sha1(DownloadFile, SHA1)
1569 ),
1570 query_pack_server(install(URL, SHA1, Info), Reply, Options),
1571 inquiry_result(Reply, URL, Options).
1572pack_inquiry(_, _, _, _).
1573
1574
1579
1580query_pack_server(Query, Result, Options) :-
1581 setting(server, ServerBase),
1582 ServerBase \== '',
1583 atom_concat(ServerBase, query, Server),
1584 format(codes(Data), '~q.~n', Query),
1585 info_level(Informational, Options),
1586 print_message(Informational, pack(contacting_server(Server))),
1587 setup_call_cleanup(
1588 http_open(Server, In,
1589 [ post(codes(application/'x-prolog', Data)),
1590 header(content_type, ContentType)
1591 ]),
1592 read_reply(ContentType, In, Result),
1593 close(In)),
1594 message_severity(Result, Level, Informational),
1595 print_message(Level, pack(server_reply(Result))).
1596
1597read_reply(ContentType, In, Result) :-
1598 sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
1599 !,
1600 set_stream(In, encoding(utf8)),
1601 read(In, Result).
1602read_reply(ContentType, In, _Result) :-
1603 read_string(In, 500, String),
1604 print_message(error, pack(no_prolog_response(ContentType, String))),
1605 fail.
1606
1607info_level(Level, Options) :-
1608 option(silent(true), Options),
1609 !,
1610 Level = silent.
1611info_level(informational, _).
1612
1613message_severity(true(_), Informational, Informational).
1614message_severity(false, warning, _).
1615message_severity(exception(_), error, _).
1616
1617
1622
1623inquiry_result(Reply, File, Options) :-
1624 findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation),
1625 \+ member(cancel, Evaluation),
1626 select_option(git(_), Options, Options1, _),
1627 forall(member(install_dependencies(Resolution), Evaluation),
1628 maplist(install_dependency(Options1), Resolution)).
1629
1630eval_inquiry(true(Reply), URL, Eval, _) :-
1631 include(alt_hash, Reply, Alts),
1632 Alts \== [],
1633 print_message(warning, pack(alt_hashes(URL, Alts))),
1634 ( memberchk(downloads(Count), Reply),
1635 ( git_url(URL, _)
1636 -> Default = yes,
1637 Eval = with_git_commits_in_same_version
1638 ; Default = no,
1639 Eval = with_alt_hashes
1640 ),
1641 confirm(continue_with_alt_hashes(Count, URL), Default, [])
1642 -> true
1643 ; !, 1644 Eval = cancel
1645 ).
1646eval_inquiry(true(Reply), _, Eval, Options) :-
1647 include(dependency, Reply, Deps),
1648 Deps \== [],
1649 select_dependency_resolution(Deps, Eval, Options),
1650 ( Eval == cancel
1651 -> !
1652 ; true
1653 ).
1654eval_inquiry(true(Reply), URL, true, Options) :-
1655 file_base_name(URL, File),
1656 info_level(Informational, Options),
1657 print_message(Informational, pack(inquiry_ok(Reply, File))).
1658eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))),
1659 URL, Eval, Options) :-
1660 ( confirm(continue_with_modified_hash(URL), no, Options)
1661 -> Eval = true
1662 ; Eval = cancel
1663 ).
1664
1665alt_hash(alt_hash(_,_,_)).
1666dependency(dependency(_,_,_,_,_)).
1667
1668
1674
1675select_dependency_resolution(Deps, Eval, Options) :-
1676 resolve_dependencies(Deps, Resolution),
1677 exclude(local_dep, Resolution, ToBeDone),
1678 ( ToBeDone == []
1679 -> !, Eval = true
1680 ; print_message(warning, pack(install_dependencies(Resolution))),
1681 ( memberchk(_-unresolved, Resolution)
1682 -> Default = cancel
1683 ; Default = install_deps
1684 ),
1685 menu(pack(resolve_deps),
1686 [ install_deps = install_deps,
1687 install_no_deps = install_no_deps,
1688 cancel = cancel
1689 ], Default, Choice, Options),
1690 ( Choice == cancel
1691 -> !, Eval = cancel
1692 ; Choice == install_no_deps
1693 -> !, Eval = install_no_deps
1694 ; !, Eval = install_dependencies(Resolution)
1695 )
1696 ).
1697
1698local_dep(_-resolved(_)).
1699
1700
1706
1707install_dependency(Options,
1708 _Token-resolve(Pack, VersionAtom, [_URL|_], SubResolve)) :-
1709 atom_version(VersionAtom, Version),
1710 current_pack(Pack),
1711 pack_info(Pack, _, version(InstalledAtom)),
1712 atom_version(InstalledAtom, Installed),
1713 Installed == Version, 1714 !,
1715 maplist(install_dependency(Options), SubResolve).
1716install_dependency(Options,
1717 _Token-resolve(Pack, VersionAtom, [URL|_], SubResolve)) :-
1718 !,
1719 atom_version(VersionAtom, Version),
1720 merge_options([ url(URL),
1721 version(Version),
1722 interactive(false),
1723 inquiry(false),
1724 info(list),
1725 pack(Pack)
1726 ], Options, InstallOptions),
1727 pack_install(Pack, InstallOptions),
1728 maplist(install_dependency(Options), SubResolve).
1729install_dependency(_, _-_).
1730
1731
1732 1735
1742
1743available_download_versions(URL, Versions) :-
1744 wildcard_pattern(URL),
1745 github_url(URL, User, Repo),
1746 !,
1747 findall(Version-VersionURL,
1748 github_version(User, Repo, Version, VersionURL),
1749 Versions).
1750available_download_versions(URL, Versions) :-
1751 wildcard_pattern(URL),
1752 !,
1753 file_directory_name(URL, DirURL0),
1754 ensure_slash(DirURL0, DirURL),
1755 print_message(informational, pack(query_versions(DirURL))),
1756 setup_call_cleanup(
1757 http_open(DirURL, In, []),
1758 load_html(stream(In), DOM,
1759 [ syntax_errors(quiet)
1760 ]),
1761 close(In)),
1762 findall(MatchingURL,
1763 absolute_matching_href(DOM, URL, MatchingURL),
1764 MatchingURLs),
1765 ( MatchingURLs == []
1766 -> print_message(warning, pack(no_matching_urls(URL)))
1767 ; true
1768 ),
1769 versioned_urls(MatchingURLs, VersionedURLs),
1770 keysort(VersionedURLs, SortedVersions),
1771 reverse(SortedVersions, Versions),
1772 print_message(informational, pack(found_versions(Versions))).
1773available_download_versions(URL, [Version-URL]) :-
1774 ( pack_version_file(_Pack, Version0, URL)
1775 -> Version = Version0
1776 ; Version = unknown
1777 ).
1778
1782
1783github_url(URL, User, Repo) :-
1784 uri_components(URL, uri_components(https,'github.com',Path,_,_)),
1785 atomic_list_concat(['',User,Repo|_], /, Path).
1786
1787
1792
1793github_version(User, Repo, Version, VersionURI) :-
1794 atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
1795 uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
1796 setup_call_cleanup(
1797 http_open(ApiUri, In,
1798 [ request_header('Accept'='application/vnd.github.v3+json')
1799 ]),
1800 json_read_dict(In, Dicts),
1801 close(In)),
1802 member(Dict, Dicts),
1803 atom_string(Tag, Dict.name),
1804 tag_version(Tag, Version),
1805 atom_string(VersionURI, Dict.zipball_url).
1806
1807wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
1808wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
1809
1810ensure_slash(Dir, DirS) :-
1811 ( sub_atom(Dir, _, _, 0, /)
1812 -> DirS = Dir
1813 ; atom_concat(Dir, /, DirS)
1814 ).
1815
1816absolute_matching_href(DOM, Pattern, Match) :-
1817 xpath(DOM, //a(@href), HREF),
1818 uri_normalized(HREF, Pattern, Match),
1819 wildcard_match(Pattern, Match).
1820
1821versioned_urls([], []).
1822versioned_urls([H|T0], List) :-
1823 file_base_name(H, File),
1824 ( pack_version_file(_Pack, Version, File)
1825 -> List = [Version-H|T]
1826 ; List = T
1827 ),
1828 versioned_urls(T0, T).
1829
1830
1831 1834
1838
1839update_dependency_db :-
1840 retractall(pack_requires(_,_)),
1841 retractall(pack_provides_db(_,_)),
1842 forall(current_pack(Pack),
1843 ( findall(Info, pack_info(Pack, dependency, Info), Infos),
1844 update_dependency_db(Pack, Infos)
1845 )).
1846
1847update_dependency_db(Name, Info) :-
1848 retractall(pack_requires(Name, _)),
1849 retractall(pack_provides_db(Name, _)),
1850 maplist(assert_dep(Name), Info).
1851
1852assert_dep(Pack, provides(Token)) :-
1853 !,
1854 assertz(pack_provides_db(Pack, Token)).
1855assert_dep(Pack, requires(Token)) :-
1856 !,
1857 assertz(pack_requires(Pack, Token)).
1858assert_dep(_, _).
1859
1863
1864validate_dependencies :-
1865 unsatisfied_dependencies(Unsatisfied),
1866 !,
1867 print_message(warning, pack(unsatisfied(Unsatisfied))).
1868validate_dependencies.
1869
1870
1871unsatisfied_dependencies(Unsatisfied) :-
1872 findall(Req-Pack, pack_requires(Pack, Req), Reqs0),
1873 keysort(Reqs0, Reqs1),
1874 group_pairs_by_key(Reqs1, GroupedReqs),
1875 exclude(satisfied_dependency, GroupedReqs, Unsatisfied),
1876 Unsatisfied \== [].
1877
1878satisfied_dependency(Needed-_By) :-
1879 pack_provides(_, Needed),
1880 !.
1881satisfied_dependency(Needed-_By) :-
1882 compound(Needed),
1883 Needed =.. [Op, Pack, ReqVersion],
1884 ( pack_provides(Pack, Pack)
1885 -> pack_info(Pack, _, version(PackVersion)),
1886 version_data(PackVersion, PackData)
1887 ; Pack == prolog
1888 -> current_prolog_flag(version_data, swi(Major,Minor,Patch,_)),
1889 PackData = [Major,Minor,Patch]
1890 ),
1891 version_data(ReqVersion, ReqData),
1892 cmp(Op, Cmp),
1893 call(Cmp, PackData, ReqData).
1894
1898
1899pack_provides(Pack, Pack) :-
1900 current_pack(Pack).
1901pack_provides(Pack, Token) :-
1902 pack_provides_db(Pack, Token).
1903
1907
1908pack_depends_on(Pack, Dependency) :-
1909 ( atom(Pack)
1910 -> pack_depends_on_fwd(Pack, Dependency, [Pack])
1911 ; pack_depends_on_bwd(Pack, Dependency, [Dependency])
1912 ).
1913
1914pack_depends_on_fwd(Pack, Dependency, Visited) :-
1915 pack_depends_on_1(Pack, Dep1),
1916 \+ memberchk(Dep1, Visited),
1917 ( Dependency = Dep1
1918 ; pack_depends_on_fwd(Dep1, Dependency, [Dep1|Visited])
1919 ).
1920
1921pack_depends_on_bwd(Pack, Dependency, Visited) :-
1922 pack_depends_on_1(Dep1, Dependency),
1923 \+ memberchk(Dep1, Visited),
1924 ( Pack = Dep1
1925 ; pack_depends_on_bwd(Pack, Dep1, [Dep1|Visited])
1926 ).
1927
1928pack_depends_on_1(Pack, Dependency) :-
1929 atom(Dependency),
1930 !,
1931 pack_provides(Dependency, Token),
1932 pack_requires(Pack, Token).
1933pack_depends_on_1(Pack, Dependency) :-
1934 pack_requires(Pack, Token),
1935 pack_provides(Dependency, Token).
1936
1937
1951
1952resolve_dependencies(Dependencies, Resolution) :-
1953 maplist(dependency_pair, Dependencies, Pairs0),
1954 keysort(Pairs0, Pairs1),
1955 group_pairs_by_key(Pairs1, ByToken),
1956 maplist(resolve_dep, ByToken, Resolution).
1957
1958dependency_pair(dependency(Token, Pack, Version, URLs, SubDeps),
1959 Token-(Pack-pack(Version,URLs, SubDeps))).
1960
1961resolve_dep(Token-Pairs, Token-Resolution) :-
1962 ( resolve_dep2(Token-Pairs, Resolution)
1963 *-> true
1964 ; Resolution = unresolved
1965 ).
1966
1967resolve_dep2(Token-_, resolved(Pack)) :-
1968 pack_provides(Pack, Token).
1969resolve_dep2(_-Pairs, resolve(Pack, VersionAtom, URLs, SubResolves)) :-
1970 keysort(Pairs, Sorted),
1971 group_pairs_by_key(Sorted, ByPack),
1972 member(Pack-Versions, ByPack),
1973 Pack \== (-),
1974 maplist(version_pack, Versions, VersionData),
1975 sort(VersionData, ByVersion),
1976 reverse(ByVersion, ByVersionLatest),
1977 member(pack(Version,URLs,SubDeps), ByVersionLatest),
1978 atom_version(VersionAtom, Version),
1979 include(dependency, SubDeps, Deps),
1980 resolve_dependencies(Deps, SubResolves).
1981
1982version_pack(pack(VersionAtom,URLs,SubDeps),
1983 pack(Version,URLs,SubDeps)) :-
1984 atom_version(VersionAtom, Version).
1985
1986
1987
2007
2008pack_attach(Dir, Options) :-
2009 '$pack_attach'(Dir, Options).
2010
2011
2012 2015
2016:- multifile prolog:message//1. 2017
2019
(_Question, _Alternatives, Default, Selection, Options) :-
2021 option(interactive(false), Options),
2022 !,
2023 Selection = Default.
2024menu(Question, Alternatives, Default, Selection, _) :-
2025 length(Alternatives, N),
2026 between(1, 5, _),
2027 print_message(query, Question),
2028 print_menu(Alternatives, Default, 1),
2029 print_message(query, pack(menu(select))),
2030 read_selection(N, Choice),
2031 !,
2032 ( Choice == default
2033 -> Selection = Default
2034 ; nth1(Choice, Alternatives, Selection=_)
2035 -> true
2036 ).
2037
([], _, _).
2039print_menu([Value=Label|T], Default, I) :-
2040 ( Value == Default
2041 -> print_message(query, pack(menu(default_item(I, Label))))
2042 ; print_message(query, pack(menu(item(I, Label))))
2043 ),
2044 I2 is I + 1,
2045 print_menu(T, Default, I2).
2046
2047read_selection(Max, Choice) :-
2048 get_single_char(Code),
2049 ( answered_default(Code)
2050 -> Choice = default
2051 ; code_type(Code, digit(Choice)),
2052 between(1, Max, Choice)
2053 -> true
2054 ; print_message(warning, pack(menu(reply(1,Max)))),
2055 fail
2056 ).
2057
2063
2064confirm(_Question, Default, Options) :-
2065 Default \== none,
2066 option(interactive(false), Options, true),
2067 !,
2068 Default == yes.
2069confirm(Question, Default, _) :-
2070 between(1, 5, _),
2071 print_message(query, pack(confirm(Question, Default))),
2072 read_yes_no(YesNo, Default),
2073 !,
2074 format(user_error, '~N', []),
2075 YesNo == yes.
2076
2077read_yes_no(YesNo, Default) :-
2078 get_single_char(Code),
2079 code_yes_no(Code, Default, YesNo),
2080 !.
2081
2082code_yes_no(0'y, _, yes).
2083code_yes_no(0'Y, _, yes).
2084code_yes_no(0'n, _, no).
2085code_yes_no(0'N, _, no).
2086code_yes_no(_, none, _) :- !, fail.
2087code_yes_no(C, Default, Default) :-
2088 answered_default(C).
2089
2090answered_default(0'\r).
2091answered_default(0'\n).
2092answered_default(0'\s).
2093
2094
2095 2098
2099:- multifile prolog:message//1. 2100
2101prolog:message(pack(Message)) -->
2102 message(Message).
2103
2104:- discontiguous
2105 message//1,
2106 label//1. 2107
2108message(invalid_info(Term)) -->
2109 [ 'Invalid package description: ~q'-[Term] ].
2110message(directory_exists(Dir)) -->
2111 [ 'Package target directory exists and is not empty:', nl,
2112 '\t~q'-[Dir]
2113 ].
2114message(already_installed(pack(Pack, Version))) -->
2115 { atom_version(AVersion, Version) },
2116 [ 'Pack `~w'' is already installed @~w'-[Pack, AVersion] ].
2117message(already_installed(Pack)) -->
2118 [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
2119message(invalid_name(File)) -->
2120 [ '~w: A package archive must be named <pack>-<version>.<ext>'-[File] ],
2121 no_tar_gz(File).
2122
2123no_tar_gz(File) -->
2124 { sub_atom(File, _, _, 0, '.tar.gz') },
2125 !,
2126 [ nl,
2127 'Package archive files must have a single extension. E.g., \'.tgz\''-[]
2128 ].
2129no_tar_gz(_) --> [].
2130
2131message(kept_foreign(Pack)) -->
2132 [ 'Found foreign libraries for target platform.'-[], nl,
2133 'Use ?- pack_rebuild(~q). to rebuild from sources'-[Pack]
2134 ].
2135message(no_pack_installed(Pack)) -->
2136 [ 'No pack ~q installed. Use ?- pack_list(Pattern) to search'-[Pack] ].
2137message(no_packages_installed) -->
2138 { setting(server, ServerBase) },
2139 [ 'There are no extra packages installed.', nl,
2140 'Please visit ~wlist.'-[ServerBase]
2141 ].
2142message(remove_with(Pack)) -->
2143 [ 'The package can be removed using: ?- ~q.'-[pack_remove(Pack)]
2144 ].
2145message(unsatisfied(Packs)) -->
2146 [ 'The following dependencies are not satisfied:', nl ],
2147 unsatisfied(Packs).
2148message(depends(Pack, Deps)) -->
2149 [ 'The following packages depend on `~w\':'-[Pack], nl ],
2150 pack_list(Deps).
2151message(remove(PackDir)) -->
2152 [ 'Removing ~q and contents'-[PackDir] ].
2153message(remove_existing_pack(PackDir)) -->
2154 [ 'Remove old installation in ~q'-[PackDir] ].
2155message(install_from(Pack, Version, git(URL))) -->
2156 [ 'Install ~w@~w from GIT at ~w'-[Pack, Version, URL] ].
2157message(install_from(Pack, Version, URL)) -->
2158 [ 'Install ~w@~w from ~w'-[Pack, Version, URL] ].
2159message(select_install_from(Pack, Version)) -->
2160 [ 'Select download location for ~w@~w'-[Pack, Version] ].
2161message(install_downloaded(File)) -->
2162 { file_base_name(File, Base),
2163 size_file(File, Size) },
2164 [ 'Install "~w" (~D bytes)'-[Base, Size] ].
2165message(git_post_install(PackDir, Pack)) -->
2166 ( { is_foreign_pack(PackDir, _) }
2167 -> [ 'Run post installation scripts for pack "~w"'-[Pack] ]
2168 ; [ 'Activate pack "~w"'-[Pack] ]
2169 ).
2170message(no_meta_data(BaseDir)) -->
2171 [ 'Cannot find pack.pl inside directory ~q. Not a package?'-[BaseDir] ].
2172message(inquiry(Server)) -->
2173 [ 'Verify package status (anonymously)', nl,
2174 '\tat "~w"'-[Server]
2175 ].
2176message(search_no_matches(Name)) -->
2177 [ 'Search for "~w", returned no matching packages'-[Name] ].
2178message(rebuild(Pack)) -->
2179 [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
2180message(upgrade(Pack, From, To)) -->
2181 [ 'Upgrade "~w" from '-[Pack] ],
2182 msg_version(From), [' to '-[]], msg_version(To).
2183message(up_to_date(Pack)) -->
2184 [ 'Package "~w" is up-to-date'-[Pack] ].
2185message(query_versions(URL)) -->
2186 [ 'Querying "~w" to find new versions ...'-[URL] ].
2187message(no_matching_urls(URL)) -->
2188 [ 'Could not find any matching URL: ~q'-[URL] ].
2189message(found_versions([Latest-_URL|More])) -->
2190 { length(More, Len),
2191 atom_version(VLatest, Latest)
2192 },
2193 [ ' Latest version: ~w (~D older)'-[VLatest, Len] ].
2194message(process_output(Codes)) -->
2195 { split_lines(Codes, Lines) },
2196 process_lines(Lines).
2197message(contacting_server(Server)) -->
2198 [ 'Contacting server at ~w ...'-[Server], flush ].
2199message(server_reply(true(_))) -->
2200 [ at_same_line, ' ok'-[] ].
2201message(server_reply(false)) -->
2202 [ at_same_line, ' done'-[] ].
2203message(server_reply(exception(E))) -->
2204 [ 'Server reported the following error:'-[], nl ],
2205 '$messages':translate_message(E).
2206message(cannot_create_dir(Alias)) -->
2207 { findall(PackDir,
2208 absolute_file_name(Alias, PackDir, [solutions(all)]),
2209 PackDirs0),
2210 sort(PackDirs0, PackDirs)
2211 },
2212 [ 'Cannot find a place to create a package directory.'-[],
2213 'Considered:'-[]
2214 ],
2215 candidate_dirs(PackDirs).
2216message(no_match(Name)) -->
2217 [ 'No registered pack matches "~w"'-[Name] ].
2218message(conflict(version, [PackV, FileV])) -->
2219 ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
2220 [', file claims version '-[]], msg_version(FileV).
2221message(conflict(name, [PackInfo, FileInfo])) -->
2222 ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
2223 [', file claims ~w: ~p'-[FileInfo]].
2224message(no_prolog_response(ContentType, String)) -->
2225 [ 'Expected Prolog response. Got content of type ~p'-[ContentType], nl,
2226 '~s'-[String]
2227 ].
2228message(pack(no_upgrade_info(Pack))) -->
2229 [ '~w: pack meta-data does not provide an upgradable URL'-[Pack] ].
2230
2231candidate_dirs([]) --> [].
2232candidate_dirs([H|T]) --> [ nl, ' ~w'-[H] ], candidate_dirs(T).
2233
2234 2235message(resolve_remove) -->
2236 [ nl, 'Please select an action:', nl, nl ].
2237message(create_pack_dir) -->
2238 [ nl, 'Create directory for packages', nl ].
2239message(menu(item(I, Label))) -->
2240 [ '~t(~d)~6| '-[I] ],
2241 label(Label).
2242message(menu(default_item(I, Label))) -->
2243 [ '~t(~d)~6| * '-[I] ],
2244 label(Label).
2245message(menu(select)) -->
2246 [ nl, 'Your choice? ', flush ].
2247message(confirm(Question, Default)) -->
2248 message(Question),
2249 confirm_default(Default),
2250 [ flush ].
2251message(menu(reply(Min,Max))) -->
2252 ( { Max =:= Min+1 }
2253 -> [ 'Please enter ~w or ~w'-[Min,Max] ]
2254 ; [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
2255 ).
2256
2258
2259message(alt_hashes(URL, _Alts)) -->
2260 { git_url(URL, _)
2261 },
2262 !,
2263 [ 'GIT repository was updated without updating version' ].
2264message(alt_hashes(URL, Alts)) -->
2265 { file_base_name(URL, File)
2266 },
2267 [ 'Found multiple versions of "~w".'-[File], nl,
2268 'This could indicate a compromised or corrupted file', nl
2269 ],
2270 alt_hashes(Alts).
2271message(continue_with_alt_hashes(Count, URL)) -->
2272 [ 'Continue installation from "~w" (downloaded ~D times)'-[URL, Count] ].
2273message(continue_with_modified_hash(_URL)) -->
2274 [ 'Pack may be compromised. Continue anyway'
2275 ].
2276message(modified_hash(_SHA1-URL, _SHA2-[URL])) -->
2277 [ 'Content of ~q has changed.'-[URL]
2278 ].
2279
2280alt_hashes([]) --> [].
2281alt_hashes([H|T]) --> alt_hash(H), ( {T == []} -> [] ; [nl], alt_hashes(T) ).
2282
2283alt_hash(alt_hash(Count, URLs, Hash)) -->
2284 [ '~t~d~8| ~w'-[Count, Hash] ],
2285 alt_urls(URLs).
2286
2287alt_urls([]) --> [].
2288alt_urls([H|T]) -->
2289 [ nl, ' ~w'-[H] ],
2290 alt_urls(T).
2291
2293
2294message(install_dependencies(Resolution)) -->
2295 [ 'Package depends on the following:' ],
2296 msg_res_tokens(Resolution, 1).
2297
2298msg_res_tokens([], _) --> [].
2299msg_res_tokens([H|T], L) --> msg_res_token(H, L), msg_res_tokens(T, L).
2300
2301msg_res_token(Token-unresolved, L) -->
2302 res_indent(L),
2303 [ '"~w" cannot be satisfied'-[Token] ].
2304msg_res_token(Token-resolve(Pack, Version, [URL|_], SubResolves), L) -->
2305 !,
2306 res_indent(L),
2307 [ '"~w", provided by ~w@~w from ~w'-[Token, Pack, Version, URL] ],
2308 { L2 is L+1 },
2309 msg_res_tokens(SubResolves, L2).
2310msg_res_token(Token-resolved(Pack), L) -->
2311 !,
2312 res_indent(L),
2313 [ '"~w", provided by installed pack ~w'-[Token,Pack] ].
2314
2315res_indent(L) -->
2316 { I is L*2 },
2317 [ nl, '~*c'-[I,0'\s] ].
2318
2319message(resolve_deps) -->
2320 [ nl, 'What do you wish to do' ].
2321label(install_deps) -->
2322 [ 'Install proposed dependencies' ].
2323label(install_no_deps) -->
2324 [ 'Only install requested package' ].
2325
2326
2327message(git_fetch(Dir)) -->
2328 [ 'Running "git fetch" in ~q'-[Dir] ].
2329
2331
2332message(inquiry_ok(Reply, File)) -->
2333 { memberchk(downloads(Count), Reply),
2334 memberchk(rating(VoteCount, Rating), Reply),
2335 !,
2336 length(Stars, Rating),
2337 maplist(=(0'*), Stars)
2338 },
2339 [ '"~w" was downloaded ~D times. Package rated ~s (~D votes)'-
2340 [ File, Count, Stars, VoteCount ]
2341 ].
2342message(inquiry_ok(Reply, File)) -->
2343 { memberchk(downloads(Count), Reply)
2344 },
2345 [ '"~w" was downloaded ~D times'-[ File, Count ] ].
2346
2347 2348unsatisfied([]) --> [].
2349unsatisfied([Needed-[By]|T]) -->
2350 [ ' - "~w" is needed by package "~w"'-[Needed, By], nl ],
2351 unsatisfied(T).
2352unsatisfied([Needed-By|T]) -->
2353 [ ' - "~w" is needed by the following packages:'-[Needed], nl ],
2354 pack_list(By),
2355 unsatisfied(T).
2356
2357pack_list([]) --> [].
2358pack_list([H|T]) -->
2359 [ ' - Package "~w"'-[H], nl ],
2360 pack_list(T).
2361
2362process_lines([]) --> [].
2363process_lines([H|T]) -->
2364 [ '~s'-[H] ],
2365 ( {T==[]}
2366 -> []
2367 ; [nl], process_lines(T)
2368 ).
2369
2370split_lines([], []) :- !.
2371split_lines(All, [Line1|More]) :-
2372 append(Line1, [0'\n|Rest], All),
2373 !,
2374 split_lines(Rest, More).
2375split_lines(Line, [Line]).
2376
2377label(remove_only(Pack)) -->
2378 [ 'Only remove package ~w (break dependencies)'-[Pack] ].
2379label(remove_deps(Pack, Deps)) -->
2380 { length(Deps, Count) },
2381 [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
2382label(create_dir(Dir)) -->
2383 [ '~w'-[Dir] ].
2384label(install_from(git(URL))) -->
2385 !,
2386 [ 'GIT repository at ~w'-[URL] ].
2387label(install_from(URL)) -->
2388 [ '~w'-[URL] ].
2389label(cancel) -->
2390 [ 'Cancel' ].
2391
2392confirm_default(yes) -->
2393 [ ' Y/n? ' ].
2394confirm_default(no) -->
2395 [ ' y/N? ' ].
2396confirm_default(none) -->
2397 [ ' y/n? ' ].
2398
2399msg_version(Version) -->
2400 { atom(Version) },
2401 !,
2402 [ '~w'-[Version] ].
2403msg_version(VersionData) -->
2404 !,
2405 { atom_version(Atom, VersionData) },
2406 [ '~w'-[Atom] ]