- (let logger = new Uwobo_logger.processingLogger () in
- 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 local_params = ref [] in (* association list <key, parameters> *)
- let global_params = ref [] in (* association list <name, value> *)
- let properties = ref [] in (* association list <name, value> *)
- 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
- 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)
+ if Unix.fork () = 0 then
+ (let logger = new Uwobo_logger.processingLogger () in
+ 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
+ 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 *)
+ Uwobo_engine.apply
+ ~logger:syslogger ~styles ~keys ~input ~params ~props
+ in
+ let content_type = (* value of Content-Type HTTP response header *)
+ sprintf
+ "%s; charset=%s"
+ (match media_type with None -> default_media_type | Some t -> t)
+ (match encoding with None -> default_encoding | Some e -> e)
+ in
+ syslogger#log
+ `Debug
+ (sprintf
+ "sending output to client (Content-Type: %s)...."
+ content_type);
+ Http_daemon.send_basic_headers ~code:200 outchan;
+ Http_daemon.send_header "Content-Type" content_type outchan;
+ Http_daemon.send_CRLF outchan;
+ write_result outchan
+ with Uwobo_failure errmsg ->
+ return_error
+ (sprintf "Stylesheet chain application failed: %s" errmsg)
+ outchan)