/*  $Id$

    Part of SWI-Prolog RDF parser

    Author:  Jan Wielemaker
    E-mail:  jan@swi.psy.uva.nl
    WWW:     http://www.swi.psy.uva.nl/projects/SWI-Prolog/
    Copying: LGPL-2.  See the file COPYING or http://www.gnu.org

    Copyright (C) 1990-2000 SWI, University of Amsterdam. All rights reserved.
*/


:- use_module(library(cgi)).
:- use_module(library(sgml)).
:- use_module(rdf).
:- use_module(rdf_parser).
:- use_module(rewrite).
:- use_module(pretty_print).

term_expansion(F, T) :- rew_term_expansion(F, T).
goal_expansion(F, T) :- rew_goal_expansion(F, T).

:- dynamic new_rdf_namespace/1.

parse(Text, RDFTerm, Triples) :-
	parse_atom(Text, Term),
	(   find_rdf(Term, RDFTerm)
	->  true
	;   RDFTerm = Term
	),
	xml_to_rdf(RDFTerm, [], Triples).

find_rdf(Term, RDFTerm) :-
	RDFTerm = element(NS:'RDF', _, _),
	term_member(RDFTerm, Term), !,
	(   rdf_name_space(NS)
	->  true
	;   assert(rdf_parser:rdf_name_space(NS)),
	    assert(new_rdf_namespace(NS))
	).

term_member(X, X).
term_member(X, Compound) :-
	compound(Compound),
	arg(_, Compound, Arg),
	term_member(X, Arg).

%	parse_atom(+Atom, -Term, +Options
%
%	Parse and atom into a structured term

parse_atom(Atom, Term) :-
	atom_to_memory_file(Atom, MemFile),
	open_memory_file(MemFile, read, Stream),
	new_sgml_parser(Parser, []),
	set_sgml_parser(Parser, dialect(xmlns)),
	set_sgml_parser(Parser, space(sgml)),
	sgml_parse(Parser,
		   [ source(Stream),
		     document(Term)
		   ]),
	free_sgml_parser(Parser),
	close(Stream),
	free_memory_file(MemFile).


		 /*******************************
		 *	 HTML GENERATION	*
		 *******************************/

:- op(100, fx, #).
:- op(110, xfx, ::).

emit([]) :- !.
emit([H|T]) :- !,
	emit(H),
	emit(T).
emit(Fmt-Args) :- !,
	format(Fmt, Args),
	retractall(nl_done(_)).
emit(#Term) :- !,
	#Term.
emit(#Term::Content) :- !,
	#Term::Content.
emit(Atom) :-
	write(Atom),
	retractall(nl_done(_)).

#Term::Content :-
	Term =.. [Name|Attributes],
	layout(before(open, Name)),
	format('<~w', [Name]),
	attlist(Attributes),
	format('>', []),
	retractall(nl_done(_)),
	layout(after(open, Name)),
	emit(Content),
	end_tag(Name).
#pre(Text) :- !,
	sgml_quote(Text, Quoted),
	#pre::Quoted.
#box(Text) :- !,
	box(Text, '#e0e0e0').
#box(Text, Colour) :- !,
	box(Text, Colour).
#Term :-
	Term =.. [Name|Attributes],
	layout(before(open, Name)),
	format('<~w', [Name]),
	attlist(Attributes),
	format('>', []),
	retractall(nl_done(_)),
	layout(after(open, Name)),
	end_tag(Name).

end_tag(Name) :-
	blines(Name, _, o), !.
end_tag(Name) :-
	layout(before(close, Name)),
	format('</~w>', [Name]),
	retractall(nl_done(_)),
	layout(after(close, Name)).


layout(before(open, Name)) :-
	blines(Name, N-_, _), !,
	nls(N).
layout(after(open, Name)) :-
	blines(Name, _-N, _), !,
	nls(N).
layout(before(close, Name)) :-
	blines(Name, _, N-_), !,
	nls(N).
layout(after(close, Name)) :-
	blines(Name, _, _-N), !,
	nls(N).
layout(_) :-
	retractall(nl_done(_)).

:- dynamic
	nl_done/1.

nls(N) :-
	(   nl_done(Done)
	->  true
	;   Done = 0
	),
	ToDo is N - Done,
	New is max(N, Done),
	retractall(nl_done(Done)),
	assert(nl_done(New)),
	do_nl(ToDo).

do_nl(N) :-
	N > 0, !,
	nl,
	NN is N - 1,
	do_nl(NN).
do_nl(_).

blines(tr,    1-0, 0-0).
blines(table, 2-1, 1-1).
blines(form,  2-1, 1-1).
blines(h1,    2-0, 0-1).
blines(h2,    2-0, 0-2).
blines(h3,    2-0, 0-2).
blines(h4,    2-0, 0-2).
blines(p,     2-1, o).			% omitted end-tag

attlist([]).
attlist([Name=Value|T]) :- !,
	sgml_quote_value(Value, Quoted),
	format(' ~w=~w', [Name, Quoted]),
	attlist(T).
attlist([Name|T]) :-
	format(' ~w', [Name]),
	attlist(T).

head(Title) :-
	emit([ 'Content-type: text/html\n\n',
	       '<html>\n',
	       '<head>\n',
	       '<title>~w</title>~n'-[Title],
	       '</head>\n\n',
	       '<body bgcolor="white">\n'
	     ]).
foot :-
	emit([ '</body>\n',
	       '</html>\n'
	     ]).


pre(Text) :-
	sgml_quote(Text, Quoted),
	#pre::Quoted.

box(Text, Colour) :-
	emit('<p>\n'),
	#table(width='80%', align=center, border=6, bgcolor=Colour)::
	  [#tr::[#td(nowrap)::[#pre(Text)]]].


		 /*******************************
		 *	      QUOTING		*
		 *******************************/

sgml_quote_value(Value, Arg) :-
	atom_chars(Value, Chars),
	(   name_chars(Chars)
	->  Arg = Value
	;   sgml_quote_chars(Chars, Quoted),
	    atom_chars(Arg, Quoted)
	).

name_chars([H|T]) :-
	char_type(H, alpha),
	all_alnum(T).

all_alnum([]).
all_alnum([H|T]) :-
	char_type(H, csymf),
	all_alnum(T).

sgml_quote_chars(L, ['"'|T]) :-
	sgml_quote2(L, T, ['"']).

sgml_quote2([], T, T).
sgml_quote2([H|T0], List, Rest) :-
	sgml_quote_char(H, List, T), !,
	sgml_quote2(T0, T, Rest).
sgml_quote2([H|T0], [H|T], Rest) :-
	sgml_quote2(T0, T, Rest).

sgml_quote_char('<', [&, l, t, ;|T], T).
sgml_quote_char('>', [&, g, t, ;|T], T).
sgml_quote_char('&', [&, a, m, p, ;|T], T).
sgml_quote_char('"', [&, q, u, o, t, ;|T], T).
%sgml_quote_char('\'', [&, a, p, o, s, ;|T], T).

sgml_quote(Text, Quoted) :-
	atom_chars(Text, Chars),
	sgml_quote2(Chars, QuotedChars, []),
	atom_chars(Quoted, QuotedChars).


		 /*******************************
		 *	  PAGE GENERATION	*
		 *******************************/

parsed(Time, Triples) :-
	length(Triples, Len),
	#h2::'RDF statement parsed successfully',
	#p::[ 'Your RDF statement has been parsed in ~2f seconds, '-[Time],
	      'creating ', #b::Len, ' triples. ',
	      'Please find the created triples in the table below.'
	    ],
	(   getenv('HTTP_REFERER', Referer)
	->  #p::[ 'If you want to try another RDF statement, please go ',
		  'back to ', #a(href=Referer)::'the request form', '.'
		]
	;   true
	).

rdf_table(Triples) :-
	maplist(triple_row, Triples, TripleRows),
	#p,
	#table(caption='RDF triples',
	       align=center, border=2, cellpadding=3)::
	  [ #tr::[#th::'Subject', #th::'Predicate', #th::'Object']
	  | TripleRows
	  ].

triple_row(rdf(Subj, Pred, Obj), #tr::[#td::S,#td::P,#td::O]) :-
	cell(Subj, S),
	cell(Pred, P),
	cell(Obj, O).

cell(rdf:Local,  [#em::rdf, :, #b::Local]) :- !.
cell(literal(X), [#b::'literal(', X, #b::')']) :- !.
cell(each(X),    [#b::'each(', X, #b::')']) :- !.
cell(pefix(X),   [#b::'prefix(', X, #b::')']) :- !.
cell(NS:Local,   [NS, :, #b::Local]) :- !.
cell(V,		 [T]) :-
	sformat(T, '~p', [V]).

		 /*******************************
		 *	       ERRORS		*
		 *******************************/

show_errors :-
	getenv('ERROR_FILE', File),
	size_file(File, Size),
	Size > 0, !,
	read_file(File, Data),
	#h4::[#font(color=red)::
	      'The following errors occurred while processing your request'],
	#p,
	#box(Data, '#ff8c00').
show_errors.

show_new_namepace :-
	new_rdf_namespace(NS), !,
	#h4::[#font(color=red)::'Warning: unofficial RDF Namespace'],
	#p::['It appears your RDF description uses the unofficial ',
	     'name space ', #b::NS, '. ',
	     'This name space has been added for RDF.'
	    ].
show_new_namepace.


		 /*******************************
		 *	       COMMENT		*
		 *******************************/

comment(TextId) :-
	#h4::'<hr>Comment',
	#p::[ 'If you do not agree with the output or have other comments, ',
	      'Please write them in the text-area below and submit them'
	    ],
	getenv('REQUEST_URI', Script),
	#form(method=post, action=Script)::
	  [ #input(type=hidden, name=id, value=TextId),
	    #table(align=center)::
	      [ #tr::[#td::[#textarea(name=comment, cols=64, rows=10)]],
		#tr::[#td(align=right)::['E-mail: ', #input(name=mail)]],
		#tr::[#td(align=right)::[#input(type=submit)]]
	      ]
	  ].


		 /*******************************
		 *	       REQUEST		*
		 *******************************/

request_location('Online-requests').

%	Save the request and return a local identifier for it.

save_request(Text, Id) :-
	request_dir(Dir, Date),
	atomic_list_concat([Dir, /, Date], DateDir),
	ensure_dir(DateDir),
	between(1, 10000, N),
	    atomic_list_concat([DateDir, /, N, '.rdf'], File),
	    \+ exists_file(File), !,
	    open(File, write, Fd),
	    format(Fd, '~w~n', [Text]),
	    close(Fd),
	    atomic_list_concat([Date, /, N], Id).

request_dir(BaseDir, Date) :-
	get_time(Time),
	convert_time(Time, Y, M, D, _, _, _, _),
	request_location(BaseDir),
	atomic_list_concat([D, -, M, -, Y], Date).

ensure_dir(Dir) :-
	exists_directory(Dir), !.
ensure_dir(Dir) :-
	make_directory(Dir).

save_comment(Id, Mail, Comment) :-
	request_location(Base),
	atomic_list_concat([Base, '/', Id], FileBase),
	absolute_file_name(FileBase, AbsFileBase),
	absolute_file_name(Base, AbsBase),
	sub_atom(AbsFileBase, 0, _, _, AbsBase), 	% verify in tree
	atom_concat(AbsFileBase, '.cmt', CmtFile),
	open(CmtFile, write, Fd),
	format(Fd, 'E-mail: ~w~n~n~w~n', [Mail, Comment]),
	close(Fd).


		 /*******************************
		 *	       ENTRY		*
		 *******************************/

main :-
	cgi_get_form(Arguments),
	(   (   memberchk(attachment(Text), Arguments),
		Text \== ''
	    ;   memberchk(rdf(Text), Arguments)
	    )
	->  save_request(Text, TextId),
	    (	OldTime is cputime,
		parse(Text, _Prolog, Triples),
		Time is cputime - OldTime
	    ->  head('RDF Triples'),
		parsed(Time, Triples),
		show_errors,
		show_new_namepace,
		rdf_table(Triples),
		comment(TextId),
		foot
	    ;	head('Failed to parse'),
		#p::[ 'I failed to parse your request' ],
		show_errors,
		comment(TextId),
		foot
	    ),
	    halt
	;   memberchk(comment(Comment), Arguments),
	    memberchk(id(Id), Arguments),
	    memberchk(mail(Mail), Arguments)
	->  save_comment(Id, Mail, Comment),
	    head('Thanks for comment'),
	    #p::'Thank you for your comments',
	    foot,
	    halt
	).
main :-
	head('Failed'),
	#p::[ 'This CGI-script failed to understand your request' ],
	foot,
	halt.

go :-
	catch(main, E, error(E)).

error(E) :-
	message_to_string(E, Msg),
	head('Failed to parse'),
	show_errors,
	#p::[ 'An exception was raised while parsing your request:' ],
	#pre(Msg),
	foot,
	halt.


		 /*******************************
		 *	       TEST		*
		 *******************************/

test :-
	read_file('suite/t1.rdf', Text),
	catch(parse(Text, _Prolog, Triples), E, error(E)),
	head('RDF Triples'),
	rdf_table(Triples),
	foot.


		 /*******************************
		 *	       UTIL		*
		 *******************************/

read_file(File, Atom) :-
	open(File, read, Fd),
	get_code(Fd, C),
	read_stream(C, Fd, Chars),
	close(Fd),
	atom_codes(Atom, Chars).

read_stream(-1, _, []) :- !.
read_stream(C0, Fd, [C0|T]) :-
	get_code(Fd, C),
	read_stream(C, Fd, T).
