ocaml 3.09 transition

[helm.git] / helm / uwobo / uwobo_engine.ml

diff --git a/helm/uwobo/uwobo_engine.ml b/helm/uwobo/uwobo_engine.ml
index d7a1c4995025e6aa11ca4c3a1a2921374ed6f067..03a3b424d726f1c65faa2693529fc06b9415dd41 100644 (file)
--- a/helm/uwobo/uwobo_engine.ml
+++ b/helm/uwobo/uwobo_engine.ml
@@ -33,46 +33,8 @@ open Uwobo_common;;
   in /tmp/uwobo_intermediate_<seqno>_<pid>.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),