1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2013, VU University Amsterdam
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalidate any other reasons why the executable file might be covered by
   27    the GNU General Public License.
   28*/
   29
   30:- module(pack_analyzer,
   31	  [ pack_analysis/2,			% +Pack, -Results
   32	    xref_pack/1,			% +Pack
   33	    pack_prolog_entry/1,		% +Entry
   34	    xref_pack_file/2,			% +Pack, +File
   35	    pack_members/2,			% +Pack, -Members
   36	    pack_open_entry/3			% +Pack, +Entry, -Stream
   37	  ]).   38:- use_module(library(lists)).   39:- use_module(library(apply)).   40:- use_module(library(archive)).   41:- use_module(library(filesex)).   42:- use_module(library(prolog_xref)).   43:- use_module(library(prolog_source)).   44:- use_module(library(option)).   45:- use_module(library(debug)).   46:- use_module(library(git)).   47
   48:- use_module(pack_mirror).   49:- use_module(pack_info).   50
   51/** <module> Analyse the content of a Prolog pack
   52
   53This module analyses a Prolog pack without loading it.
   54*/
   55
   56:- dynamic
   57	pack_dependency/4.   58
   59:- meta_predicate
   60	find_unique(?, 0, ?, ?).   61
   62%%	pack_analysis(+Pack, -Results)
   63%
   64%	Result is the analysis  result  for   Pack.  Results  is a list,
   65%	containing the following elements:
   66%
   67%	  * size(SizeBytes)
   68%	  Summed size of all files in Pack.  Always exactly one.
   69%	  * files(Files)
   70%	  List of files in the pack.  Each file is represented by a
   71%	  term file(Name, SizeBytes).
   72%	  * prolog_source(File, Size, Module, Exports, Extra)
   73%	  One for each Prolog file in pack.  If the file is not a module
   74%	  file, Module is unified to =|-|= and Exports is []. Each
   75%	  member of Exports is a term export(PI, Info), where Info
   76%	  is a list with additional properties.  Currently defined
   77%	  Info terms are:
   78%	    - doc(Summary, Comment)
   79%	  Extra is reserved for additional information.  Currently defines:
   80%	    - doc(Title, Comment)
   81
   82pack_analysis(Pack,
   83	      [ size(Size),
   84		files(Members)
   85	      | Results
   86	      ]) :-
   87	pack_members(Pack, Members),
   88	maplist(arg(2), Members, SizeByFile),
   89	sum_list(SizeByFile, Size),
   90	xref_pack(Pack),
   91	find_unique(Readme, readme(Pack, Members, Readme), Results, Res0),
   92	find_unique(Info,   file_info(Pack, Members, Info), Res0, Res1),
   93	find_unique(ReqF,   required_file(Pack, ReqF), Res1, Res2),
   94	find_unique(ReqP,   required_predicate(Pack, ReqP), Res2, []).
   95
   96find_unique(Templ, Goal, List, Tail) :-
   97	findall(Templ, Goal, List0),
   98	sort(List0, List1),
   99	append(List1, Tail, List).
  100
  101readme(Pack, Members, readme(Text)) :-
  102	member(file(Name, _Size), Members),
  103	downcase_atom(Name, Down),
  104	readme_file(Down), !,
  105	setup_call_cleanup(
  106	    pack_open_entry(Pack, Name, Stream),
  107	    read_stream_to_codes(Stream, Codes),
  108	    close(Stream)),
  109	string_to_list(Text, Codes).
  110
  111readme_file(readme).
  112readme_file('readme.txt').
  113
  114
  115file_info(Pack, Members,
  116	  prolog_source(Entry, Size, Module, Exports, Documentation)) :-
  117	xref_pack_source(Pack, Entry, Source),
  118	memberchk(file(Entry,Size), Members),
  119	(   xref_module(Source, Module)
  120	->  findall(export(Name/Arity, Info),
  121		    ( xref_exported(Source, Head),
  122		      functor(Head, Name, Arity),
  123		      (	  xref_comment(Source, Head, Summary, PredComment)
  124		      ->  Info = [doc(Summary, PredComment)]
  125		      ;	  Info = []
  126		      )
  127		    ),
  128		    Exports)
  129	;   Module = (-),			% Warning?
  130	    Exports = []
  131	),
  132	(   xref_comment(Source, Title, FileComment)
  133	->  Documentation = [ doc(Title, FileComment) ]
  134	;   Documentation = []
  135	).
  136
  137required_file(Pack, required_file(Spec, From)) :-
  138	xref_pack_source(Pack, _, Source),
  139	xref_uses_file(Source, Spec, File),
  140	classify_file(Pack, File, From0),
  141	from_class(From0, From).
  142
  143from_class(pack(Pack), pack(Pack)) :- !.
  144from_class(Alias, From) :-
  145	functor(Alias, From, 1), !.
  146from_class(From, From).
  147
  148classify_file(Pack, File, From) :-
  149	(   xref_pack_source(Pack, _, File)
  150	->  From = pack
  151	;   absolute_file_name(pack(.), PackRoot,
  152			       [ file_type(directory),
  153				 solutions(all)
  154			       ]),
  155	    atom_concat(PackRoot, Local, File)
  156	->  atomic_list_concat(Segments, /, Local),
  157	    Segments = [FromPack|_],
  158	    From = pack(FromPack)
  159	;   absolute_file_name(swi(.), SwiRoot,
  160			       [ file_type(directory)
  161			       ]),
  162	    atom_concat(SwiRoot, _, File)
  163	->  file_name_on_path(File, From)
  164	;   From = File				% Needs further classification
  165	).
  166
  167%%	required_predicate(+Pack, -Required) is nondet.
  168%
  169%	True if Required is a predicate that is required by Pack.
  170
  171required_predicate(Pack, required_predicate(Name/Arity, From)) :-
  172	xref_pack_source(Pack, _, Source),
  173	xref_called(Source, Head, _By),
  174	functor(Head, Name, Arity),
  175	(   xref_defined(Source, Head, How)
  176	->  classify_predicate_source(How, Pack, From)
  177	;   predicate_property(Head, iso)
  178	->  From = iso
  179	;   predicate_property(system:Head, visible)
  180	->  From = swi
  181	;   predicate_property(Head, autoload(Autoload))
  182	->  classify_file(Pack, Autoload, From)
  183	;   From = undefined
  184	).
  185
  186classify_predicate_source(imported(File), Pack, From) :-
  187	classify_file(Pack, File, From).
  188
  189
  190%%	xref_pack(+Pack) is det.
  191%
  192%	Run the cross-referencer on all Prolog files inside pack.
  193
  194xref_pack(Pack) :-
  195	absolute_file_name(Pack, PackPath),
  196	retractall(pack_dependency(PackPath, _Spec, _How, _Dep)),
  197	pack_members(PackPath, Members),
  198	maplist(arg(1), Members, Entries),
  199	include(pack_prolog_entry, Entries, PrologEntries),
  200	maplist(xref_pack_file(PackPath), PrologEntries).
  201
  202pack_prolog_entry(Entry) :-
  203	sub_atom(Entry, 0, _, _, 'prolog/'),
  204	file_name_extension(_, Ext, Entry),
  205	user:prolog_file_type(Ext, prolog), !.
  206
  207
  208%%	xref_pack_file(+Pack, +File) is det.
  209%
  210%	Run the cross-referencer on File inside Pack.
  211
  212xref_pack_file(Pack, File) :-
  213	catch(xref_pack_file_2(Pack, File),
  214	      E, print_message(error, E)), !.
  215xref_pack_file(Pack, File) :-
  216	print_message(warning,
  217		      error(goal_failed(xref_pack_file(Pack, File)),
  218			    _)).
  219
  220xref_pack_file_2(Pack, File) :-
  221	exists_directory(Pack), !,
  222	directory_file_path(Pack, File, Path),
  223	xref_source(Path, [register_called(all)]).
  224xref_pack_file_2(Pack, File) :-
  225	absolute_file_name(Pack, AbsPack,
  226			   [ access(read)
  227			   ]),
  228	directory_file_path(AbsPack, File, Path),
  229	xref_source(Path, [register_called(all)]).
  230
  231
  232		 /*******************************
  233		 *	      MEMBERS		*
  234		 *******************************/
  235
  236%%	pack_open_entry(+Pack, +Entry, -Stream) is det.
  237%
  238%	Open an entry in the Pack for  reading. The entry must be closed
  239%	with close/1.
  240
  241pack_open_entry(Directory, Entry, Stream) :-
  242	exists_directory(Directory), !,
  243	directory_file_path(Directory, Entry, File),
  244	open(File, read, Stream).
  245pack_open_entry(Archive, Entry, Stream) :-
  246	ar_prefix(Archive, Prefix),
  247	atom_concat(Prefix, Entry, Name),
  248	setup_call_cleanup(
  249	    archive_open(Archive, Handle, []),
  250	    ( archive_next_header(Handle, Name),
  251	      archive_open_entry(Handle, Stream)
  252	    ),
  253	    archive_close(Handle)),
  254	format(atom(StreamName), '~w/~w', [Archive, Entry]),
  255	set_stream(Stream, file_name(StreamName)).
  256
  257:- dynamic
  258	ar_prefix_cache/2,
  259	ar_members_cache/3.  260
  261ar_prefix(Archive, Prefix) :-
  262	ar_prefix_cache(Archive, Prefix0), !,
  263	Prefix = Prefix0.
  264ar_prefix(Archive, Prefix) :-
  265	ar_pack_members(Archive, _, Prefix),
  266	assertz(ar_prefix_cache(Archive, Prefix)).
  267
  268%%	pack_members(+Pack, -Members:list) is det.
  269%
  270%	Members is a list of file(File,Size) that represent the files in
  271%	Pack. Pack is either a git repository, a directory holding files
  272%	or an archive.
  273
  274:- dynamic
  275	pack_member_cache/3.  276
  277pack_members(Dir, Members) :-
  278	time_file(Dir, T),
  279	pack_member_cache(Dir, T, Members0), !,
  280	Members = Members0.
  281pack_members(Dir, Members) :-
  282	pack_members_no_cache(Dir, Members0),
  283	time_file(Dir, T),
  284	asserta(pack_member_cache(Dir, T, Members0)),
  285	Members = Members0.
  286
  287pack_members_no_cache(Directory, Members) :-
  288	is_git_directory(Directory), !,
  289	git_ls_tree(Entries, [directory(Directory)]),
  290	include(git_blob, Entries, Blobs),
  291	maplist(git_entry, Blobs, Members).
  292pack_members_no_cache(Directory, Members) :-
  293	exists_directory(Directory), !,
  294	recursive_directory_files(Directory, Files),
  295	maplist(file_entry(Directory), Files, Members).
  296pack_members_no_cache(Archive, Members) :-
  297	E = error(archive_error(_,_),_),
  298	catch(ar_pack_members(Archive, Members0, Prefix),
  299	      E, bad_archive(Archive, E)),
  300	maplist(strip_prefix(Prefix), Members0, Members).
  301
  302bad_archive(Archive, Error) :-
  303	delete_file(Archive),
  304	throw(Error).
  305
  306git_blob(object(_Mode, blob, _Hash, _Size, _Name)).
  307git_entry(object(_Mode, blob, _Hash, Size, Name), file(Name, Size)).
  308
  309ar_pack_members(Archive, Members, Prefix) :-
  310	(   ar_members_cache(Archive, Members0, Prefix0)
  311	->  true
  312	;   read_ar_pack_members(Archive, Members0, Prefix0)
  313	->  asserta(ar_members_cache(Archive, Members0, Prefix0))
  314	),
  315	Members = Members0,
  316	Prefix  = Prefix0.
  317
  318read_ar_pack_members(Archive, Members0, Prefix) :-
  319	setup_call_cleanup(
  320	    archive_open(Archive, Handle, []),
  321	    findall(Member, ar_member(Handle, Member), Members0),
  322	    archive_close(Handle)),
  323	(   member(file(InfoFile,_), Members0),
  324	    atom_concat(Prefix, 'pack.pl', InfoFile)
  325	->  true
  326	;   existence_error(pack_file, 'pack.pl')
  327	).
  328
  329ar_member(Handle, Entry) :-
  330	repeat,
  331	(   archive_next_header(Handle, File)
  332	->  true
  333	;   !, fail
  334	),
  335	archive_header_property(Handle, filetype(Type)),
  336	make_entry(Type, Handle, File, Entry).
  337
  338make_entry(file, Handle, File, file(File, Size)) :- !,
  339	archive_header_property(Handle, size(Size)).
  340make_entry(link, Handle, File, link(File, Target)) :- !,
  341	archive_header_property(Handle, link_target(Target)).
  342make_entry(directory, _, _, _) :- !,
  343	fail.
  344make_entry(Type, _, Name, Entry) :-
  345	atom(Type), !,
  346	Entry =.. [Type, Name].
  347make_entry(Type, _, Name, _Entry) :-
  348	print_message(warning, unknown_archive_type(Type, Name)),
  349	fail.
  350
  351strip_prefix(Prefix, Term0, Term) :-
  352	Term0 =.. [Type, Name, Size],
  353	atom_concat(Prefix, Stripped, Name),
  354	Term =.. [Type, Stripped, Size].
  355
  356file_entry(Pack, File, file(File,Size)) :-
  357	directory_file_path(Pack, File, Path),
  358	size_file(Path, Size).
  359
  360%%	recursive_directory_files(+Dir, -Files) is det.
  361%
  362%	True when Files is a list holding all files in Dir, recursively.
  363
  364recursive_directory_files(Dir, Files) :-
  365	dir_prefix(Dir, Prefix),
  366	recursive_directory_files(Dir, Prefix, Files, []).
  367
  368recursive_directory_files(Dir, Prefix, AllFiles, Rest) :-
  369	directory_files(Dir, Files),
  370	dir_files(Files, Dir, Prefix, AllFiles, Rest).
  371
  372dir_files([], _, _, Files, Files).
  373dir_files([H|T], Dir, Prefix, Files, Rest) :-
  374	(   special(H)
  375	->  dir_files(T, Dir, Prefix, Files, Rest)
  376	;   directory_file_path(Dir, H, Entry),
  377	    (	exists_directory(Entry)
  378	    ->	recursive_directory_files(Entry, Prefix, Files, Rest0)
  379	    ;	atom_concat(Prefix, File, Entry),
  380		Files = [File|Rest0]
  381	    ),
  382	    dir_files(T, Dir, Prefix, Rest0, Rest)
  383	).
  384
  385dir_prefix(., '') :- !.
  386dir_prefix(Dir, Prefix) :-
  387	(   sub_atom(Dir, _, _, 0, /)
  388	->  Prefix = Dir
  389	;   atom_concat(Dir, /, Prefix)
  390	).
  391
  392special(.).
  393special(..).
  394
  395		 /*******************************
  396		 *	     XREF HOOKS		*
  397		 *******************************/
  398
  399:- multifile
  400	prolog:xref_open_source/2,
  401	prolog:xref_source_identifier/2,
  402	prolog:xref_source_file/3.  403
  404%%	prolog:xref_open_source(+Id, -Stream) is semidet.
  405%
  406%	If Id refers to a known  Prolog   pack,  open  the pack entry. A
  407%	pack-file identifier is the path-name  of   the  archive or pack
  408%	directory, followed by the entry in the pack.
  409
  410prolog:xref_open_source(File, Stream) :-
  411	pack_prefix(Pack, Prefix),
  412	atom_concat(Prefix, Entry, File),
  413	pack_open_entry(Pack, Entry, Stream).
  414
  415%%	prolog:xref_source_identifier(+Path, -Id) is semidet.
  416
  417prolog:xref_source_identifier(Path, Path) :-
  418	atom(Path),
  419	pack_mirror_directory(MirrorDir),
  420	sub_atom(Path, 0, _, _, MirrorDir),
  421	atom(Path),
  422	pack_prefix(_Pack, Prefix),
  423	sub_atom(Path, 0, _, _, Prefix), !.
  424
  425%%	pack_file(+Path, -Pack, -Entry) is semidet.
  426%
  427%	True if Path originates from Entry in Pack.
  428
  429pack_file(Path, Pack, Entry) :-
  430	pack_prefix(Pack, Prefix),
  431	atom_concat(Prefix, Entry, Path),
  432	pack_members(Pack, Members),
  433	memberchk(file(Entry,_Size), Members).
  434
  435%%	resolve_pack_file(+Spec, -Source, -SourcePack, -SourceEntry) is	nondet.
  436%
  437%	True if Spec appearing in OrgPack can  be resolved by file Entry
  438%	in ResPack.
  439
  440resolve_pack_file(library(File), Source, SourcePack, SourceEntry) :-
  441	(   atom(File)
  442	->  FileName = File
  443	;   path_segments_atom(File, FileName)
  444	),
  445	directory_file_path(prolog, FileName, EntryNoExt),
  446	user:prolog_file_type(Ext, prolog),
  447	file_name_extension(EntryNoExt, Ext, SourceEntry),
  448	pack_file(Source, SourcePack, SourceEntry).
  449
  450%%	assert_dependency(OrgPack, OrgSpec, How, Src) is det.
  451
  452assert_dependency(OrgPack, OrgSpec, How, Src) :-
  453	pack_dependency(OrgPack, OrgSpec, How, Src), !.
  454assert_dependency(OrgPack, OrgSpec, How, Src) :-
  455	asserta(pack_dependency(OrgPack, OrgSpec, How, Src)).
  456
  457%%	prolog:xref_source_file(+Spec, -SourceID, +Options) is semidet.
  458
  459prolog:xref_source_file(library(File), Source, Options) :-
  460	option(relative_to(Origin), Options),
  461	pack_file(Origin, OrgPack, _OrigEntry),
  462	debug(pack(xref), 'Search for ~q from pack ~q',
  463	      [library(File), OrgPack]),
  464	findall(t(Src, SrcPack, SrcEntry),
  465		resolve_pack_file(library(File), Src, SrcPack, SrcEntry),
  466		Triples),
  467	(   select(t(Source, OrgPack, _), Triples, Alt)
  468	->  true
  469	;   select(t(Source, _, _), Triples, Alt),
  470	    assert_dependency(OrgPack, library(File), dep, Source)
  471	),
  472	forall(member(t(AltSrc,_,_), Alt),
  473	       assert_dependency(OrgPack, library(File), alt, AltSrc)).
  474prolog:xref_source_file(Spec, Source, _Options) :-
  475	atom(Spec),
  476	(   pack_file(Spec, _, _)
  477	->  Source = Spec
  478	;   user:prolog_file_type(Ext, prolog),
  479	    file_name_extension(Spec, Ext, Source),
  480	    pack_file(Source, _, _)
  481	),
  482	debug(pack(xref), 'Resolved ~q to ~q', [Spec, Source]).
  483
  484%%	xref_pack_source(+Pack, ?Entry, ?Source) is nondet.
  485%
  486%	True when Source is the canonical xref source of Entry in Pack.
  487
  488xref_pack_source(Pack, Entry, Source) :-
  489	xref_current_source(Source),
  490	pack_prefix(Pack, Prefix),
  491	atom_concat(Prefix, Entry, Source).
  492
  493
  494pack_prefix(Archive, Prefix) :-
  495	pack_archive(_Pack, _Hash, Archive),
  496	atom_concat(Archive, /, Prefix)