From: Stefano Zacchiroli Date: Fri, 6 Dec 2002 17:01:00 +0000 (+0000) Subject: - added 'constructor' for response class X-Git-Tag: v0_3_99~170 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=546ec5e551646b24abc9ad769c157a153d49ca88;p=helm.git - added 'constructor' for response class - added methods 'addHeaders' and 'replaceHeaders' --- diff --git a/helm/DEVEL/ocaml-http/http_response.ml b/helm/DEVEL/ocaml-http/http_response.ml index 5ca7878ac..a0bda3582 100644 --- a/helm/DEVEL/ocaml-http/http_response.ml +++ b/helm/DEVEL/ocaml-http/http_response.ml @@ -25,8 +25,13 @@ open Http_common;; open Http_daemon;; open Printf;; -class response = - let default_code = 200 in +let status_line_RE = Pcre.regexp "^(HTTP/\\d\\.\\d) (\\d{3}) (.*)$" + +class response + (* Warning: keep default values in sync with Http_daemon.respond function *) + ?(body = "") ?(headers = []) + ?(version = http_version) ?(code = 200) ?status () + = (* remove all bindings of 'name' from hashtbl 'tbl' *) let rec hashtbl_remove_all tbl name = if not (Hashtbl.mem tbl name) then @@ -35,82 +40,93 @@ class response = if Hashtbl.mem tbl name then hashtbl_remove_all tbl name in (* "version code reason_phrase" *) - let status_line_re = Pcre.regexp "^(HTTP/\\d\\.\\d) (\\d{3}) (.*)$" in object (self) - val mutable version = http_version - val mutable code = default_code - val mutable reason: string option = None - val contentsBuf = Buffer.create 1024 - val headers = Hashtbl.create 11 - method version = version - method setVersion v = version <- v + val mutable _version = version + val mutable _code = + match status with + | None -> code + | Some (s: Http_types.status) -> code_of_status s + val mutable _reason: string option = None + val _contentsBuf = Buffer.create 1024 + val _headers = Hashtbl.create 11 + + initializer + self#setContents body; + self#addHeaders headers - method code = code + method version = _version + method setVersion v = _version <- v + + method code = _code method setCode c = ignore (status_of_code c); (* sanity check on c *) - code <- c - method status = status_of_code code - method setStatus (s: Http_types.status) = code <- code_of_status s + _code <- c + method status = status_of_code _code + method setStatus (s: Http_types.status) = _code <- code_of_status s method reason = - match reason with - | None -> Http_misc.reason_phrase_of_code code + match _reason with + | None -> Http_misc.reason_phrase_of_code _code | Some r -> r - method setReason r = reason <- Some r + method setReason r = _reason <- Some r method statusLine = String.concat " " [string_of_version self#version; string_of_int self#code; self#reason] method setStatusLine s = try - let subs = Pcre.extract ~rex:status_line_re s in + let subs = Pcre.extract ~rex:status_line_RE s in self#setVersion (version_of_string subs.(1)); self#setCode (int_of_string subs.(2)); self#setReason subs.(3) with Not_found -> raise (Invalid_status_line s) - method isInformational = is_informational code - method isSuccess = is_success code - method isRedirection = is_redirection code - method isClientError = is_client_error code - method isServerError = is_server_error code - method isError = is_error code + method isInformational = is_informational _code + method isSuccess = is_success _code + method isRedirection = is_redirection _code + method isClientError = is_client_error _code + method isServerError = is_server_error _code + method isError = is_error _code - method contents = Buffer.contents contentsBuf + method contents = Buffer.contents _contentsBuf method setContents c = - Buffer.clear contentsBuf; - Buffer.add_string contentsBuf c - method contentsBuf = contentsBuf + Buffer.clear _contentsBuf; + Buffer.add_string _contentsBuf c + method contentsBuf = _contentsBuf method setContentsBuf b = - Buffer.clear contentsBuf; - Buffer.add_buffer contentsBuf b - method addContents s = Buffer.add_string contentsBuf s - method addContentsBuf b = Buffer.add_buffer contentsBuf b + Buffer.clear _contentsBuf; + Buffer.add_buffer _contentsBuf b + method addContents s = Buffer.add_string _contentsBuf s + method addContentsBuf b = Buffer.add_buffer _contentsBuf b method addHeader ~name ~value = Http_parser.heal_header (name, value); - Hashtbl.add headers name value + Hashtbl.add _headers name value + method addHeaders = + List.iter (fun (name, value) -> self#addHeader ~name ~value) method replaceHeader ~name ~value = Http_parser.heal_header (name, value); - Hashtbl.replace headers name value - + Hashtbl.replace _headers name value + method replaceHeaders = + List.iter (fun (name, value) -> self#replaceHeader ~name ~value) + (* FIXME duplication of code between this and send_basic_headers *) method addBasicHeaders = self#addHeader ~name:"Date" ~value:(Http_misc.date_822 ()); self#addHeader ~name:"Server" ~value:server_string - method removeHeader ~name = hashtbl_remove_all headers name - method hasHeader ~name = Hashtbl.mem headers name + method removeHeader ~name = hashtbl_remove_all _headers name + method hasHeader ~name = Hashtbl.mem _headers name method header ~name = if not (self#hasHeader name) then raise (Header_not_found name); - String.concat ", " (List.rev (Hashtbl.find_all headers name)) + String.concat ", " (List.rev (Hashtbl.find_all _headers name)) method headers = List.rev (Hashtbl.fold (fun name _ headers -> (name, self#header ~name)::headers) - headers + _headers []) method contentType = self#header "Content-Type" @@ -133,7 +149,7 @@ class response = "" (List.map (fun (h,v) -> h ^ ": " ^ v ^ crlf) self#headers)) crlf - (Buffer.contents contentsBuf) (* body *) + (Buffer.contents _contentsBuf) (* body *) method serialize outchan = output_string outchan self#toString; flush outchan diff --git a/helm/DEVEL/ocaml-http/http_response.mli b/helm/DEVEL/ocaml-http/http_response.mli index c7073da26..08c5d9db5 100644 --- a/helm/DEVEL/ocaml-http/http_response.mli +++ b/helm/DEVEL/ocaml-http/http_response.mli @@ -19,5 +19,9 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) -class response: Http_types.response +class response: + ?body:string -> ?headers:(string * string) list -> + ?version:Http_types.version -> ?code:int -> ?status:Http_types.status -> + unit -> + Http_types.response