From b765ffc60cbfa17e81e2985a9562d792fdce4a69 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Tue, 26 Nov 2002 17:42:15 +0000 Subject: [PATCH] cvs snapshot Tue, 26 Nov 2002 18:41:34 +0100 --- helm/uwobo/src/ocaml/uwobo.ml | 90 +++++++++++++--------------- helm/uwobo/src/ocaml/uwobo_logger.ml | 4 +- 2 files changed, 46 insertions(+), 48 deletions(-) diff --git a/helm/uwobo/src/ocaml/uwobo.ml b/helm/uwobo/src/ocaml/uwobo.ml index 2ecf95518..d45045b5d 100644 --- a/helm/uwobo/src/ocaml/uwobo.ml +++ b/helm/uwobo/src/ocaml/uwobo.ml @@ -60,6 +60,7 @@ in (* values common to all threads *) 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 *) @@ -67,9 +68,10 @@ let usage_string = "Help message: not yet written!!" in (* TODO *) (* thread action *) let callback req outchan = try + syslogger#log `Debug (sprintf "Received request: %s" req#path); (match req#path with | "/add" -> - (let bindings = req#param_all "bind" in + (let bindings = req#paramAll "bind" in if bindings = [] then invocation_error "No [key,stylesheet] binding provided" outchan else begin @@ -95,7 +97,12 @@ let callback req outchan = end) | "/remove" -> (* TODO this branch is almost identical to "/reload" one *) (let log = new Uwobo_logger.processingLogger () in - (match (Pcre.split ~pat:"," (req#param "keys")) with + 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; @@ -129,7 +136,12 @@ let callback req outchan = Http_daemon.respond ~body:log#asHtml outchan) | "/reload" -> (* TODO this branch is almost identical to "/remove" one *) (let log = new Uwobo_logger.processingLogger () in - (match (Pcre.split ~pat:"," (req#param "keys")) with + 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; @@ -163,49 +175,33 @@ let callback req outchan = (* 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 local_params = ref [] in (* association list *) - let global_params = ref [] in (* association list *) - let properties = ref [] in (* association list *) - let get_style_param key name = - let params = (* try local params and fallback on global params *) - try List.assoc key !local_params with Not_found -> global_params - in - List.assoc name !params (* may raise Not_found *) - in - let get_property name = List.assoc name !properties in - 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 add_global_param name value = - let name = Pcre.replace ~pat:"^param\\." name in - global_params := (name, value) :: !global_params - in - let add_local_param name value = - let pieces = Pcre.extract ~pat:"^param\\.([^.]+)\\.(.*)" name in - let (key, param) = (pieces.(1), pieces.(2)) in - (try - let previous_params = List.assoc key !local_params in - let new_params = (param, value) :: previous_params in - local_params := new_params :: (List.remove_assoc key !local_params) - with Not_found -> (* first local parameter for 'key' *) - local_params := [(param, value)] :: !local_params) - in - let add_property name value = - properties := - (Pcre.replace ~pat:"^prop\\." name, value) :: !properties + 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 - List.iter - (fun (name, value) -> - match name with - | name when is_global_param name -> add_global_param name value - | name when is_local_param name -> add_local_param name value - | name when is_property name -> add_property name value - | _ -> ()) - req#params; Uwobo_engine.apply - ~logger ~styles ~keys ~input:xmluri - ~params:get_style_param ~props:get_property - outchan) + ~logger ~styles ~keys ~input:xmluri ~params ~props outchan) | "/help" -> Http_daemon.respond ~body:usage_string outchan | invalid_request -> Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan) @@ -221,8 +217,8 @@ in (* daemon initialization *) syslogger#log `Notice - (sprintf "%s started and listening on port %d\n" daemon_name port); -syslogger#log `Notice (sprintf "current directory is %s\n" (Sys.getcwd ())); + (sprintf "%s started and listening on port %d" daemon_name port); +syslogger#log `Notice (sprintf "current directory is %s" (Sys.getcwd ())); Http_daemon.start' ~port ~mode:`Thread callback; -syslogger#log `Notice (sprintf "%s is terminating, bye!\n" daemon_name) +syslogger#log `Notice (sprintf "%s is terminating, bye!" daemon_name) diff --git a/helm/uwobo/src/ocaml/uwobo_logger.ml b/helm/uwobo/src/ocaml/uwobo_logger.ml index c0e73b9b9..b7e4239a6 100644 --- a/helm/uwobo/src/ocaml/uwobo_logger.ml +++ b/helm/uwobo/src/ocaml/uwobo_logger.ml @@ -27,12 +27,14 @@ let string_of_priority = function class sysLogger ?(level: priority = `Notice) () = object + 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 log (prio: priority) msg = - if enabled && (int_of_priority prio < level_no) then + if enabled && (int_of_priority prio <= level_no) then prerr_endline (sprintf ("%s: %s") (string_of_priority prio) msg) end -- 2.39.2