+csv dep for PG'OCaml.
[cocanwiki.git] / scripts / lib / cocanwiki_template.ml
index e7189c7..8782f01 100644 (file)
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki_template.ml,v 1.5 2005/11/24 14:54:15 rich Exp $
+ * $Id: cocanwiki_template.ml,v 1.12 2006/12/06 09:46:57 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
 
 open Unix
 
+open ExtString
+
+open Apache
+
 open Cocanwiki_files
 open Cocanwiki_strings
 
 (* This is used to generate the id fields from URLs on the site menu. *)
 let id_of_url str =
-  let str = String.copy str in
-  for i = 0 to String.length str - 1 do
-    if not (isalnum str.[i]) then str.[i] <- '_'
-  done;
-  str
+  let buf = UTF8.Buf.create (String.length str) in
+  UTF8.iter (
+    fun c ->
+      if iswebsafe c then UTF8.Buf.add_char buf c
+      else UTF8.Buf.add_char buf (UChar.of_char '_')
+  ) str;
+  UTF8.Buf.contents buf
 
 let base =
   let base =
@@ -53,6 +59,15 @@ let base =
 let { tm_year = year } = gmtime (time ())
 let year = year + 1900
 
+(* Sniff for MSIE of a particular version. *)
+let is_msie_version user_agent version =
+  try
+    let index = String.find user_agent "MSIE " in
+    let index = index + 5 in
+    String.length user_agent > index && user_agent.[index] = version
+  with
+    Invalid_string -> false
+
 (* Cache of precompiled templates, arranged by full path. *)
 let cache = Hashtbl.create 32
 
@@ -77,72 +92,100 @@ let _get_template filename =
        Hashtbl.replace cache path (template, mtime);
        template
 
-let get_template ?page (dbh : Dbi.connection) hostid filename =
+let get_template ?page r dbh hostid filename =
   let template = _get_template filename in
 
-  if hostid > 0 then (
+  if hostid > 0l then (
     (* Get standard fields concerning this host from the database. *)
-    let sth =
-      dbh#prepare_cached
-       "select h.theme_css, p.name, p.url, h.search_box,
+    let rows =
+      PGSQL(dbh) "nullable-results"
+       "select h.theme_css, h.css is not null,
+                h.ie6_fixes_css is not null, h.ie7_fixes_css is not null,
+                p.name, p.url, h.search_box,
                 h.brand, h.brand_tagline, h.brand_description,
-                h.pagebug
+                h.pagebug, h.ie_imagetoolbar_no, h.global_noodp
            from hosts h left outer join powered_by p on h.powered_by = p.id
-          where h.id = ?" in
-    sth#execute [`Int hostid];
+          where h.id = $hostid" in
 
-    let theme_css, powered_by_name, powered_by_url, search_box,
-      brand, brand_tagline, brand_description, pagebug =
-      match sth#fetch1 () with
-      | [ a; b; c; d; e; f; g; h] -> a, b, c, d, e, f, g, h
+    let theme_css, has_host_css, has_ie6_fixes_css, has_ie7_fixes_css,
+      powered_by_name, powered_by_url, search_box,
+      brand, brand_tagline, brand_description, pagebug, ie_imagetoolbar_no,
+      global_noodp =
+      match rows with
+      | [ row ] -> row
       | _ -> assert false in
 
     let theme_css =
       match theme_css with
-      | `Null -> "/_css/standard.css"
-      | `String file -> file
-      | _ -> assert false in
+      | None -> "/_css/standard.css"
+      | Some file -> file in
+
+    let has_host_css =
+      match has_host_css with
+      | Some true -> true
+      | _ -> false in
+
+    (* Send the IE6/7 fixes header only to browsers claiming to be MSIE.
+     * A browser such as Opera which claims to be MSIE will see the header
+     * but ignore it because it is surrounded by comment code to defend
+     * against browsers which aren't really MSIE.
+     *)
+    let ua = lazy (
+      try Table.get (Request.headers_in r) "User-Agent"
+      with Not_found -> ""
+    ) in
+
+    let has_ie6_fixes_css =
+      has_ie6_fixes_css = Some true && is_msie_version (Lazy.force ua) '6' in
+
+    let has_ie7_fixes_css =
+      has_ie7_fixes_css = Some true && is_msie_version (Lazy.force ua) '7' in
 
     let powered_by_name, powered_by_url =
       match powered_by_name, powered_by_url with
-      | `Null, `Null ->
+      | None, None ->
          let url = "http://sandbox.merjis.com/" in
          let name = Cocanwiki_version.package ^ " " ^
                     Cocanwiki_version.version in
          name, url
-      | `String name, `String url -> name, url
+      | Some name, Some url -> name, url
       | _ -> assert false in
 
-    let search_box = match search_box with `Bool b -> b | _ -> assert false in
-
     let branding, brand,
       has_brand_tagline, brand_tagline,
       has_brand_description, brand_description =
       match brand with
-      | `Null -> false, "", false, "", false, ""
-      | `String brand ->
+      | None -> false, "", false, "", false, ""
+      | Some brand ->
          let has_brand_tagline, brand_tagline =
            match brand_tagline with
-           | `Null -> false, ""
-           | `String s -> true, s
-           | _ -> assert false in
+           | None -> false, ""
+           | Some s -> true, s in
          let has_brand_description, brand_description =
            match brand_description with
-           | `Null -> false, ""
-           | `String s -> true, s
-           | _ -> assert false in
+           | None -> false, ""
+           | Some s -> true, s in
          true, brand,
          has_brand_tagline, brand_tagline,
-         has_brand_description, brand_description
-      | _ -> assert false in
+         has_brand_description, brand_description in
 
     let has_pagebug, pagebug =
       match pagebug with
-      | `Null -> false, ""
-      | `String pagebug -> true, pagebug
-      | _ -> assert false in
+      | None -> false, ""
+      | Some pagebug -> true, pagebug in
+
+    let search_box = match search_box with Some b -> b | _ -> assert false in
+
+    let ie_imagetoolbar_no =
+      match ie_imagetoolbar_no with Some b -> b | _ -> assert false in
+
+    let global_noodp =
+      match global_noodp with Some b -> b | _ -> assert false in
 
     template#set "theme_css" theme_css;
+    template#conditional "has_host_css" has_host_css;
+    template#conditional "has_ie6_fixes_css" has_ie6_fixes_css;
+    template#conditional "has_ie7_fixes_css" has_ie7_fixes_css;
     template#set "powered_by_name" powered_by_name;
     template#set "powered_by_url" powered_by_url;
     template#conditional "search_box" search_box;
@@ -154,11 +197,13 @@ let get_template ?page (dbh : Dbi.connection) hostid filename =
     template#set "brand_description" brand_description;
     template#conditional "has_pagebug" has_pagebug;
     template#set "pagebug" pagebug;
+    template#conditional "ie_imagetoolbar_no" ie_imagetoolbar_no;
+    template#conditional "noodp" global_noodp;
 
     (* Site menu. *)
-    let sth = dbh#prepare_cached "select url, label, ordering from sitemenu
-                                   where hostid = ? order by ordering" in
-    sth#execute [`Int hostid];
+    let rows = PGSQL(dbh)
+      "select url, label, ordering from sitemenu
+        where hostid = $hostid order by ordering" in
 
     let is_homepage =
       match page with
@@ -167,23 +212,27 @@ let get_template ?page (dbh : Dbi.connection) hostid filename =
       | _ -> false in
     template#conditional "is_homepage" is_homepage;
 
-    let table = sth#map (function [`String url; `String label; _] ->
-                          let is_linked =
-                            match page with
-                            | None -> true
-                            | Some page when page = url -> false
-                            | _ -> true in
-                          let id = id_of_url url in
-                          [ "url", Template.VarString url;
-                            "label", Template.VarString label;
-                            "is_linked", Template.VarConditional is_linked;
-                            "id", Template.VarString id ]
-                        | _ -> assert false) in
+    let table = List.map
+      (fun (url, label, _) ->
+        let is_linked =
+          match page with
+          | None -> true
+          | Some page when page = url -> false
+          | _ -> true in
+        let id = id_of_url url in
+        [ "url", Template.VarString url;
+          "label", Template.VarString label;
+          "is_linked", Template.VarConditional is_linked;
+          "id", Template.VarString id ]
+      ) rows in
 
     template#table "sitemenu" table;
   )
   else (* if we have no hostid *) (
     template#set "theme_css" "/_css/standard.css";
+    template#conditional "has_host_css" false;
+    template#conditional "has_ie6_fixes_css" false;
+    template#conditional "has_ie7_fixes_css" false;
     template#set "powered_by_name" (Cocanwiki_version.package ^ " " ^
                                    Cocanwiki_version.version);
     template#set "powered_by_url" "http://sandbox.merjis.com/";
@@ -196,6 +245,8 @@ let get_template ?page (dbh : Dbi.connection) hostid filename =
     template#set "brand_description" "";
     template#conditional "has_pagebug" false;
     template#set "pagebug" "";
+    template#conditional "ie_imagetoolbar_no" false;
+    template#conditional "noodp" false;
     template#conditional "is_homepage" false;
     template#table "sitemenu" [];
   );