X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=scripts%2Flib%2Fcocanwiki_emailnotify.ml;h=c63b846af2b133054092e28caf56f5b8e6f72102;hb=d303f75eed3a09bbe2516d9a2a9a4aa9b862ceb3;hp=07e759722b51d017a16a109fddaf4c4c8813f83d;hpb=529b55fe61e017417faae092fe221bbd41368aa5;p=cocanwiki.git diff --git a/scripts/lib/cocanwiki_emailnotify.ml b/scripts/lib/cocanwiki_emailnotify.ml index 07e7597..c63b846 100644 --- a/scripts/lib/cocanwiki_emailnotify.ml +++ b/scripts/lib/cocanwiki_emailnotify.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: cocanwiki_emailnotify.ml,v 1.3 2004/10/23 15:00:16 rich Exp $ + * $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 @@ -24,55 +24,45 @@ 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 : Dbi.connection) hostid = +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 = + let own_userid, from = match user with | None - | Some Anonymous -> 0 - | Some (User (userid, _, _)) -> userid in + | 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 sth = dbh#prepare_cached "select email, name from users - where hostid = ? and id <> ? and email_notify - and email is not null - and invite is null" in - sth#execute [`Int hostid; `Int own_userid]; - - let to_addr = sth#map (function - | [`String email; `String name] -> - "\"" ^ name ^ "\" <" ^ email ^ ">" - | _ -> assert false) in + 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 ( - (* Get the from address of the user, if available. *) - let from = - match user with - | None - | Some Anonymous -> None - | Some (User (userid, _, _)) -> - let sth = dbh#prepare_cached "select email from users - where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int userid]; - - match sth#fetch1 () with - | [ `Null ] -> None - | [ `String email ] -> Some email - | _ -> assert false in - (* 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. @@ -82,5 +72,5 @@ let email_notify ~subject ~body ?user (dbh : Dbi.connection) hostid = let subject = "Site notice: " ^ subject in (* Send the email. *) - Sendmail.send_mail ~subject ~to_addr ~body ?from () + Sendmail.send_mail ~subject ~to_addr ?from body )