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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  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_info,
   31	  [ update_pack_metadata/0,
   32	    update_pack_metadata_in_background/0,
   33	    pack_file_hierarchy//1,		% +Pack
   34	    pack_readme//1,			% +Pack
   35	    pack_file_details/3,		% +Pack, +File, +Options
   36	    clean_pack_info/1,			% +Pack
   37	    pack_archive/3			% ?Pack, ?Hash, ?Archive
   38	  ]).   39:- use_module(library(http/http_dispatch)).   40:- use_module(library(http/mimetype)).   41:- use_module(library(http/html_write)).   42:- use_module(library(http/html_head)).   43:- use_module(library(pldoc/doc_wiki)).   44:- use_module(library(pldoc/doc_html),
   45	      [ doc_for_file/2			% other imports conflict
   46	      ]).				% with doc_wiki
   47:- use_module(library(pldoc/doc_htmlsrc)).   48:- use_module(library(prolog_xref)).   49:- use_module(library(debug)).   50:- use_module(pack_analyzer).   51:- use_module(pack_mirror).   52:- use_module(pack).   53:- use_module(wiki).

   59		 /*******************************
   60		 *	   COLLECT INFO		*
   61		 *******************************/
   62
   63:- dynamic
   64	pack_archive/3,			% ?Pack, ?Hash, ?Archive
   65	pack_file/4,			% ?Pack, ?File, ?Info, ?XrefID
   66	xreffed_pack/2.

 update_pack_metadata is det

 update_pack_metadata_in_background is det

Destroy and recompute all pack meta-data. update_pack_metadata_in_background/0 runs update_pack_metadata/0 in a detached thread.

   75update_pack_metadata :-
   76	absolute_file_name(log('pack-warnings.log'), LogFile,
   77			   [ access(write) ]),
   78	setup_call_cleanup(
   79	    ( open(LogFile, write, ErrorOut, [encoding(utf8)]),
   80	      asserta((user:thread_message_hook(_Term, Kind, Lines) :-
   81			(   must_print(Kind)
   82			->  print_message_lines(ErrorOut, kind(Kind), Lines)
   83			;   true
   84			)))
   85	    ),
   86	    ( clean_pack_metadata,
   87	      mirror_packs,
   88	      xref_packs
   89	    ),
   90	    close(ErrorOut)).
   91
   92must_print(warning).
   93must_print(error).
   94
   95clean_pack_metadata :-
   96	retractall(pack_archive(_,_,_)),
   97	forall(retract(pack_file(_,_,_,XrefID)),
   98	       (   xref_current_source(XrefID)
   99	       ->  xref_clean(XrefID)
  100	       ;   true
  101	       )),
  102	retractall(xreffed_pack(_,_)).
  103
  104update_pack_metadata_in_background :-
  105	thread_create(update_pack_metadata, _,
  106		      [ detached(true),
  107			alias(update_pack_metadata)
  108		      ]).

 mirror_packs

Mirror the latest versions of all known packs

  114mirror_packs :-
  115	forall(pack(Pack), mirror_pack(Pack)).

 mirror_pack(+Pack)

Process a pack, collecting the relevant information into the (local) Prolog database. Automatically reprocesses the pack if the pack has been upgraded.

  123mirror_pack(Pack) :-
  124	pack_mirror(Pack, ArchiveFile, Hash),
  125	absolute_file_name(ArchiveFile, ArchivePath),
  126	(   pack_archive(Pack, Hash, ArchivePath)
  127	->  true
  128	;   clean_pack_info(Pack),
  129	    pack_members(ArchivePath, Members),
  130	    maplist(assert_file_info(Pack, ArchivePath), Members),
  131	    assertz(pack_archive(Pack, Hash, ArchivePath))
  132	), !.
  133mirror_pack(Pack) :-
  134	print_message(warning, pack(mirror_failed(Pack))).
  135
  136assert_file_info(Pack, ArchivePath, file(File, Size)) :-
  137	(   pack_prolog_entry(File)
  138	->  directory_file_path(ArchivePath, File, XrefID),
  139	    assertz(pack_file(Pack, File, file(Size), XrefID))
  140	;   assertz(pack_file(Pack, File, file(Size), -))
  141	).
  142assert_file_info(Pack, _, link(File, Target)) :-
  143	assertz(pack_file(Pack, File, link(Target), -)).

 clean_pack_info(+Pack)

Remove the collected info for Pack

  149clean_pack_info(Pack) :-
  150	retractall(pack_archive(Pack,_,_)),
  151	forall(retract(pack_file(Pack, _, _, XrefID)),
  152	       (   XrefID == (-)
  153	       ->  true
  154	       ;   xref_clean(XrefID)
  155	       )).

 xref_packs

Cross-reference all mirrored packs

  161xref_packs :-
  162    !.
  163xref_packs :-
  164	forall(pack_archive(Pack, _Hash, Archive),
  165	       ( debug(pack(xref), 'Cross-referencing pack ~w', [Pack]),
  166		 ensure_xref_pack(Archive))).
  167
  168ensure_xref_pack(Pack) :-
  169	xreffed_pack(Pack, _), !.
  170ensure_xref_pack(Pack) :-
  171	xref_pack(Pack),
  172	get_time(Time),
  173	asserta(xreffed_pack(Pack, Time)).
  174
  175
  176		 /*******************************
  177		 *	     VISUALS		*
  178		 *******************************/

 pack_file_hierarchy(+Pack)// is det

Create a ul for all files that appear in the pack. Maybe we should consider a tree-styled nested ul?

  185pack_file_hierarchy(Pack) -->
  186	html(h2(class(wiki), 'Contents of pack "~w"'-[Pack])),
  187	{ mirror_pack(Pack),
  188	  pack_archive(Pack, _Hash, Archive),
  189	  ensure_xref_pack(Archive),
  190	  findall(File, pack_file(Pack, File, _Size, _XrefID), Files),
  191	  files_to_tree(Files, Trees)
  192	},
  193	pack_size(Pack),
  194	html_requires(css('ul_tree.css')),
  195	html(div(class('pack-files'),
  196		 ul(class(tree),
  197		    \dir_nodes(Pack, Trees)))).
  198
  199pack_size(Pack) -->
  200	{ aggregate_all(
  201	      sum(Size)-count,
  202	      pack_file(Pack, _Name, file(Size), _XrefID),
  203	      Total-Count)
  204	},
  205	html(p([ 'Pack contains ', \n('~D', Count), ' files holding a total of ',
  206		 b(\n(human, Total)), ' bytes.'
  207	       ])).
  208
  209dir_nodes(_, []) --> [].
  210dir_nodes(Pack, [H|T]) --> dir_node(H, Pack), dir_nodes(Pack, T).
  211
  212dir_node(leaf(File), Pack) --> !,
  213	html(li(class(file), \pack_file_link(Pack, File))).
  214dir_node(tree(Dir, SubTrees), Pack) -->
  215	html(li(class(dir),
  216		[ span(class(dir), Dir),
  217		  ul(class(dir),
  218		     \dir_nodes(Pack, SubTrees))
  219		])).
  220
  221pack_file_link(Pack, File) -->
  222	{ file_base_name(File, Label),
  223	  http_link_to_id(pack_file_details, [], HREF0),
  224	  atomic_list_concat([HREF0, Pack, File], /, HREF)
  225	},
  226	html(a(href(HREF), Label)),
  227	file_hierarchy_info(Pack, File).
  228
  229file_hierarchy_info(Pack, File) -->
  230	{ pack_file(Pack, File, file(Size), XrefID)
  231	}, !,
  232	html(span(class('file-tree-info'),
  233		 [ '(', \n(human, Size), ' bytes',
  234		   \prolog_file_info(Pack, File, XrefID),
  235		   ')'
  236		 ])).
  237file_hierarchy_info(_,_) --> [].
  238
  239prolog_file_info(_, _, -) --> !.
  240prolog_file_info(_Pack, File, XrefID) -->
  241	module_info(File, XrefID).
  242
  243module_info(File, XrefID) -->
  244	{ xref_module(XrefID, Module), !,
  245	  file_base_name(File, Base),
  246	  file_name_extension(Clean, _, Base)
  247	},
  248	(   {Module == Clean}
  249	->  []
  250	;   html(span(class('module-mismatch'), Module))
  251	).
  252module_info(_, _) -->
  253	html([', ', span(class(warning), 'not a module')]).

 files_to_tree(+Files:list(atom), -Tree) is det

Creates a tree from a list of file names. A tree is a term

• tree(Dir, SubTrees)
• leaf(File)

  263files_to_tree(Files, Tree) :-
  264	map_list_to_pairs(path_of, Files, Pairs),
  265	keysort(Pairs, Sorted),
  266	make_tree(Sorted, Tree).
  267
  268path_of(File, Segments) :-
  269	atomic_list_concat(Segments, /, File).
  270
  271make_tree([], []).
  272make_tree([H|T], [Node|More]) :-
  273	first_path(H, HS, Dir),
  274	(   HS = []-File
  275	->  Node = leaf(File),
  276	    Rest = T
  277	;   Node = tree(Dir, SubTrees),
  278	    same_first_path(T, Dir, TS, Rest),
  279	    make_tree([HS|TS], SubTrees)
  280	),
  281	make_tree(Rest, More).
  282
  283first_path([Dir|Sub]-File, Sub-File, Dir).
  284
  285same_first_path([], _, [], []) :- !.
  286same_first_path([H|T], Dir, [HS|TS], Rest) :-
  287	first_path(H, HS, Dir), !,
  288	same_first_path(T, Dir, TS, Rest).
  289same_first_path(Rest, _, [], Rest).

 n(+Format, +Value)//

HTML component to emit a number.

  296n(Fmt, Value) -->
  297	{ number_html(Fmt, Value, HTML) },
  298	html(HTML).
  299
  300number_html(human, Value, HTML) :-
  301	integer(Value), !,
  302	human_count(Value, HTML).
  303number_html(Fmt, Value, HTML) :-
  304	number(Value), !,
  305	HTML = Fmt-[Value].
  306number_html(_, Value, '~p'-[Value]).
  307
  308
  309human_count(Number, HTML) :-
  310	Number < 1024, !,
  311	HTML = '~d'-[Number].
  312human_count(Number, HTML) :-
  313	Number < 1024*1024, !,
  314	KB is Number/1024,
  315	digits(KB, N),
  316	HTML = '~*fK'-[N, KB].
  317human_count(Number, HTML) :-
  318	Number < 1024*1024*1024, !,
  319	MB is Number/(1024*1024),
  320	digits(MB, N),
  321	HTML = '~*fM'-[N, MB].
  322human_count(Number, HTML) :-
  323	TB is Number/(1024*1024*1024),
  324	digits(TB, N),
  325	HTML = '~*fG'-[N, TB].
  326
  327digits(Count, N) :-
  328	(   Count < 100
  329	->  N = 1
  330	;   N = 0
  331	).

 pack_readme(+Pack)//

Insert readme information if provided.

  337pack_readme(Pack) -->
  338	{ pack_readme_file(Pack, File, Size) },
  339	pack_readme(Pack, File, Size).
  340
  341pack_readme(_Pack, File, Size) -->
  342	{ MaxSize = 50000,
  343	  Size > MaxSize
  344	}, !,
  345	html(p(class(warning),
  346	       'Readme file ~w too large (~D bytes; maximum size is ~D)'-
  347	       [File, Size, MaxSize])).
  348pack_readme(Pack, File, _) -->
  349	{ pack_archive(Pack, _, Archive),
  350	  format(atom(FileURL), '~w/~w', [Archive, File]),
  351	  setup_call_cleanup(
  352	      pack_open_entry(Archive, File, Stream),
  353	      read_stream_to_codes(Stream, String),
  354	      close(Stream)),
  355	  setup_call_cleanup(
  356	      b_setval(pldoc_file, FileURL),
  357	      wiki_codes_to_dom(String, [], DOM),
  358	      nb_delete(pldoc_file))
  359	},
  360	html(DOM).
  361
  362pack_readme_file(Pack, Readme, Size) :-
  363	mirror_pack(Pack),
  364	pack_file(Pack, Readme, file(Size), -),
  365	downcase_atom(Readme, Key),
  366	readme_file(Key).
  367
  368readme_file(readme).
  369readme_file('readme.txt').
  370readme_file('readme.md').

 pack_file_details(+Pack, +File, +Options) is det

Reply with an web-page with details on File in Pack. Options:

show(+Show)

One of doc, src, raw

public_only(+Bool)

To be done

- Is rendering files without checking them a good idea?

  382pack_file_details(Pack, _File, _Options) :-
  383	mirror_pack(Pack),
  384	pack_archive(Pack, _Hash, Archive),
  385	ensure_xref_pack(Archive),
  386	fail.
  387pack_file_details(Pack, File, Options) :-
  388	pack_file(Pack, File, file(_Size), XrefID),
  389	XrefID \== (-),
  390	option(show(Show), Options, doc),
  391	(   Show == doc
  392	->  !,
  393	    format(atom(Title), 'Pack ~w -- ~w', [Pack, File]),
  394	    doc_for_file(XrefID,
  395			 [ title(Title),
  396			   edit(false)
  397			 ])
  398	;   Show == src
  399	->  !,
  400	    pack_archive(Pack, _Hash, Archive),
  401	    directory_file_path(Archive, File, Path),
  402	    format('Content-type: text/html~n~n'),
  403	    source_to_html(Path, stream(current_output), [])
  404	).
  405pack_file_details(Pack, File, _Options) :-
  406	pack_file(Pack, File, file(Size), -),
  407	file_base_name(File, Base),
  408	downcase_atom(Base, BaseLwr),
  409	wiki_file(BaseLwr), !,
  410	format(atom(Title), 'Pack ~w -- ~w', [Pack, File]),
  411	reply_html_page(
  412	    pack(text, Title),
  413	    title(Title),
  414	    \pack_readme(Pack, File, Size)).
  415pack_file_details(Pack, File, _Options) :-
  416	pack_file(Pack, File, file(_Size), -),
  417	pack_archive(Pack, _Hash, Archive),
  418	file_mime_type(File, MimeType),
  419	format('Content-type: ~w~n~n', [MimeType]),
  420	setup_call_cleanup(
  421	    pack_open_entry(Archive, File, Stream),
  422	    copy_stream_data(Stream, current_output),
  423	    close(Stream)),
  424	!.
  425pack_file_details(Pack, File, _Options) :-
  426	format(atom(Title), 'Pack ~w -- ~w', [Pack, File]),
  427	reply_html_page(
  428	    pack(warning, Title),
  429	    title(Title),
  430	    \no_pack_file(Pack, File)).
  431
  432no_pack_file(Pack, File) -->
  433	html(p(class(warning),
  434	       [ 'The current version of pack ', code(class(pack), Pack), ' does not ',
  435		 ' contain a file ', code(class(file), File)
  436	       ])).
  437
  438wiki_file(readme).
  439wiki_file(todo).
  440wiki_file(Name) :- file_name_extension(_, md, Name).
  441wiki_file(Name) :- file_name_extension(_, txt, Name).
  442
  443:- multifile
  444	plweb:page_title//1.  445
  446plweb:page_title(pack(_Type, Title)) -->
  447	html(Title)