(* This file is part of gikia. * * gikia 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 3 of the License, or * (at your option) any later version. * * gikia 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 gikia. If not, see . * * Copyright 2010-2012 Alexander Markov *) open Lwt open Eliom_common open Eliom_service open Eliom_parameter open Eliom_registration open Eliom_duce open Eliom_duce.Xhtml open Xhtml_types_duce open ExtLib open Printf open Utils let head (links: ( {{ [Xhtml_types_duce.link*] }} ) ) title : Xhtml_types_duce.head = {{ [ [] [] !links (utf title)] }} let htmltext_page prefix (links:{{ [Xhtml_types_duce.link*] }}) title content = let head = head links title in let read p = catch (fun () -> Io.read p) (fun _ -> return "") in read (prefix ^/ "header.html") >>= fun header -> read (prefix ^/ "footer.html") >>= fun footer -> return (sprintf "<html xmlns=\"http://www.w3.org/1999/xhtml\">%s%s<body>%s%s</body></html>" (Duce_printer.string_of_xhtml head) header content footer) let duce_page prefix (links:{{ [Xhtml_types_duce.link*] }}) title (content: {{ Xhtml_types_duce.blocks }} ) = htmltext_page prefix links title (Duce_printer.string_of_xhtmls content) let cache_wrap get prefix _a = Cache.from get prefix _a let send = Html_text.send let cache_wrap_send get prefix _a = let last_modified _a = try let mtime = (Unix.stat _a).Unix.st_mtime in let c = CalendarLib.Calendar.from_unixfloat mtime in let rfc822 = Utils.rfc822_of_calendar c in let headers = Http_headers.empty in let add_modified h = Http_headers.add (Http_headers.name "Last-Modified") rfc822 h in Some (add_modified headers) with _ -> None in cache_wrap get prefix _a >>= fun page -> send ?headers:(last_modified _a) page