1/*  Author:        Fabrizio Rituzzi
    2    E-mail:        fabrizio.riguzzi@unife.it
    3    WWW:           http://mcs.unife.it/~friguzzi/
    4    Copyright (C): 2017, Fabrizio Riguzzi
    5
    6    All rights reserved.
    7
    8    Redistribution and use in source and binary forms, with or without
    9    modification, are permitted provided that the following conditions
   10    are met:
   11
   12    1. Redistributions of source code must retain the above copyright
   13       notice, this list of conditions and the following disclaimer.
   14
   15    2. Redistributions in binary form must reproduce the above copyright
   16       notice, this list of conditions and the following disclaimer in
   17       the documentation and/or other materials provided with the
   18       distribution.
   19
   20    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   21    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   22    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   23    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   24    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   25    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   26    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   27    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   28    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   29    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   30    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   31    POSSIBILITY OF SUCH DAMAGE.
   32*/
   33
   34:- module(mail_merge,
   35  [mail_merge/3]).   36  
   37:- use_module(library(smtp)).   38:- use_module(library(settings)).

Perform Mail Merge

This module provides a simple means to perform mail merge from a Prolog application: send personalized email message to a list of recipients. Here is a simple example:

mail_merge('Hello ~s how are you?',[['gianni@abc.com','Gianni'],
  ['stefi@cde.com','Stefi']],
  [subject('Hello'),from('Fabrizo'),auth(<google_user>-<google_password>)]).

*/

 mail_merge(+Message:atom_or_string, +Addresses:list, +Options:list) is det
Perform mail merge using SMTP. Message is a format string as in format/2, Addresses is a list of lists, each sublist is of the form =[To|Fields]= where To is the recipient of the message and Fields contain the values to replace placeholders in Message. Message and Fields are passed to format/2 to produce the message. Options are passed to smtp_send_mail/3 from package smtp, they are:

Defaults are provided by settings associated to this module. host, port, security and auth_method are set by default to the values needed by gmail. If you use your gmail account you should just provide the option auth(<google_user>-<google_password>) You should also make sure that your google account has the option "Allow less secure apps" set to on. You can find the option in your account page under Apps with account access.

   94mail_merge(Message,Addresses,Options):-
   95  maplist(send_mail(Message,Options),Addresses).
   96
   97send_mail(Message,Options,[To|Fields]):-
   98  smtp_send_mail(To,
   99    send_message(Message,Fields),
  100    Options).
  101
  102send_message(Message,Fields,Out) :-
  103    format(Out, Message,Fields).
  104
  105
  106:- set_setting_default(smtp:host,        'smtp.gmail.com').  107:- set_setting_default(smtp:port,        465).  108:- set_setting_default(smtp:security,    ssl).  109:- set_setting_default(smtp:auth_method, login).