X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Fuwobo%2Fsrc%2Focaml%2Fuwobo_engine.ml;h=aad4f971b8d8032bc712a447e8ea145f801837b7;hb=a4df9661e15509e5da6ed9c57e3ab6a27a440c3f;hp=75e4669bf0d0ac251bd0d959c0cc8dc2930e7890;hpb=a722972c23b670aab14255d80e933b1fb1469fdb;p=helm.git diff --git a/helm/uwobo/src/ocaml/uwobo_engine.ml b/helm/uwobo/src/ocaml/uwobo_engine.ml index 75e4669bf..aad4f971b 100644 --- a/helm/uwobo/src/ocaml/uwobo_engine.ml +++ b/helm/uwobo/src/ocaml/uwobo_engine.ml @@ -1,41 +1,59 @@ - -(* 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 + * 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. + * + * 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. * - * 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/. + * For details, see the HELM World-Wide-Web page, + * http://helm.cs.unibo.it/ *) open Printf;; open Uwobo_common;; + (** set this to true and uwobo will save transformation's intermediate results + in /tmp/uwobo_intermediate__.xml *) +let save_intermediate_results = false;; + 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 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) @@ -51,17 +69,9 @@ let apply_properties logger last_stylesheet props = elt | Some node -> new Gdome.element_of_node node) in - let apply_property (name, value) = - if Uwobo_common.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 @@ -82,10 +92,12 @@ let get_property name (document: Gdome.document) = 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 "Creating input document ..."; + let intermediate_results_seqno = ref 0 in let result = (* Gdome.document *) List.fold_left (fun source (key, stylesheet) -> @@ -94,19 +106,26 @@ let apply let params = List.map (fun (key,value) -> (key, "'" ^ value ^ "'")) (params key) in - logger#log - `Debug - (sprintf - "Gdome_xslt.applyStylesheet params=%s" + 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 -> @@ -114,9 +133,7 @@ let apply 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 *)