(* COCANWIKI scripts.
 * Written by Richard W.M. Jones <rich@merjis.com>.
 * Copyright (C) 2004 Merjis Ltd.
 * $Id: cocanwiki.ml,v 1.1 2004/09/07 10:14:09 rich Exp $
 *)

open Apache
open Registry
open Cgi
open Printf

open Merjisforwiki

module Pool = DbiPool (Dbi_postgres)

(* Wrapper around [Cgi.Template.template] function which loads the
 * template from a pre-defined path and sets up some default variables.
 *)
let get_template =
  let path =
    try Sys.getenv "COCANWIKI_TEMPLATES"
    with Not_found -> "/usr/share/cocanwiki/templates" in
  let is_dir path =
    try (Unix.stat path).Unix.st_kind = Unix.S_DIR
    with Unix.Unix_error _ -> false in
  if not (is_dir path) then
    failwith ("environment variable $COCANWIKI_TEMPLATES " ^
	      "must be set to point to my 'templates' directory " ^
	      "(see README file for more details)");
  fun filename ->
    Template.template (path // filename)

(* Generate a printable datestamp for pages. *)
let printable_date (date, _) =
  sprintf "%d %s %04d" date.Dbi.day (short_month date.Dbi.month) date.Dbi.year

let printable_date_time (date, time) =
  sprintf "%d %s %04d %02d:%02d" date.Dbi.day (short_month date.Dbi.month)
    date.Dbi.year time.Dbi.hour time.Dbi.min

(* This function is used to grab a database handle.  It's used in a couple
 * of very special places, and is not for general consumption.
 *)
let _get_dbh r = Pool.get r "cocanwiki"

(* The [CgiExit] exception should be folded back into the base
 * mod_caml code at some point.  It just causes the 'run' function to
 * return at that point safely.  (XXX)
 *)
exception CgiExit

(* Our wrapper around the standard [register_script] function. *)
let register_script run =
  (* Actually register the script with the real [Registry] module. *)
  register_script
    (fun r ->
       let q = new cgi r in
       let dbh = _get_dbh r in

       (* Get the host ID, by comparing the Host: header with the hostnames
	* table in the database.
	*)
       let hostid, hostname =
	 let hostname = try Request.hostname r
	 with Not_found -> failwith "No ``Host:'' header in request" in
	 let hostname = String.lowercase hostname in

	 let sth = dbh#prepare_cached "select h.id, h.canonical_hostname
                                         from hostnames hn, hosts h
                                        where hn.name = ?
                                          and hn.hostid = h.id" in
	 sth#execute [`String hostname];

	 try
	   (match sth#fetch1 () with
		[ `Int id; `String hostname ] -> id, hostname
	      | _ -> assert false)
	 with
	     Not_found ->
	       failwith ("Hostname ``" ^ hostname ^ "'' not found in " ^
			 "the hosts/hostnames tables in the database.") in

       (* Call the actual CGI script.  Note the fourth (unit) argument
	* is reserved for later usage (for authentication information).
	*)
       try
	 run r q dbh (hostid, hostname) ()
       with
	   CgiExit -> ())