+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: cocanwiki_mail.ml,v 1.1 2004/10/14 15:57:15 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 ExtString
+
+(*
+(* Rebuild mail threads for (year, month).
+ * The algorithm used is by JWZ - see:
+ * http://www.jwz.org/doc/threading.html
+ *)
+class ['a] container m =
+object (self)
+ val mutable message = (m : 'a option)
+ val mutable parent = (None : 'a container option)
+ val mutable children = ([] : 'a container list)
+
+ method message = message
+ method set_message m = message <- Some m
+
+ (* Don't call 'set_parent' explicitly. I wish I could understand the
+ * section in the manual on friend methods ...
+ *)
+ method parent = parent
+ method set_parent c = parent <- Some c
+ method set_no_parent () = parent <- None
+
+ method children = children
+ method add_child c =
+ assert (not (List.exists (fun child -> Oo.id child = Oo.id c) children));
+ children <- c :: children;
+ assert (c#parent = None);
+ c#set_parent self
+ method remove_child c =
+ match c#parent with
+ None
+ | Some parent when Oo.id parent <> Oo.id self
+ let n = List.length children in
+ children <- List.filter (fun child -> Oo.id child <> Oo.id c) children;
+ assert (List.length children = n-1)
+end
+
+let re_re = Pcre.regexp "^Re\\[\\d+\\]:\\s*"
+
+let thread_mail (dbh : Dbi.connection) hostid year month =
+ let title = "Mail/%04d/%02d/Thread Index" in
+
+ (* Pull out all the emails relevant to this month. *)
+ let sth =
+ dbh#prepare_cached "select id, subject, inet_message_id, message_date
+ from messages
+ where hostid = ?
+ and extract (year from message_date) = ?
+ and extract (month from message_date) = ?" in
+ sth#execute [`Int hostid; `Int year; `Int month];
+
+ let msgs =
+ sth#map
+ (function [`Int id; `String subject; `String inet_message_id;
+ `Timestamp message_date] ->
+ id, (inet_message_id, subject, message_date)
+ | _ -> assert false) in
+
+ let references =
+ if msgs <> [] then (
+ let sth =
+ let qs = Dbi.placeholders (List.length msgs) in
+ dbh#prepare_cached ("select message_id, inet_message_id, ordering
+ from messages
+ where message_id in " ^ qs ^ "
+ order by message_id, ordering") in
+ sth#execute (List.map (fun (id, _) -> `Int id) msgs);
+ sth#map (function [`Int id; `String inet_message_id; _] ->
+ id, inet_message_id
+ | _ -> assert false)
+ ) else [] in
+
+ (* Aggregate the msgs and references structures together.
+ * Note that references will be in the correct order (because of the
+ * 'order by' clause in the select statement above), with the parent
+ * message appearing first in the list.
+ *)
+ let msgs =
+ List.map (fun (id, (inet_message_id, subject, message_date)) ->
+ let references =
+ List.filter (fun (i, _) -> i = id) references in
+ let references = List.map snd references in
+ id, (inet_message_id, references, subject, message_date))
+ msgs in
+
+ (* Get the base subject lines (removing Re:, etc.). *)
+ let msgs =
+ List.map (fun (id, (inet_message_id, references, subject, message_date)) ->
+ let rec loop subject =
+ let n = String.length subject in
+ if String.starts_with subject "Re: " then
+ loop (String.sub subject 4 (n-4))
+ else if String.starts_with subject "Re:" then
+ loop (String.sub subject 3 (n-3))
+ else if String.starts_with subject "RE: " then
+ loop (String.sub subject 4 (n-4))
+ else if String.starts_with subject "RE:" then
+ loop (String.sub subject 3 (n-3))
+ else if Pcre.pmatch ~rex:re_re subject then (
+ let subs = Pcre.exec ~rex:re_re subject in
+ let i = String.length (Pcre.get_substring subs 0) in
+ loop (String.sub subject i (n-i))
+ ) else
+ subject
+ in
+ let base_subject = loop subject in
+ let is_reply = base_subject <> subject in
+ id, (inet_message_id, references,
+ subject, base_subject, is_reply, message_date)) msgs in
+
+ (*--- Step 1. ---*)
+ (* Hash of inet_message_id -> container. *)
+ let id_table = Hashtbl 1024 in
+ List.iter
+ (fun ((id, (inet_message_id, references, _, _, _, _)) as message) ->
+ let container =
+ try
+ let container = Hashtbl.find id_table inet_message_id in
+ if container#message = None then container#set_message message;
+ container
+ with
+ Not_found ->
+ let container = new container (Some message) in
+ Hashtbl.add id_table inet_message_id container;
+ container in
+
+ (* References. *)
+ let ref_containers =
+ List.map
+ (fun inet_message_id ->
+ try
+ Hashtbl.find id_table inet_message_id
+ with
+ Not_found ->
+ let container = new container None in
+ Hashtbl.add id_table inet_message_id container;
+ container) references in
+ (* Link the reference containers together. *)
+ iter_in_pairs
+ (fun child parent ->
+ if not (reachable parent child) && not (reachable child parent)
+ then (
+ if parent#child = None then parent#set_child = child;
+ if child#parent = None then child#set_parent = parent;
+ )) ref_containers;
+
+ (* Parent of this message is first element in references. *)
+ match ref_containers with
+ [] ->
+ let old_parent = container#parent in
+ container#set_no_parent ();
+ if old_parent <>
+ | parent :: _ when Oo.id parent <> my_parent_id ->
+ container#set_parent
+
+
+
+ ) msgs;
+*)