2 * Written by Richard W.M. Jones <rich@merjis.com>.
3 * Copyright (C) 2004 Merjis Ltd.
4 * $Id: cocanwiki.ml,v 1.1 2004/09/07 10:14:09 rich Exp $
14 module Pool = DbiPool (Dbi_postgres)
16 (* Wrapper around [Cgi.Template.template] function which loads the
17 * template from a pre-defined path and sets up some default variables.
21 try Sys.getenv "COCANWIKI_TEMPLATES"
22 with Not_found -> "/usr/share/cocanwiki/templates" in
24 try (Unix.stat path).Unix.st_kind = Unix.S_DIR
25 with Unix.Unix_error _ -> false in
26 if not (is_dir path) then
27 failwith ("environment variable $COCANWIKI_TEMPLATES " ^
28 "must be set to point to my 'templates' directory " ^
29 "(see README file for more details)");
31 Template.template (path // filename)
33 (* Generate a printable datestamp for pages. *)
34 let printable_date (date, _) =
35 sprintf "%d %s %04d" date.Dbi.day (short_month date.Dbi.month) date.Dbi.year
37 let printable_date_time (date, time) =
38 sprintf "%d %s %04d %02d:%02d" date.Dbi.day (short_month date.Dbi.month)
39 date.Dbi.year time.Dbi.hour time.Dbi.min
41 (* This function is used to grab a database handle. It's used in a couple
42 * of very special places, and is not for general consumption.
44 let _get_dbh r = Pool.get r "cocanwiki"
46 (* The [CgiExit] exception should be folded back into the base
47 * mod_caml code at some point. It just causes the 'run' function to
48 * return at that point safely. (XXX)
52 (* Our wrapper around the standard [register_script] function. *)
53 let register_script run =
54 (* Actually register the script with the real [Registry] module. *)
58 let dbh = _get_dbh r in
60 (* Get the host ID, by comparing the Host: header with the hostnames
61 * table in the database.
63 let hostid, hostname =
64 let hostname = try Request.hostname r
65 with Not_found -> failwith "No ``Host:'' header in request" in
66 let hostname = String.lowercase hostname in
68 let sth = dbh#prepare_cached "select h.id, h.canonical_hostname
69 from hostnames hn, hosts h
71 and hn.hostid = h.id" in
72 sth#execute [`String hostname];
75 (match sth#fetch1 () with
76 [ `Int id; `String hostname ] -> id, hostname
80 failwith ("Hostname ``" ^ hostname ^ "'' not found in " ^
81 "the hosts/hostnames tables in the database.") in
83 (* Call the actual CGI script. Note the fourth (unit) argument
84 * is reserved for later usage (for authentication information).
87 run r q dbh (hostid, hostname) ()