1 (* Basic Merjis functions.
2 * Copyright (C) 2004 Merjis Ltd.
3 * Written By Richard W.M. Jones (rich@merjis.com)
4 * $Id: merjisforwiki.ml,v 1.1 2004/09/07 10:14:09 rich Exp $
7 (* This is a copy of an internal library which we use at Merjis. *)
13 (*----- Basic stuff. -----*)
27 (*----- String functions. -----*)
29 let string_contains substr str =
30 try String.find str substr; true
31 with String.Invalid_string -> false
33 let string_of_char = String.make 1
36 if String.length str < n then str else String.sub str 0 (n-1)
38 (* These versions only work in the C locale for 7-bit characters. *)
41 (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
44 c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z'
50 c >= '0' && c <= '9' || c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z'
59 c >= '0' && c <= '9' || c >= 'a' && c <= 'f' || c >= 'A' && c <= 'F'
61 let triml ?(test = isspace) str =
63 let n = ref (String.length str) in
64 while !n > 0 && test str.[!i]; do
69 else String.sub str !i !n
71 let trimr ?(test = isspace) str =
72 let n = ref (String.length str) in
73 while !n > 0 && test str.[!n-1]; do
76 if !n = String.length str then str
77 else String.sub str 0 !n
79 let trim ?(test = isspace) str =
82 let string_for_all f str =
83 let len = String.length str in
88 if not (f c) then false
94 let string_exists f str =
95 let len = String.length str in
106 let string_is_whitespace = string_for_all isspace
108 (*----- List functions. -----*)
111 fst (List.split_nth n xs)
113 let rec uniq ?(cmp = Pervasives.compare) = function
116 | x :: y :: xs when compare x y = 0 ->
121 let sort_uniq ?cmp xs =
122 let xs = List.sort ?cmp xs in
123 let xs = uniq ?cmp xs in
126 let frequency ?(cmp = Pervasives.compare) xs =
127 let xs = List.sort ~cmp xs in
128 let rec loop = function
131 | x :: y :: xs when cmp x y = 0 ->
132 let rest = loop (y :: xs) in
133 let (count, _), rest = List.hd rest, List.tl rest in
139 List.rev (List.sort xs)
141 (* This version by Isaac Trotts. *)
142 let group_by ?(cmp = Pervasives.compare) ls =
145 (fun acc (day1, x1) ->
148 | (day2, ls2) :: acctl ->
150 then (day1, x1 :: ls2) :: acctl
151 else (day1, [x1]) :: acc)
155 let ls' = List.rev ls' in
156 List.map (fun (x, xs) -> x, List.rev xs) ls'
158 (*----- File functions. -----*)
160 let (//) = Filename.concat
162 let rec input_all_lines chan =
164 let line = input_line chan in
165 line :: input_all_lines chan
170 let buf = Buffer.create 16384 in
171 let tmpsize = 16384 in
172 let tmp = String.create tmpsize in
174 while n := input chan tmp 0 tmpsize; !n > 0 do
175 Buffer.add_substring buf tmp 0 !n;
179 let input_file filename =
180 let chan = open_in_bin filename in
181 let data = input_all chan in
185 let output_file filename data =
186 let chan = open_out_bin filename in
187 output_string chan data;
190 let output_tempfile data =
191 let filename, chan = Filename.open_temp_file "tmp" ".tmp" in
192 output_string chan data;
196 (*----- Command functions. -----*)
199 let code = Sys.command cmd in
200 if code <> 0 then failwith (cmd ^ ": error code " ^ string_of_int code)
202 let copy infile outfile =
203 cmd (sprintf "cp %s %s" infile outfile)
206 let chan = Unix.open_process_in cmd in
207 let lines = input_all_lines chan in
208 let stat = Unix.close_process_in chan in
212 failwith ("command failed with code " ^ string_of_int i)
213 | Unix.WSIGNALED i ->
214 failwith ("command killed by signal " ^ string_of_int i)
216 failwith ("command stopped by signal " ^ string_of_int i));
220 try Unix.unlink file with Unix.Unix_error _ -> ()
222 (*----- Meta-functions. -----*)
226 (*----- Time and date. -----*)
227 let short_weekday = function
228 | 0 -> "Sun" | 1 -> "Mon" | 2 -> "Tue" | 3 -> "Wed"
229 | 4 -> "Thu" | 5 -> "Fri" | 6 -> "Sat" | 7 -> "Sun"
230 | _ -> invalid_arg "short_weekday"
232 let short_month = function
233 | 1 -> "Jan" | 2 -> "Feb" | 3 -> "Mar" | 4 -> "Apr"
234 | 5 -> "May" | 6 -> "Jun" | 7 -> "Jul" | 8 -> "Aug"
235 | 9 -> "Sep" | 10 -> "Oct" | 11 -> "Nov" | 12 -> "Dec"
236 | _ -> invalid_arg "short_month"
238 (*----- Images. -----*)
240 (* Find the format of an image. Uses the external 'identify' program,
241 * part of ImageMagick. Returns (mime_type, width, height). Throws
242 * Invalid_argument "image_identify" if the data is not an image.
244 let image_identify_re = Pcre.regexp "^\\S+ ([A-Z]+) (\\d+)x(\\d+)"
246 let image_identify data =
247 let filename = output_tempfile data in
248 let in_chan = Unix.open_process_in ("identify " ^ filename) in
249 let line = input_line in_chan in
250 let status = Unix.close_process_in in_chan in
253 Unix.WEXITED 0 -> (* Identify was OK with it ... *)
255 | Unix.WEXITED _ -> (* Couldn't identify the file type. *)
256 raise (Invalid_argument "image_identify")
257 | Unix.WSIGNALED n ->
258 failwith ("image_identify: 'identify' killed by signal " ^
261 failwith ("image_identify: 'identify' stopped by signal " ^
264 let subs = Pcre.exec ~rex:image_identify_re line in
265 let type_string = Pcre.get_substring subs 1 in
266 let width = int_of_string (Pcre.get_substring subs 2) in
267 let height = int_of_string (Pcre.get_substring subs 3) in
269 match type_string with
270 "JPEG" -> "image/jpeg"
271 | "GIF" -> "image/gif"
272 | "PNG" -> "image/png"
273 | _ -> raise (Invalid_argument "image_identify") in
277 raise (Invalid_argument "image_identify")
279 (* Make a thumbnail of an image. This uses the ImageMagick program 'convert'.
281 let image_thumbnail data max_width max_height =
282 let filename = output_tempfile data in
283 let cmd = sprintf "convert -size %dx%d %s -resize %dx%d -"
284 max_width max_height filename max_width max_height in
285 let in_chan = Unix.open_process_in cmd in
286 let thumbnail = input_all in_chan in
287 let status = Unix.close_process_in in_chan in
290 Unix.WEXITED 0 -> (* Convert was OK with it ... *)
292 | Unix.WEXITED n -> (* Convert failed. *)
293 failwith ("convert: fail with error code " ^ string_of_int n)
294 | Unix.WSIGNALED n ->
295 failwith ("convert: killed by signal " ^ string_of_int n)
297 failwith ("convert: stopped by signal " ^ string_of_int n));
298 let mime_type, width, height = image_identify thumbnail in
299 thumbnail, mime_type, width, height
301 (*----- Files and MIME types. -----*)
303 let ws_re = Pcre.regexp "\\s+"
304 let ext_re = Pcre.regexp "\\.([a-z0-9]+)$"
308 let chan = open_in "/etc/mime.types" in
309 let lines = input_all_lines chan in
311 let lines = List.filter (fun line ->
312 not (string_is_whitespace line) &&
313 String.length line > 0 &&
314 line.[0] <> '#') lines in
316 List.iter (fun line ->
317 let fields = Pcre.split ~rex:ws_re line in
321 List.iter (fun ext ->
322 res := (ext, typ) :: !res) exts) lines;
327 let mime_type_of_filename name =
329 let subs = Pcre.exec ~rex:ext_re name in
330 let ext = Pcre.get_substring subs 1 in
331 let ext = String.lowercase ext in
332 List.assoc ext mime_types
334 Not_found -> "application/octet-stream"