scripts/cocanwiki_images.ml

   1 (* COCANWIKI scripts.
   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/09/07 14:58:34 rich Exp $
   5  *)
   6
   7 open Printf
   8
   9 open Cocanwiki_strings
  10 open Cocanwiki_files
  11
  12 (* Find the format of an image.  Uses the external 'identify' program,
  13  * part of ImageMagick.  Returns (mime_type, width, height).  Throws
  14  * Invalid_argument "image_identify" if the data is not an image.
  15  *)
  16 let image_identify_re = Pcre.regexp "^\\S+ ([A-Z]+) (\\d+)x(\\d+)"
  17
  18 let image_identify data =
  19   let filename = output_tempfile data in
  20   let in_chan = Unix.open_process_in ("identify " ^ filename) in
  21   let line = input_line in_chan in
  22   let status = Unix.close_process_in in_chan in
  23   unlink filename;
  24   (match status with
  25        Unix.WEXITED 0 ->                (* Identify was OK with it ... *)
  26          ()
  27      | Unix.WEXITED _ ->                (* Couldn't identify the file type. *)
  28          raise (Invalid_argument "image_identify")
  29      | Unix.WSIGNALED n ->
  30          failwith ("image_identify: 'identify' killed by signal " ^
  31                    string_of_int n)
  32      | Unix.WSTOPPED n ->
  33          failwith ("image_identify: 'identify' stopped by signal " ^
  34                    string_of_int n));
  35   try
  36     let subs = Pcre.exec ~rex:image_identify_re line in
  37     let type_string = Pcre.get_substring subs 1 in
  38     let width = int_of_string (Pcre.get_substring subs 2) in
  39     let height = int_of_string (Pcre.get_substring subs 3) in
  40     let typ =
  41       match type_string with
  42           "JPEG" -> "image/jpeg"
  43         | "GIF" -> "image/gif"
  44         | "PNG" -> "image/png"
  45         | _ -> raise (Invalid_argument "image_identify") in
  46     typ, width, height
  47   with
  48       Not_found ->
  49          raise (Invalid_argument "image_identify")
  50
  51 (* Make a thumbnail of an image.  This uses the ImageMagick program 'convert'.
  52  *)
  53 let image_thumbnail data max_width max_height =
  54   let filename = output_tempfile data in
  55   let cmd = sprintf "convert -size %dx%d %s -resize %dx%d -"
  56               max_width max_height filename max_width max_height in
  57   let in_chan = Unix.open_process_in cmd in
  58   let thumbnail = input_all in_chan in
  59   let status = Unix.close_process_in in_chan in
  60   unlink filename;
  61   (match status with
  62        Unix.WEXITED 0 ->                (* Convert was OK with it ... *)
  63          ()
  64      | Unix.WEXITED n ->                (* Convert failed. *)
  65          failwith ("convert: fail with error code " ^ string_of_int n)
  66      | Unix.WSIGNALED n ->
  67          failwith ("convert: killed by signal " ^ string_of_int n)
  68      | Unix.WSTOPPED n ->
  69          failwith ("convert: stopped by signal " ^ string_of_int n));
  70   let mime_type, width, height = image_identify thumbnail in
  71   thumbnail, mime_type, width, height
  72
  73 (*----- Files and MIME types. -----*)
  74
  75 let ws_re = Pcre.regexp "\\s+"
  76 let ext_re = Pcre.regexp "\\.([a-z0-9]+)$"
  77
  78 let mime_types =
  79   try
  80     let chan = open_in "/etc/mime.types" in
  81     let lines = input_all_lines chan in
  82     close_in chan;
  83     let lines = List.filter (fun line ->
  84                                not (string_is_whitespace line) &&
  85                                String.length line > 0 &&
  86                                line.[0] <> '#') lines in
  87     let res = ref [] in
  88     List.iter (fun line ->
  89                  let fields = Pcre.split ~rex:ws_re line in
  90                  match fields with
  91                      [] -> assert false
  92                    | typ :: exts ->
  93                        List.iter (fun ext ->
  94                                     res := (ext, typ) :: !res) exts) lines;
  95     !res
  96   with
  97       Sys_error _ -> []
  98
  99 let mime_type_of_filename name =
 100   try
 101     let subs = Pcre.exec ~rex:ext_re name in
 102     let ext = Pcre.get_substring subs 1 in
 103     let ext = String.lowercase ext in
 104     List.assoc ext mime_types
 105   with
 106       Not_found -> "application/octet-stream"