(* COCANWIKI - a wiki written in Objective CAML.
 * Written by Richard W.M. Jones <rich@merjis.com>.
 * Copyright (C) 2004 Merjis Ltd.
 * $Id: cocanwiki_images.ml,v 1.2 2004/09/09 12:21:22 rich Exp $
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 * Boston, MA 02111-1307, USA.
 *)

open Printf

open Cocanwiki_strings
open Cocanwiki_files

(* Find the format of an image.  Uses the external 'identify' program,
 * part of ImageMagick.  Returns (mime_type, width, height).  Throws
 * Invalid_argument "image_identify" if the data is not an image.
 *)
let image_identify_re = Pcre.regexp "^\\S+ ([A-Z]+) (\\d+)x(\\d+)"

let image_identify data =
  let filename = output_tempfile data in
  let in_chan = Unix.open_process_in ("identify " ^ filename) in
  let line = input_line in_chan in
  let status = Unix.close_process_in in_chan in
  unlink filename;
  (match status with
       Unix.WEXITED 0 ->		(* Identify was OK with it ... *)
	 ()
     | Unix.WEXITED _ ->		(* Couldn't identify the file type. *)
	 raise (Invalid_argument "image_identify")
     | Unix.WSIGNALED n ->
	 failwith ("image_identify: 'identify' killed by signal " ^
		   string_of_int n)
     | Unix.WSTOPPED n ->
	 failwith ("image_identify: 'identify' stopped by signal " ^
		   string_of_int n));
  try
    let subs = Pcre.exec ~rex:image_identify_re line in
    let type_string = Pcre.get_substring subs 1 in
    let width = int_of_string (Pcre.get_substring subs 2) in
    let height = int_of_string (Pcre.get_substring subs 3) in
    let typ =
      match type_string with
	  "JPEG" -> "image/jpeg"
	| "GIF" -> "image/gif"
	| "PNG" -> "image/png"
	| _ -> raise (Invalid_argument "image_identify") in
    typ, width, height
  with
      Not_found ->
	 raise (Invalid_argument "image_identify")

(* Make a thumbnail of an image.  This uses the ImageMagick program 'convert'.
 *)
let image_thumbnail data max_width max_height =
  let filename = output_tempfile data in
  let cmd = sprintf "convert -size %dx%d %s -resize %dx%d -"
	      max_width max_height filename max_width max_height in
  let in_chan = Unix.open_process_in cmd in
  let thumbnail = input_all in_chan in
  let status = Unix.close_process_in in_chan in
  unlink filename;
  (match status with
       Unix.WEXITED 0 ->		(* Convert was OK with it ... *)
	 ()
     | Unix.WEXITED n ->		(* Convert failed. *)
	 failwith ("convert: fail with error code " ^ string_of_int n)
     | Unix.WSIGNALED n ->
	 failwith ("convert: killed by signal " ^ string_of_int n)
     | Unix.WSTOPPED n ->
	 failwith ("convert: stopped by signal " ^ string_of_int n));
  let mime_type, width, height = image_identify thumbnail in
  thumbnail, mime_type, width, height

(*----- Files and MIME types. -----*)

let ws_re = Pcre.regexp "\\s+"
let ext_re = Pcre.regexp "\\.([a-z0-9]+)$"

let mime_types =
  try
    let chan = open_in "/etc/mime.types" in
    let lines = input_all_lines chan in
    close_in chan;
    let lines = List.filter (fun line ->
			       not (string_is_whitespace line) &&
			       String.length line > 0 &&
			       line.[0] <> '#') lines in
    let res = ref [] in
    List.iter (fun line ->
		 let fields = Pcre.split ~rex:ws_re line in
		 match fields with
		     [] -> assert false
		   | typ :: exts ->
		       List.iter (fun ext ->
				    res := (ext, typ) :: !res) exts) lines;
    !res
  with
      Sys_error _ -> []

let mime_type_of_filename name =
  try
    let subs = Pcre.exec ~rex:ext_re name in
    let ext = Pcre.get_substring subs 1 in
    let ext = String.lowercase ext in
    List.assoc ext mime_types
  with
      Not_found -> "application/octet-stream"