3 * Stefano Zacchiroli <zack@cs.unibo.it>
4 * for the HELM Team http://helm.cs.unibo.it/
6 * This file is part of HELM, an Hypertextual, Electronic
7 * Library of Mathematics, developed at the Computer Science
8 * Department, University of Bologna, Italy.
10 * HELM is free software; you can redistribute it and/or
11 * modify it under the terms of the GNU General Public License
12 * as published by the Free Software Foundation; either version 2
13 * of the License, or (at your option) any later version.
15 * HELM is distributed in the hope that it will be useful,
16 * but WITHOUT ANY WARRANTY; without even the implied warranty of
17 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 * GNU General Public License for more details.
20 * You should have received a copy of the GNU General Public License
21 * along with HELM; if not, write to the Free Software
22 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
25 * For details, see the HELM World-Wide-Web page,
26 * http://helm.cs.unibo.it/
32 (** set this to true and uwobo will save transformation's intermediate results
33 in /tmp/uwobo_intermediate_<seqno>_<pid>.xml *)
34 let save_intermediate_results = false;;
36 exception Unsupported_property of string;;
38 let xslNS = Gdome.domString "http://www.w3.org/1999/XSL/Transform"
39 let outputS = Gdome.domString "output"
40 let q_outputS = Gdome.domString "xsl:output"
42 let default_properties = [] (* no default properties *)
44 (** apply an output property to an xslt stylesheet *)
45 let apply_property logger (element: Gdome.element) (name, value) =
46 if Uwobo_common.is_supported_property name then begin
47 logger#log `Debug (sprintf "Setting property: %s = %s" name value);
48 element#setAttribute (Gdome.domString name) (Gdome.domString value)
50 raise (Unsupported_property name)
52 (** set a list of output properties in an xslt stylesheet, return a copy of
53 the given stylesheet modified as needed, given stylesheet wont be changed by
55 Before applying "props" properties applies a set of default properties as
56 defined in "default_properties" *)
57 let apply_properties logger last_stylesheet props =
59 new Gdome.document_of_node (last_stylesheet#cloneNode ~deep:true)
62 let node_list = last_stylesheet#getElementsByTagNameNS xslNS outputS in
63 (match node_list#item 0 with
64 | None -> (* no xsl:output element, create it from scratch *)
65 logger#log `Debug "Creating xsl:output node ...";
66 let elt = last_stylesheet#createElementNS (Some xslNS) q_outputS in
67 let root = last_stylesheet#get_documentElement in
68 ignore (root#appendChild (elt :> Gdome.node));
70 | Some node -> new Gdome.element_of_node node)
73 (apply_property logger (output_element :> Gdome.element))
74 (default_properties @ props);
77 (** given a Gdome.document representing an XSLT stylesheet and an output
78 property return 'Some value' where 'value' is the property value, or None if
80 let get_property name (document: Gdome.document) =
81 let node_list = document#getElementsByTagNameNS xslNS outputS in
82 match node_list#item 0 with
85 let element = new Gdome.element_of_node node in
86 let domName = Gdome.domString name in
87 if element#hasAttribute domName then
88 Some (element#getAttribute domName)#to_string
93 ~(logger: Uwobo_logger.sysLogger)
94 ~(styles: Uwobo_styles.styles)
95 ~keys ~params ~props ~input
97 (* "p_" prefix means "processed" *)
98 let (p_stylesheets, last_stylesheet) = styles#get keys in
99 logger#log `Debug "Creating input document ...";
100 let intermediate_results_seqno = ref 0 in
101 let result = (* Gdome.document *)
103 (fun source (key, stylesheet) ->
104 logger#log `Debug (sprintf "Applying stylesheet %s ..." key);
107 List.map (fun (key,value) -> (key, "'" ^ value ^ "'")) (params key)
110 (sprintf "Gdome_xslt.applyStylesheet params=%s"
111 (String.concat ", " (List.map (fun (k,v) -> k^": "^v) params)));
112 let res = Gdome_xslt.applyStylesheet ~source ~stylesheet ~params in
113 if save_intermediate_results then begin
114 let domImpl = Gdome.domImplementation () in
116 (domImpl#saveDocumentToFile
118 ~name:(sprintf "/tmp/uwobo_intermediate_%d_%d.xml"
119 !intermediate_results_seqno (Unix.getpid()))
121 incr intermediate_results_seqno;
124 with e -> raise (Uwobo_failure (Printexc.to_string e)))
128 let last_stylesheet = (* used to retrieve serialization options *)
130 apply_properties logger last_stylesheet props
131 with Unsupported_property prop ->
132 raise (Uwobo_failure (sprintf "Unsupported property: %s" prop))
134 let p_last_stylesheet = Gdome_xslt.processStylesheet last_stylesheet in
135 ((fun outchan -> (* serialization function *)
136 Gdome_xslt.saveResultToChannel ~outchan ~result
137 ~stylesheet:p_last_stylesheet),
138 (get_property "media-type" last_stylesheet), (* media-type *)
139 (get_property "encoding" last_stylesheet)) (* encoding *)