add config to display note at top, RT#84990
[freeside.git] / FS / FS / msg_template / email.pm
1 package FS::msg_template::email;
2 use base qw( FS::msg_template );
3
4 use strict;
5 use vars qw( $DEBUG $conf );
6
7 # stuff needed for template generation
8 use Date::Format qw( time2str );
9 use File::Temp;
10 use IPC::Run qw(run);
11 use Text::Template;
12
13 use HTML::Entities qw( decode_entities encode_entities ) ;
14 use HTML::FormatText;
15 use HTML::TreeBuilder;
16 use Encode;
17
18 # needed to send email
19 use FS::Misc qw( generate_email );
20 use FS::Conf;
21 use Email::Sender::Simple qw( sendmail );
22
23 use FS::Record qw( qsearch qsearchs );
24
25 # needed to manage template_content objects
26 use FS::template_content;
27 use FS::UID qw( dbh );
28
29 # needed to manage prepared messages
30 use FS::cust_msg;
31
32 FS::UID->install_callback( sub { $conf = new FS::Conf; } );
33
34 our $DEBUG = 0;
35 our $me = '[FS::msg_template::email]';
36
37 =head1 NAME
38
39 FS::msg_template::email - Construct email notices with Text::Template.
40
41 =head1 DESCRIPTION
42
43 FS::msg_template::email is a message processor in which the template contains 
44 L<Text::Template> strings for the message subject line and body, and the 
45 message is delivered by email.
46
47 Currently the C<from_addr> and C<bcc_addr> fields used by this processor are
48 in the main msg_template table.
49
50 =head1 METHODS
51
52 =over 4
53
54 =item insert [ CONTENT ]
55
56 Adds this record to the database.  If there is an error, returns the error,
57 otherwise returns false.
58
59 A default (no locale) L<FS::template_content> object will be created.  CONTENT 
60 is an optional hash containing 'subject' and 'body' for this object.
61
62 =cut
63
64 sub insert {
65   my $self = shift;
66   my %content = @_;
67
68   my $oldAutoCommit = $FS::UID::AutoCommit;
69   local $FS::UID::AutoCommit = 0;
70   my $dbh = dbh;
71
72   my $error = $self->SUPER::insert;
73   if ( !$error ) {
74     $content{'msgnum'} = $self->msgnum;
75     $content{'subject'} ||= '';
76     $content{'body'} ||= '';
77     my $template_content = new FS::template_content (\%content);
78     $error = $template_content->insert;
79   }
80
81   if ( $error ) {
82     $dbh->rollback if $oldAutoCommit;
83     return $error;
84   }
85
86   $dbh->commit if $oldAutoCommit;
87   return;
88 }
89
90 =item replace [ OLD_RECORD ] [ CONTENT ]
91
92 Replaces the OLD_RECORD with this one in the database.  If there is an error,
93 returns the error, otherwise returns false.
94
95 CONTENT is an optional hash containing 'subject', 'body', and 'locale'.  If 
96 supplied, an L<FS::template_content> object will be created (or modified, if 
97 one already exists for this locale).
98
99 =cut
100
101 sub replace {
102   my $self = shift;
103   my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') ) 
104               ? shift
105               : $self->replace_old;
106   my %content = @_;
107   
108   my $oldAutoCommit = $FS::UID::AutoCommit;
109   local $FS::UID::AutoCommit = 0;
110   my $dbh = dbh;
111
112   my $error = $self->SUPER::replace($old);
113
114   if ( !$error and %content ) {
115     $content{'locale'} ||= '';
116     my $new_content = qsearchs('template_content', {
117                         'msgnum' => $self->msgnum,
118                         'locale' => $content{'locale'},
119                       } );
120     if ( $new_content ) {
121       $new_content->subject($content{'subject'});
122       $new_content->body($content{'body'});
123       $error = $new_content->replace;
124     }
125     else {
126       $content{'msgnum'} = $self->msgnum;
127       $new_content = new FS::template_content \%content;
128       $error = $new_content->insert;
129     }
130   }
131
132   if ( $error ) {
133     $dbh->rollback if $oldAutoCommit;
134     return $error;
135   }
136
137   warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit;
138   $dbh->commit if $oldAutoCommit;
139   return;
140 }
141
142 =item content_locales
143
144 Returns a hashref of the L<FS::template_content> objects attached to 
145 this template, with the locale as key.
146
147 =cut
148
149 sub content_locales {
150   my $self = shift;
151   return $self->{'_content_locales'} ||= +{
152     map { $_->locale , $_ } 
153     qsearch('template_content', { 'msgnum' => $self->msgnum })
154   };
155 }
156
157 =item prepare OPTION => VALUE
158
159 Fills in the template and returns an L<FS::cust_msg> object.
160
161 Options are passed as a list of name/value pairs:
162
163 =over 4
164
165 =item cust_main
166
167 Customer object
168
169 =item object
170
171 Additional context object (currently, can be a cust_main, cust_pkg, 
172 cust_bill, cust_pay, cust_pay_pending, or svc_(acct, phone, broadband, 
173 domain) ).  If the object is a svc_*, its cust_pkg will be fetched and 
174 used for substitution.
175
176 As a special case, this may be an arrayref of two objects.  Both 
177 objects will be available for substitution, with their field names 
178 prefixed with 'new_' and 'old_' respectively.  This is used in the 
179 rt_ticket export when exporting "replace" events.
180
181 =item from_config
182
183 Configuration option to use as the source address, based on the customer's 
184 agentnum.  If unspecified (or the named option is empty), 'invoice_from' 
185 will be used.
186
187 The I<from_addr> field in the template takes precedence over this.
188
189 =item to
190
191 Destination address.  The default is to use the customer's 
192 invoicing_list addresses.  Multiple addresses may be comma-separated.
193
194 =item substitutions
195
196 A hash reference of additional substitutions
197
198 =item msgtype
199
200 A string identifying the kind of message this is. Currently can be "invoice", 
201 "receipt", "admin", or null. Expand this list as necessary.
202
203 =item override_content
204
205 A string to use as the HTML body; if specified, replaces the entire
206 body of the message. This should be used ONLY by L<FS::report_batch> and may
207 go away in the future.
208
209 =item attach
210
211 A L<MIME::Entity> (or arrayref of them) to attach to the message.
212
213 =item to_contact_classnum
214
215 Set a string containing a comma-separated list.  This list may contain:
216
217 - the text "invoice" indicating contacts with invoice_dest flag should
218   be included
219 - the text "message" indicating contacts with message_dest flag should
220   be included
221 - numbers representing classnum id values for email contact classes.
222   If any classnum are present, emails should only be sent to contact_email
223   addresses where contact_email.classnum contains one of these classes.
224   The classnum 0 also includes where contact_email.classnum IS NULL
225
226 If neither 'invoice' nor 'message' has been specified, this method will
227 behave as if 'invoice' had been selected
228
229 =cut
230
231 =back
232
233 =cut
234
235 sub prepare {
236
237   my( $self, %opt ) = @_;
238
239   my $cust_main = $opt{'cust_main'}; # or die 'cust_main required';
240   my $object = $opt{'object'}; # or die 'object required';
241
242   my $hashref = $self->prepare_substitutions(%opt);
243
244   # localization
245   my $locale = $cust_main && $cust_main->locale || '';
246   warn "no locale for cust#".$cust_main->custnum."; using default content\n"
247     if $DEBUG and $cust_main && !$locale;
248   my $content = $self->content($locale);
249
250   warn "preparing template '".$self->msgname."\n"
251     if $DEBUG;
252
253   $_ = encode_entities($_ || '') foreach values(%$hashref);
254
255   ###
256   # clean up template
257   ###
258   my $subject_tmpl = new Text::Template (
259     TYPE   => 'STRING',
260     SOURCE => $content->subject,
261   );
262
263   warn "$me filling in subject template\n" if $DEBUG;
264   my $subject = $subject_tmpl->fill_in( HASH => $hashref );
265
266   my $body = $content->body;
267   my ($skin, $guts) = eviscerate($body);
268   @$guts = map { 
269     $_ = decode_entities($_); # turn all punctuation back into itself
270     s/\r//gs;           # remove \r's
271     s/<br[^>]*>/\n/gsi; # and <br /> tags
272     s/<p>/\n/gsi;       # and <p>
273     s/<\/p>//gsi;       # and </p>
274     s/\240/ /gs;        # and &nbsp;
275     $_
276   } @$guts;
277   
278   $body = '{ use Date::Format qw(time2str); "" }';
279   while(@$skin || @$guts) {
280     $body .= shift(@$skin) || '';
281     $body .= shift(@$guts) || '';
282   }
283
284   ###
285   # fill-in
286   ###
287
288   my $body_tmpl = new Text::Template (
289     TYPE          => 'STRING',
290     SOURCE        => $body,
291   );
292   
293   warn "$me filling in body template\n" if $DEBUG;
294   $body = $body_tmpl->fill_in( HASH => $hashref );
295
296   # override $body if requested
297   if ( $opt{'override_content'} ) {
298     warn "$me overriding template body with requested content" if $DEBUG;
299     $body = $opt{'override_content'};
300   }
301
302   ###
303   # and email
304   ###
305
306   my @to;
307   if ( exists($opt{'to'}) ) {
308
309     @to = map { $_->format } Email::Address->parse($opt{'to'});
310
311   } elsif ( $cust_main ) {
312
313     my $classnum = $opt{'to_contact_classnum'} || '';
314     my @classes = ref($classnum) ? @$classnum : split(',', $classnum);
315
316     # There are two e-mail opt-in flags per contact_email address.
317     # If neither 'invoice' nor 'message' has been specified, default
318     # to 'invoice'.
319     #
320     # This default supports the legacy behavior of
321     #    send to all invoice recipients
322     push @classes,'invoice'
323       unless grep {$_ eq 'invoice' || $_ eq 'message'} @classes;
324
325     @to = $cust_main->contact_list_email(@classes);
326     # not guaranteed to produce contacts, but then customers aren't
327     # guaranteed to have email addresses on file. in that case, env_to
328     # will be null and sending this message will fail.
329
330   } else {
331     die 'no To: address or cust_main object specified';
332   }
333
334   my $from_addr = $self->from_addr;
335
336   if ( !$from_addr ) {
337
338     my $agentnum = $cust_main ? $cust_main->agentnum : '';
339
340     if ( $opt{'from_config'} ) {
341       $from_addr = $conf->config($opt{'from_config'}, $agentnum);
342     }
343     $from_addr ||= $conf->invoice_from_full($agentnum);
344   }
345
346   my $text_body = encode('UTF-8',
347                   HTML::FormatText->new(leftmargin => 0, rightmargin => 70)
348                       ->format( HTML::TreeBuilder->new_from_content($body) )
349                   );
350
351   warn "$me constructing MIME entities\n" if $DEBUG;
352   my %email = generate_email(
353     'from'      => $from_addr,
354     'to'        => \@to,
355     'bcc'       => $self->bcc_addr || undef,
356     'subject'   => $subject,
357     'html_body' => $body,
358     'text_body' => $text_body,
359   );
360
361   warn "$me creating message headers\n" if $DEBUG;
362   # strip display-name from envelope addresses
363   # (use Email::Address for this? it chokes on non-ASCII characters in
364   # the display-name, which is not great for us)
365   my $env_from = $from_addr;
366   foreach ($env_from, @to) {
367     s/^\s*//;
368     s/\s*$//;
369     s/^(.*)\s*<(.*@.*)>$/$2/;
370   }
371
372   my $domain;
373   if ( $env_from =~ /\@([\w\.\-]+)/ ) {
374     $domain = $1;
375   } else {
376     warn 'no domain found in invoice from address '. $env_from .
377          '; constructing Message-ID (and saying HELO) @example.com'; 
378     $domain = 'example.com';
379   } 
380   my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
381
382   my $time = time;
383   my $message = MIME::Entity->build(
384     'From'        => $from_addr,
385     'To'          => join(', ', @to),
386     'Sender'      => $from_addr,
387     'Reply-To'    => $from_addr,
388     'Date'        => time2str("%a, %d %b %Y %X %z", $time),
389     'Subject'     => Encode::encode('MIME-Header', $subject),
390     'Message-ID'  => "<$message_id>",
391     'Encoding'    => '7bit',
392     'Type'        => 'multipart/related',
393   );
394
395   if ( $opt{'attach'} ) {
396     my @attach;
397     if (ref $opt{'attach'} eq 'ARRAY') {
398       @attach = @{ $opt{'attach'} };
399     } else {
400       @attach = $opt{'attach'};
401     }
402     foreach (@attach) {
403       $message->add_part($_);
404     }
405   }
406
407   #$message->head->replace('Content-type',
408   #  'multipart/related; '.
409   #  'boundary="' . $message->head->multipart_boundary . '"; ' .
410   #  'type=multipart/alternative'
411   #);
412
413   foreach my $part (@{ $email{mimeparts} }) {
414     warn "$me appending part ".$part->mime_type."\n" if $DEBUG;
415     $message->add_part( $part );
416   }
417
418   # effective To: address (not in headers)
419   push @to, $self->bcc_addr if $self->bcc_addr;
420   my @env_to;
421   foreach my $dest (@to) {
422     push @env_to, map { $_->address } Email::Address->parse($dest);
423   }
424
425   my $cust_msg = FS::cust_msg->new({
426       'custnum'   => $cust_main ? $cust_main->custnum : '',
427       'msgnum'    => $self->msgnum,
428       '_date'     => $time,
429       'env_from'  => $env_from,
430       'env_to'    => join(',', @env_to),
431       'header'    => $message->header_as_string,
432       'body'      => $message->body_as_string,
433       'error'     => '',
434       'status'    => 'prepared',
435       'msgtype'   => ($opt{'msgtype'} || ''),
436       'preview'   => $body, # html content only
437   });
438
439   return $cust_msg;
440 }
441
442 =item render OPTION => VALUE ...
443
444 Fills in the template and renders it to a PDF document.  Returns the 
445 name of the PDF file.
446
447 Options are as for 'prepare', but 'from' and 'to' are meaningless.
448
449 =cut
450
451 # will also have options to set paper size, margins, etc.
452
453 sub render {
454   my $self = shift;
455   eval "use PDF::WebKit";
456   die $@ if $@;
457   my %opt = @_;
458   my %hash = $self->prepare(%opt);
459   my $html = $hash{'html_body'};
460
461   # Graphics/stylesheets should probably go in /var/www on the Freeside 
462   # machine.
463   my $script_path = `/usr/bin/which freeside-wkhtmltopdf`;
464   chomp $script_path;
465   my $kit = PDF::WebKit->new(\$html); #%options
466   # hack to use our wrapper script
467   $kit->configure(sub { shift->wkhtmltopdf($script_path) });
468
469   $kit->to_pdf;
470 }
471
472 =item print OPTIONS
473
474 Render a PDF and send it to the printer.  OPTIONS are as for 'render'.
475
476 =cut
477
478 sub print {
479   my( $self, %opt ) = @_;
480   do_print( [ $self->render(%opt) ], agentnum=>$opt{cust_main}->agentnum );
481 }
482
483 # helper sub for package dates
484 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
485
486 # helper sub for money amounts
487 my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) };
488
489 # helper sub for usage-related messages
490 my $usage_warning = sub {
491   my $svc = shift;
492   foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
493     my $amount = $svc->$col; next if $amount eq '';
494     my $method = $col.'_threshold';
495     my $threshold = $svc->$method; next if $threshold eq '';
496     return [$col, $amount, $threshold] if $amount <= $threshold;
497     # this only returns the first one that's below threshold, if there are 
498     # several.
499   }
500   return ['', '', ''];
501 };
502
503 =item content LOCALE
504
505 Returns the L<FS::template_content> object appropriate to LOCALE, if there 
506 is one.  If not, returns the one with a NULL locale.
507
508 =cut
509
510 sub content {
511   my $self = shift;
512   my $locale = shift;
513   qsearchs('template_content', 
514             { 'msgnum' => $self->msgnum, 'locale' => $locale }) || 
515   qsearchs('template_content',
516             { 'msgnum' => $self->msgnum, 'locale' => '' });
517 }
518
519 =cut
520
521 =item send_prepared CUST_MSG
522
523 Takes the CUST_MSG object and sends it to its recipient. The "smtpmachine"
524 configuration option will be used to find the outgoing mail server.
525
526 =cut
527
528 sub send_prepared {
529   my $self = shift;
530   my $cust_msg = shift or die "cust_msg required";
531
532   if ( $FS::Misc::DISABLE_ALL_NOTICES ) {
533     warn 'send_prepared() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG;
534     return;
535   }
536
537   my $domain = 'example.com';
538   if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) {
539     $domain = $1;
540   }
541
542   # in principle should already be a list of bare addresses, but run it
543   # through Email::Address to make sure
544   my @env_to = map { $_->address } Email::Address->parse($cust_msg->env_to);
545
546   my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
547                    'helo' => $domain );
548
549   my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
550   $smtp_opt{'port'} = $port;
551   
552   my $transport;
553   if ( defined($enc) && $enc eq 'starttls' ) {
554     $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
555     $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
556   } else {
557     if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
558       $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);     
559     } 
560     $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
561     $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
562   }
563
564   warn "$me sending message\n" if $DEBUG;
565   my $message = join("\n", $cust_msg->header, $cust_msg->body);
566   local $@;
567   eval {
568     sendmail( $message, { transport => $transport,
569                           from      => $cust_msg->env_from,
570                           to        => \@env_to })
571   };
572   my $error = '';
573   if(ref($@) and $@->isa('Email::Sender::Failure')) {
574     $error = $@->code.' ' if $@->code;
575     $error .= $@->message;
576   }
577   else {
578     $error = $@;
579   }
580
581   $cust_msg->set('error', $error);
582   $cust_msg->set('status', $error ? 'failed' : 'sent');
583   if ( $cust_msg->custmsgnum ) {
584     $cust_msg->replace;
585   } else {
586     $cust_msg->insert;
587   }
588
589   $error;
590 }
591
592 =back
593
594 =cut
595
596 # internal use only
597
598 sub eviscerate {
599   # Every bit as pleasant as it sounds.
600   #
601   # We do this because Text::Template::Preprocess doesn't
602   # actually work.  It runs the entire template through 
603   # the preprocessor, instead of the code segments.  Which 
604   # is a shame, because Text::Template already contains
605   # the code to do this operation.
606   my $body = shift;
607   my (@outside, @inside);
608   my $depth = 0;
609   my $chunk = '';
610   while($body || $chunk) {
611     my ($first, $delim, $rest);
612     # put all leading non-delimiters into $first
613     ($first, $rest) =
614         ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
615     $chunk .= $first;
616     # put a leading delimiter into $delim if there is one
617     ($delim, $rest) =
618       ($rest =~ /^([{}]?)(.*)$/s);
619
620     if( $delim eq '{' ) {
621       $chunk .= '{';
622       if( $depth == 0 ) {
623         push @outside, $chunk;
624         $chunk = '';
625       }
626       $depth++;
627     }
628     elsif( $delim eq '}' ) {
629       $depth--;
630       if( $depth == 0 ) {
631         push @inside, $chunk;
632         $chunk = '';
633       }
634       $chunk .= '}';
635     }
636     else {
637       # no more delimiters
638       if( $depth == 0 ) {
639         push @outside, $chunk . $rest;
640       } # else ? something wrong
641       last;
642     }
643     $body = $rest;
644   }
645   (\@outside, \@inside);
646 }
647
648 =head1 BUGS
649
650 =head1 SEE ALSO
651
652 L<FS::Record>, schema.html from the base documentation.
653
654 =cut
655
656 1;