X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fuwobo%2Fuwobo_common.ml;h=b4a910f9d7cb0b17bd738ccac6283dfd9857016d;hb=5325734bc2e4927ed7ec146e35a6f0f2b49f50c1;hp=5578b09fbc85a0fc016c4004f7340dc84acf0597;hpb=fdc2491d02e3bb98d7f320917b29632d97bd1164;p=helm.git
diff --git a/helm/uwobo/uwobo_common.ml b/helm/uwobo/uwobo_common.ml
index 5578b09fb..b4a910f9d 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";
@@ -45,7 +48,7 @@ let supported_properties = [
let is_supported_property name = List.mem name supported_properties
-let version = "0.2.0" ;;
+let version = "0.2.1" ;;
let usage_string =
sprintf
@@ -69,18 +72,26 @@ let usage_string =
help
display this help message
+
+ newsession?port=p
+ starts a new daemon on a given port p
+
+
+ kill
+ kills the daemon. The log file is mantained.
+
add?bind=key,uri[&bind=key,uri[&...]]
load a new stylesheet, specified by uri, and bind it to key
key
- remove[?keys=key1,key2,...]
+ remove?keys=[key1,key2,...]
unload stylesheets specified by key1, key2, ... or all
stylesheets if no key was given
- reload[?keys=key1,key2,...]
+ reload?keys=[key1,key2,...]
reload stylesheets specified by key1, key2, ... or all
stylesheets if no key was given
@@ -89,9 +100,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
@@ -109,11 +126,67 @@ let usage_string =
(String.concat ", " supported_properties) (* supported properties *)
;;
-let pp_error = sprintf "
Error: %s
";;
-let return_error msg outchan =
- Http_daemon.respond ~body:(pp_error msg) outchan;;
+let pp_error =
+ sprintf
+ "Error: %s%s"
+;;
+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
+;;