(* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. * $Id: cocanwiki_emailnotify.ml,v 1.7 2006/03/27 16:43:44 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 open Registry open Cgi open Printf open ExtList open Cocanwiki (* This is where we coordinate email notification from various * scripts which create or update the wiki. *) let email_notify ~subject ~body ?user dbh hostid = (* Get own userid, if we have it. Don't want to send email * notification back to the person who changed the page. If * we don't have a userid, set it to 0, because no real user can * have userid = 0. * * Also get the user's email address. *) let own_userid, from = match user with | None | Some Anonymous -> 0l, None | Some (User (userid, _, _, prefs)) -> userid, prefs.email in (* Send a change email to everyone who hasn't opted out using * their preferences. This behaviour replaces the old * 'email_notify' table. Don't send email to invited accounts * who have not yet confirmed. *) let rows = PGSQL(dbh) "select name, email from users where hostid = $hostid and id <> $own_userid and email_notify and email is not null and invite is null" in let to_addr = List.filter_map ( function | (name, Some email) -> Some ("\"" ^ name ^ "\" <" ^ email ^ ">") | (name, None) -> None ) rows in if to_addr <> [] then ( (* Prepare the body of the message. The assumption is that * this takes time and database access, so we defer the creation * of the body until we know that someone needs to be notified. *) let body = body () in let subject = "Site notice: " ^ subject in (* Send the email. *) Sendmail.send_mail ~subject ~to_addr ?from body )