keys);
Http_daemon.respond ~body:log#asHtml outchan
in
+ let parse_apply_params = (* parse parameters for '/apply' action *)
+ let is_global_param x = Pcre.pmatch ~pat:"^param(\\.[^.]+){1}$" x in
+ let is_local_param x = Pcre.pmatch ~pat:"^param(\\.[^.]+){2}$" x in
+ let is_property x = Pcre.pmatch ~pat:"^prop\\.[^.]+$" x in
+ List.fold_left
+ (fun (old_params, old_properties) (name, value) ->
+ match name with
+ | name when is_global_param name ->
+ let name = Pcre.replace ~pat:"^param\\." name in
+ ((fun x -> (old_params x) @ [name, value]), old_properties)
+ | name when is_local_param name ->
+ let pieces = Pcre.extract ~pat:"^param\\.([^.]+)\\.(.*)" name in
+ let (key, name) = (pieces.(1), pieces.(2)) in
+ ((function
+ | x when x = key -> [name, value] @ (old_params x)
+ | x -> old_params x),
+ old_properties)
+ | name when is_property name ->
+ let name = Pcre.replace ~pat:"^prop\\." name in
+ (old_params, ((name, value) :: old_properties))
+ | _ -> (old_params, old_properties))
+ ((fun _ -> []), []) (* no parameters, no properties *)
+ in
try
syslogger#log `Debug (sprintf "Received request: %s" req#path);
(match req#path with
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
(* 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 is_global_param x = Pcre.pmatch ~pat:"^param(\\.[^.]+){1}$" x in
- let is_local_param x = Pcre.pmatch ~pat:"^param(\\.[^.]+){2}$" x in
- let is_property x = Pcre.pmatch ~pat:"^prop\\.[^.]+$" x in
- let (params, props) =
- List.fold_left
- (fun (old_params, old_properties) (name, value) ->
- match name with
- | name when is_global_param name ->
- let name = Pcre.replace ~pat:"^param\\." name in
- ((fun x -> (old_params x) @ [name, value]),
- old_properties)
- | name when is_local_param name ->
- let pieces = Pcre.extract ~pat:"^param\\.([^.]+)\\.(.*)" name in
- let (key, name) = (pieces.(1), pieces.(2)) in
- ((function
- | x when x = key -> [name, value] @ (old_params x)
- | x -> old_params x),
- old_properties)
- | name when is_property name ->
- let name = Pcre.replace ~pat:"^prop\\." name in
- (old_params, ((name, value) :: old_properties))
- | _ -> (old_params, old_properties))
- ((fun _ -> []), []) (* no parameters, no properties *)
- req#params
- in
+ 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 output =
| `Debug -> "DEBUG"
class sysLogger ?(level: priority = `Notice) () =
- object
+ object (self)
+ inherit Uwobo_common.threadSafe
initializer
print_endline (sprintf "Logger started with level %s" (string_of_priority level))
val level_no = int_of_priority level
val mutable enabled = false
- method enable = enabled <- true
- method disable = enabled <- false
+ method enable = self#doCritical (lazy (enabled <- true))
+ method disable = self#doCritical (lazy (enabled <- false))
method log (prio: priority) msg =
- if enabled && (int_of_priority prio <= level_no) then
- prerr_endline (sprintf ("%s: %s") (string_of_priority prio) msg)
+ self#doCritical (lazy (
+ if enabled && (int_of_priority prio <= level_no) then
+ prerr_endline (sprintf ("%s: %s") (string_of_priority prio) msg)
+ ))
end
+ (** non thread safe, a processingLogger is usually instantied locally for each
+ thread *)
class processingLogger =
let html_escape s = (* TODO too naive, use Nethtml.encode instead *)
Pcre.replace ~pat:"<" ~templ:"<"