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): 2009-2015, 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(plweb_wiki,
   31	  [ wiki_file_to_dom/2,		% +File, -DOM
   32	    wiki_file_codes_to_dom/3,	% +Codes, +File, -DOM
   33	    wiki_page_title/2,		% +Location, -Title
   34	    index_wiki_pages/0,		%
   35	    update_wiki_page_title/1,	% +Location
   36	    wiki_extension/1,		% ?Extension
   37	    file//2,			% +File, +Options
   38	    include//3,			% +Object, +Type, +Options
   39	    extract_title/3,		% +DOM0, -Title, -DOM
   40	    title_text/2,		% +Title, -Text:atom
   41	    safe_file_name/1		% +Name
   42	  ]).   43:- reexport(library(pldoc/doc_html),
   44	    except([ file//2,
   45		     include//3
   46		   ])).   47
   48:- use_module(library(pldoc/doc_wiki)).   49:- use_module(library(http/html_write)).   50:- use_module(library(http/http_wrapper)).   51:- use_module(library(http/http_dispatch)).   52:- use_module(library(readutil)).   53:- use_module(library(option)).   54:- use_module(library(apply)).   55:- use_module(library(lists)).   56:- use_module(library(filesex)).   57:- use_module(wiki_edit).   58
   59:- predicate_options(file//2, 2,
   60		     [ absolute_path(atom),
   61		       label(any)
   62		     ]).   63:- predicate_options(include//3, 3,
   64		     [pass_to(pldoc_html:include/5, 3)]).   65
   66%%	wiki_file_to_dom(+File, +DOM) is det.
   67%
   68%	DOM is the HTML dom representation for the content of File.
   69
   70wiki_file_to_dom(File, DOM) :-
   71	read_file_to_codes(File, String, []),
   72	wiki_file_codes_to_dom(String, File, DOM).
   73
   74%%	wiki_codes_to_dom(+Codes, +File, -DOM)
   75%
   76%	DOM is the HTML dom representation for Codes that originate from
   77%	File.
   78
   79wiki_file_codes_to_dom(String, File, DOM) :-
   80	(   nb_current(pldoc_file, OrgFile)
   81	->  setup_call_cleanup(
   82		b_setval(pldoc_file, File),
   83		wiki_codes_to_dom(String, [], DOM),
   84		b_setval(pldoc_file, OrgFile))
   85	;   setup_call_cleanup(
   86		b_setval(pldoc_file, File),
   87		wiki_codes_to_dom(String, [], DOM),
   88		nb_delete(pldoc_file))
   89	).
   90
   91
   92		 /*******************************
   93		 *	     RENDERING		*
   94		 *******************************/
   95
   96%%	include(+Object, +Type, +Options)//
   97
   98include(Object, Type, Options) -->
   99	pldoc_html:include(Object, Type,
  100			   [ map_extension([txt-html])
  101			   | Options
  102			   ]).
  103
  104%%	file(+Path, Options)//
  105%
  106%	Trap translation of \file(+Path, Options)
  107
  108file(Path, Options) -->
  109	{ \+ option(label(_), Options),
  110	  file_base_name(Path, File),
  111	  file_name_extension(Label, txt, File), !,
  112	  file_href(Options, Options1)
  113	},
  114	pldoc_html:file(Path,
  115			[ label(Label),
  116			  map_extension([txt-html]),
  117			  edit_handler(wiki_edit)
  118			| Options1
  119			]).
  120file(File, Options) -->
  121	{ file_href(Options, Options1)
  122	},
  123	pldoc_html:file(File,
  124			[ map_extension([txt-html]),
  125			  edit_handler(wiki_edit)
  126			| Options1
  127			]).
  128
  129
  130file_href(Options0, Options) :-
  131	\+ ( nb_current(pldoc_file, CFile),
  132	     CFile \== []
  133	   ),
  134	option(absolute_path(Path), Options0),
  135	absolute_file_name(document_root(.),
  136			   DocRoot,
  137			   [ file_type(directory),
  138			     access(read)
  139			   ]),
  140	atom_concat(DocRoot, DocLocal, Path), !,
  141	ensure_leading_slash(DocLocal, HREF),
  142	Options = [ href(HREF) | Options0 ].
  143file_href(Options, Options).
  144
  145ensure_leading_slash(Path, SlashPath) :-
  146	(   sub_atom(Path, 0, _, _, /)
  147	->  SlashPath = Path
  148	;   atom_concat(/, Path, SlashPath)
  149	).
  150
  151		 /*******************************
  152		 *     OBJECT INTEGRATION	*
  153		 *******************************/
  154
  155:- multifile
  156	prolog:doc_object_summary/4,
  157	prolog:doc_object_link//2,
  158	prolog:doc_object_page//2,
  159	prolog:doc_category/3,
  160	prolog:doc_file_index_header//2.  161
  162prolog:doc_object_summary(wiki(Location), wiki, wiki, Summary) :-
  163	wiki_page_title(Location, Summary).
  164
  165:- dynamic
  166	wiki_page_title_cache/3,	% Location, Title, Time
  167	wiki_pages_indexed/1.  168
  169%%	wiki_page_title(?Location, ?Title) is nondet.
  170%
  171%	True when Title is the title of the wiki page at Location.
  172
  173wiki_page_title(Location, Title) :-
  174	wiki_pages_indexed(_), !,
  175	wiki_page_title_cache(Location, Title, _).
  176wiki_page_title(Location, Title) :-
  177	nonvar(Location), !,
  178	(   wiki_page_title_cache(Location, TitleRaw, _)
  179	->  Title = TitleRaw
  180	;   extract_wiki_page_title(Location, File, TitleRaw)
  181	->  time_file(File, Modified),
  182	    assertz(wiki_page_title_cache(Location, TitleRaw, Modified)),
  183	    Title = TitleRaw
  184	;   print_message(warning, wiki(no_title(Location))),
  185	    Title = 'No title'
  186	).
  187wiki_page_title(Location, Title) :-
  188	index_wiki_pages,
  189	wiki_page_title(Location, Title).
  190
  191
  192update_wiki_title_cache :-
  193	wiki_locations(Pages),
  194	maplist(update_wiki_page_title, Pages).
  195
  196%%	update_wiki_page_title(Location) is det.
  197%
  198%	Update the cached information about a wiki file.
  199
  200update_wiki_page_title(Location) :-
  201	wiki_page_title_cache(Location, _, Time), !,
  202	location_wiki_file(Location, File),
  203	time_file(File, Modified),
  204	(   abs(Time-Modified) < 1
  205	->  true
  206	;   extract_wiki_page_title(Location, File, Title),
  207	    retractall(wiki_page_title_cache(Location, _, _)),
  208	    assertz(wiki_page_title_cache(Location, Title, Modified))
  209	).
  210update_wiki_page_title(Location) :-
  211	extract_wiki_page_title(Location, File, Title),
  212	time_file(File, Modified),
  213	assertz(wiki_page_title_cache(Location, Title, Modified)).
  214
  215extract_wiki_page_title(Location, File, Title) :-
  216	(   var(File)
  217	->  location_wiki_file(Location, File, read)
  218	;   true
  219	),
  220	(   catch(wiki_file_to_dom(File, DOM), E,
  221		  ( print_message(warning, E),
  222		    fail
  223		  )),
  224	    dom_title(DOM, Title)
  225	->  true
  226	;   format(atom(Title), 'Wiki page at "~w"', Location)
  227	).
  228
  229
  230%%	dom_title(+DOM, -Title) is semidet.
  231%
  232%	Get the title as an atom from a parsed wiki page.
  233%
  234%	@tbd	Currently assumes no markup in the title.
  235
  236dom_title([h1(_, TitleList)|_], Title) :-
  237	maplist(to_atom, TitleList, TitleList2),
  238	atomic_list_concat(TitleList2, Title).
  239
  240to_atom(Atomic, Atomic) :- atomic(Atomic).
  241to_atom(predref(Name/Arity), Label) :-
  242	atomic_list_concat([Name,/,Arity], Label).
  243
  244prolog:doc_object_link(wiki(Location), _Options) -->
  245	{ wiki_page_title(Location, Title) },
  246	html([ '[wiki] ', Title ]).
  247
  248prolog:doc_object_page(wiki(Location), _Options) -->
  249	{ http_current_request(Request),
  250	  http_redirect(see_other, root(Location), Request)
  251	}.
  252
  253prolog:doc_category(wiki, 60, 'Wiki pages').
  254
  255prolog:doc_file_index_header(wiki, _) --> [].
  256
  257%%	index_wiki_pages
  258%
  259%	Create a (title) index of  the   available  wiki  pages. This is
  260%	started from server/1 in a background thread.
  261
  262index_wiki_pages :-
  263	wiki_pages_indexed(_), !.
  264index_wiki_pages :-
  265	with_mutex(index_wiki_pages,
  266		   index_wiki_pages_sync).
  267
  268index_wiki_pages_sync :-
  269	wiki_pages_indexed(_).
  270index_wiki_pages_sync :-
  271	wiki_locations(Locations),
  272	maplist(wiki_page_title, Locations, _Titles),
  273	get_time(Now),
  274	asserta(wiki_pages_indexed(Now)).
  275
  276
  277%%	wiki_locations(-Locations) is det.
  278%
  279%	True when Files is a list of all .txt files on the site.
  280
  281wiki_locations(Files) :-
  282	findall(Dir, absolute_file_name(
  283			 document_root(.), Dir,
  284			 [ access(read),
  285			   file_type(directory),
  286			   solutions(all)
  287			 ]),
  288		RootDirs),
  289	maplist(wiki_locations, RootDirs, NestedFiles),
  290	append(NestedFiles, Files).
  291
  292wiki_locations(Dir, Files) :-
  293	phrase(wiki_locations(Dir, Dir), Files).
  294
  295wiki_locations([], _) --> !.
  296wiki_locations([H|T], Root) --> !,
  297	wiki_locations(H, Root),
  298	wiki_locations(T, Root).
  299wiki_locations(CurrentDir, Root) -->
  300	{ exists_directory(CurrentDir), !,
  301	  directory_files(CurrentDir, Members),
  302	  exclude(special, Members, Members2),
  303	  maplist(directory_file_path(CurrentDir), Members2, MemberPaths)
  304	},
  305	wiki_locations(MemberPaths, Root).
  306wiki_locations(Entry, Root) -->
  307	{ file_name_extension(_, Ext, Entry),
  308	  wiki_extension(Ext), !,
  309	  directory_file_path(Root, Wiki, Entry)
  310	},
  311	[Wiki].
  312wiki_locations(_, _) --> [].
  313
  314wiki_extension(txt).
  315wiki_extension(md).
  316
  317special(.).
  318special(..).
  319
  320%!	extract_title(+DOM0, -Title, -DOM) is det.
  321%
  322%	Extract the title from a wiki page.  The title is considered
  323%	to be the first h<N> element.
  324
  325extract_title([H|T], Title, T) :-
  326	title(H, Title), !.
  327extract_title(DOM, 'SWI-Prolog', DOM).
  328
  329title(h1(_Attrs, Title), Title).
  330title(h2(_Attrs, Title), Title).
  331title(h3(_Attrs, Title), Title).
  332title(h4(_Attrs, Title), Title).
  333
  334%!	title_text(+Title, -Text:atom) is det.
  335%
  336%	Turn the title, represented as  an   argument  to html//1 into a
  337%	plain string. Turns it  into  HTML,   then  parses  the HTML and
  338%	finally extracts the string. First clause   avoids  this for the
  339%	common normal case.
  340
  341title_text(Title, Text) :-
  342	maplist(atomic, Title), !,
  343	atomics_to_string(Title, Text).
  344title_text(Title, Text) :-
  345	phrase(html(Title), Tokens),
  346	with_output_to(string(HTML), print_html(Tokens)),
  347	setup_call_cleanup(
  348	    open_string(HTML, In),
  349	    load_html(In, DOM, []),
  350	    close(In)),
  351	xpath(element(div, [], DOM), /('*'(text)), Text).
  352
  353%!	safe_file_name(+Name)
  354%
  355%	True  when  Name  is  a  file    without  references  to  parent
  356%	directories.
  357
  358safe_file_name(Name) :-
  359    must_be(atom, Name),
  360    prolog_to_os_filename(FileName, Name),
  361    \+ unsafe_name(FileName),
  362    !.
  363safe_file_name(Name) :-
  364    permission_error(read, file, Name).
  365
  366unsafe_name(Name) :- Name == '..'.
  367unsafe_name(Name) :- sub_atom(Name, 0, _, _, '../').
  368unsafe_name(Name) :- sub_atom(Name, _, _, _, '/../').
  369unsafe_name(Name) :- sub_atom(Name, _, _, 0, '/..')