(* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. * $Id: cocanwiki_server_settings.ml,v 1.3 2004/10/09 15:01:58 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 Apache open Registry open Cgi open Printf (* Server-wide settings. * * These are stored in a single row in the database in the table * 'server_settings'. You must restart the server if you change * this row. * * It's not possible to read these at server start-up time because the * Apache server is still running as 'root' and will not normally be * allowed to access the database. We thus read them at the earliest * opportunity, in a request context, and cache the results. *) let server_settings_version, server_settings_stats_page, server_settings_crash_email = let default = 1, None, None in let settings = ref None in let get_settings (dbh : Dbi.connection) = let sth = dbh#prepare "select version, stats_page, crash_email from server_settings" in sth#execute []; let s = try (match sth#fetch1 () with | [ `Int version; (`String _ | `Null) as stats_page; (`String _ | `Null) as crash_email ] -> let stats_page = match stats_page with `String s -> Some s | `Null -> None in let crash_email = match crash_email with `String s -> Some s | `Null -> None in version, stats_page, crash_email | _ -> assert false) with Not_found -> default in sth#finish (); settings := Some s; s in let server_settings_version dbh = let (version, _, _) = match !settings with None -> get_settings dbh | Some settings -> settings in version in let server_settings_stats_page dbh = let (_, stats_page, _) = match !settings with None -> get_settings dbh | Some settings -> settings in stats_page in let server_settings_crash_email dbh = let (_, _, crash_email) = match !settings with None -> get_settings dbh | Some settings -> settings in crash_email in server_settings_version, server_settings_stats_page, server_settings_crash_email