View source with raw 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., 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).

Visual (web) components that show info about packs

*/

   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	forall(pack_archive(Pack, _Hash, Archive),
  160	       ( debug(pack(xref), 'Cross-referencing pack ~w', [Pack]),
  161		 ensure_xref_pack(Archive))).
  162
  163ensure_xref_pack(Pack) :-
  164	xreffed_pack(Pack, _), !.
  165ensure_xref_pack(Pack) :-
  166	xref_pack(Pack),
  167	get_time(Time),
  168	asserta(xreffed_pack(Pack, Time)).
  169
  170
  171		 /*******************************
  172		 *	     VISUALS		*
  173		 *******************************/
 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?
  180pack_file_hierarchy(Pack) -->
  181	html(h2(class(wiki), 'Contents of pack "~w"'-[Pack])),
  182	{ mirror_pack(Pack),
  183	  pack_archive(Pack, _Hash, Archive),
  184	  ensure_xref_pack(Archive),
  185	  findall(File, pack_file(Pack, File, _Size, _XrefID), Files),
  186	  files_to_tree(Files, Trees)
  187	},
  188	pack_size(Pack),
  189	html_requires(css('ul_tree.css')),
  190	html(div(class('pack-files'),
  191		 ul(class(tree),
  192		    \dir_nodes(Pack, Trees)))).
  193
  194pack_size(Pack) -->
  195	{ aggregate_all(
  196	      sum(Size)-count,
  197	      pack_file(Pack, _Name, file(Size), _XrefID),
  198	      Total-Count)
  199	},
  200	html(p([ 'Pack contains ', \n('~D', Count), ' files holding a total of ',
  201		 b(\n(human, Total)), ' bytes.'
  202	       ])).
  203
  204dir_nodes(_, []) --> [].
  205dir_nodes(Pack, [H|T]) --> dir_node(H, Pack), dir_nodes(Pack, T).
  206
  207dir_node(leaf(File), Pack) --> !,
  208	html(li(class(file), \pack_file_link(Pack, File))).
  209dir_node(tree(Dir, SubTrees), Pack) -->
  210	html(li(class(dir),
  211		[ span(class(dir), Dir),
  212		  ul(class(dir),
  213		     \dir_nodes(Pack, SubTrees))
  214		])).
  215
  216pack_file_link(Pack, File) -->
  217	{ file_base_name(File, Label),
  218	  http_link_to_id(pack_file_details, [], HREF0),
  219	  atomic_list_concat([HREF0, Pack, File], /, HREF)
  220	},
  221	html(a(href(HREF), Label)),
  222	file_hierarchy_info(Pack, File).
  223
  224file_hierarchy_info(Pack, File) -->
  225	{ pack_file(Pack, File, file(Size), XrefID)
  226	}, !,
  227	html(span(class('file-tree-info'),
  228		 [ '(', \n(human, Size), ' bytes',
  229		   \prolog_file_info(Pack, File, XrefID),
  230		   ')'
  231		 ])).
  232file_hierarchy_info(_,_) --> [].
  233
  234prolog_file_info(_, _, -) --> !.
  235prolog_file_info(_Pack, File, XrefID) -->
  236	module_info(File, XrefID).
  237
  238module_info(File, XrefID) -->
  239	{ xref_module(XrefID, Module), !,
  240	  file_base_name(File, Base),
  241	  file_name_extension(Clean, _, Base)
  242	},
  243	(   {Module == Clean}
  244	->  []
  245	;   html(span(class('module-mismatch'), Module))
  246	).
  247module_info(_, _) -->
  248	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
  258files_to_tree(Files, Tree) :-
  259	map_list_to_pairs(path_of, Files, Pairs),
  260	keysort(Pairs, Sorted),
  261	make_tree(Sorted, Tree).
  262
  263path_of(File, Segments) :-
  264	atomic_list_concat(Segments, /, File).
  265
  266make_tree([], []).
  267make_tree([H|T], [Node|More]) :-
  268	first_path(H, HS, Dir),
  269	(   HS = []-File
  270	->  Node = leaf(File),
  271	    Rest = T
  272	;   Node = tree(Dir, SubTrees),
  273	    same_first_path(T, Dir, TS, Rest),
  274	    make_tree([HS|TS], SubTrees)
  275	),
  276	make_tree(Rest, More).
  277
  278first_path([Dir|Sub]-File, Sub-File, Dir).
  279
  280same_first_path([], _, [], []) :- !.
  281same_first_path([H|T], Dir, [HS|TS], Rest) :-
  282	first_path(H, HS, Dir), !,
  283	same_first_path(T, Dir, TS, Rest).
  284same_first_path(Rest, _, [], Rest).
 n(+Format, +Value)//
HTML component to emit a number.
  291n(Fmt, Value) -->
  292	{ number_html(Fmt, Value, HTML) },
  293	html(HTML).
  294
  295number_html(human, Value, HTML) :-
  296	integer(Value), !,
  297	human_count(Value, HTML).
  298number_html(Fmt, Value, HTML) :-
  299	number(Value), !,
  300	HTML = Fmt-[Value].
  301number_html(_, Value, '~p'-[Value]).
  302
  303
  304human_count(Number, HTML) :-
  305	Number < 1024, !,
  306	HTML = '~d'-[Number].
  307human_count(Number, HTML) :-
  308	Number < 1024*1024, !,
  309	KB is Number/1024,
  310	digits(KB, N),
  311	HTML = '~*fK'-[N, KB].
  312human_count(Number, HTML) :-
  313	Number < 1024*1024*1024, !,
  314	MB is Number/(1024*1024),
  315	digits(MB, N),
  316	HTML = '~*fM'-[N, MB].
  317human_count(Number, HTML) :-
  318	TB is Number/(1024*1024*1024),
  319	digits(TB, N),
  320	HTML = '~*fG'-[N, TB].
  321
  322digits(Count, N) :-
  323	(   Count < 100
  324	->  N = 1
  325	;   N = 0
  326	).
 pack_readme(+Pack)//
Insert readme information if provided.
  332pack_readme(Pack) -->
  333	{ pack_readme_file(Pack, File, Size) },
  334	pack_readme(Pack, File, Size).
  335
  336pack_readme(_Pack, File, Size) -->
  337	{ MaxSize = 20000,
  338	  Size > MaxSize
  339	}, !,
  340	html(p(class(warning),
  341	       'Readme file ~w too large (~D bytes; maximum size is ~D)'-
  342	       [File, Size, MaxSize])).
  343pack_readme(Pack, File, _) -->
  344	{ pack_archive(Pack, _, Archive),
  345	  format(atom(FileURL), '~w/~w', [Archive, File]),
  346	  setup_call_cleanup(
  347	      pack_open_entry(Archive, File, Stream),
  348	      read_stream_to_codes(Stream, String),
  349	      close(Stream)),
  350	  setup_call_cleanup(
  351	      b_setval(pldoc_file, FileURL),
  352	      wiki_codes_to_dom(String, [], DOM),
  353	      nb_delete(pldoc_file))
  354	},
  355	html(DOM).
  356
  357pack_readme_file(Pack, Readme, Size) :-
  358	mirror_pack(Pack),
  359	pack_file(Pack, Readme, file(Size), -),
  360	downcase_atom(Readme, Key),
  361	readme_file(Key).
  362
  363readme_file(readme).
  364readme_file('readme.txt').
  365readme_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?
  377pack_file_details(Pack, _File, _Options) :-
  378	mirror_pack(Pack),
  379	pack_archive(Pack, _Hash, Archive),
  380	ensure_xref_pack(Archive),
  381	fail.
  382pack_file_details(Pack, File, Options) :-
  383	pack_file(Pack, File, file(_Size), XrefID),
  384	XrefID \== (-),
  385	option(show(Show), Options, doc),
  386	(   Show == doc
  387	->  !,
  388	    format(atom(Title), 'Pack ~w -- ~w', [Pack, File]),
  389	    doc_for_file(XrefID,
  390			 [ title(Title),
  391			   edit(false)
  392			 ])
  393	;   Show == src
  394	->  !,
  395	    pack_archive(Pack, _Hash, Archive),
  396	    directory_file_path(Archive, File, Path),
  397	    format('Content-type: text/html~n~n'),
  398	    source_to_html(Path, stream(current_output), [])
  399	).
  400pack_file_details(Pack, File, _Options) :-
  401	pack_file(Pack, File, file(Size), -),
  402	file_base_name(File, Base),
  403	downcase_atom(Base, BaseLwr),
  404	wiki_file(BaseLwr), !,
  405	format(atom(Title), 'Pack ~w -- ~w', [Pack, File]),
  406	reply_html_page(
  407	    pack(text, Title),
  408	    title(Title),
  409	    \pack_readme(Pack, File, Size)).
  410pack_file_details(Pack, File, _Options) :-
  411	pack_file(Pack, File, file(_Size), -),
  412	pack_archive(Pack, _Hash, Archive),
  413	file_mime_type(File, MimeType),
  414	format('Content-type: ~w~n~n', [MimeType]),
  415	setup_call_cleanup(
  416	    pack_open_entry(Archive, File, Stream),
  417	    copy_stream_data(Stream, current_output),
  418	    close(Stream)).
  419
  420wiki_file(readme).
  421wiki_file(todo).
  422wiki_file(Name) :- file_name_extension(_, md, Name).
  423wiki_file(Name) :- file_name_extension(_, txt, Name).
  424
  425:- multifile
  426	plweb:page_title//1.  427
  428plweb:page_title(pack(_Type, Title)) -->
  429	html(Title)