View source with formatted comments or as raw
    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	exclude(macos_file, Members0, Members1),
  301	maplist(strip_prefix(Prefix), Members1, Members).
  302
  303bad_archive(Archive, Error) :-
  304	delete_file(Archive),
  305	throw(Error).
  306
  307git_blob(object(_Mode, blob, _Hash, _Size, _Name)).
  308git_entry(object(_Mode, blob, _Hash, Size, Name), file(Name, Size)).
  309
  310ar_pack_members(Archive, Members, Prefix) :-
  311	(   ar_members_cache(Archive, Members0, Prefix0)
  312	->  true
  313	;   read_ar_pack_members(Archive, Members0, Prefix0)
  314	->  asserta(ar_members_cache(Archive, Members0, Prefix0))
  315	),
  316	Members = Members0,
  317	Prefix  = Prefix0.
  318
  319read_ar_pack_members(Archive, Members0, Prefix) :-
  320	setup_call_cleanup(
  321	    archive_open(Archive, Handle, []),
  322	    findall(Member, ar_member(Handle, Member), Members0),
  323	    archive_close(Handle)),
  324	(   member(file(InfoFile,_), Members0),
  325	    atom_concat(Prefix, 'pack.pl', InfoFile)
  326	->  true
  327	;   existence_error(pack_file, 'pack.pl')
  328	).
  329
  330ar_member(Handle, Entry) :-
  331	repeat,
  332	(   archive_next_header(Handle, File)
  333	->  true
  334	;   !, fail
  335	),
  336	archive_header_property(Handle, filetype(Type)),
  337	make_entry(Type, Handle, File, Entry).
  338
  339make_entry(file, Handle, File, file(File, Size)) :- !,
  340	archive_header_property(Handle, size(Size)).
  341make_entry(link, Handle, File, link(File, Target)) :- !,
  342	archive_header_property(Handle, link_target(Target)).
  343make_entry(directory, _, _, _) :- !,
  344	fail.
  345make_entry(Type, _, Name, Entry) :-
  346	atom(Type), !,
  347	Entry =.. [Type, Name].
  348make_entry(Type, _, Name, _Entry) :-
  349	print_message(warning, unknown_archive_type(Type, Name)),
  350	fail.
  351
  352%!	macos_file(@Entry) is semidet.
  353%
  354%	Delete MacOS metadata.
  355
  356macos_file(file(Name, _Size)) :-
  357	sub_atom(Name, 0, _, _, '__MACOSX').
  358
  359strip_prefix(Prefix, Term0, Term) :-
  360	Term0 =.. [Type, Name, Size],
  361	atom_concat(Prefix, Stripped, Name),
  362	Term =.. [Type, Stripped, Size].
  363
  364file_entry(Pack, File, file(File,Size)) :-
  365	directory_file_path(Pack, File, Path),
  366	size_file(Path, Size).
  367
  368%%	recursive_directory_files(+Dir, -Files) is det.
  369%
  370%	True when Files is a list holding all files in Dir, recursively.
  371
  372recursive_directory_files(Dir, Files) :-
  373	dir_prefix(Dir, Prefix),
  374	recursive_directory_files(Dir, Prefix, Files, []).
  375
  376recursive_directory_files(Dir, Prefix, AllFiles, Rest) :-
  377	directory_files(Dir, Files),
  378	dir_files(Files, Dir, Prefix, AllFiles, Rest).
  379
  380dir_files([], _, _, Files, Files).
  381dir_files([H|T], Dir, Prefix, Files, Rest) :-
  382	(   special(H)
  383	->  dir_files(T, Dir, Prefix, Files, Rest)
  384	;   directory_file_path(Dir, H, Entry),
  385	    (	exists_directory(Entry)
  386	    ->	recursive_directory_files(Entry, Prefix, Files, Rest0)
  387	    ;	atom_concat(Prefix, File, Entry),
  388		Files = [File|Rest0]
  389	    ),
  390	    dir_files(T, Dir, Prefix, Rest0, Rest)
  391	).
  392
  393dir_prefix(., '') :- !.
  394dir_prefix(Dir, Prefix) :-
  395	(   sub_atom(Dir, _, _, 0, /)
  396	->  Prefix = Dir
  397	;   atom_concat(Dir, /, Prefix)
  398	).
  399
  400special(.).
  401special(..).
  402
  403		 /*******************************
  404		 *	     XREF HOOKS		*
  405		 *******************************/
  406
  407:- multifile
  408	prolog:xref_open_source/2,
  409	prolog:xref_source_identifier/2,
  410	prolog:xref_source_file/3.  411
  412%%	prolog:xref_open_source(+Id, -Stream) is semidet.
  413%
  414%	If Id refers to a known  Prolog   pack,  open  the pack entry. A
  415%	pack-file identifier is the path-name  of   the  archive or pack
  416%	directory, followed by the entry in the pack.
  417
  418prolog:xref_open_source(File, Stream) :-
  419	pack_prefix(Pack, Prefix),
  420	atom_concat(Prefix, Entry, File),
  421	pack_open_entry(Pack, Entry, Stream).
  422
  423%%	prolog:xref_source_identifier(+Path, -Id) is semidet.
  424
  425prolog:xref_source_identifier(Path, Path) :-
  426	atom(Path),
  427	pack_mirror_directory(MirrorDir),
  428	sub_atom(Path, 0, _, _, MirrorDir),
  429	atom(Path),
  430	pack_prefix(_Pack, Prefix),
  431	sub_atom(Path, 0, _, _, Prefix), !.
  432
  433%%	pack_file(+Path, -Pack, -Entry) is semidet.
  434%
  435%	True if Path originates from Entry in Pack.
  436
  437pack_file(Path, Pack, Entry) :-
  438	pack_prefix(Pack, Prefix),
  439	atom_concat(Prefix, Entry, Path),
  440	pack_members(Pack, Members),
  441	memberchk(file(Entry,_Size), Members).
  442
  443%%	resolve_pack_file(+Spec, -Source, -SourcePack, -SourceEntry) is	nondet.
  444%
  445%	True if Spec appearing in OrgPack can  be resolved by file Entry
  446%	in ResPack.
  447
  448resolve_pack_file(library(File), Source, SourcePack, SourceEntry) :-
  449	(   atom(File)
  450	->  FileName = File
  451	;   path_segments_atom(File, FileName)
  452	),
  453	directory_file_path(prolog, FileName, EntryNoExt),
  454	user:prolog_file_type(Ext, prolog),
  455	file_name_extension(EntryNoExt, Ext, SourceEntry),
  456	pack_file(Source, SourcePack, SourceEntry).
  457
  458%%	assert_dependency(OrgPack, OrgSpec, How, Src) is det.
  459
  460assert_dependency(OrgPack, OrgSpec, How, Src) :-
  461	pack_dependency(OrgPack, OrgSpec, How, Src), !.
  462assert_dependency(OrgPack, OrgSpec, How, Src) :-
  463	asserta(pack_dependency(OrgPack, OrgSpec, How, Src)).
  464
  465%%	prolog:xref_source_file(+Spec, -SourceID, +Options) is semidet.
  466
  467prolog:xref_source_file(library(File), Source, Options) :-
  468	option(relative_to(Origin), Options),
  469	pack_file(Origin, OrgPack, _OrigEntry),
  470	debug(pack(xref), 'Search for ~q from pack ~q',
  471	      [library(File), OrgPack]),
  472	findall(t(Src, SrcPack, SrcEntry),
  473		resolve_pack_file(library(File), Src, SrcPack, SrcEntry),
  474		Triples),
  475	(   select(t(Source, OrgPack, _), Triples, Alt)
  476	->  true
  477	;   select(t(Source, _, _), Triples, Alt),
  478	    assert_dependency(OrgPack, library(File), dep, Source)
  479	),
  480	forall(member(t(AltSrc,_,_), Alt),
  481	       assert_dependency(OrgPack, library(File), alt, AltSrc)).
  482prolog:xref_source_file(Spec, Source, _Options) :-
  483	atom(Spec),
  484	(   pack_file(Spec, _, _)
  485	->  Source = Spec
  486	;   user:prolog_file_type(Ext, prolog),
  487	    file_name_extension(Spec, Ext, Source),
  488	    pack_file(Source, _, _)
  489	),
  490	debug(pack(xref), 'Resolved ~q to ~q', [Spec, Source]).
  491
  492%%	xref_pack_source(+Pack, ?Entry, ?Source) is nondet.
  493%
  494%	True when Source is the canonical xref source of Entry in Pack.
  495
  496xref_pack_source(Pack, Entry, Source) :-
  497	xref_current_source(Source),
  498	pack_prefix(Pack, Prefix),
  499	atom_concat(Prefix, Entry, Source).
  500
  501
  502pack_prefix(Archive, Prefix) :-
  503	pack_archive(_Pack, _Hash, Archive),
  504	atom_concat(Archive, /, Prefix)