X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fuwobo%2Fuwobo_engine.ml;h=03a3b424d726f1c65faa2693529fc06b9415dd41;hb=4167cea65ca58897d1a3dbb81ff95de5074700cc;hp=d7a1c4995025e6aa11ca4c3a1a2921374ed6f067;hpb=d2c60bae1c4badba0a0f29e3fd2faed6d3a1869e;p=helm.git diff --git a/helm/uwobo/uwobo_engine.ml b/helm/uwobo/uwobo_engine.ml index d7a1c4995..03a3b424d 100644 --- a/helm/uwobo/uwobo_engine.ml +++ b/helm/uwobo/uwobo_engine.ml @@ -33,46 +33,8 @@ open Uwobo_common;; 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. - 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) - in - let output_element = - let node_list = last_stylesheet#getElementsByTagNameNS xslNS outputS in - (match node_list#item 0 with - | None -> (* no xsl:output element, create it from scratch *) - 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#appendChild (elt :> Gdome.node)); - elt - | Some node -> new Gdome.element_of_node node) - in - 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 property return 'Some value' where 'value' is the property value, or None if @@ -237,7 +199,7 @@ let apply input = (* "p_" prefix means "processed" *) - let (p_stylesheets, last_stylesheet) = styles#get keys in + let (p_stylesheets,last_stylesheet) = styles#get keys props logger in logger#log `Debug "Creating input document ..."; let intermediate_results_seqno = ref 0 in let result = (* Gdome.document *) @@ -246,7 +208,23 @@ let apply logger#log `Debug (sprintf "Applying stylesheet %s ..." key); try let params = - List.map (fun (key,value) -> (key, "'" ^ value ^ "'")) (params key) + List.map + (fun (key,value) -> + let quoted_value = + if String.contains value '\'' then + if String.contains value '"' then + raise + (Failure + ("A parameter value can not contain both single and " ^ + "double quotes, since it must be a valid XPath string " ^ + "literal")) + else + "\"" ^ value ^ "\"" + else + "'" ^ value ^ "'" + in + (key,quoted_value) + ) (params key) in logger#log `Debug (sprintf "Gdome_xslt.applyStylesheet params=%s" @@ -276,13 +254,7 @@ let apply ~msgs:[LibXsltErrorMsg "error1"; LibXsltDebugMsg "debug1"] result; *) - let last_stylesheet = (* used to retrieve serialization options *) - try - apply_properties logger last_stylesheet props - with Unsupported_property prop -> - raise (Uwobo_failure (sprintf "Unsupported property: %s" prop)) - in - let p_last_stylesheet = Gdome_xslt.processStylesheet last_stylesheet in + let p_last_stylesheet = snd (List.hd (List.rev p_stylesheets)) in ((fun outchan -> (* serialization function *) Gdome_xslt.saveResultToChannel ~outchan ~result ~stylesheet:p_last_stylesheet),