From beaf9a3cb95519e68e5806ac2f8a45b480d8e5ac Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Wed, 27 Nov 2002 17:11:37 +0000 Subject: [PATCH] snapshot Wed, 27 Nov 2002 18:10:57 +0100 --- helm/uwobo/src/ocaml/.cvsignore | 3 +- helm/uwobo/src/ocaml/.depend | 8 +- helm/uwobo/src/ocaml/uwobo.ml | 7 +- helm/uwobo/src/ocaml/uwobo_common.ml | 98 ++++++++++++++++++++++++ helm/uwobo/src/ocaml/uwobo_common.mli | 44 +++++++++++ helm/uwobo/src/ocaml/uwobo_engine.ml | 72 +++++++++++++++++ helm/uwobo/src/ocaml/uwobo_engine.mli | 44 +++++++++++ helm/uwobo/src/ocaml/uwobo_styles.ml | 106 ++++++++++++++++++++++++++ helm/uwobo/src/ocaml/uwobo_styles.mli | 40 ++++++++++ 9 files changed, 413 insertions(+), 9 deletions(-) create mode 100644 helm/uwobo/src/ocaml/uwobo_common.ml create mode 100644 helm/uwobo/src/ocaml/uwobo_common.mli create mode 100644 helm/uwobo/src/ocaml/uwobo_engine.ml create mode 100644 helm/uwobo/src/ocaml/uwobo_engine.mli create mode 100644 helm/uwobo/src/ocaml/uwobo_styles.ml create mode 100644 helm/uwobo/src/ocaml/uwobo_styles.mli diff --git a/helm/uwobo/src/ocaml/.cvsignore b/helm/uwobo/src/ocaml/.cvsignore index 3535ea5d5..7a77a0ecd 100644 --- a/helm/uwobo/src/ocaml/.cvsignore +++ b/helm/uwobo/src/ocaml/.cvsignore @@ -3,4 +3,5 @@ *.cmx *.cma *.cmxa -uwobo* +uwobo +uwobo.opt diff --git a/helm/uwobo/src/ocaml/.depend b/helm/uwobo/src/ocaml/.depend index 96ae180f4..f07755e38 100644 --- a/helm/uwobo/src/ocaml/.depend +++ b/helm/uwobo/src/ocaml/.depend @@ -8,8 +8,8 @@ uwobo_engine.cmo: uwobo_common.cmi uwobo_logger.cmi uwobo_styles.cmi \ uwobo_engine.cmi uwobo_engine.cmx: uwobo_common.cmx uwobo_logger.cmx uwobo_styles.cmx \ uwobo_engine.cmi -uwobo_logger.cmo: uwobo_logger.cmi -uwobo_logger.cmx: uwobo_logger.cmi -uwobo_styles.cmo: uwobo_styles.cmi -uwobo_styles.cmx: uwobo_styles.cmi +uwobo_logger.cmo: uwobo_common.cmi uwobo_logger.cmi +uwobo_logger.cmx: uwobo_common.cmx uwobo_logger.cmi +uwobo_styles.cmo: uwobo_common.cmi uwobo_styles.cmi +uwobo_styles.cmx: uwobo_common.cmx uwobo_styles.cmi uwobo_engine.cmi: uwobo_logger.cmi uwobo_styles.cmi diff --git a/helm/uwobo/src/ocaml/uwobo.ml b/helm/uwobo/src/ocaml/uwobo.ml index 625455469..334255b40 100644 --- a/helm/uwobo/src/ocaml/uwobo.ml +++ b/helm/uwobo/src/ocaml/uwobo.ml @@ -157,7 +157,8 @@ let callback req outchan = defined for all stylesheets (i.e. param.param=value) *) let (params, props) = parse_apply_params req#params in syslogger#log `Debug (sprintf "Parsing input document %s ..." xmluri); - let input = styles#domImpl#createDocumentFromURI ~uri:xmluri () in + let domImpl = Gdome.domImplementation () in + let input = domImpl#createDocumentFromURI ~uri:xmluri () in let output = Uwobo_engine.apply ~logger ~styles ~keys ~input ~params ~props (* TODO uhm ... what to do if Uwobo_failure is raised? *) @@ -174,9 +175,7 @@ let callback req outchan = syslogger#log `Debug (sprintf "saving output document to %s ..." tempfile); - let res = - styles#domImpl#saveDocumentToFile ~doc:output ~name:tempfile () - in + let res = domImpl#saveDocumentToFile ~doc:output ~name:tempfile () in if not res then raise (Uwobo_failure ("unable to save output to file " ^ tempfile)); syslogger#log `Debug "sending output to client ...."; diff --git a/helm/uwobo/src/ocaml/uwobo_common.ml b/helm/uwobo/src/ocaml/uwobo_common.ml new file mode 100644 index 000000000..09f9ba5a1 --- /dev/null +++ b/helm/uwobo/src/ocaml/uwobo_common.ml @@ -0,0 +1,98 @@ + +(* 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/. + *) + +let debug = false;; +let debug_print msg = if debug then prerr_endline msg;; + +exception Uwobo_failure of string;; + +class threadSafe = + object (self) + + val mutex = Mutex.create () + + (** condition variable: 'no readers is currently reading' *) + val noReaders = Condition.create () + + (** readers count *) + val mutable readersCount = 0 + + method private incrReadersCount = (* internal, not exported *) + self#doCritical (lazy ( + readersCount <- readersCount + 1 + )) + + method private decrReadersCount = (* internal, not exported *) + self#doCritical (lazy ( + if readersCount > 0 then readersCount <- readersCount - 1; + )) + + method private signalNoReaders = (* internal, not exported *) + self#doCritical (lazy ( + if readersCount = 0 then Condition.signal noReaders + )) + + method private doCritical: 'a. 'a lazy_t -> 'a = + fun action -> + debug_print ""; + (try + Mutex.lock mutex; + let res = Lazy.force action in + Mutex.unlock mutex; + debug_print ""; + res + with e -> + Mutex.unlock mutex; + raise e); + + method private doReader: 'a. 'a lazy_t -> 'a = + fun action -> + debug_print ""; + let cleanup () = + self#decrReadersCount; + self#signalNoReaders + in + self#incrReadersCount; + let res = (try Lazy.force action with e -> (cleanup (); raise e)) in + cleanup (); + debug_print ""; + res + + (* TODO may starve!!!! is what we want or not? *) + method private doWriter: 'a. 'a lazy_t -> 'a = + fun action -> + debug_print ""; + self#doCritical (lazy ( + while readersCount > 0 do + Condition.wait noReaders mutex + done; + let res = Lazy.force action in + debug_print ""; + res + )) + + end + diff --git a/helm/uwobo/src/ocaml/uwobo_common.mli b/helm/uwobo/src/ocaml/uwobo_common.mli new file mode 100644 index 000000000..a056678f2 --- /dev/null +++ b/helm/uwobo/src/ocaml/uwobo_common.mli @@ -0,0 +1,44 @@ + +(* 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/. + *) + +exception Uwobo_failure of string;; + +class threadSafe: + object + + (** execute 'action' in mutual exclusion between all other threads *) + method private doCritical: 'a lazy_t -> 'a + + (** execute 'action' acting as a 'reader' i.e.: multiple readers can act + at the same time but no writer can act until no readers are acting *) + method private doReader: 'a lazy_t -> 'a + + (** execute 'action' acting as a 'writer' i.e.: when a writer is acting, + no readers or writer can act, beware that writers can starve *) + method private doWriter: 'a lazy_t -> 'a + + end + diff --git a/helm/uwobo/src/ocaml/uwobo_engine.ml b/helm/uwobo/src/ocaml/uwobo_engine.ml new file mode 100644 index 000000000..9e4850bbb --- /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 " +

Uwobo_engine.apply: not yet implemented!

+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))) + + (* 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 + diff --git a/helm/uwobo/src/ocaml/uwobo_engine.mli b/helm/uwobo/src/ocaml/uwobo_engine.mli new file mode 100644 index 000000000..378375fa6 --- /dev/null +++ b/helm/uwobo/src/ocaml/uwobo_engine.mli @@ -0,0 +1,44 @@ + +(* 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/. + *) + + (** + @param logger logger for processing messages + @param styles stylesheets object + @param keys (ordered) list of stylesheet names to be applied + @param params function mapping stylesheet names to parameters list + @param props xml:output properties + @param input URI of input document + @param channel on which write final output + *) +val apply: + logger: Uwobo_logger.processingLogger -> + styles: Uwobo_styles.styles -> + keys: string list -> + params: (string -> (string * string) list) -> + props: (string * string) list -> + input: Gdome.document -> + Gdome.document + diff --git a/helm/uwobo/src/ocaml/uwobo_styles.ml b/helm/uwobo/src/ocaml/uwobo_styles.ml new file mode 100644 index 000000000..93fdb8e63 --- /dev/null +++ b/helm/uwobo/src/ocaml/uwobo_styles.ml @@ -0,0 +1,106 @@ + +(* 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;; + +exception Stylesheet_not_found of string;; +exception Stylesheet_already_in of string;; + +class styles = + object (self) + (* INVARIANT: 'stylesheets' and 'uris' are in sync *) + + inherit Uwobo_common.threadSafe + + val mutable stylesheets = [] + val mutable uris = [] + val domImpl = Gdome.domImplementation () + + (** process an XSLT stylesheet *) + method private process uri = + Gdome_xslt.processStylesheet (domImpl#createDocumentFromURI ~uri ()) + + method get keys = + self#doReader (lazy ( + List.fold_left + (fun collected_styles key -> + (List.find (fun (k, _) -> k = key) stylesheets)::collected_styles) + [] + (List.rev keys) + )) + + method add key uri = + self#doWriter (lazy ( + if (List.mem_assoc key uris) then + raise (Stylesheet_already_in key) + else begin + uris <- (key, uri) :: uris; + stylesheets <- (key, self#process uri) :: stylesheets + end + )) + + method remove key = + self#doWriter (lazy ( + if not (List.mem_assoc key uris) then + raise (Stylesheet_not_found key) + else begin + uris <- List.remove_assoc key uris; + stylesheets <- List.remove_assoc key stylesheets + end + )) + + method removeAll = + self#doWriter (lazy ( + uris <- []; + stylesheets <- [] + )) + + method list = + let uris = self#doReader (lazy ( + uris + )) + in + List.map + (fun (key, uri) -> sprintf "key = %s, uri = %s" key (List.assoc key uris)) + uris + + method reload key = + self#doWriter (lazy ( + (try + let uri = List.assoc key uris in + stylesheets <- + (key, self#process uri) :: (List.remove_assoc key stylesheets) + with Not_found -> + raise (Stylesheet_not_found key)) + )) + + method reloadAll = + self#doWriter (lazy ( + stylesheets <- List.map (fun (key, uri) -> (key, self#process uri)) uris + )) + + end + diff --git a/helm/uwobo/src/ocaml/uwobo_styles.mli b/helm/uwobo/src/ocaml/uwobo_styles.mli new file mode 100644 index 000000000..a8b3c947b --- /dev/null +++ b/helm/uwobo/src/ocaml/uwobo_styles.mli @@ -0,0 +1,40 @@ + +(* 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/. + *) + +exception Stylesheet_not_found of string;; +exception Stylesheet_already_in of string;; + +class styles: + object + method get: string list -> (string * I_gdome_xslt.processed_stylesheet) list + method add: string -> string -> unit + method remove: string -> unit + method removeAll: unit + method list: string list + method reload: string -> unit + method reloadAll: unit + end + -- 2.39.2