- generalized sysLogger class so that it logs to a generic output

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

diff --git a/helm/uwobo/src/ocaml/uwobo_engine.ml b/helm/uwobo/src/ocaml/uwobo_engine.ml
index fcbc0f36488da637dde37a05e49f2992684f1783..4d85786dc5f3d1b87467f40bdb27f61d20a39b15 100644 (file)
--- a/helm/uwobo/src/ocaml/uwobo_engine.ml
+++ b/helm/uwobo/src/ocaml/uwobo_engine.ml
@@ -27,54 +27,33 @@
 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 = [ "method", "xml" ] *)
+let 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
@@ -124,8 +95,8 @@ let apply
   ~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) ->
@@ -140,6 +111,16 @@ let apply
               "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