]> matita.cs.unibo.it Git - helm.git/commitdiff
- redesigned error and warning handling for libxslt
authorStefano Zacchiroli <zack@upsilon.cc>
Fri, 4 Apr 2003 09:36:53 +0000 (09:36 +0000)
committerStefano Zacchiroli <zack@upsilon.cc>
Fri, 4 Apr 2003 09:36:53 +0000 (09:36 +0000)
- added support for error and warning for the apply method

helm/uwobo/uwobo.ml
helm/uwobo/uwobo_common.ml
helm/uwobo/uwobo_common.mli
helm/uwobo/uwobo_engine.ml
helm/uwobo/uwobo_engine.mli
helm/uwobo/uwobo_styles.ml
helm/uwobo/uwobo_styles.mli

index 9dc9b539405f4b5b08480249d5d5ad3edb1e0d9a..729c5c01721bfcb4936023fb57c8b86e046532df 100644 (file)
@@ -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: ("<h2>LibXSLT's messages:</h2>" ^
+              String.concat "<br />\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 <key, stylesheet> 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
index c71024ce8c40427dae4804cf209c2af03fd58a0d..7ae0260ae274803ffbc24db745737b8910ad9cc5 100644 (file)
  *  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
     </p>
     <p>
-      <b><kbd>apply?xmluri=uri&keys=key1,key2,...[&param.name=value[&param.name=value[&...]]][&param.key.name=value[&param.key.name=value[&...]]][&prop.name[=value][&prop.name[=value][&...]]]</kbd></b><br />
+      <b><kbd>apply?xmluri=uri&keys=key1,key2,...[&errormode={ignore|comment|embed}][&debugmode={ignore|comment|embed}][&param.name=value[&param.name=value[&...]]][&param.key.name=value[&param.key.name=value[&...]]][&prop.name[=value][&prop.name[=value][&...]]]</kbd></b><br />
       apply a chain of stylesheets, specified by <em>key1, key2, ...</em>, to an
       input document, specified by <em>uri</em>.<br />
+      Error and debugging modes could be ste to three different values.
+      <em>ignore</em> means that LibXSLT messages are ignored; <em>comment</em>
+      meanst that LibXSLT messages are embedded in the result document inside an
+      XML like comment; <em>embed</em> 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<br />
       Additional parameters can be set for each stylesheet application: global
       parameters (i.e. parameters passed to all stylesheets) are set using
       <em>param.name=value</em> syntax, per stylesheet parameters are set using
@@ -110,11 +119,66 @@ let usage_string =
 ;;
 
 let pp_error =
-  sprintf "<html><body><span style=\"color:red\">Error: %s</span></body></html>"
+  sprintf
+    "<html><body><span style=\"color:red\">Error: %s</span>%s</body></html>"
 ;;
-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
+;;
+
index a531d8a0b4c9230fa5001dd8a5fd02cd8429abb5..9bd90c5146f5784d93a08f87cb04b2b7db4533f6 100644 (file)
 
 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
+
index aad4f971b8d8032bc712a447e8ea145f801837b7..d7a1c4995025e6aa11ca4c3a1a2921374ed6f067 100644 (file)
@@ -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) ^ "<br />" 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) ^ "<br />" 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
index 0631bdeed9a5ce29f436cd06e0e22552e747e766..407afab02b1ee605a8c736f35785d016f4079098 100644 (file)
  *  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)
 
index 4fb2cbf31a63ab6c205493846500d89476c2f3c9..3aa33877bfc479adaace3ef43fb357caded38262 100644 (file)
  *)
 
 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 *)
 
index 7b2fa171e31f0b47a32a67d5c5f36b9563cd3b32..2817e14a5a48323f7f0decc58213c1dd4f10bb6a 100644 (file)
  *  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} *)