scripts/cocanwiki_images.ml

   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.2 2004/09/09 12:21:22 rich Exp $
   5  *
   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.
  10  *
  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.
  15  *
  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.
  20  *)
  21
  22 open Printf
  23
  24 open Cocanwiki_strings
  25 open Cocanwiki_files
  26
  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.
  30  *)
  31 let image_identify_re = Pcre.regexp "^\\S+ ([A-Z]+) (\\d+)x(\\d+)"
  32
  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
  38   unlink filename;
  39   (match status with
  40        Unix.WEXITED 0 ->                (* Identify was OK with it ... *)
  41          ()
  42      | Unix.WEXITED _ ->                (* Couldn't identify the file type. *)
  43          raise (Invalid_argument "image_identify")
  44      | Unix.WSIGNALED n ->
  45          failwith ("image_identify: 'identify' killed by signal " ^
  46                    string_of_int n)
  47      | Unix.WSTOPPED n ->
  48          failwith ("image_identify: 'identify' stopped by signal " ^
  49                    string_of_int n));
  50   try
  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
  55     let typ =
  56       match type_string with
  57           "JPEG" -> "image/jpeg"
  58         | "GIF" -> "image/gif"
  59         | "PNG" -> "image/png"
  60         | _ -> raise (Invalid_argument "image_identify") in
  61     typ, width, height
  62   with
  63       Not_found ->
  64          raise (Invalid_argument "image_identify")
  65
  66 (* Make a thumbnail of an image.  This uses the ImageMagick program 'convert'.
  67  *)
  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
  75   unlink filename;
  76   (match status with
  77        Unix.WEXITED 0 ->                (* Convert was OK with it ... *)
  78          ()
  79      | Unix.WEXITED n ->                (* Convert failed. *)
  80          failwith ("convert: fail with error code " ^ string_of_int n)
  81      | Unix.WSIGNALED n ->
  82          failwith ("convert: killed by signal " ^ string_of_int n)
  83      | Unix.WSTOPPED 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
  87
  88 (*----- Files and MIME types. -----*)
  89
  90 let ws_re = Pcre.regexp "\\s+"
  91 let ext_re = Pcre.regexp "\\.([a-z0-9]+)$"
  92
  93 let mime_types =
  94   try
  95     let chan = open_in "/etc/mime.types" in
  96     let lines = input_all_lines chan in
  97     close_in chan;
  98     let lines = List.filter (fun line ->
  99                                not (string_is_whitespace line) &&
 100                                String.length line > 0 &&
 101                                line.[0] <> '#') lines in
 102     let res = ref [] in
 103     List.iter (fun line ->
 104                  let fields = Pcre.split ~rex:ws_re line in
 105                  match fields with
 106                      [] -> assert false
 107                    | typ :: exts ->
 108                        List.iter (fun ext ->
 109                                     res := (ext, typ) :: !res) exts) lines;
 110     !res
 111   with
 112       Sys_error _ -> []
 113
 114 let mime_type_of_filename name =
 115   try
 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
 120   with
 121       Not_found -> "application/octet-stream"