View source with formatted comments or as raw
    1/*  Part of ClioPatria SeRQL and SPARQL server
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2010-2011, University of Amsterdam,
    7			      VU University Amsterdam
    8
    9    This program is free software; you can redistribute it and/or
   10    modify it under the terms of the GNU General Public License
   11    as published by the Free Software Foundation; either version 2
   12    of the License, or (at your option) any later version.
   13
   14    This program is distributed in the hope that it will be useful,
   15    but WITHOUT ANY WARRANTY; without even the implied warranty of
   16    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17    GNU General Public License for more details.
   18
   19    You should have received a copy of the GNU General Public
   20    License along with this library; if not, write to the Free Software
   21    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22
   23    As a special exception, if you link this library with other files,
   24    compiled with a Free Software compiler, to produce an executable, this
   25    library does not by itself cause the resulting executable to be covered
   26    by the GNU General Public License. This exception does not however
   27    invalidate any other reasons why the executable file might be covered by
   28    the GNU General Public License.
   29*/
   30
   31:- module(cp_graphviz,
   32	  [ graphviz_graph//2,		% :Closure, +Options
   33	    reply_graphviz_graph/3      % +Graph, +Language, +Options
   34	  ]).   35:- use_module(library(http/http_dispatch)).   36:- use_module(library(http/http_parameters)).   37:- use_module(library(http/http_session)).   38:- use_module(library(http/html_write)).   39:- use_module(library(http/html_head)).   40:- use_module(library(http/http_path)).   41:- use_module(library(process)).   42:- use_module(library(debug)).   43:- use_module(library(option)).   44:- use_module(library(settings)).   45:- use_module(library(semweb/rdf_db)).   46:- use_module(library(semweb/rdf_graphviz)).   47:- use_module(library(http/http_wrapper)).   48
   49:- setting(graphviz:format, oneof([svg,canviz]), svg,
   50	   'Technique to include RDF graphs in a page').   51
   52/** <module> Render RDF-graphs
   53
   54This module provides graphviz_graph//2 to render   a  list of rdf(S,P,O)
   55terms as a graph.
   56
   57@see	library(semweb/rdf_abstract) for various operations on graphs
   58	represented as lists of rdf(S,P,O).
   59*/
   60
   61:- html_resource(js('canviz.js'),
   62		 [ requires([ js('path/path.js'),
   63			      js('prototype/prototype.js')
   64			    ])
   65		 ]).   66:- html_resource(js('path/path.js'),
   67		 [ requires([ js('prototype/prototype.js')
   68			    ])
   69		 ]).   70
   71% Note that images are requested relative to this URL.  Changing this
   72% also requires changing the `image server' in graphviz.pl
   73
   74:- http_handler(root('graphviz/send_graph'), send_graph, []).   75
   76%%	graphviz_graph(:Closure, +Options)//
   77%
   78%	Display an RDF graph graphical in the   browser.  The graph is a
   79%	list  of  rdf(S,P,O)  triples  and    is   obtained  by  calling
   80%	call(Closure, Graph). This component  inserts   HTML  that  will
   81%	cause  a  subsequent  call  to    send_graph/1,  which  executes
   82%	call(Closure,  Graph)  and  sends  the  graph.  This  design  is
   83%	required for the HTML5/canviz rendering. For   SVG we could have
   84%	opted for embedded SVG,  but  this   design  is  currently  more
   85%	portable  and  avoid  slowing  down  page  rendering  if  it  is
   86%	expensive to produce the graph.
   87%
   88%	Options is an option-list for  gviz_write_rdf/3. In addition, it
   89%	processes the option:
   90%
   91%	    * render(+Exe)
   92%	    Set the rendering engine.  Default is =dot=.
   93%	    * format(+Format)
   94%	    One of =canviz=, using AJAX-based rendering on HTML5 canvas
   95%	    or =svg=, using SVG.  The default is defined by the setting
   96%	    graphviz:format.
   97%	    * object_attributes(+List)
   98%	    Additional attributes to pass to the SVG =object= element.
   99%
  100%	This facility requires the graphiz   renderer programs installed
  101%	in the executable search-path.
  102%
  103%	@see http://code.google.com/p/canviz/
  104%	@see http://www.graphviz.org/
  105
  106:- meta_predicate
  107	graphviz_graph(1, :, ?, ?).  108:- dynamic
  109	closure/4.				% Hash, Closure, Options, Time
  110
  111graphviz_graph(_Closure, _:Options) -->
  112	{ option(render(Renderer), Options, dot),
  113	  \+ has_graphviz_renderer(Renderer)
  114	}, !,
  115	no_graph_viz(Renderer).
  116graphviz_graph(Closure, Options) -->
  117	{ setting(graphviz:format, DefFormat),
  118	  Options = _:PlainOptions,
  119	  option(format(Format), PlainOptions, DefFormat),
  120	  meta_options(is_meta, Options, QOptions),
  121	  variant_sha1(Closure+QOptions, Hash),
  122	  get_time(Now),
  123	  assert(closure(Hash, Closure, QOptions, Now)),
  124	  remove_old_closures(Now)
  125	},
  126	graphviz_graph_fmt(Format, Hash, QOptions).
  127
  128
  129graphviz_graph_fmt(canviz, Hash, _Options) --> !,
  130	{ http_link_to_id(send_graph, [hash(Hash)], HREF)
  131	},
  132	html_requires(js('canviz.js')),
  133	html([ div(class(graph),
  134		   div(id(canviz), [])),
  135	       div(id(debug_output), []),
  136	       script(type('text/javascript'),
  137		      \[ 'document.observe(\'dom:loaded\', function() {\n',
  138			 '  new Canviz(\'canviz\', \'~w\');\n'-[HREF],
  139			 '});'
  140		       ])
  141	     ]).
  142graphviz_graph_fmt(svg, Hash, Options) -->
  143	{ option(object_attributes(Attrs), Options, []),
  144	  http_link_to_id(send_graph,
  145			  [ hash(Hash),
  146			    lang(svg),
  147			    target('_top')
  148			  ], HREF)
  149	},
  150	html([ object([ data(HREF),
  151			type('image/svg+xml')
  152		      | Attrs
  153		      ],
  154		      [])
  155	     ]).
  156
  157is_meta(wrap_url).
  158is_meta(shape_hook).
  159is_meta(bag_shape_hook).
  160
  161has_graphviz_renderer(Renderer) :-
  162	process:exe_options(ExeOptions),
  163	absolute_file_name(path(Renderer), _,
  164			   [ file_errors(fail)
  165			   | ExeOptions
  166			   ]).
  167
  168no_graph_viz(Renderer) -->
  169	html(div(id('no-graph-viz'),
  170		 [ 'The server does not have the graphviz program ',
  171		   code(Renderer), ' installed in PATH. ',
  172		   'See ', a(href('http://www.graphviz.org/'),
  173			     'http://www.graphviz.org/'), ' for details.'
  174		 ])).
  175
  176%%	send_graph(+Request)
  177%
  178%	HTTP handler to send a graph.  This   HTTP  handler is a private
  179%	handler for graphviz_graph//2, rendering a   list  of rdf(S,P,O)
  180%	triples using Graphviz.
  181
  182send_graph(Request) :-
  183	http_parameters(Request,
  184			[ hash(Hash,
  185			       [ description('Hash-key to the graph-data')
  186			       ]),
  187			  lang(Lang,
  188			       [ default(xdot),
  189				 description('-TXXX option of graphviz')
  190			       ]),
  191			  target(Target,
  192				 [ optional(true),
  193				   description('Add TARGET= to all links')
  194				 ])
  195			]),
  196	closure(Hash, Closure, Options, _),
  197	call(Closure, Graph),
  198	reply_graphviz_graph(Graph, Lang, [target(Target)|Options]).
  199
  200reply_graphviz_graph(_Graph, _Lang, Options) :-
  201	option(render(Renderer), Options, dot),
  202	\+ has_graphviz_renderer(Renderer), !,
  203	http_current_request(Request),
  204	http_reply_file(help('error.svg'), [], Request).
  205reply_graphviz_graph(Graph, Lang, Options) :-
  206	option(target(Target), Options, _),
  207	length(Graph, Len),
  208	debug(graphviz, 'Graph contains ~D triples', [Len]),
  209	select_option(render(Renderer), Options, GraphOptions0, dot),
  210	target_option(Target, GraphOptions0, GraphOptions),
  211	atom_concat('-T', Lang, GraphLang),
  212	process_create(path(Renderer), [GraphLang],
  213		       [ stdin(pipe(ToDOT)),
  214			 stdout(pipe(XDotOut)),
  215			 process(PID)
  216		       ]),
  217	set_stream(ToDOT, encoding(utf8)),
  218	set_stream(XDotOut, encoding(utf8)),
  219	thread_create(send_to_dot(Graph, GraphOptions, ToDOT), _,
  220		      [ detached(true) ]),
  221	call_cleanup(load_structure(stream(XDotOut),
  222				    SVGDom0,
  223				    [ dialect(xml) ]),
  224		     (	 process_wait(PID, _Status),
  225			 close(XDotOut)
  226		     )),
  227	rewrite_sgv_dom(SVGDom0, SVGDom),
  228	graph_mime_type(Lang, ContentType),
  229	format('Content-type: ~w~n~n', [ContentType]),
  230	xml_write(current_output, SVGDom,
  231		  [ layout(false)
  232		  ]).
  233
  234rewrite_sgv_dom([element(svg, Attrs, Content)],
  235		[element(svg, Attrs,
  236			 [ element(script, ['xlink:href'=SVGPan], []),
  237			   element(g, [ id=viewport
  238				      ],
  239				   Content)
  240			 ])]) :-
  241	http_absolute_location(js('SVGPan.js'), SVGPan, []).
  242rewrite_sgv_dom(DOM, DOM).
  243
  244
  245target_option(Target, GraphOptions0, GraphOptions) :-
  246	(   nonvar(Target)
  247	->  GraphOptions = [target(Target)|GraphOptions0]
  248	;   GraphOptions = GraphOptions0
  249	).
  250
  251
  252graph_mime_type(xdot, 'text/plain; charset=UTF-8') :- !.
  253graph_mime_type(svg,  'image/svg+xml; charset=UTF-8') :- !.
  254graph_mime_type(Lang, 'text/plain; charset=UTF-8') :-
  255	print_message(warning,
  256		      format('Do not know content-type for grapviz \c
  257		             language ~w.  Please extend graph_mime_type/2',
  258			     Lang)).
  259
  260send_to_dot(Graph, Options, Out) :-
  261	(   debugging(dot)
  262	->  retractall(user:graphviz(_,_)),
  263	    assert(user:graphviz(Graph, Options))
  264	;   true
  265	),
  266	call_cleanup(gviz_write_rdf(Out, Graph, Options),
  267		     close(Out)), !.
  268
  269copy_graph_data(Out) :-
  270	debugging(graphviz), !,
  271	get_code(Out, C0),
  272	copy_graph_data(C0, Out).
  273copy_graph_data(Out) :-
  274	copy_stream_data(Out, current_output).
  275
  276copy_graph_data(-1, _) :- !.
  277copy_graph_data(C, Stream) :-
  278	put_code(C),
  279	put_code(user_error, C),
  280	get_code(Stream, C2),
  281	copy_graph_data(C2, Stream).
  282
  283
  284%%	remove_old_closures(+Now)
  285%
  286%	Remove closures that are older than 15 minutes.
  287
  288remove_old_closures(Time) :-
  289	(   closure(Hash, _, _, Stamp),
  290	    Time > Stamp+900,
  291	    retract(closure(Hash, _, _, Stamp)),
  292	    fail
  293	;   true
  294	)