Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 3e9b98aab4
Fetching contributors…

Cannot retrieve contributors at this time

file 144 lines (127 sloc) 4.289 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
(* Copyright (C) 2009 Mauricio Fernandez <mfp@acm.org> *)
open ExtString
open ExtList

type comment = {
  c_id : string;
  c_author : string;
  c_date : float;
  c_url : string option;
  c_markup : Simple_markup.paragraph list;
}

type sort_criterion = [`Date]

module M = Map.Make(String)
module S = Set.Make(struct
                      type t = comment
                      let compare a b = compare a.c_id b.c_id
                    end)

type t = {
  basedir : string;
  mutable comments : S.t M.t;
  mutable last_read : float M.t;
  refresh_period : float;
}

let compare = function
    `Date -> (fun x y -> compare x.c_date y.c_date)

let (/^) = Filename.concat

let read_comment file =
  try
    let hs, body_ls = Node.split_headers_body (Std.input_file ~bin:true file) in
      Some {
        c_id = Filename.basename file;
        c_author = List.assoc "author" hs;
        c_date = Netdate.since_epoch (Netdate.parse (List.assoc "date" hs));
        c_url = (try Some (List.assoc "url" hs) with Not_found -> None);
        c_markup = Simple_markup.parse_lines body_ls;
      }
  with _ -> None

let write_comment c body io =
  IO.printf io "date: %s\nauthor: %s\n" (Netdate.mk_mail_date c.c_date) c.c_author;
  begin match c.c_url with
      None -> IO.printf io "\n"
    | Some url -> IO.printf io "url: %s\n\n" url
  end;
  IO.nwrite io body

let refresh_comments t page =
  print_endline ("refreshing comments for " ^ page);
  let list_comments dir =
    Catalog.dir_filter_map
      (fun f ->
         let fname = dir /^ f in
           match (Unix.stat fname).Unix.st_kind with
               Unix.S_REG -> Some fname
             | _ -> None)
      dir
  in
    try
      let comment_files = list_comments (t.basedir /^ page) in
      let comments = List.filter_map read_comment comment_files in
      let s = List.fold_left (fun s c -> S.add c s) S.empty comments in
        t.comments <- M.add page s t.comments;
        t.last_read <- M.add page (Unix.gettimeofday ()) t.last_read
    with _ -> ()


let make ?(refresh_period = 60.) dir =
  {
    basedir = dir; comments = M.empty;
    last_read = M.empty; refresh_period = refresh_period;
  }

let find_default default k m = try M.find k m with Not_found -> default

let get_comments t page =
  try
    let last_read = find_default 0. page t.last_read in
      if Unix.gettimeofday () > last_read +. t.refresh_period then
        refresh_comments t page;
      Some (S.elements (M.find page t.comments))
  with _ -> None

let is_directory path =
  try match (Unix.stat path).Unix.st_kind with
      Unix.S_DIR -> true
    | _ -> false
  with _ -> false

let rec mkdir_p ?(perms = 0o750) path =
  if path.[0] <> '/' then
    mkdir_p ~perms (String.concat "/" [Unix.getcwd(); path])
  else try
    (* common case first *)
    Unix.mkdir path perms
  with Unix.Unix_error _ ->
    if not (is_directory path) then begin
      let rec paths p l =
        if p = "/" then l else paths (Filename.dirname p) (p :: l)
      in
        List.iter
          (fun p ->
             try
               Unix.mkdir p perms
             with Unix.Unix_error _ as e ->
               if not (is_directory p) then raise e)
          (paths path [])
    end

let get_set_elm x s = S.choose (S.diff s (S.diff s (S.singleton x)))

let add_comment t page ~author ?url ?(date = Unix.gettimeofday ()) ~body () =
  let author = match String.strip author with
      "" -> "anonymous"
    | s -> (try fst (String.split s "\n") with _ -> s) in
  let basename =
    Digest.to_hex (Digest.string (String.concat "\n"
                                    [author; Option.default "" url; body])) in
  let page_comments = find_default S.empty page t.comments in
  let c =
    {
      c_id = basename;
      c_author = author;
      c_date = date;
      c_url = url;
      c_markup = Simple_markup.parse_text body;
    }
  in
    if S.mem c page_comments then
      get_set_elm c page_comments
    else
      let dir = t.basedir /^ page in
        mkdir_p dir;
        let fname = dir /^ basename in
        let io = IO.output_channel (open_out_bin fname) in
        let comments = M.add page (S.add c page_comments) t.comments in
          Std.finally (fun () -> IO.close_out io) (write_comment c body) io;
          t.comments <- comments;
          c
Something went wrong with that request. Please try again.