:- ensure_loaded(common).
cvs_id('$Id: parse.pl,v 1.17 2004/10/27 16:50:31 sandro Exp $').
/*

  issues:
        error messages getting into Ret
        save ns info, save error counts
        write error-page in html?

*/

:- ensure_loaded(convert).
:- ensure_loaded(library(rdf)).
:- ensure_loaded(library(debug)).
%%%   counter to mt.pl !:- ensure_loaded(library('semweb/rdf_db')).
:- multifile
	message_hook/3.

:- multi_dynamic(after_parse/2).    % (Ret, Goal) -- if you want to be notified

% not thread_local, so they can be monitored
:- dynamic current_retrieval_graph/2.
:- multifile current_retrieval_graph/2.

:- dynamic current_retrieval_counter/2.
:- multifile current_retrieval_counter/2.

:- dynamic total_retrieval_counter/2.
:- multifile total_retrieval_counter/2.

:- multifile redirect_messages_to_queue/3.
:- dynamic redirect_messages_to_queue/3.

% see buffer_parser_errors/1 and savfe_parser_errors/1.
:- multifile parser_errors/4.
:- dynamic parser_errors/4.

max_triples_per_graph(10000).

/*
message_hook(Term, Kind, Lines) :-
	format(user_error, '[hook] ~q ~q ~q~n', [Term, Kind, Lines]).
*/

parse_rdf(Ret) :-
	% serialize parsing efforts (for a given retrieval), although
        %   it seems odd that there would every be more than one-per-retrieval
	%atom_concat('parse_metadata for ', Ret, Resource),
	%with_write_lock(Resource,
	%		unsafe_parse_rdf(Ret)).
	unsafe_parse_rdf(Ret).

unsafe_parse_rdf(Ret) :-
	once(ret_get(Ret, retr:finalResource, BaseURI)),
	ret_file(Ret, data, DataFile),
	open(DataFile, read, In, [lock(read)]),
	debug(parse, 'reading ~q', [DataFile]),
	open_new_retrieval_graph(Ret, _),
	new_retrieval_counters(Ret),
	buffer_parser_errors(Ret),
	process_rdf(In, on_triples(Ret), [
					  base_uri(BaseURI),
					  blank_nodes(share),
					  convert_typed_literal(convert_typed_litera),
					  namespaces(NS),
					  max_errors(50),
					  syntax_errors(print)
					 ]
		   ),
	close_retrieval_graph(Ret),
	total_retrieval_counter(Ret, Counter),
	flag(Counter, Count, Count),
	debug(parse, 'parsed total of ~w triples', [Count]),
	ret_set(Ret, retr:triples, literal(Count)),
	ret_assert_triple(Ret, BaseURI, rdf:type, retr:'RDFSource'),
	save_namespace_information(Ret, NS),
	save_parser_errors(Ret).

on_triples(Ret, Triples, _Location) :-
	length(Triples, Len),
	once(current_retrieval_counter(Ret, Counter)),
	flag(Counter, Count, Count),
	debug(parse_detail, 'got ~w triples, at ~w, for ~a', [Len, Count, Ret]),
	(   checklist(on_triple(Ret), Triples)
	->  true
	;   throw(on_triple_failed(Ret))
	).

open_new_retrieval_graph(Ret, Graph) :-
	rdfpage_gen_uri(Graph),
	retractall(current_retrieval_graph(Ret, _)),
	assert(current_retrieval_graph(Ret, Graph)),
	debug(parse, 'parsing to new graph ~a', [Graph]).
		    

close_retrieval_graph(Ret) :-
	debug(parse, 'closing graph', []),
	(   current_retrieval_graph(Ret, Graph),
	    current_retrieval_counter(Ret, Counter)
	->  flag(Counter, Count, Count),
	    ret_assert_triple(Ret, Graph, retr:triples, literal(Count)),
	    ret_set(Ret, retr:chunk, Graph),
	    rdfpage_qsave(Graph),
	    paged_in_by_parser(Graph),
	    debug(parse, 'parsed ~w triples to ~a', [Count, Graph])
	;   true
	).
new_retrieval_counters(Ret) :-
	thread_self(Me),
	retractall(current_retrieval_counter(Ret, _)),
	retractall(total_retrieval_counter(Ret, _)),
	atom_concat(Me, '_per_graph_triple_counter', PerGraphCounter),
	atom_concat(Me, '_total_triple_counter', TotalCounter),
	assert(current_retrieval_counter(Ret, PerGraphCounter)),
	assert(total_retrieval_counter(Ret, TotalCounter)),
	flag(PerGraphCounter, _, 0),
	flag(TotalCounter, _, 0).
	
on_triple(Ret, rdf(S,P,O)) :-
	once(current_retrieval_graph(Ret, OldGraph)),
	once(current_retrieval_counter(Ret, Counter)),
	total_retrieval_counter(Ret, TotalCounter),
	flag(Counter, Count, Count),
	max_triples_per_graph(Max),
	assume(ground(old(OldGraph))),
	(   Count >= Max
	->  debug(parse, 'limit hit! ~a', [Ret]),
	    close_retrieval_graph(Ret),
	    open_new_retrieval_graph(Ret, Graph),
	    flag(Counter, _, 1),       
	    debug(parse, 'rolled over to new graph doing ~a ~a', [Ret, Graph])  
	;   Graph = OldGraph,
	    flag(Counter, NCount, NCount+1)
	),
	assume(ground(Graph)),
	rename_bnode(Graph, S, S1),
	rename_bnode(Graph, O, O1),
	debug(parse_super_detail, '~q', [rdf_assert(S1, P, O1, Graph)]),
	flag(TotalCounter, Total, Total+1),
	!,  %why needed?
	thread_self(Self),
	log_term(parse_log(Self, in, rdf_assert(S1, P, O1, Graph))),
	rdf_transaction(rdf_assert(S1, P, O1, Graph)),
	log_term(parse_log(Self, out, rdf_assert(S1, P, O1, Graph))).


rename_bnode(Graph, Old, New) :-
	(   atom(Old),
	    atom_prefix(Old, '__')
	->  rdf_split_url(_Base, Local, Old), % let's reuse the "local" part 
	    rdfpage_sub_uri(Graph, Local, New),
	    debug(parse_skolem, 'term: ~q -> ~q', [Old, New])
	;   New=Old
	).

save_namespace_information(Ret, NS) :-
	rdfpage_sub_uri(Page, _, Ret),
	rdfpage_sub_uri(Page, nsinfo, Base),
	save_namespace_information(Ret, Base, NS).
save_namespace_information(_, _, []).
save_namespace_information(Ret, Base, [Short=Long|Rest]) :-
	gensym(Base, Sym),
	ret_set(Ret, retr:namespacePair, Sym),
	ret_assert_triple(Ret, Sym, retr:key, literal(Short)),
	ret_assert_triple(Ret, Sym, retr:namespace, Long),
	save_namespace_information(Ret, Rest).


/*

rdf(Ret, retr:finalResource, URI), parse_rdf(Ret).


?- time(parse_rdf('http://roke.hawke.org:7116/page/2#retrieval')).
 reading '/home/sandro/cvs/dev.w3.org/2004/semwalker/sandbox/usr/local/webcache/semwalker/0/000/02-data'
% parsing to http://roke.hawke.org:7116/page/1907
% parsed 100 triples to http://roke.hawke.org:7116/page/1907
% parsing to http://roke.hawke.org:7116/page/1908
% rolled over to new graph doing http://roke.hawke.org:7116/page/2#retrieval
% parsed 100 triples to http://roke.hawke.org:7116/page/1908
...

% parsed total of 1648 triples
nsinfo: [rdfs='http://www.w3.org/2000/01/rdf-schema#', rdf='http://www.w3.org/1999/02/22-rdf-syntax-ns#']
% 304,681 inferences, 2.41 CPU in 2.69 seconds (89% CPU, 126424 Lips)

Yes
?- time(rdf_load('/home/sandro/cvs/dev.w3.org/2004/semwalker/sandbox/usr/local/webcache/semwalker/0/000/02-data')).
% Parsed "02-data" in 0.09 sec; 1,648 triples
% 200,593 inferences, 0.09 CPU in 0.12 seconds (76% CPU, 2228811 Lips)

up max to 10000; so we don't get the roll-overs.

?- time(parse_rdf('http://roke.hawke.org:7116/page/2#retrieval')).
% reading '/home/sandro/cvs/dev.w3.org/2004/semwalker/sandbox/usr/local/webcache/semwalker/0/000/02-data'
% parsing to http://roke.hawke.org:7116/page/1927
% parsed 1648 triples to http://roke.hawke.org:7116/page/1927
% parsed total of 1648 triples
nsinfo: [rdfs='http://www.w3.org/2000/01/rdf-schema#', rdf='http://www.w3.org/1999/02/22-rdf-syntax-ns#']
% 298,137 inferences, 0.29 CPU in 0.30 seconds (96% CPU, 1028059 Lips)

rdf_db:rdf_save_db_/2                     2 =        2+0        44.8%

% reading '/home/sandro/cvs/dev.w3.org/2004/semwalker/sandbox/usr/local/webcache/semwalker/0/000/07-data'

Ret = 'http://roke.hawke.org:7116/page/7#retrieval'
URI = 'http://cicho0.tripod.com/Dep_of_Computer_Science'

ERROR: RDF: Failed to interpret "<script language="JavaScript1.1">objAdMgr.renderFooter();"

Warning: SGML2PL(xmlns): http://cicho0.tripod.com/Dep_of_Computer_Science:157: Inserted omitted end-tag for "img"

parse_rdf('http://roke.hawke.org:7116/page/7#retrieval').

nsinfo: [[]='http://cicho0.tripod.com/Dep_of_Computer_Science#', daml='http://www.daml.org/2001/03/daml+oil#', rdfs='http://www.w3.org/2000/01/rdf-schema#', rdf='http://www.w3.org/1999/02/22-rdf-syntax-ns#']



*/

/*

Getting errors from the SGML parser to the user is a little tricky.
It doesn't just have a callback [IFAIK]; it calls print_message.  So
we hook print_message, and bring the parameters back here.  We also
switch based no the thread ID, since we don't get to carry 'Ret'
through the parser to print_message.

All this makes parse_rdf/1 be non-re-entrant, while still
thread-safe.  Good enough.

Errors look like this:

Term = sgml(sgml_parser(27889826), 'http://cicho0.tripod.com/Dep_of_Computer_Science', 148, 'Inserted omitted end-tag for "img"')
Kind = warning
Lines = ['SGML2PL(~w): ~w:~w: ~w'-[xmlns, 'http://cicho0.tripod.com/Dep_of_Computer_Science', 148, 'Inserted omitted end-tag for "img"']]


Term = rdf(unparsed(element(script, [language='JavaScript1.1'], ['objAdMgr.renderFooter();'])))
Kind = error
Lines = ['RDF: Failed to interpret "~s"'-[[60, 115, 99, 114, 105, 112, 116, 32, 108, 97, 110, 103, 117, 97, 103, 101, 61, 34, 74, 97, 118, 97, 83, 99, 114, 105, 112, 116, 49, 46, 49, 34, 62, 111, 98, 106, 65, 100, 77, 103, 114, 46, 114, 101, 110, 100, 101, 114, 70, 111, 111, 116, 101, 114, 40, 41, 59]]]

*/
  
buffer_parser_errors(Ret) :-		     
	%   not re-entrant (no surprise there) because of SGML error API
	%   (but still thread safe, which is good enough)
	thread_self(Thread),
	retractall(parser_errors(Ret, _, _, _)),
	assert(redirect_messages_to_queue(Thread, rdf(_), parser_errors(Ret))),
	assert(redirect_messages_to_queue(Thread, sgml(_,_,_,_), parser_errors(Ret))).

save_parser_errors(Ret) :-
	thread_self(Thread),
	retractall(redirect_messages_to_queue(Thread, rdf(_), _)),
	retractall(redirect_messages_to_queue(Thread, sgml(_,_,_,_), _)),
	retractall(parser_errors(Ret, informational, Kind, Lines)),
	retractall(parser_errors(Ret, silent, Kind, Lines)),
	(   once(parser_errors(Ret, _, _, _))
	->  ret_file(Ret, parse_errors, ErrorFile),
	    current_output(Normal),   % er, this copies stdout to stderr.  @@@
	    open(ErrorFile, write, FileOut),
	    set_stream(FileOut, alias(user_error)),
	    findall(x, parser_errors(Ret, Term, Kind, Lines), Errors),
	    length(Errors, ErrorCount),
	    forall(  retract(parser_errors(Ret, Term, Kind, Lines)),
		     (   format(user_error, '~n~n===  Parse Error  ===', []),
			 '$messages':print_system_message(Term, Kind, Lines)
			 )
		  ),
	    set_stream(Normal, alias(user_error)),
	    close(FileOut),
	    debug(parse, 'errors written to ~q', [ErrorFile]),
	    ret_set(Ret, retr:parseErrors, literal(ErrorCount))
	;   true
	).

		     

parse_retrieval(Ret) :-
	catch((
	       (   maybe_type(html, Ret),
		   ret_set_status(Ret, retr:parsingAsHTML)
	       ->  parse_html(Ret, data),
		   (   ret_get(Ret, retr:parseErrors, literal(ErrorCount)),
		       ErrorCount > 0
		   ->  tidy(Ret, data, tidied),
		       parse_html(Ret, tidied)
		   ;   true
		   )
	       ;   true
	       ),
	       (   maybe_type(rdf, Ret),
		   ret_set_status(Ret, retr:parsingAsRDFXML),
		   parse_rdf(Ret)
	       ->  true
	       ;   true
	       ),
	       forall( retract(after_parse(Ret, Goal)),
		       ( call(Goal); throw(after_parse_goal_failed(Ret, Goal)) )
		     )
	      ),
	      _Error,
	      ret_set_status(Ret, retr:internalErrorDuringParsing)
	     ).

:- ensure_loaded(library(sgml)).

parse_html(Ret, FileName) :-
	once(ret_get(Ret, retr:finalResource, FinalResource)),
	ret_file(Ret, FileName, DataFile),
	size_file(DataFile, Size),
	(   Size < 100000  % arb limit until streaming
	->  true
	;   ret_set_status(Ret, retr:tooBigForHTMLParse),
	    !,
	    fail
	),
	open(DataFile, read, In, [lock(read)]),
	debug(parse, 'reading ~q', [DataFile]),
	%  danger:   DTD corruption possible
	buffer_parser_errors(Ret),
	catch(load_structure(stream(In), Structure, [
                                          dialect(xml),
					  max_errors(200),
					  syntax_errors(print)
					 ]
		   ),
	      error(limit_exceeded(max_errors, _), _),
	      Structure = []),
	!,   % why does load_structure leave a choice point?
	save_parser_errors(Ret),
	(   Structure = [element(html, _, HTML)]
	->  (   memberchk(element(head, _, Head), HTML)
		%format(user_error, 'Head element: ~q~n', [Head])
	    ->  forall(scrape_head(Ret, FinalResource, Head), true)
	    ;   true
	    ),
	    (   memberchk(element(body, _, Body), HTML),
		(   memberchk(element(h1, _, Heading), Body)
		;   memberchk(element(h2, _, Heading), Body)
		), !,
		member(Text, Heading),
		atomic(Text)
	    ->  ret_assert_triple(Ret, FinalResource, retr:documentHeading, literal(Text))
	    ;   true
	    )
	;   true
	).
	    

scrape_head(Ret, Address, Head) :-
	memberchk(element(title, _, [Title]), Head),
	atomic(Title),
	ret_assert_triple(Ret, Address, retr:documentTitle, literal(Title)).
%scrape_head(_Ret, _Address, Head) :-
%	ground(Head),
%	member(element(meta, MA, MD), Head),
%	format(user_error, 'Meta element: ~q ~q~n', [MA, MD]).
scrape_head(Ret, Address, Head) :-
	member(element(link, LinkAttr, _), Head),
	memberchk(rel=alternate, LinkAttr),
	memberchk(type='application/rss+xml', LinkAttr),
	memberchk(href=Href, LinkAttr),
	ret_assert_triple(Ret, Address, retr:rssLink, Href).
scrape_head(Ret, Address, Head) :-
	member(element(link, LinkAttr, _), Head),
	memberchk(rel=meta, LinkAttr),
	memberchk(type='application/rdf+xml', LinkAttr),
	memberchk(href=Href, LinkAttr),
	ret_assert_triple(Ret, Address, retr:rdfLink, Href).

content_type(Ret, C) :-
	ret_get(Ret, retr:contentType, literal(CF)),
	(  sub_atom(CF, Pos, _Len, _After1, ';')
	-> sub_atom(CF, 0, Pos, _After2, C)
	;  C=CF
	).

maybe_type(Short, Ret) :-
	(  content_type(Ret, C)
	-> content_type_map(Short, C)
	;  true
	).

content_type_map(rdf, 'application/rdf+xml').
content_type_map(rdf, 'application/xml').
content_type_map(rdf, 'application/octet-stream').
content_type_map(rdf, 'text/xml').
content_type_map(rdf, 'text/plain').
content_type_map(rdf, 'text/plain').

content_type_map(html, 'text/html').

tidy(Ret, From, To) :-
	app_config_file_no_sandbox(tidy, Tidy),
	ret_file(Ret, From, FromFile),
	ret_file(Ret, To, ToFile),
	shell_format('~w -asxhtml -quiet -f /dev/null < ~w > ~w',
		     [Tidy, FromFile, ToFile]).
