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(pack_analyzer).   50:- use_module(pack_mirror).   51:- use_module(pack).   52:- use_module(wiki).

   58		 /*******************************
   59		 *	   COLLECT INFO		*
   60		 *******************************/
   61
   62:- dynamic
   63	pack_archive/3,			% ?Pack, ?Hash, ?Archive
   64	pack_file/4,			% ?Pack, ?File, ?Info, ?XrefID
   65	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.

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

 mirror_packs

Mirror the latest versions of all known packs

  111mirror_packs :-
  112	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.

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

 clean_pack_info(+Pack)

Remove the collected info for Pack

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

 xref_packs

Cross-reference all mirrored packs

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

 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?

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

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

 n(+Format, +Value)//

HTML component to emit a number.

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

 pack_readme(+Pack)//

Insert readme information if provided.

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

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