From: Stefano Zacchiroli Date: Wed, 27 Nov 2002 01:45:57 +0000 (+0000) Subject: snapshot Wed, 27 Nov 2002 02:45:45 +0100 X-Git-Tag: V_0_0_6~49 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=2a5683cf113dc524f685af57cf7ae2dda3190467;p=helm.git snapshot Wed, 27 Nov 2002 02:45:45 +0100 --- diff --git a/helm/uwobo/src/ocaml/.depend b/helm/uwobo/src/ocaml/.depend index 1fd2e0ef2..96ae180f4 100644 --- a/helm/uwobo/src/ocaml/.depend +++ b/helm/uwobo/src/ocaml/.depend @@ -1,7 +1,13 @@ -uwobo.cmo: uwobo_engine.cmi uwobo_logger.cmi uwobo_styles.cmi -uwobo.cmx: uwobo_engine.cmx uwobo_logger.cmx uwobo_styles.cmx -uwobo_engine.cmo: uwobo_engine.cmi -uwobo_engine.cmx: uwobo_engine.cmi +uwobo.cmo: uwobo_common.cmi uwobo_engine.cmi uwobo_logger.cmi \ + uwobo_styles.cmi +uwobo.cmx: uwobo_common.cmx uwobo_engine.cmx uwobo_logger.cmx \ + uwobo_styles.cmx +uwobo_common.cmo: uwobo_common.cmi +uwobo_common.cmx: uwobo_common.cmi +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 diff --git a/helm/uwobo/src/ocaml/Makefile b/helm/uwobo/src/ocaml/Makefile index 6030b6eca..38eb50801 100644 --- a/helm/uwobo/src/ocaml/Makefile +++ b/helm/uwobo/src/ocaml/Makefile @@ -1,9 +1,9 @@ -REQUIRES = http gdome2 gdome2-xslt threads pcre +REQUIRES = http gdome2 gdome2-xslt threads pcre unix COMMONOPTS = -package "$(REQUIRES)" -pp camlp4o OCAMLC = ocamlfind ocamlc $(COMMONOPTS) -thread OCAMLOPT = ocamlfind ocamlopt $(COMMONOPTS) -thread OCAMLDEP = ocamlfind ocamldep $(COMMONOPTS) -MODULES = uwobo_styles uwobo_logger uwobo_engine uwobo +MODULES = uwobo_common uwobo_styles uwobo_logger uwobo_engine uwobo OBJS = $(patsubst %,%.cmo,$(MODULES)) OBJSOPT = $(patsubst %,%.cmx,$(MODULES)) diff --git a/helm/uwobo/src/ocaml/uwobo.ml b/helm/uwobo/src/ocaml/uwobo.ml index d45045b5d..142fddd7d 100644 --- a/helm/uwobo/src/ocaml/uwobo.ml +++ b/helm/uwobo/src/ocaml/uwobo.ml @@ -25,6 +25,7 @@ *) open Printf;; +open Uwobo_common;; (* debugging settings *) let debug = true;; @@ -62,11 +63,31 @@ in let syslogger = new Uwobo_logger.sysLogger ~level:debug_level () in syslogger#enable; let styles = new Uwobo_styles.styles in -let styles_mutex = Mutex.create () in let usage_string = "Help message: not yet written!!" in (* TODO *) (* thread action *) let callback req outchan = + (* perform an 'action' that can be applied to a list of keys or, if no + keys was given, to all keys *) + let act_on_keys req styles outchan per_key_action all_keys_action logmsg = + let log = new Uwobo_logger.processingLogger () in + let keys = + try + Pcre.split ~pat:"," (req#param "keys") + with Http_request.Param_not_found _ -> [] + in + (match keys with + | [] -> (* no key provided, act on all stylesheets *) + log#log "reloading all stylesheets ..."; + (try all_keys_action () with e -> log#log (Printexc.to_string e)) + | keys -> + List.iter + (fun key -> (* act on a single stylesheet *) + log#log (sprintf "%s stylesheet %s" logmsg key); + (try per_key_action key with e -> log#log (Printexc.to_string e))) + keys); + Http_daemon.respond ~body:log#asHtml outchan + in try syslogger#log `Debug (sprintf "Received request: %s" req#path); (match req#path with @@ -82,92 +103,27 @@ let callback req outchan = match pieces with | [key; style] -> log#log (sprintf "adding binding <%s,%s>" key style); - Mutex.lock styles_mutex; (try styles#add key style; with e -> - log#log - (sprintf - "failure while adding <%s,%s>: exception %s" - key style (Printexc.to_string e))); - Mutex.unlock styles_mutex + log#log (Printexc.to_string e)) | _ -> log#log (sprintf "invalid binding %s" binding)) bindings; Http_daemon.respond ~body:log#asHtml outchan end) - | "/remove" -> (* TODO this branch is almost identical to "/reload" one *) - (let log = new Uwobo_logger.processingLogger () in - let keys = - try - Pcre.split ~pat:"," (req#param "keys") - with Http_request.Param_not_found _ -> [] - in - (match keys with - | [] -> (* no key provided, unload all stylesheets *) - log#log "removing all stylesheets ..."; - Mutex.lock styles_mutex; - (try - styles#removeAll - with e -> - log#log - (sprintf - "failure while removing all stylesheets: exception %s" - (Printexc.to_string e))); - Mutex.unlock styles_mutex - | keys -> - List.iter - (fun key -> (* remove a single stylesheet *) - Mutex.lock styles_mutex; - log#log (sprintf "removing stylesheet %s" key); - (try - styles#remove key - with e -> - log#log - (sprintf - "failure while removing stylesheet %s: exception %s" - key (Printexc.to_string e))); - Mutex.unlock styles_mutex) - keys); - Http_daemon.respond ~body:log#asHtml outchan) | "/list" -> (let log = new Uwobo_logger.processingLogger () in log#log "Stylesheet list:"; - styles#iterKeys (fun k -> log#log (styles#getInfo k)); - Http_daemon.respond ~body:log#asHtml outchan) - | "/reload" -> (* TODO this branch is almost identical to "/remove" one *) - (let log = new Uwobo_logger.processingLogger () in - let keys = - try - Pcre.split ~pat:"," (req#param "keys") - with Http_request.Param_not_found _ -> [] - in - (match keys with - | [] -> (* no key provided, reload all stylesheets *) - log#log "reloading all stylesheets ..."; - Mutex.lock styles_mutex; - (try - styles#reloadAll - with e -> - log#log - (sprintf - "failure while reloading all stylesheets: exception %s" - (Printexc.to_string e))); - Mutex.unlock styles_mutex - | keys -> - List.iter - (fun key -> (* reload a single stylesheet *) - Mutex.lock styles_mutex; - log#log (sprintf "reloading stylesheet %s" key); - (try - styles#reload key - with e -> - log#log - (sprintf - "failure while reloading stylesheet %s: exception %s" - key (Printexc.to_string e))); - Mutex.unlock styles_mutex) - keys); + List.iter (fun s -> log#log s) styles#list; Http_daemon.respond ~body:log#asHtml outchan) + | "/remove" -> + act_on_keys + req styles outchan + styles#remove (fun () -> styles#removeAll) "removing" + | "/reload" -> + act_on_keys + req styles outchan + styles#reload (fun () -> styles#reloadAll) "reloading" | "/apply" -> (let logger = new Uwobo_logger.processingLogger () in let xmluri = req#param "xmluri" in @@ -200,8 +156,35 @@ let callback req outchan = ((fun _ -> []), []) (* no parameters, no properties *) req#params in - Uwobo_engine.apply - ~logger ~styles ~keys ~input:xmluri ~params ~props outchan) + syslogger#log `Debug (sprintf "Parsing input document %s ..." xmluri); + let input = styles#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? *) + in + syslogger#log `Debug logger#asText; + let tempfile = (* temporary file on which save XML output *) + (* TODO I don't need a tempfile, but gdome seems not to permit to + return the string representation of a Gdome.document *) + let inchan = Unix.open_process_in "tempfile --prefix=uwobo" in + let name = input_line inchan in + close_in inchan; + name + in + syslogger#log + `Debug + (sprintf "saving output document to %s ..." tempfile); + let res = + styles#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 ...."; + Http_daemon.send_basic_headers ~code:200 outchan; + (* TODO set Content-Type *) + Http_daemon.send_CRLF outchan; + Http_daemon.send_file ~name:tempfile outchan; + Unix.unlink tempfile) | "/help" -> Http_daemon.respond ~body:usage_string outchan | invalid_request -> Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan) diff --git a/helm/uwobo/src/ocaml/uwobo_logger.ml b/helm/uwobo/src/ocaml/uwobo_logger.ml index b7e4239a6..2907b0726 100644 --- a/helm/uwobo/src/ocaml/uwobo_logger.ml +++ b/helm/uwobo/src/ocaml/uwobo_logger.ml @@ -1,4 +1,29 @@ +(* 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;; type priority = [ diff --git a/helm/uwobo/src/ocaml/uwobo_logger.mli b/helm/uwobo/src/ocaml/uwobo_logger.mli index 6046c3877..f98c810e2 100644 --- a/helm/uwobo/src/ocaml/uwobo_logger.mli +++ b/helm/uwobo/src/ocaml/uwobo_logger.mli @@ -1,4 +1,29 @@ +(* 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/. + *) + type priority = [ | `Emerg (* system is unusable *) | `Alert (* action must be taken immediately *)