-
-(* Copyright (C) 2002, HELM Team.
- *
- * This file is part of HELM, an Hypertextual, Electronic
- * Library of Mathematics, developed at the Computer Science
- * Department, University of Bologna, Italy.
- *
- * HELM is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * HELM is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
+(*
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@cs.unibo.it>
+ * for the HELM Team http://helm.cs.unibo.it/
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
*
- * You should have received a copy of the GNU General Public License
- * along with HELM; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- * MA 02111-1307, USA.
- *
- * For details, see the HELM World-Wide-Web page,
- * http://cs.unibo.it/helm/.
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
*)
open Printf;;
open Uwobo_common;;
-exception Unsupported_property of string;;
-
-let supported_properties = [
- "cdata-section-elements";
- "doctype-public";
- "doctype-system";
- "encoding";
- "indent";
- "media-type";
- "method";
- "omit-xml-declaration";
- "standalone";
- "version"
-]
+ (** set this to true and uwobo will save transformation's intermediate results
+ in /tmp/uwobo_intermediate_<seqno>_<pid>.xml *)
+let save_intermediate_results = false;;
-let dump_args keys params props =
- (sprintf "
-Keys: %s<br />
-Parameters:<br />
-%s
-Props: %s<br />
-"
- (String.concat ", " keys)
- (String.concat
- "<br />\n"
- (List.map
- (fun key ->
- (sprintf
- "Key: %s, Params: %s"
- key
- (String.concat
- ", "
- (List.map
- (fun (key,value) -> sprintf "%s:%s" key value)
- (params key)))))
- keys))
- (String.concat
- ", "
- (List.map (fun (key,value) -> sprintf "%s:%s" key value) props)))
+exception Unsupported_property of string;;
let xslNS = Gdome.domString "http://www.w3.org/1999/XSL/Transform"
let outputS = Gdome.domString "output"
let q_outputS = Gdome.domString "xsl:output"
-let is_supported_property name = List.mem name supported_properties
+
+let default_properties = [] (* no default properties *)
+
+ (** apply an output property to an xslt stylesheet *)
+let apply_property logger (element: Gdome.element) (name, value) =
+ if Uwobo_common.is_supported_property name then begin
+ logger#log `Debug (sprintf "Setting property: %s = %s" name value);
+ element#setAttribute (Gdome.domString name) (Gdome.domString value)
+ end else
+ raise (Unsupported_property name)
(** set a list of output properties in an xslt stylesheet, return a copy of
the given stylesheet modified as needed, given stylesheet wont be changed by
- this operation *)
+ this operation.
+ Before applying "props" properties applies a set of default properties as
+ defined in "default_properties" *)
let apply_properties logger last_stylesheet props =
let last_stylesheet =
new Gdome.document_of_node (last_stylesheet#cloneNode ~deep:true)
logger#log `Debug "Creating xsl:output node ...";
let elt = last_stylesheet#createElementNS (Some xslNS) q_outputS in
let root = last_stylesheet#get_documentElement in
- ignore (root#insertBefore (elt :> Gdome.node) root#get_firstChild);
+ ignore (root#appendChild (elt :> Gdome.node));
elt
| Some node -> new Gdome.element_of_node node)
in
- let apply_property (name, value) =
- if is_supported_property name then begin
- logger#log `Debug (sprintf "Setting property: %s = %s" name value);
- output_element#setAttribute
- (Gdome.domString name)
- (Gdome.domString value)
- end
- else
- raise (Unsupported_property name)
- in
- List.iter apply_property props;
+ List.iter
+ (apply_property logger (output_element :> Gdome.element))
+ (default_properties @ props);
last_stylesheet
(** given a Gdome.document representing an XSLT stylesheet and an output
let apply
~(logger: Uwobo_logger.sysLogger)
~(styles: Uwobo_styles.styles)
- ~keys ~params ~props ~input =
+ ~keys ~params ~props ~input
+ =
(* "p_" prefix means "processed" *)
let (p_stylesheets, last_stylesheet) = styles#get keys in
- logger#log `Debug (dump_args keys params props);
logger#log `Debug "Creating input document ...";
+ let intermediate_results_seqno = ref 0 in
let result = (* Gdome.document *)
List.fold_left
(fun source (key, stylesheet) ->
let params =
List.map (fun (key,value) -> (key, "'" ^ value ^ "'")) (params key)
in
- Gdome_xslt.applyStylesheet ~source ~stylesheet ~params
+ logger#log `Debug
+ (sprintf "Gdome_xslt.applyStylesheet params=%s"
+ (String.concat ", " (List.map (fun (k,v) -> k^": "^v) params)));
+ let res = Gdome_xslt.applyStylesheet ~source ~stylesheet ~params in
+ if save_intermediate_results then begin
+ let domImpl = Gdome.domImplementation () in
+ ignore
+ (domImpl#saveDocumentToFile
+ ~doc:res
+ ~name:(sprintf "/tmp/uwobo_intermediate_%d_%d.xml"
+ !intermediate_results_seqno (Unix.getpid()))
+ ());
+ incr intermediate_results_seqno;
+ end;
+ res
with e -> raise (Uwobo_failure (Printexc.to_string e)))
input
p_stylesheets
in
- (* used to retrieve serialization options *)
- let last_stylesheet =
+ let last_stylesheet = (* used to retrieve serialization options *)
try
apply_properties logger last_stylesheet props
with Unsupported_property prop ->
in
let p_last_stylesheet = Gdome_xslt.processStylesheet last_stylesheet in
((fun outchan -> (* serialization function *)
- Gdome_xslt.saveResultToChannel
- ~outchan
- ~result
+ Gdome_xslt.saveResultToChannel ~outchan ~result
~stylesheet:p_last_stylesheet),
(get_property "media-type" last_stylesheet), (* media-type *)
(get_property "encoding" last_stylesheet)) (* encoding *)
projects / helm.git / blobdiff