snapshot Wed, 27 Nov 2002 18:10:57 +0100

[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
new file mode 100644 (file)
index 0000000..9e4850b
--- /dev/null
+++ b/helm/uwobo/src/ocaml/uwobo_engine.ml
@@ -0,0 +1,72 @@
+
+(* 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.
+ *
+ * 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/.
+ *)
+
+open Printf;;
+open Uwobo_common;;
+
+let dump_args keys params props =
+  (sprintf "
+<h1>Uwobo_engine.apply: not yet implemented!</h1>
+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)))
+
+  (* TODO add global mutex, stylesheets are freezed at the request moment *)
+let apply
+  ~(logger: Uwobo_logger.processingLogger)
+  ~(styles: Uwobo_styles.styles)
+  ~keys ~params ~props ~input =
+  let stylesheets = styles#get keys in
+  logger#log (dump_args keys params props);
+  logger#log "Creating input document ...";
+  List.fold_left
+    (fun source (key, stylesheet) ->
+      logger#log (sprintf "Applying stylesheet %s ..." key);
+      try
+        Gdome_xslt.applyStylesheet ~source ~stylesheet ~params:(params key)
+      with e -> raise (Uwobo_failure (Printexc.to_string e)))
+    input
+    stylesheets
+