File Coverage

lib/Synapse/MailSender.pm
Criterion Covered Total %
statement 135 147 91.8
branch 31 42 73.8
condition 11 19 57.8
subroutine 24 26 92.3
pod 15 16 93.7
total 216 250 86.4


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Synapse::MailSender - email notification system
4              
5              
6             =head1 About Synapse's Open Telephony Toolkit
7              
8             L is a part of Synapse's Wholesale Open Telephony Toolkit.
9              
10             As we are refactoring our codebase, we at Synapse have decided to release a
11             substantial portion of our code under the GPL. We hope that as a developer, you
12             will find it as useful as we have found open source and CPAN to be of use to
13             us.
14              
15              
16             =head1 What is L all about
17              
18             Wether it's to send rate notifications, QOS alarms, rate import confirmation,
19             or credit limit warnings, doing wholesale telecom requires sending mail. Lots
20             of mail, in fact.
21              
22             The goal of this module is to provide a simple and easy to work with email
23             sending library as well as a templating library. It is based on L
24             to construct the mail and send it, and on L and
25             L to provide an XML email templating framework.
26              
27             This modules allows you to constructs emails which have:
28              
29             =over 4
30              
31             =item - an optional 'SetSender' attribute (set to 'From' by default)
32              
33             =item - a 'From' field
34              
35             =item - a 'To' field
36              
37             =item - one or more optional 'Cc' (carbon copy) fields
38              
39             =item - one or more optional 'Bcc' (blind carbon copy) fields
40              
41             =item - a subject field
42              
43             =item - One or more paragraphs, which will make up for the email contents, which
44             is ALWAYS pure text. This module is designed for boring and dull email
45             notifications.
46              
47             =item - One or more optional file attachments, since it is useful for doing
48             things like attaching PDF invoices, Excel spreadsheets with statistics, or cdr
49             files in .CSV format for instance.
50              
51             =back
52              
53             =head1 A simple example:
54              
55             Say you have template.xml:
56              
57            
58             From
59             To
60             Subject
61             Hello, World
62            
63              
64             And somedata.yaml
65              
66             ---
67             From: foo@bar.net
68             To: baz@buz.com
69             Subject: foo bar baz buz
70              
71             You can use the provided script synapse-mailsender and type in the following
72             command to have your email sent out:
73              
74             synapse-mailsender ./template.xml ./somedata.yaml
75              
76              
77             =head1 API
78              
79             =cut
80             package Synapse::MailSender;
81 1     1   28803 use MIME::Lite;
  1         45976  
  1         40  
82 1     1   875 use MIME::Type::FileName;
  1         5121  
  1         52  
83 1     1   915 use XML::Parser::REX;
  1         857  
  1         27  
84 1     1   864 use Petal::Tiny;
  1         6656  
  1         40  
85 1     1   840 use YAML::XS;
  1         3390  
  1         58  
86 1     1   791 use Synapse::Logger;
  1         486  
  1         49  
87 1     1   6 use warnings;
  1         2  
  1         23  
88 1     1   5 use strict;
  1         1  
  1         1532  
89              
90             our $VERSION = '1.4';
91              
92              
93             =head2 $class->new();
94              
95             Creates a new L object.
96              
97             =cut
98             sub new {
99 5     5 1 27088 my $class = shift;
100 5         18 my $self = bless { @_ }, $class;
101 5   50     52 $self->{Sendmail} ||= '/usr/sbin/sendmail';
102 5         15 return $self;
103             }
104              
105              
106             =head2 $self->Sendmail ('/usr/local/bin/mysendmail');
107              
108             Sets the sendmail command to use with MIME::Lite. By default, is set to
109             /usr/sbin/sendmail.
110              
111             =cut
112             sub Sendmail {
113 0     0 1 0 my $self = shift;
114 0         0 $self->{Sendmail} = shift;
115             }
116              
117              
118             =head2 $self->From ('from@example.com');
119              
120             Sets the 'From' field.
121              
122             =cut
123             sub From {
124 5     5 1 1642 my $self = shift;
125 5         23 $self->{From} = [ @_ ];
126             }
127              
128              
129             =head2 $self->To ('to@example.com');
130              
131             Sets the 'To' field.
132              
133             =cut
134             sub To {
135 5     5 1 1495 my $self = shift;
136 5         23 $self->{To} = [ @_ ];
137             }
138              
139              
140             =head2 $self->Cc ('cc@example.com');
141              
142             Adds a carbon copy recipient. Can be invoked multiple times to add more than
143             one carbon copy recipients.
144              
145             =cut
146             sub Cc {
147 5     5 1 1425 my $self = shift;
148 5   50     35 $self->{Cc} ||= [];
149 5         7 push @{$self->{Cc}}, @_;
  5         16  
150             }
151              
152              
153             =head2 $self->Bcc ('cc@example.com');
154              
155             Adds a 'blind carbon copy' recipient. Can be invoked multiple times to add more
156             than one blind carbon copy recipients.
157              
158             =cut
159             sub Bcc {
160 5     5 1 1671 my $self = shift;
161 5   50     35 $self->{Bcc} ||= [];
162 5         7 push @{$self->{Bcc}}, @_;
  5         22  
163             }
164              
165              
166             =head2 $self->Subject ('Your account is over limit');
167              
168             Sets the 'Subject' field.
169              
170             =cut
171             sub Subject {
172 5     5 1 1637 my $self = shift;
173 5         17 $self->{Subject} = shift;
174             }
175              
176              
177             =head2 $self->SetSender ('Your account is over limit');
178              
179             Sets the 'SetSender' field. If not set, the 'From' field will be used, which is
180             what you want most of the time anyways.
181              
182             =cut
183             sub SetSender {
184 5     5 1 1587 my $self = shift;
185 5         16 $self->{SetSender} = shift;
186             }
187              
188              
189             =head2 $self->Body ('Dear Customer');
190              
191             Adds a paragraph to the text body. i.e. you can call this method once per
192             paragraph.
193              
194             =cut
195             sub Body {
196 3     3 1 2117 my $self = shift;
197 3   100     19 $self->{Body} ||= [];
198 3         5 push @{$self->{Body}}, @_;
  3         12  
199             }
200              
201              
202             =head2 $self->Say ('Dear Customer');
203              
204             Alias for Body(), looks nicer in templates.
205              
206             =cut
207             sub Say {
208 39     39 1 3489 my $self = shift;
209 39   100     112 $self->{Body} ||= [];
210 39         39 push @{$self->{Body}}, @_;
  39         120  
211             }
212              
213              
214             =head2 $self->Para ('Dear Customer');
215              
216             Another alias for Body(), can't make up my mind right now...
217              
218             =cut
219             sub Para {
220 3     3 1 10348 my $self = shift;
221 3   50     13 $self->{Body} ||= [];
222 3         6 push @{$self->{Body}}, @_;
  3         10  
223             }
224              
225              
226             =head2 $self->Attach ('/path/to/file.xls');
227              
228             Attaches a file to the message.
229              
230             =cut
231             sub Attach {
232 15     15 1 1760 my $self = shift;
233 15   100     58 $self->{Attach} ||= [];
234 15         17 push @{$self->{Attach}}, @_;
  15         45  
235             }
236              
237              
238 40     40 0 83 sub None {}
239              
240              
241              
242             =head2 $self->loadxml ($path_to_xml_template, option1 => $option1, option2 => $option2, etc)
243              
244             Uses L to process $path_to_xml_template. Passes the following
245             arguments to the template:
246              
247             =over 4
248              
249             =item self : current L object
250              
251             =item anything else you pass to it, i.e. in this case 'option1' and 'option2'.
252              
253             =back
254              
255             Say your code looks like this:
256              
257             my $sMailSender = Synapse::MailSender->new();
258             $sMailSender->loadxml ( '/opt/templates/accountsuspended.xml',
259             user => $user,
260             accountDetailsFile => $user->accountFile() );
261             $sMailSender->send();
262              
263              
264             Your template itself may look roughly like this:
265              
266            
267             example@example.com
268             example@example.com
269             example@example.com
270             example@example.com
271             Your account is over limit
272             Dear Customer,
273            
274             Unfortunately, your account with a balance of 0.00
275             has reached its allowed limit.
276             Your services are being suspended for now. We kindly request that you post a payment with us
277             so that your account reaches its allowed credit limit.
278             Get in touch.
279             Cheers
280             Ourselves (example@example.com)
281             some-file.xls
282            
283              
284              
285             =head2 $self->loadxml ($path_to_xml_template, $yamlfile)
286              
287             Same as above, but passes a YAML file as options for template processing. The
288             Dumped YAML is passed as 'yaml' in the template. option1 => $option1, option2
289             => $option2, etc)
290              
291              
292             =head2 $self->loadxml ($xmldata, option1 => $option1, option2 => $option2, etc)
293              
294             Same as above, but instead of passing an XML Template name, the XML template
295             data is passed directly.
296              
297              
298             =head2 $self->loadxml ($xmldata, $yamlfile)
299              
300             Spame as above, but instead of passing an XML Template name, the XML template
301             data is passed directly.
302              
303             Plus, passes a YAML file as options for template processing. The Dumped YAML is
304             passed as 'yaml' in the template. option1 => $option1, option2 => $option2,
305             etc)
306              
307              
308             =cut
309             sub loadxml {
310 4     4 1 54 my $self = shift;
311 4         10 my $xml = shift;
312 4         39 my $tmpl = Petal::Tiny->new ($xml);
313 4 100       282 my $res = (@_ == 1) ? $tmpl->process (self => $self, yaml => _loadyaml (shift())) : $tmpl->process (self => $self, @_);
314 4         32328 $self->_loadxml($res);
315             }
316              
317              
318             sub _loadyaml {
319 2     2   5 my $yamlfile = shift @_;
320 2 50       67 open YAML, "<$yamlfile" or do {
321 0         0 logger ("cannot read open YAML file $yamlfile");
322 0         0 die "Cannot read open $yamlfile";
323             };
324 2         64 my $data = join '', ;
325 2         21 close YAML;
326 2         4 my $res = eval {
327 2         255 my ($yaml) = Load $data;
328 2         8 $yaml;
329             };
330 2 50       7 $@ and logger($@);
331 2         12 return $res;
332             }
333              
334              
335             sub _loadxml {
336 4     4   9 my $self = shift;
337 4         9 my $xmldata = shift;
338 4         8 eval {
339 4         26 my @tokens = XML::Parser::REX::ShallowParse ($xmldata);
340 4         958 my $method = 'None';
341 4         12 for (@tokens) {
342 264 100       508 /^\/i and do { $method = 'SetSender'; next };
  4         6  
  4         5  
343 260 100       490 /^\/i and do { $method = 'From'; next };
  4         6  
  4         10  
344 256 100       486 /^\/i and do { $method = 'To'; next };
  4         5  
  4         5  
345 252 100       478 /^\/i and do { $method = 'Cc'; next };
  4         7  
  4         5  
346 248 100       528 /^\/i and do { $method = 'Bcc'; next };
  4         7  
  4         7  
347 244 100       412 /^\/i and do { $method = 'Subject'; next };
  4         4  
  4         6  
348 240 50       418 /^\/i and do { $method = 'Body'; next };
  0         0  
  0         0  
349 240 100       435 /^\/i and do { $method = 'Say'; next };
  36         51  
  36         42  
350 204 50       400 /^\/i and do { $method = 'Para'; next };
  0         0  
  0         0  
351 204 100       343 /^\/i and do { $method = 'Attach'; next };
  12         18  
  12         16  
352 192 100       395 /^\
  80         97  
  80         114  
353 112         244 $self->$method($_);
354             }
355             };
356 4 50       37 $@ and logger($@);
357             }
358              
359              
360             =head2 $self->message();
361              
362             Once you have configured your L object with the methods
363             above, you can construct a L object by invoking $self->message();
364              
365             =cut
366             sub message {
367 5     5 1 77571 my $self = shift;
368            
369 5 50       33 my $from = ref $self->{From} ? join ', ', @{$self->{From}} : $self->{From};
  5         18  
370 5 50       27 my $to = ref $self->{To} ? join ', ', @{$self->{To}} : $self->{To};
  5         17  
371 5 50       22 my $cc = ref $self->{Cc} ? join ', ', @{$self->{Cc}} : $self->{Cc};
  5         16  
372 5 50       20 my $bcc = ref $self->{Bcc} ? join ', ', @{$self->{Bcc}} : $self->{Bcc};
  5         38  
373 5         15 my $subject = $self->{Subject};
374 5         9 my $body = join "\n\n", @{$self->{Body}};
  5         22  
375            
376             ### Create a new multipart message:
377 5         32 my %args = (
378             From => $from,
379             To => $to,
380             Subject => $subject,
381             Type => 'multipart/mixed'
382             );
383 5 50       108 $args{Cc} = $cc if ($cc);
384 5 50       19 $args{Bcc} = $bcc if ($bcc);
385            
386             ### Add parts (each "attach" has same arguments as "new"):
387 5         63 my $msg = MIME::Lite->new (%args);
388 5         86810 $msg->attach ( Type => 'TEXT', Data => $body );
389 5   50     1365 $self->{Attach} ||= [];
390 5         12 foreach my $file ( @{$self->{Attach}} ) {
  5         18  
391 15         3088 my $type = MIME::Type::FileName::guess ($file);
392 15         220 $msg->attach ( Type => $type,
393             Path => $file,
394             Disposition => 'attachment' );
395             }
396            
397             ### return final object
398 5         1479 return $msg;
399             }
400              
401              
402             =head2 $self->send();
403              
404             Once you have configured your L object with the methods
405             above, you can send the corresponding email message using this method.
406              
407             =cut
408             sub send {
409 0     0 1   my $self = shift;
410 0           my $msg = $self->message();
411 0           my $str = $msg->as_string; # somehow this seems to fix a bug where by sometimes the message is empty...
412 0   0       $msg->send_by_sendmail (
413             Sendmail => $self->{Sendmail},
414             SetSender => $self->{SetSender} || $self->{From}->[0],
415             );
416             }
417              
418              
419             1;
420              
421              
422             __END__