X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fuwobo%2Fsrc%2Focaml%2Fuwobo_engine.ml;h=aad4f971b8d8032bc712a447e8ea145f801837b7;hb=a4df9661e15509e5da6ed9c57e3ab6a27a440c3f;hp=fcbc0f36488da637dde37a05e49f2992684f1783;hpb=e5de7dd8a5252e83ba067e638a847bcdeaffde4b;p=helm.git diff --git a/helm/uwobo/src/ocaml/uwobo_engine.ml b/helm/uwobo/src/ocaml/uwobo_engine.ml index fcbc0f364..aad4f971b 100644 --- a/helm/uwobo/src/ocaml/uwobo_engine.ml +++ b/helm/uwobo/src/ocaml/uwobo_engine.ml @@ -1,80 +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. * - * 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__.xml *) +let save_intermediate_results = false;; -let dump_args keys params props = - (sprintf " -Keys: %s
-Parameters:
-%s -Props: %s
-" - (String.concat ", " keys) - (String.concat - "
\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) @@ -90,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 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 @@ -121,11 +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 (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) -> @@ -134,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 -> @@ -154,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 *)