1 (* COCANWIKI - a wiki written in Objective CAML.
2 * Written by Richard W.M. Jones <rich@merjis.com>.
3 * Copyright (C) 2004 Merjis Ltd.
4 * $Id: cocanwiki_images.ml,v 1.1 2004/10/21 11:42:05 rich Exp $
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation; either version 2 of the License, or
9 * (at your option) any later version.
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 * GNU General Public License for more details.
16 * You should have received a copy of the GNU General Public License
17 * along with this program; see the file COPYING. If not, write to
18 * the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 * Boston, MA 02111-1307, USA.
24 open Cocanwiki_strings
27 (* Find the format of an image. Uses the external 'identify' program,
28 * part of ImageMagick. Returns (mime_type, width, height). Throws
29 * Invalid_argument "image_identify" if the data is not an image.
31 let image_identify_re = Pcre.regexp "^\\S+ ([A-Z]+) (\\d+)x(\\d+)"
33 let image_identify data =
34 let filename = output_tempfile data in
35 let in_chan = Unix.open_process_in ("identify " ^ filename) in
36 let line = input_line in_chan in
37 let status = Unix.close_process_in in_chan in
40 Unix.WEXITED 0 -> (* Identify was OK with it ... *)
42 | Unix.WEXITED _ -> (* Couldn't identify the file type. *)
43 raise (Invalid_argument "image_identify")
45 failwith ("image_identify: 'identify' killed by signal " ^
48 failwith ("image_identify: 'identify' stopped by signal " ^
51 let subs = Pcre.exec ~rex:image_identify_re line in
52 let type_string = Pcre.get_substring subs 1 in
53 let width = int_of_string (Pcre.get_substring subs 2) in
54 let height = int_of_string (Pcre.get_substring subs 3) in
56 match type_string with
57 "JPEG" -> "image/jpeg"
58 | "GIF" -> "image/gif"
59 | "PNG" -> "image/png"
60 | _ -> raise (Invalid_argument "image_identify") in
64 raise (Invalid_argument "image_identify")
66 (* Make a thumbnail of an image. This uses the ImageMagick program 'convert'.
68 let image_thumbnail data max_width max_height =
69 let filename = output_tempfile data in
70 let cmd = sprintf "convert -size %dx%d %s -resize %dx%d -"
71 max_width max_height filename max_width max_height in
72 let in_chan = Unix.open_process_in cmd in
73 let thumbnail = input_all in_chan in
74 let status = Unix.close_process_in in_chan in
77 Unix.WEXITED 0 -> (* Convert was OK with it ... *)
79 | Unix.WEXITED n -> (* Convert failed. *)
80 failwith ("convert: fail with error code " ^ string_of_int n)
82 failwith ("convert: killed by signal " ^ string_of_int n)
84 failwith ("convert: stopped by signal " ^ string_of_int n));
85 let mime_type, width, height = image_identify thumbnail in
86 thumbnail, mime_type, width, height
88 (*----- Files and MIME types. -----*)
90 let ws_re = Pcre.regexp "\\s+"
91 let ext_re = Pcre.regexp "\\.([a-z0-9]+)$"
95 let chan = open_in "/etc/mime.types" in
96 let lines = input_all_lines chan in
98 let lines = List.filter (fun line ->
99 not (string_is_whitespace line) &&
100 String.length line > 0 &&
101 line.[0] <> '#') lines in
103 List.iter (fun line ->
104 let fields = Pcre.split ~rex:ws_re line in
108 List.iter (fun ext ->
109 res := (ext, typ) :: !res) exts) lines;
114 let mime_type_of_filename name =
116 let subs = Pcre.exec ~rex:ext_re name in
117 let ext = Pcre.get_substring subs 1 in
118 let ext = String.lowercase ext in
119 List.assoc ext mime_types
121 Not_found -> "application/octet-stream"