X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=scripts%2Fpagestyle.ml;h=f6b7f4640b97107a5fc00a1d65af2cdc46bf9fe3;hb=cd059731a60fd3d4dcf426430ad26ff227b91910;hp=94a5d8179b1566fdc8ec04a54c4e1d9fd042a3f7;hpb=3062d573a7617339324c23cdd4755f8f04956b92;p=cocanwiki.git diff --git a/scripts/pagestyle.ml b/scripts/pagestyle.ml index 94a5d81..f6b7f46 100644 --- a/scripts/pagestyle.ml +++ b/scripts/pagestyle.ml @@ -1,7 +1,22 @@ -(* COCANWIKI scripts. +(* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: pagestyle.ml,v 1.1 2004/09/07 10:14:09 rich Exp $ + * $Id: pagestyle.ml,v 1.8 2006/03/28 16:24:08 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 @@ -11,41 +26,38 @@ open Printf open Cocanwiki -let run r (q : cgi) (dbh : Dbi.connection) (hostid, _) _ = +let run r (q : cgi) dbh hostid _ _ = let page = q#param "page" in let version = - try Some (int_of_string (q#param "version")) with Not_found -> None in + try Some (Int32.of_string (q#param "version")) with Not_found -> None in (* Get the CSS. *) - let sth = - match version with - None -> - let sth = dbh#prepare_cached - "select css from pages where hostid = ? and url = ?" in - sth#execute [`Int hostid; `String page]; - sth - | Some version -> - let sth = dbh#prepare_cached - "select css from pages - where hostid = ? and id = ? and - (url = ? or url_deleted = ?)" in - sth#execute [`Int hostid; `Int version; `String page; `String page]; - sth in let css = - match sth#fetch1 () with - [ `Null ] -> "" - | [ `String css ] -> css - | _ -> assert false in + match version with + | None -> + List.hd ( + PGSQL(dbh) + "select css from pages where hostid = $hostid and url = $page" + ) + | Some version -> + List.hd ( + PGSQL(dbh) + "select css from pages + where hostid = $hostid and id = $version and + (url = $page or url_deleted = $page)" + ) in + + let css = match css with None -> "" | Some css -> css in (* It's crucial, for speed of page delivery and rendering, to have * an expires header for CSS. Even though this means that occasionally * people will need to hit [Shift]+Reload, I'm going to set a * medium-length expiry time on this resource. *) - Table.set (Request.headers_out r) "Expires" (Cgi_expires.expires_medium ()); + Table.set (Request.headers_out r) "Expires" (Expires.medium ()); q#header ~content_type:"text/css" (); - print_string r css + ignore (print_string r css) let () = register_script run