From: Stefano Zacchiroli
Date: Fri, 4 Apr 2003 09:36:53 +0000 (+0000)
Subject: - redesigned error and warning handling for libxslt
X-Git-Tag: before_refactoring~53
X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=d2c60bae1c4badba0a0f29e3fd2faed6d3a1869e;p=helm.git
- redesigned error and warning handling for libxslt
- added support for error and warning for the apply method
---
diff --git a/helm/uwobo/uwobo.ml b/helm/uwobo/uwobo.ml
index 9dc9b5394..729c5c017 100644
--- a/helm/uwobo/uwobo.ml
+++ b/helm/uwobo/uwobo.ml
@@ -110,6 +110,33 @@ let parse_apply_params =
((fun _ -> []), []) (* no parameters, no properties *)
;;
+ (** Parse libxslt's message modes for error and debugging messages. Default is
+ to ignore mesages of both kind *)
+let parse_libxslt_msgs_mode (req: Http_types.request) =
+ ((try
+ (match req#param "errormode" with
+ | s when String.lowercase s = "ignore" -> LibXsltMsgIgnore
+ | s when String.lowercase s = "comment" -> LibXsltMsgComment
+ | s when String.lowercase s = "embed" -> LibXsltMsgEmbed
+ | err ->
+ raise (Uwobo_failure
+ (sprintf
+ "Unknown value '%s' for parameter '%s', use one of '%s' or '%s'"
+ err "errormode" "ignore" "comment")))
+ with Http_types.Param_not_found _ -> LibXsltMsgIgnore),
+ (try
+ (match req#param "debugmode" with
+ | s when String.lowercase s = "ignore" -> LibXsltMsgIgnore
+ | s when String.lowercase s = "comment" -> LibXsltMsgComment
+ | s when String.lowercase s = "embed" -> LibXsltMsgEmbed
+ | err ->
+ raise (Uwobo_failure
+ (sprintf
+ "Unknown value '%s' for parameter '%s', use one of '%s' or '%s'"
+ err "debugmode" "ignore" "comment")))
+ with Http_types.Param_not_found _ -> LibXsltMsgIgnore))
+;;
+
(** send ~cmd (without trailing "\n"!) through ~cmd_pipe, then wait for answer
on ~res_pipe (with a timeout of 60 seconds) and send over outchan data
received from ~res_pipe *)
@@ -139,18 +166,21 @@ let (add_cmd_RE, remove_cmd_RE, reload_cmd_RE) =
(Pcre.regexp "^add ", Pcre.regexp "^remove ", Pcre.regexp "^reload ")
;;
-exception Restart_HTTP_daemon;;
+ (** raised by child processes when HTTP daemon process have to be restarted *)
+exception Restart_HTTP_daemon ;;
(** log a list of libxslt's messages using a processing logger *)
-let log_libxslt_msgs logger =
+let log_libxslt_msgs logger libxslt_logger =
List.iter
(function
- | Uwobo_styles.LibXsltErrorMsg msg ->
- logger#logBold ("LibXSLT ERROR: " ^ msg)
- | Uwobo_styles.LibXsltDebugMsg msg ->
- logger#logEmph ("LibXSLT DEBUG " ^ msg))
+ | (LibXsltErrorMsg _) as msg -> logger#logBold (string_of_xslt_msg msg)
+ | (LibXsltDebugMsg _) as msg -> logger#logEmph (string_of_xslt_msg msg))
+ libxslt_logger#msgs
;;
+ (* LibXSLT logger *)
+let veillogger = new Uwobo_common.libXsltLogger ;;
+
(* request handler action
@param syslogger Uwobo_logger.sysLogger instance used for logginf
@param styles Uwobo_styles.styles instance which keeps the stylesheets list
@@ -181,30 +211,35 @@ let callback
let cmd = sprintf "reload %s" (req#param "keys") in
short_circuit_grandfather_and_client ~cmd ~cmd_pipe ~res_pipe outchan
| "/list" ->
- (let log = new Uwobo_logger.processingLogger () in
+ (let logger = new Uwobo_logger.processingLogger () in
(match styles#list with
- | [] -> log#log "No stylesheets loaded (yet)!"
+ | [] -> logger#log "No stylesheets loaded (yet)!"
| l ->
- log#log "Stylesheets list:";
- List.iter (fun s -> log#log s) l);
- respond_html log#asHtml outchan)
+ logger#log "Stylesheets list:";
+ List.iter (fun s -> logger#log s) l);
+ respond_html logger#asHtml outchan)
| "/apply" ->
let logger = new Uwobo_logger.processingLogger () in
+ veillogger#clearMsgs;
let xmluri = req#param "xmluri" in
let keys = Pcre.split ~pat:"," (req#param "keys") in
(* notation: "local" parameters are those defined on a per-stylesheet
pasis (i.e. param.key.param=value), "global" parameters are those
defined for all stylesheets (i.e. param.param=value) *)
let (params, props) = parse_apply_params req#params in
+ let (libxslt_errormode, libxslt_debugmode) =
+ parse_libxslt_msgs_mode req
+ in
syslogger#log `Debug (sprintf "Parsing input document %s ..." xmluri);
let domImpl = Gdome.domImplementation () in
let input = domImpl#createDocumentFromURI ~uri:xmluri () in
syslogger#log `Debug "Applying stylesheet chain ...";
(try
let (write_result, media_type, encoding) = (* out_channel -> unit *)
- let res = Uwobo_engine.apply
- ~logger:syslogger ~styles ~keys ~input ~params ~props in
- res
+ Uwobo_engine.apply
+ ~logger:syslogger ~styles ~keys ~params ~props ~veillogger
+ ~errormode:libxslt_errormode ~debugmode:libxslt_debugmode
+ input
in
let content_type = (* value of Content-Type HTTP response header *)
sprintf "%s; charset=%s"
@@ -220,7 +255,10 @@ let callback
write_result outchan
with Uwobo_failure errmsg ->
return_error
- (sprintf "Stylesheet chain application failed: %s" errmsg)
+ ("Stylesheet chain application failed: " ^ errmsg)
+ ~body: ("LibXSLT's messages:
" ^
+ String.concat "
\n"
+ (List.map string_of_xslt_msg veillogger#msgs))
outchan)
| "/help" -> respond_html usage_string outchan
| invalid_request ->
@@ -304,43 +342,45 @@ let main () =
Pcre.split ~pat:";" (Pcre.replace ~rex:add_cmd_RE line)
in
stop_http_daemon ();
- let log = new Uwobo_logger.processingLogger () in
+ let logger = new Uwobo_logger.processingLogger () in
List.iter
(fun binding -> (* add a binding *)
let pieces = Pcre.split ~pat:"," binding in
match pieces with
| [key; style] ->
- log#log (sprintf "adding binding <%s,%s>" key style);
+ logger#log (sprintf "adding binding <%s,%s>" key style);
+ veillogger#clearMsgs;
(try
- log_libxslt_msgs log (styles#add key style)
+ veillogger#clearMsgs;
+ styles#add key style;
+ log_libxslt_msgs logger veillogger;
with e ->
- log#log (Printexc.to_string e))
- | _ -> log#log (sprintf "invalid binding %s" binding))
+ logger#log (Printexc.to_string e))
+ | _ -> logger#log (sprintf "invalid binding %s" binding))
bindings;
- output_string res_pipe log#asHtml;
+ output_string res_pipe logger#asHtml;
flush res_pipe;
raise Restart_HTTP_daemon
| line when Pcre.pmatch ~rex:remove_cmd_RE line -> (* /remove *)
stop_http_daemon ();
let arg = Pcre.replace ~rex:remove_cmd_RE line in
let logger = new Uwobo_logger.processingLogger () in
+ veillogger#clearMsgs;
act_on_keys
arg styles logger
- (fun key -> log_libxslt_msgs logger (styles#remove key))
- (fun () -> log_libxslt_msgs logger styles#removeAll)
- styles#keys
+ styles#remove (fun () -> styles#removeAll) styles#keys
"removing";
+ log_libxslt_msgs logger veillogger;
output_string res_pipe (logger#asHtml);
raise Restart_HTTP_daemon
| line when Pcre.pmatch ~rex:reload_cmd_RE line -> (* /reload *)
stop_http_daemon ();
let arg = Pcre.replace ~rex:reload_cmd_RE line in
let logger = new Uwobo_logger.processingLogger () in
+ veillogger#clearMsgs;
act_on_keys
arg styles logger
- (fun key -> log_libxslt_msgs logger (styles#reload key))
- (fun () -> log_libxslt_msgs logger styles#reloadAll)
- styles#keys
+ styles#reload (fun () -> styles#reloadAll) styles#keys
"reloading";
output_string res_pipe (logger#asHtml);
raise Restart_HTTP_daemon
diff --git a/helm/uwobo/uwobo_common.ml b/helm/uwobo/uwobo_common.ml
index c71024ce8..7ae0260ae 100644
--- a/helm/uwobo/uwobo_common.ml
+++ b/helm/uwobo/uwobo_common.ml
@@ -26,9 +26,12 @@
* http://helm.cs.unibo.it/
*)
-open Printf;;
+open Printf ;;
-exception Uwobo_failure of string;;
+exception Uwobo_failure of string ;;
+
+let uwobo_namespace = "http://helm.cs.unibo.it/uwobo" ;;
+let xsl_namespace = "http://helm.cs.unibo.it/uwobo" ;;
let supported_properties = [
"cdata-section-elements";
@@ -89,9 +92,15 @@ let usage_string =
return a list of loaded stylesheets
- apply?xmluri=uri&keys=key1,key2,...[¶m.name=value[¶m.name=value[&...]]][¶m.key.name=value[¶m.key.name=value[&...]]][&prop.name[=value][&prop.name[=value][&...]]]
+ apply?xmluri=uri&keys=key1,key2,...[&errormode={ignore|comment|embed}][&debugmode={ignore|comment|embed}][¶m.name=value[¶m.name=value[&...]]][¶m.key.name=value[¶m.key.name=value[&...]]][&prop.name[=value][&prop.name[=value][&...]]]
apply a chain of stylesheets, specified by key1, key2, ..., to an
input document, specified by uri.
+ Error and debugging modes could be ste to three different values.
+ ignore means that LibXSLT messages are ignored; comment
+ meanst that LibXSLT messages are embedded in the result document inside an
+ XML like comment; embed means that LibXSLT messages are embedded
+ at the beginning of the result document (as childs of the root node) in
+ XML elements in the UWOBO namespace
Additional parameters can be set for each stylesheet application: global
parameters (i.e. parameters passed to all stylesheets) are set using
param.name=value syntax, per stylesheet parameters are set using
@@ -110,11 +119,66 @@ let usage_string =
;;
let pp_error =
- sprintf "
Error: %s"
+ sprintf
+ "Error: %s%s"
;;
-let return_error msg outchan =
- Http_daemon.respond ~body:(pp_error msg) outchan;;
+let return_error msg ?(body = "") outchan =
+ Http_daemon.respond ~body:(pp_error msg body) outchan;;
let bad_request body outchan =
Http_daemon.respond_error ~code:400 ~body outchan
;;
+ (** {2 LibXSLT logging} *)
+
+type xslt_msg =
+ | LibXsltErrorMsg of string
+ | LibXsltDebugMsg of string
+;;
+
+let string_of_xslt_msg = function
+ | LibXsltErrorMsg msg -> "LibXSLT ERROR: " ^ msg
+ | LibXsltDebugMsg msg -> "LibXSLT DEBUG: " ^ msg
+;;
+
+type xslt_msg_mode =
+ | LibXsltMsgIgnore
+ | LibXsltMsgComment
+ | LibXsltMsgEmbed
+;;
+
+class libXsltLogger =
+ let is_libxslt_error = function LibXsltErrorMsg _ -> true | _ -> false in
+ let is_libxslt_debug = function LibXsltDebugMsg _ -> true | _ -> false in
+ let flatten_libxslt_msg = function
+ | LibXsltErrorMsg msg -> msg
+ | LibXsltDebugMsg msg -> msg
+ in
+ object (self)
+
+ initializer
+ Gdome_xslt.setErrorCallback
+ (Some (fun msg -> self#appendMsg (LibXsltErrorMsg msg)));
+ Gdome_xslt.setDebugCallback
+ (Some (fun msg -> self#appendMsg (LibXsltDebugMsg msg)))
+
+ val mutable libXsltMsgs = [] (** libxslt's error and debugging messages *)
+
+ (* libxslt's error and debugging messages handling *)
+
+ method private appendMsg msg = libXsltMsgs <- msg :: libXsltMsgs
+
+ method clearMsgs = libXsltMsgs <- []
+ method clearErrorMsgs =
+ libXsltMsgs <- List.filter is_libxslt_debug libXsltMsgs
+ method clearDebugMsgs =
+ libXsltMsgs <- List.filter is_libxslt_error libXsltMsgs
+
+ method msgs = libXsltMsgs
+ method errorMsgs =
+ List.map flatten_libxslt_msg (List.filter is_libxslt_error libXsltMsgs)
+ method debugMsgs =
+ List.map flatten_libxslt_msg (List.filter is_libxslt_debug libXsltMsgs)
+
+ end
+;;
+
diff --git a/helm/uwobo/uwobo_common.mli b/helm/uwobo/uwobo_common.mli
index a531d8a0b..9bd90c514 100644
--- a/helm/uwobo/uwobo_common.mli
+++ b/helm/uwobo/uwobo_common.mli
@@ -28,15 +28,48 @@
exception Uwobo_failure of string
+ (** XML namespace of UWOBO generated XML elements *)
+val uwobo_namespace: string
+
val supported_properties: string list
val is_supported_property: string -> bool
val version: string (** version *)
val usage_string: string (** HTTP GET usage string *)
- (** return an ok (200) http response, which display in html an error message
- *)
-val return_error: string -> out_channel -> unit
+ (** return an ok (200) http response, which display in html an error message.
+ Error title is reported inside an h1 tag; error body, if given, follows *)
+val return_error: string -> ?body: string -> out_channel -> unit
(** return a 400 (bad request) http response *)
val bad_request: string -> out_channel -> unit
+ (** {2 LibXSLT logging} *)
+
+ (** libxslt's message *)
+type xslt_msg =
+ | LibXsltErrorMsg of string (** libxslt's error messages *)
+ | LibXsltDebugMsg of string (** libxslt's debugging messages *)
+
+ (** pretty print a xslt_msg *)
+val string_of_xslt_msg: xslt_msg -> string
+
+ (** libxslt's message reporting mode. That is: how to report libxslt's
+ messages during apply method *)
+type xslt_msg_mode =
+ | LibXsltMsgIgnore (** Ignore some kind of messages *)
+ | LibXsltMsgComment (** Embed in XML comments some kind of messages *)
+ | LibXsltMsgEmbed (** Embed in XML elements some kind of messages *)
+
+class libXsltLogger:
+ object
+
+ method clearMsgs: unit
+ method clearErrorMsgs: unit
+ method clearDebugMsgs: unit
+
+ method msgs: xslt_msg list
+ method errorMsgs: string list
+ method debugMsgs: string list
+
+ end
+
diff --git a/helm/uwobo/uwobo_engine.ml b/helm/uwobo/uwobo_engine.ml
index aad4f971b..d7a1c4995 100644
--- a/helm/uwobo/uwobo_engine.ml
+++ b/helm/uwobo/uwobo_engine.ml
@@ -88,11 +88,153 @@ let get_property name (document: Gdome.document) =
Some (element#getAttribute domName)#to_string
else
None
+;;
+
+let namespaceURI = Some (Gdome.domString Uwobo_common.uwobo_namespace) ;;
+
+ (** output type wrt adding of debugging/error messages *)
+type outputType =
+ | XmlOutput of Gdome.node
+ | TextPlainOutput of Gdome.text
+ | NoOutput
+;;
+
+exception Found of int ;;
+
+ (** add debugging and/or error messages to a Gdome document. Handle three
+ distinct cases: (1) output contains an XML tree, (2) output contains only one
+ text node, (3) output contains no data.
+ If output contains an XML tree then users wishes are preserved and messages
+ are either not included or included as comments or included as XML ndoes.
+ If output contains only a text node comments are either not included or
+ included at the beginning of the textual output.
+ If output contains no data (i.e. DOM superroot node with no element or text
+ children) messages are embedded as XML comments or not embedded at all *)
+let add_msgs ~errormode ~debugmode ~msgs (doc: Gdome.document) =
+ let getOutputType (doc: Gdome.document) =
+ let children = doc#get_childNodes in
+ let len = children#get_length in
+ let rec find_element i =
+ if i > len then
+ raise Not_found
+ else
+ (match children#item i with
+ | Some node when node#get_nodeType = GdomeNodeTypeT.ELEMENT_NODE ->
+ XmlOutput node
+ | _ -> find_element (i + 1))
+ in
+ let rec find_text i =
+ if i > len then
+ raise Not_found
+ else
+ (match children#item i with
+ | Some node when node#get_nodeType = GdomeNodeTypeT.TEXT_NODE ->
+ TextPlainOutput (new Gdome.text_of_node node)
+ | _ -> find_element (i + 1))
+ in
+ if len = 0 then
+ NoOutput
+ else
+ (try find_element 0 with Not_found ->
+ (try find_text 0 with Not_found -> NoOutput))
+ in
+ match getOutputType (doc :> Gdome.document) with
+ | XmlOutput node ->
+ let add_generic_msg mode build tagname =
+ (match mode with
+ | LibXsltMsgIgnore -> (fun msg -> ())
+ | LibXsltMsgComment ->
+ (fun msg ->
+(* let contents = string_of_xslt_msg (build msg) ^ "
" in *)
+ let contents = string_of_xslt_msg (build msg) in
+ ignore (node#insertBefore
+ ~newChild:(doc#createComment
+ (Gdome.domString contents) :> Gdome.node)
+ ~refChild:node#get_firstChild))
+ | LibXsltMsgEmbed ->
+ (fun msg ->
+(* let contents = string_of_xslt_msg (build msg) ^ "
" in *)
+ let contents = string_of_xslt_msg (build msg) in
+ let element =
+ doc#createElementNS
+ ~namespaceURI ~qualifiedName:(Gdome.domString tagname)
+ in
+ ignore (element#appendChild
+ (doc#createTextNode
+ ~data:(Gdome.domString contents) :> Gdome.node));
+ ignore (node#insertBefore
+ ~newChild:(element :> Gdome.node)
+ ~refChild:node#get_firstChild)))
+ in
+ let add_error_msg =
+ add_generic_msg
+ errormode (fun msg -> LibXsltErrorMsg msg) "uwobo:error"
+ in
+ let add_debug_msg =
+ add_generic_msg
+ debugmode (fun msg -> LibXsltDebugMsg msg) "uwobo:debug"
+ in
+ List.iter
+ (function
+ | LibXsltErrorMsg msg -> add_error_msg msg
+ | LibXsltDebugMsg msg -> add_debug_msg msg)
+ (List.rev msgs) (* because each msg is added as 1st children *)
+| TextPlainOutput text ->
+ let add_generic_msg mode build =
+ (match mode with
+ | LibXsltMsgIgnore -> (fun _ -> ())
+ | LibXsltMsgComment | LibXsltMsgEmbed ->
+ (fun msg ->
+ text#insertData ~offset:0
+ ~arg:(Gdome.domString
+ (string_of_xslt_msg (build msg) ^ "\n"))))
+ in
+ let add_error_msg =
+ add_generic_msg errormode (fun msg -> LibXsltErrorMsg msg)
+ in
+ let add_debug_msg =
+ add_generic_msg debugmode (fun msg -> LibXsltDebugMsg msg)
+ in
+ List.iter
+ (function
+ | LibXsltErrorMsg msg -> add_error_msg msg
+ | LibXsltDebugMsg msg -> add_debug_msg msg)
+ (List.rev msgs) (* because each msg is added as 1st children *)
+| NoOutput ->
+ let add_generic_msg mode build =
+ (match mode with
+ | LibXsltMsgIgnore -> (fun _ -> ())
+ | LibXsltMsgComment | LibXsltMsgEmbed ->
+ (fun msg ->
+ let comment_node =
+ (* use comments anyway because text nodes aren't allowed in DOM as
+ superroot children *)
+ doc#createComment
+ (Gdome.domString (string_of_xslt_msg (build msg)))
+ in
+ ignore (doc#insertBefore ~newChild:(comment_node :> Gdome.node)
+ ~refChild:doc#get_firstChild)))
+ in
+ let add_error_msg =
+ add_generic_msg errormode (fun msg -> LibXsltErrorMsg msg)
+ in
+ let add_debug_msg =
+ add_generic_msg debugmode (fun msg -> LibXsltDebugMsg msg)
+ in
+ List.iter
+ (function
+ | LibXsltErrorMsg msg -> add_error_msg msg
+ | LibXsltDebugMsg msg -> add_debug_msg msg)
+ (List.rev msgs) (* because each msg is added as 1st children *)
+;;
let apply
~(logger: Uwobo_logger.sysLogger)
~(styles: Uwobo_styles.styles)
- ~keys ~params ~props ~input
+ ~keys ~params ~props
+ ~(veillogger: Uwobo_common.libXsltLogger)
+ ?(errormode = LibXsltMsgIgnore) ?(debugmode = LibXsltMsgIgnore)
+ input
=
(* "p_" prefix means "processed" *)
let (p_stylesheets, last_stylesheet) = styles#get keys in
@@ -125,6 +267,15 @@ let apply
input
p_stylesheets
in
+ (* add error and debugging messages to result document *)
+ add_msgs ~errormode ~debugmode ~msgs:veillogger#msgs result;
+(*
+ (* DEBUGGING *)
+ add_msgs
+ ~errormode:LibXsltMsgEmbed ~debugmode:LibXsltMsgEmbed
+ ~msgs:[LibXsltErrorMsg "error1"; LibXsltDebugMsg "debug1"]
+ result;
+*)
let last_stylesheet = (* used to retrieve serialization options *)
try
apply_properties logger last_stylesheet props
diff --git a/helm/uwobo/uwobo_engine.mli b/helm/uwobo/uwobo_engine.mli
index 0631bdeed..407afab02 100644
--- a/helm/uwobo/uwobo_engine.mli
+++ b/helm/uwobo/uwobo_engine.mli
@@ -26,14 +26,17 @@
* http://helm.cs.unibo.it/
*)
+open Uwobo_common ;;
+
(**
@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 errormode what to do with LibXSLT's error messages
+ @param debugmode what to do with LibXSLT's debugging messages
@param input URI of input document
- @param channel on which write final output
@return a triple: 1st element is a function that takes an out_channel and
write the result document on it, 2nd element is a string option representing
the desired media-type, 3rd is a string option representing the desired
@@ -45,6 +48,8 @@ val apply:
keys: string list ->
params: (string -> (string * string) list) ->
props: (string * string) list ->
- input: Gdome.document ->
- (out_channel -> unit) * string option * string option
+ veillogger: Uwobo_common.libXsltLogger ->
+ ?errormode: xslt_msg_mode -> ?debugmode: xslt_msg_mode ->
+ Gdome.document ->
+ ((out_channel -> unit) * string option * string option)
diff --git a/helm/uwobo/uwobo_styles.ml b/helm/uwobo/uwobo_styles.ml
index 4fb2cbf31..3aa33877b 100644
--- a/helm/uwobo/uwobo_styles.ml
+++ b/helm/uwobo/uwobo_styles.ml
@@ -27,85 +27,59 @@
*)
open Printf;;
+open Uwobo_common;;
exception Stylesheet_not_found of string ;;
exception Stylesheet_already_in of string ;;
-type xslt_msg =
- | LibXsltErrorMsg of string
- | LibXsltDebugMsg of string
-;;
-type log = xslt_msg list ;;
-
class styles =
object (self)
(* INVARIANT: 'stylesheets' and 'uris' are in sync *)
- initializer
- Gdome_xslt.setErrorCallback
- (Some (fun msg -> self#appendMsg (LibXsltErrorMsg msg)));
- Gdome_xslt.setDebugCallback
- (Some (fun msg -> self#appendMsg (LibXsltDebugMsg msg)))
-
-
val mutable stylesheets = [] (** association list: key -> Gdome.document *)
val mutable uris = [] (** association list: key -> uri *)
- val mutable libXsltMsgs = [] (** libxslt's error and debugging messages *)
val domImpl = Gdome.domImplementation ()
(** process an XSLT stylesheet *)
method private process uri =
let dom = domImpl#createDocumentFromURI ~uri () in
- ignore (Gdome_xslt.processStylesheet dom); (* fills libXsltMsgs in case
- of errors *)
+ ignore (Gdome_xslt.processStylesheet dom); (* produce libXSLT messages in
+ case of errors *)
dom
- (* libxslt's error and debugging messages handling *)
-
- method private appendMsg msg = libXsltMsgs <- msg :: libXsltMsgs
- method private clearMsgs = libXsltMsgs <- []
-
(* stylesheets management *)
method add key uri =
if (List.mem_assoc key uris) then
raise (Stylesheet_already_in key)
else begin
- self#clearMsgs;
uris <- (key, uri) :: uris;
- stylesheets <- (key, self#process uri) :: stylesheets;
- libXsltMsgs
+ stylesheets <- (key, self#process uri) :: stylesheets
end
- method remove key : log =
+ method remove key =
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;
- [] (* no XSLT action -> no logs *)
+ stylesheets <- List.remove_assoc key stylesheets
end
- method removeAll : log =
+ method removeAll =
uris <- [];
- stylesheets <- [];
- [] (* no XSLT action -> no logs *)
+ stylesheets <- []
method reload key =
(try
- self#clearMsgs;
let uri = List.assoc key uris in
stylesheets <-
- (key, self#process uri) :: (List.remove_assoc key stylesheets);
- libXsltMsgs
+ (key, self#process uri) :: (List.remove_assoc key stylesheets)
with Not_found ->
raise (Stylesheet_not_found key))
method reloadAll =
- self#clearMsgs;
- stylesheets <- List.map (fun (key, uri) -> (key, self#process uri)) uris;
- libXsltMsgs
+ stylesheets <- List.map (fun (key, uri) -> (key, self#process uri)) uris
(* stylesheets usage *)
diff --git a/helm/uwobo/uwobo_styles.mli b/helm/uwobo/uwobo_styles.mli
index 7b2fa171e..2817e14a5 100644
--- a/helm/uwobo/uwobo_styles.mli
+++ b/helm/uwobo/uwobo_styles.mli
@@ -26,15 +26,11 @@
* http://helm.cs.unibo.it/
*)
+open Uwobo_common ;;
+
exception Stylesheet_not_found of string ;;
exception Stylesheet_already_in of string ;;
- (** libxslt's message *)
-type xslt_msg =
- | LibXsltErrorMsg of string (** libxslt's error messages *)
- | LibXsltDebugMsg of string (** libxslt's debugging messages *)
-type log = xslt_msg list ;;
-
(** hold UWOBO styles at runtime *)
class styles:
object
@@ -46,19 +42,19 @@ class styles:
@param key key to which the stylesheets will be bound
@param uri uri of the stylesheet to be loaded
@raise Stylesheet_already_in if key is already bound *)
- method add: string -> string -> log
+ method add: string -> string -> unit
(** remove the stylesheet bound to a given key *)
- method remove: string -> log
+ method remove: string -> unit
(** remove all loaded stylesheet *)
- method removeAll: log
+ method removeAll: unit
(** reload the stylesheet bound to a given key *)
- method reload: string -> log
+ method reload: string -> unit
(** reload all stylesheets *)
- method reloadAll: log
+ method reloadAll: unit
(** {2 Stylesheets usage} *)