30
31:- module(mail_notify,
32 [ notify/2, 33 msg_user//1 34 ]). 35:- use_module(library(smtp)). 36:- use_module(library(debug)). 37:- use_module(library(error)). 38:- use_module(library(http/http_host)). 39:- use_module(library(http/http_dispatch)). 40:- use_module(library(http/http_wrapper)). 41:- use_module(library(pldoc/doc_html), [object_href/2]). 42:- use_module(object_support). 43:- use_module(openid). 44
45:- multifile
46 event_subject//1, 47 event_message//1.
69notify(Object, Term) :-
70 server(_), 71 notification_user(User),
72 catch(thread_send_message(
73 mail_notifier,
74 notification(Object, User, Term)),
75 error(existence_error(message_queue, _),_),
76 start_notifier(Object, User, Term)).
84notification_user(User) :-
85 site_user_logged_in(User), !.
86notification_user(Peer) :-
87 http_current_request(Request),
88 http_peer(Request, Peer), !.
89notification_user('<not from http>').
95start_notifier(Object, User, Term) :-
96 thread_create(mail_notifier, _,
97 [ alias(mail_notifier),
98 detached(true)
99 ]),
100 thread_send_message(
101 mail_notifier,
102 notification(Object, User, Term)).
103
104mail_notifier :-
105 set_output(user_output),
106 repeat,
107 thread_get_message(Msg),
108 catch(handle_message(Msg), E,
109 print_message(error, E)),
110 fail.
111
112handle_message(notification(Object, User, Term)) :- !,
113 do_notify(Object, User, Term).
114handle_message(Message) :-
115 domain_error(notification, Message).
116
117do_notify(Object, EventUser, Term) :-
118 ( watcher(Object, Watcher),
119 ( site_user_property(Watcher, email(Email))
120 -> User = Watcher
121 ; site_user_property(User, email(Watcher))
122 -> Email = Watcher
123 ; Email = Watcher,
124 User = unknown
125 ),
126 catch(notify(User, Email, Object, EventUser, Term),
127 E,
128 print_message(error, E)),
129 fail
130 ; true
131 ).
132
133notify(User, Email, Object, EventUser, Term) :-
134 phrase(make_subject(Object, Term), SubjectList),
135 phrase(make_message(User, Object, EventUser, Term), Message),
136 with_output_to(atom(Subject),
137 send_message(SubjectList, current_output)),
138 debug(notify, 'Sending mail to ~w about ~w', [Email, Object]),
139 smtp_send_mail(Email,
140 send_message(Message),
141 [ subject(Subject),
142 from('noreply@swi-prolog.org')
143 ]), !.
150send_message([], _) :- !.
151send_message([H|T], Out) :- !,
152 send_one(H, Out),
153 send_message(T, Out).
154
155send_one(Fmt-Args, Out) :- !,
156 format(Out, Fmt, Args).
157send_one(nl, Out) :- !,
158 format(Out, '~n', []).
159send_one(X, _Out) :- !,
160 domain_error(mail_message_fragment, X).
167make_subject(Object, Event) -->
168 { object_label(Object, Label) },
169 [ '[SWIPL] ~w: '-[Label] ],
170 ( event_subject(Event)
171 -> []
172 ; ['<unknown event>'-[]]
173 ).
180make_message(UUID, Object, User, Event) -->
181 opening(UUID),
182 on_object(Object),
183 by_user(User),
184 [nl],
185 ( event_message(Event)
186 -> []
187 ; ['Unknown notication event: ~q'-[Event] ]
188 ),
189 closing(UUID, Object).
190
191opening(UUID) -->
192 { site_user_property(UUID, name(Name)) }, !,
193 [ 'Dear ~w,'-[Name], nl, nl ].
194opening(_) -->
195 [ 'Hi'-[], nl, nl ].
196
197on_object(Object) -->
198 { object_label(Object, Label),
199 object_href(Object, HREF),
200 server(Server)
201 },
202 [ 'This is a change notification for ~w'-[Label], nl,
203 'URL: ~w~w'-[Server, HREF], nl
204 ].
205
206by_user(UUID) -->
207 [ 'Event generated by '-[] ],
208 msg_user(UUID), !,
209 [nl].
210by_user(_) -->
211 [].
212
213closing(UUID, _Object) -->
214 { site_user_property(UUID, _) }, !,
215 [ nl, nl,
216 'You received this message because you have indicated to '-[], nl,
217 'watch this page on the SWI-Prolog website.'-[], nl,
218 'User details: '-[]
219 ],
220 msg_user(UUID).
221closing(_, _) --> [].
230:- dynamic
231 server_cache/1. 232
233server(Server) :-
234 server_cache(Server), !.
235server(Server) :-
236 ignore(http_current_request(Request)),
237 http_current_host(Request, Host, Port, [global(true)]),
238 ( Port == 80
239 -> format(atom(Server), 'http://~w', [Host])
240 ; Port == 443
241 -> format(atom(Server), 'https://~w', [Host])
242 ; format(atom(Server), 'http://~w:~w', [Host, Port])
243 ).
250msg_user(UUID) -->
251 { site_user_property(UUID, name(Name)),
252 http_link_to_id(view_profile, [user(UUID)], HREF),
253 server(Server)
254 },
255 [ '~w <~w~w>'-[Name, Server, HREF] ].
256
257
258
270watcher(_, 'jan@swi-prolog.org')
Send notications by E-mail
This module sends E-mail notifications to watchers for events that take place on watched objects. The messages themselves are generated similar to print_message/2 using the grammars