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): 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)]).
 wiki_file_to_dom(+File, +DOM) is det
DOM is the HTML dom representation for the content of File.
   70wiki_file_to_dom(File, DOM) :-
   71	read_file_to_codes(File, String, []),
   72	wiki_file_codes_to_dom(String, File, DOM).
 wiki_codes_to_dom(+Codes, +File, -DOM)
DOM is the HTML dom representation for Codes that originate from File.
   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		 *******************************/
 include(+Object, +Type, +Options)//
   98include(Object, Type, Options) -->
   99	pldoc_html:include(Object, Type,
  100			   [ map_extension([txt-html])
  101			   | Options
  102			   ]).
 file(+Path, Options)//
Trap translation of \file(+Path, Options)
  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.
 wiki_page_title(?Location, ?Title) is nondet
True when Title is the title of the wiki page at Location.
  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).
 update_wiki_page_title(Location) is det
Update the cached information about a wiki file.
  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	).
 dom_title(+DOM, -Title) is semidet
Get the title as an atom from a parsed wiki page.
To be done
- Currently assumes no markup in the title.
  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, _) --> [].
 index_wiki_pages
Create a (title) index of the available wiki pages. This is started from server/1 in a background thread.
  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)).
 wiki_locations(-Locations) is det
True when Files is a list of all .txt files on the site.
  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(..).
 extract_title(+DOM0, -Title, -DOM) is det
Extract the title from a wiki page. The title is considered to be the first h<N> element.
  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).
 title_text(+Title, -Text:atom) is det
Turn the title, represented as an argument to html//1 into a plain string. Turns it into HTML, then parses the HTML and finally extracts the string. First clause avoids this for the common normal case.
  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).
 safe_file_name(+Name)
True when Name is a file without references to parent directories.
  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, '/..')