(* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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; *)