Permalink
Browse files

[cleanup] Base: remove sprintf

  • Loading branch information...
1 parent debb5ea commit a9f8d34c436db1b069a75e4805ab7bd962477a26 Raja committed Jun 28, 2011
View
@@ -47,8 +47,6 @@ let is_windows = Sys.os_type = "Win32"
let failwithf fmt = Printf.ksprintf failwith fmt
let invalid_argf fmt = Printf.ksprintf invalid_arg fmt
-let sprintf = Printf.sprintf
-
(* *)
let debug_getenv _ dflt = dflt
let debug_getenv_toggle _ = false
View
@@ -130,16 +130,3 @@ module Random : module type of BaseRandom
module Set : module type of BaseSet
module String : module type of BaseString
module Utf8 : module type of BaseUtf8
-
-
-(** {6 Deprecated API} *)
-
-(** The following functions are there for backward compatibility
- until we clean-up the depending code.
- Please DO NOT use it in new code *)
-
-(** You may rather use one of the following :
- + Functions from OManager, which support format
- + [FBuffer.printf], [SRope.printf]
- + [Printf.sprintf] in any other case.*)
-val sprintf : ('a, unit, string) format -> 'a
View
@@ -117,7 +117,7 @@ let encode_list_to_map encode_list =
chmap
(* Generic URL encode. *)
-let chhxmp = Array.init 256 (fun i -> Base.sprintf "%02X" i)
+let chhxmp = Array.init 256 (fun i -> Printf.sprintf "%02X" i)
let pc_encode ch = "%"^(chhxmp.(Char.code ch))
(* RFC 1738 but excluding , / ? : @ & = + $ #
View
@@ -151,7 +151,7 @@ module Binary(X : Ordered) = struct
let to_string print_elt h =
let data = Array.to_list h.data in
let data = Base.String.concat_map "; " print_elt data in
- Base.sprintf "heap{ len = %d; data = [%s]}" h.length data
+ Printf.sprintf "heap{ len = %d; data = [%s]}" h.length data
end
module type Epsilon = sig
View
@@ -106,7 +106,7 @@ decls:{{
| Pipe (p, (key, optlist, arg)) -> Printf.sprintf "%s [%s] <%s> | unix:\"%s\"" (string_of_key key) (String.concat_map "; " string_of_toption optlist) arg p
let clash_option o =
- let m = sprintf "option %s cannot be used in this context" (string_of_toption o) in
+ let m = Printf.sprintf "option %s cannot be used in this context" (string_of_toption o) in
(* #<< dddw m; >>#; *)
m
@@ -116,7 +116,7 @@ let make_status code msg = Sl (http_version_number, code, msg)
let get_response sl headers content =
(string_of_msg sl)^(List.fold_left (fun s h -> s^(string_of_msg h)) "" headers)^crlf^(get_content content)
let version = string_of_int BuildInfos.git_version_counter
-let server_name = sprintf "OPA/%s" version
+let server_name = Printf.sprintf "OPA/%s" version
let headerstr headers = List.fold_left (fun s h -> s^(string_of_msg h)) "" headers
let request_type_http_version = function
| Get (_,v) -> v
@@ -135,7 +135,7 @@ let request_type_uri = function
| Del (uri,_) -> uri
| Trace (uri,_) -> uri
| Conn (uri,_) -> uri
- | msg -> raise (Failure (sprintf "request_type_uri: %s not a request type" (string_of_msg msg)))
+ | msg -> raise (Failure (Printf.sprintf "request_type_uri: %s not a request type" (string_of_msg msg)))
let parse_content_disposition = function
| Content_Disposition (s,l) -> List.map (fun s -> rmldtrsp2 (Base.String.split_char '=' s)) (s::l)
| _ -> failwith "Not implemented yet."
@@ -445,7 +445,7 @@ handle_simple_post_cont(request_type, uri, headers, hr, body, len, contlen, time
%% Handling ( x-www-form-urlencoded )
handle_simple_post(request_type, uri, headers, hr, body, len, contlen, timeout):
debug 10 {{ Logger.debug "handle_simple_post: uri=%s contlen=%d\n%!" uri contlen }}
- let _runtime = {{ set_payload _runtime ((sprintf "FIXED:%d" contlen),headers) }}
+ let _runtime = {{ set_payload _runtime ((Printf.sprintf "FIXED:%d" contlen),headers) }}
fixed {{ contlen }}
| data ->
debug {{ Logger.debug "handle_simple_post: data='%s'\n%!" (String.escaped data) }}
View
@@ -34,10 +34,10 @@ let content_length req =
| Some v -> int_of_string v
let string_of_request_line r =
- sprintf "%s %s %s%s" (string_of_method r._method) r.request_uri r.http_version crlf
+ Printf.sprintf "%s %s %s%s" (string_of_method r._method) r.request_uri r.http_version crlf
let string_of_request r =
- sprintf "%s%s%s%s"
+ Printf.sprintf "%s%s%s%s"
(string_of_request_line r.request_line)
(RequestHeader.to_string string_of_request_header r.request_header)
crlf
@@ -62,7 +62,7 @@ type status_line =
let string_of_status_line sl =
let code = status_code sl.status in
let phrase = reason_phrase code in
- sprintf "%s %d %s%s" sl.status_http_version code phrase crlf
+ Printf.sprintf "%s %d %s%s" sl.status_http_version code phrase crlf
type res_body =
| Result of string
@@ -83,24 +83,24 @@ let reponse_content_length req =
let rec string_of_body body =
match body with
| Result s -> s
- | PartialResult (_, s, _) -> sprintf "partial\n%s" s
+ | PartialResult (_, s, _) -> Printf.sprintf "partial\n%s" s
| AuthenticationRequest body ->
let s = string_of_body body in
- sprintf "authentification\n%s" s
+ Printf.sprintf "authentification\n%s" s
let string_of_response_header r =
- sprintf "%s%s%s"
+ Printf.sprintf "%s%s%s"
(string_of_status_line r.status_line)
(ResponseHeader.to_string string_of_response_header r.response_header)
crlf
let string_of_response ?(body_limit=1024) r =
- sprintf "%s%s"
+ Printf.sprintf "%s%s"
(string_of_response_header r)
(String.sub (string_of_body r.response_message_body) 0 (min (reponse_content_length r) body_limit))
(* let string_of_response r = *)
-(* sprintf "%s%s%s%s" *)
+(* Printf.sprintf "%s%s%s%s" *)
(* (string_of_status_line r.status_line) *)
(* (ResponseHeader.to_string string_of_response_header r.response_header) *)
(* crlf *)
View
@@ -52,10 +52,10 @@ let inet_addr_of_name machine =
with Unix.Unix_error _ | Failure _ -> raise (Unknown_machine machine)
let addr_of_ipv4 (ip1, ip2, ip3, ip4) =
- Unix.inet_addr_of_string (Base.sprintf "%d.%d.%d.%d" ip1 ip2 ip3 ip4)
+ Unix.inet_addr_of_string (Printf.sprintf "%d.%d.%d.%d" ip1 ip2 ip3 ip4)
let string_of_ipv4 (ip1, ip2, ip3, ip4) =
- Base.sprintf "%d.%d.%d.%d" ip1 ip2 ip3 ip4
+ Printf.sprintf "%d.%d.%d.%d" ip1 ip2 ip3 ip4
let name_of_addr addr =
try (Unix.gethostbyaddr addr).Unix.h_name
View
@@ -41,11 +41,11 @@ let valid_email s =
let simple_mail s =
try
let _, (_, (user, domain)) = Email.parse_email_email s in
- Base.sprintf "%s@%s" user domain
+ Printf.sprintf "%s@%s" user domain
with Trx_runtime.SyntaxError _ -> raise (Bad_address s)
let mail_content ?(charset="ISO-8859-1") ?(cte="7bit") body =
- Base.sprintf "Content-Type: text/plain; charset=%s\r\n\
+ Printf.sprintf "Content-Type: text/plain; charset=%s\r\n\
Content-Transfer-Encoding: %s\r\n\
\r\n%s\r\n" charset cte body
@@ -138,7 +138,7 @@ let full_email ?(subject="") mfrom mto mdata ?return_path ?html ?(files=[]) ?cte
| Some return_path -> return_path
| None -> mfrom
in
- (Base.sprintf "From: %s\r\nReturn-Path:<%s>\r\nTo: %s\r\nMessage-ID: <%s.%s>\r\nX-Mailer: MLstate mailclient\r\nDate: %s\r\nMime-Version: 1.0\r\n%s"
+ (Printf.sprintf "From: %s\r\nReturn-Path:<%s>\r\nTo: %s\r\nMessage-ID: <%s.%s>\r\nX-Mailer: MLstate mailclient\r\nDate: %s\r\nMime-Version: 1.0\r\n%s"
mfrom return_path mto (String.random 10) mfrom (Date.rfc1123 (Time.gmtime (Time.now())))
(if subject = "" then "" else sprintf "Subject: %s\r\n" subject))
^(if files = []
@@ -169,7 +169,7 @@ let resolve_additional r n =
| Dig.Ip i -> Some i
| _ -> aux tl
else aux tl
- | _ -> resolve_UNIX (List.fold_left (fun acc x -> Base.sprintf "%s.%s" acc x) (List.hd n) (List.tl n))
+ | _ -> resolve_UNIX (List.fold_left (fun acc x -> Printf.sprintf "%s.%s" acc x) (List.hd n) (List.tl n))
in
aux (List.assoc "ADDITIONAL" r)
@@ -183,7 +183,7 @@ let resolve_additional r n =
(* FIXME: il faut en sortie une iterateur IntMapSort d'IP, triée par priorité
ensuite, on doit tenter les IP une à une... *)
let resolve_mx name =
- let output = File.process_output (Base.sprintf "dig %s MX" name) in
+ let output = File.process_output (Printf.sprintf "dig %s MX" name) in
try
let _pos, r = Dig.parse_dig_dig output in
List.assoc "ANSWER" r
@@ -240,7 +240,7 @@ let mail_send_aux ?client_certificate ?verify_params ?(secure=false) sched
let x = x * 60 in
wait_and_retry (Time.seconds x) (fun () -> try_mx mail (pred attempt) cont ips)
| Mailerror.Add_cc s ->
- let new_mail = { mail with SCC.body = Base.sprintf "Cc: %s\r\n%s" s mail.SCC.body } in
+ let new_mail = { mail with SCC.body = Printf.sprintf "Cc: %s\r\n%s" s mail.SCC.body } in
wait_and_retry (Time.seconds 1) (fun () -> try_mx new_mail (pred attempt) cont ips)
| _ when fst (read_code msg) = 451 ->
let x = 60 * attempt * attempt in
View
@@ -363,7 +363,7 @@ struct
in
match id with
| Raw x -> Printf.sprintf "``_ty_raw_%s" (Ident.to_string x)
- | Processed (t, i) -> Base.sprintf "``_ty_%s_%s" (Ident.to_string i) (tag_to_string t)
+ | Processed (t, i) -> Printf.sprintf "``_ty_%s_%s" (Ident.to_string i) (tag_to_string t)
(*
We test strictly than the of_string function is called only on
View
@@ -62,34 +62,34 @@ let string_of_certificate ce =
match ce with
| None -> ""
| Some c ->
- sprintf "[cert_file %s] [cert_privkey %s] [cert_password %s] %s [cert_capath %s]"
+ Printf.sprintf "[cert_file %s] [cert_privkey %s] [cert_password %s] %s [cert_capath %s]"
c.cert_file
c.cert_privkey
c.cert_password
(match c.cert_cafile with
| None -> ""
- | Some v -> (sprintf "[cert_cafile %s]" v))
+ | Some v -> (Printf.sprintf "[cert_cafile %s]" v))
(match c.cert_capath with
| None -> ""
- | Some v -> (sprintf "[cert_capath %s]" v))
+ | Some v -> (Printf.sprintf "[cert_capath %s]" v))
let string_of_param pe =
match pe with
| None -> ""
| Some p ->
- sprintf "%s %s %s %s [always %s]"
+ Printf.sprintf "%s %s %s %s [always %s]"
(match p.cafile with
| None -> ""
- | Some v -> (sprintf "[cafile %s]" v))
+ | Some v -> (Printf.sprintf "[cafile %s]" v))
(match p.capath with
| None -> ""
- | Some v -> (sprintf "[capath %s]" v))
+ | Some v -> (Printf.sprintf "[capath %s]" v))
(match p.certpath with
| None -> ""
- | Some v -> (sprintf "[certpath %s]" v))
+ | Some v -> (Printf.sprintf "[certpath %s]" v))
(match p.client_ca_file with
| None -> ""
- | Some v -> (sprintf "[client_ca_file %s]" v))
+ | Some v -> (Printf.sprintf "[client_ca_file %s]" v))
(match p.always with
| true -> "true"
| false -> "false")
@@ -228,7 +228,7 @@ let compute_fingerprint certificate = Ssl_ext.compute_digest certificate digest_
let certs = ref StringMap.empty
let reload_certs ?(extensions=["pem"]) verify_params =
- info "reload_certs" ?param:(Some verify_params) (sprintf "[extensions %s]" (List.fold_left (fun a b -> (sprintf "%s %s" a b)) "" extensions));
+ info "reload_certs" ?param:(Some verify_params) (Printf.sprintf "[extensions %s]" (List.fold_left (fun a b -> (Printf.sprintf "%s %s" a b)) "" extensions));
(* Clean the map *)
certs := StringMap.empty;
(* Reload every files in certpath *)
@@ -245,7 +245,7 @@ let reload_certs ?(extensions=["pem"]) verify_params =
let subject = Ssl.get_subject certificate
and fingerprint = compute_fingerprint certificate in
certs := StringMap.add fingerprint subject !certs;
- info "reload_certs" (sprintf "Certificate loaded:\n%s" (Ssl_ext.certificate_to_string certificate digest_name digest_size))
+ info "reload_certs" (Printf.sprintf "Certificate loaded:\n%s" (Ssl_ext.certificate_to_string certificate digest_name digest_size))
with
| Ssl.Certificate_error (* read_certificate *)
| Not_found (* get_subject *) -> info "reload_certs" path (* Continue even if one file fails *)
@@ -259,13 +259,13 @@ let validate_certificate certificate verify_params =
let has_certpath = Option.is_some verify_params.certpath in
let fingerprint = compute_fingerprint certificate in
if not has_certpath || ((* (hash = "" || fingerprint = hash) && *) StringMap.mem fingerprint !certs) then (
- info "validate_certificate" (sprintf "Valid certificate received:\n%s" (Ssl_ext.certificate_to_string certificate digest_name digest_size));
+ info "validate_certificate" (Printf.sprintf "Valid certificate received:\n%s" (Ssl_ext.certificate_to_string certificate digest_name digest_size));
true
) else if verify_params.accept_fun certificate then (
- info "validate_certificate" (sprintf "Certificate accepted:\n%s" (Ssl_ext.certificate_to_string certificate digest_name digest_size));
+ info "validate_certificate" (Printf.sprintf "Certificate accepted:\n%s" (Ssl_ext.certificate_to_string certificate digest_name digest_size));
true
) else (
- info "validate_certificate" (sprintf "Invalid certificate received:\n%s" (Ssl_ext.certificate_to_string certificate digest_name digest_size));
+ info "validate_certificate" (Printf.sprintf "Invalid certificate received:\n%s" (Ssl_ext.certificate_to_string certificate digest_name digest_size));
false
)
@@ -322,11 +322,11 @@ let get_listen_callback sched (server_params, client_params) server_fun =
end
with
| Ssl.Private_key_error as e ->
- warning "get_listen_callback" (sprintf "Error while trying to read private key file %S.\n" server_params.cert_privkey);
+ warning "get_listen_callback" (Printf.sprintf "Error while trying to read private key file %S.\n" server_params.cert_privkey);
raise e
(*ServerLib.do_*)(* exit 1 *)
| Ssl.Certificate_error as e ->
- warning "get_listen_callback" (sprintf "Error while trying to read ssl certificate %S.\n" server_params.cert_file);
+ warning "get_listen_callback" (Printf.sprintf "Error while trying to read ssl certificate %S.\n" server_params.cert_file);
raise e
(*ServerLib.do_*)(* exit 1 *)
end;
@@ -367,7 +367,7 @@ let get_listen_callback sched (server_params, client_params) server_fun =
| Ssl.Error_want_read -> Scheduler.listen_once sched conn continuation
| Ssl.Error_want_write -> Scheduler.connect sched conn continuation
| _ ->
- warning "glc" (sprintf "Ssl.Error_%s : %s"
+ warning "glc" (Printf.sprintf "Ssl.Error_%s : %s"
(Ssl_ext.error_to_string ssl_error) (Ssl.get_error_string()));
Scheduler.remove_connection sched conn
in
@@ -392,8 +392,8 @@ let get_err_cont sched conn err_cont =
Scheduler.remove_connection sched conn;
match e with
| Ssl.Accept_error ssl_error ->
- warning "SslAS" (sprintf "Ssl_ssl_error'%s'\n%s" (Ssl_ext.error_to_string ssl_error) backtrace)
- | e -> warning "SslAS" (sprintf "%s\n%s" (Printexc.to_string e) backtrace)
+ warning "SslAS" (Printf.sprintf "Ssl_ssl_error'%s'\n%s" (Ssl_ext.error_to_string ssl_error) backtrace)
+ | e -> warning "SslAS" (Printf.sprintf "%s\n%s" (Printexc.to_string e) backtrace)
)
| Some f -> f
@@ -413,11 +413,11 @@ let connect sched conn (client_certificate, verify_cert) ?err_cont cont =
Ssl.use_certificate ctx params.cert_file params.cert_privkey
with
| Ssl.Private_key_error as e ->
- warning "get_secure_socket" (sprintf "SslAS.client_connect: Error while trying to read private key file %s.\n" params.cert_privkey);
+ warning "get_secure_socket" (Printf.sprintf "SslAS.client_connect: Error while trying to read private key file %s.\n" params.cert_privkey);
err_cont e
(*ServerLib.do_*)(* exit 1 *)
| Ssl.Certificate_error as e ->
- warning "get_secure_socket" (sprintf "SslAS.client_connect: Error while trying to read ssl certificate %s.\n" params.cert_file);
+ warning "get_secure_socket" (Printf.sprintf "SslAS.client_connect: Error while trying to read ssl certificate %s.\n" params.cert_file);
err_cont e
(*ServerLib.do_*)(* exit 1 *)
end;
View
@@ -112,10 +112,10 @@ let parse_pre_grammar ?(name="Main") ?(stoppable=false) ~verbose input =
) pg.P.incl pg
end else
(* FIXME, Adam, this should be handled in the grammar *)
- raise (GrammarParse (B.sprintf "error parsing '%s': only %d out of %d bytes processed" name lastp input_len))
+ raise (GrammarParse (Printf.sprintf "error parsing '%s': only %d out of %d bytes processed" name lastp input_len))
with
| Trx_runtime.SyntaxError (pos, err) ->
- raise (GrammarParse (B.sprintf "error parsing '%s': %s" name (Trx_runtime.show_error input pos err)))
+ raise (GrammarParse (Printf.sprintf "error parsing '%s': %s" name (Trx_runtime.show_error input pos err)))
in
FilePos.uncache name;
result
@@ -138,16 +138,16 @@ let rewrite_funs pg =
begin match StringMap.find_opt f functions with
| None ->
if StringMap.mem f all_functions then
- failwith (B.sprintf "function %s is recursive" f)
+ failwith (Printf.sprintf "function %s is recursive" f)
else
- failwith (B.sprintf "function %s is undefined" f)
+ failwith (Printf.sprintf "function %s is undefined" f)
| Some (fdef, _) ->
let functions = StringMap.remove f functions in
let expected_arity = List.length fdef.P.vars in
if expected_arity = List.length vars then
let bindings = List.fold_left2 (fun acc idfun expra -> StringMap.add idfun (aux_seql expra) acc) bindings fdef.P.vars vars in
rewrite_fun functions bindings fdef.P.expr
- else failwith (B.sprintf "function %s is of arity %d" f expected_arity)
+ else failwith (Printf.sprintf "function %s is of arity %d" f expected_arity)
end
and aux_seql sl = List.map aux_seq sl
and aux_seq (il, map, code) = List.map aux_item il, map, code
@@ -178,7 +178,7 @@ let dependencies pg =
match primary with
| P.Ident s ->
if StringMap.mem s pg then StringSet.add s acc
- else raise (GrammarCheck (B.sprintf "definition '%s' missing!" s))
+ else raise (GrammarCheck (Printf.sprintf "definition '%s' missing!" s))
| P.Paren (P.Expr e) -> dep_of_expression acc e
| P.Paren _ -> assert false
| _ -> acc
Oops, something went wrong.

0 comments on commit a9f8d34

Please sign in to comment.