1 package FS::msg_template::email;
2 use base qw( FS::msg_template );
5 use vars qw( $DEBUG $conf );
7 # stuff needed for template generation
8 use Date::Format qw( time2str );
13 use HTML::Entities qw( decode_entities encode_entities ) ;
15 use HTML::TreeBuilder;
18 # needed to send email
19 use FS::Misc qw( generate_email );
21 use Email::Sender::Simple qw( sendmail );
23 use FS::Record qw( qsearch qsearchs );
25 # needed to manage template_content objects
26 use FS::template_content;
27 use FS::UID qw( dbh );
29 # needed to manage prepared messages
32 FS::UID->install_callback( sub { $conf = new FS::Conf; } );
35 our $me = '[FS::msg_template::email]';
39 FS::msg_template::email - Construct email notices with Text::Template.
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.
47 Currently the C<from_addr> and C<bcc_addr> fields used by this processor are
48 in the main msg_template table.
54 =item insert [ CONTENT ]
56 Adds this record to the database. If there is an error, returns the error,
57 otherwise returns false.
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.
68 my $oldAutoCommit = $FS::UID::AutoCommit;
69 local $FS::UID::AutoCommit = 0;
72 my $error = $self->SUPER::insert;
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;
82 $dbh->rollback if $oldAutoCommit;
86 $dbh->commit if $oldAutoCommit;
90 =item replace [ OLD_RECORD ] [ CONTENT ]
92 Replaces the OLD_RECORD with this one in the database. If there is an error,
93 returns the error, otherwise returns false.
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).
103 my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') )
105 : $self->replace_old;
108 my $oldAutoCommit = $FS::UID::AutoCommit;
109 local $FS::UID::AutoCommit = 0;
112 my $error = $self->SUPER::replace($old);
114 if ( !$error and %content ) {
115 $content{'locale'} ||= '';
116 my $new_content = qsearchs('template_content', {
117 'msgnum' => $self->msgnum,
118 'locale' => $content{'locale'},
120 if ( $new_content ) {
121 $new_content->subject($content{'subject'});
122 $new_content->body($content{'body'});
123 $error = $new_content->replace;
126 $content{'msgnum'} = $self->msgnum;
127 $new_content = new FS::template_content \%content;
128 $error = $new_content->insert;
133 $dbh->rollback if $oldAutoCommit;
137 warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit;
138 $dbh->commit if $oldAutoCommit;
142 =item content_locales
144 Returns a hashref of the L<FS::template_content> objects attached to
145 this template, with the locale as key.
149 sub content_locales {
151 return $self->{'_content_locales'} ||= +{
152 map { $_->locale , $_ }
153 qsearch('template_content', { 'msgnum' => $self->msgnum })
157 =item prepare OPTION => VALUE
159 Fills in the template and returns an L<FS::cust_msg> object.
161 Options are passed as a list of name/value pairs:
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.
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.
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'
187 The I<from_addr> field in the template takes precedence over this.
191 Destination address. The default is to use the customer's
192 invoicing_list addresses. Multiple addresses may be comma-separated.
196 A hash reference of additional substitutions
200 A string identifying the kind of message this is. Currently can be "invoice",
201 "receipt", "admin", or null. Expand this list as necessary.
203 =item override_content
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.
211 A L<MIME::Entity> (or arrayref of them) to attach to the message.
213 =item to_contact_classnum
215 Set a string containing a comma-separated list. This list may contain:
217 - the text "invoice" indicating contacts with invoice_dest flag should
219 - the text "message" indicating contacts with message_dest flag should
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
226 If neither 'invoice' nor 'message' has been specified, this method will
227 behave as if 'invoice' had been selected
237 my( $self, %opt ) = @_;
239 my $cust_main = $opt{'cust_main'}; # or die 'cust_main required';
240 my $object = $opt{'object'}; # or die 'object required';
242 my $hashref = $self->prepare_substitutions(%opt);
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);
250 warn "preparing template '".$self->msgname."\n"
253 $_ = encode_entities($_ || '') foreach values(%$hashref);
258 my $subject_tmpl = new Text::Template (
260 SOURCE => $content->subject,
263 warn "$me filling in subject template\n" if $DEBUG;
264 my $subject = $subject_tmpl->fill_in( HASH => $hashref );
266 my $body = $content->body;
267 my ($skin, $guts) = eviscerate($body);
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
278 $body = '{ use Date::Format qw(time2str); "" }';
279 while(@$skin || @$guts) {
280 $body .= shift(@$skin) || '';
281 $body .= shift(@$guts) || '';
288 my $body_tmpl = new Text::Template (
293 warn "$me filling in body template\n" if $DEBUG;
294 $body = $body_tmpl->fill_in( HASH => $hashref );
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'};
307 if ( exists($opt{'to'}) ) {
309 @to = map { $_->format } Email::Address->parse($opt{'to'});
311 } elsif ( $cust_main ) {
313 my $classnum = $opt{'to_contact_classnum'} || '';
314 my @classes = ref($classnum) ? @$classnum : split(',', $classnum);
316 # There are two e-mail opt-in flags per contact_email address.
317 # If neither 'invoice' nor 'message' has been specified, default
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;
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.
331 die 'no To: address or cust_main object specified';
334 my $from_addr = $self->from_addr;
338 my $agentnum = $cust_main ? $cust_main->agentnum : '';
340 if ( $opt{'from_config'} ) {
341 $from_addr = $conf->config($opt{'from_config'}, $agentnum);
343 $from_addr ||= $conf->invoice_from_full($agentnum);
346 my $text_body = encode('UTF-8',
347 HTML::FormatText->new(leftmargin => 0, rightmargin => 70)
348 ->format( HTML::TreeBuilder->new_from_content($body) )
351 warn "$me constructing MIME entities\n" if $DEBUG;
352 my %email = generate_email(
353 'from' => $from_addr,
355 'bcc' => $self->bcc_addr || undef,
356 'subject' => $subject,
357 'html_body' => $body,
358 'text_body' => $text_body,
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) {
369 s/^(.*)\s*<(.*@.*)>$/$2/;
373 if ( $env_from =~ /\@([\w\.\-]+)/ ) {
376 warn 'no domain found in invoice from address '. $env_from .
377 '; constructing Message-ID (and saying HELO) @example.com';
378 $domain = 'example.com';
380 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
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',
395 if ( $opt{'attach'} ) {
397 if (ref $opt{'attach'} eq 'ARRAY') {
398 @attach = @{ $opt{'attach'} };
400 @attach = $opt{'attach'};
403 $message->add_part($_);
407 #$message->head->replace('Content-type',
408 # 'multipart/related; '.
409 # 'boundary="' . $message->head->multipart_boundary . '"; ' .
410 # 'type=multipart/alternative'
413 foreach my $part (@{ $email{mimeparts} }) {
414 warn "$me appending part ".$part->mime_type."\n" if $DEBUG;
415 $message->add_part( $part );
418 # effective To: address (not in headers)
419 push @to, $self->bcc_addr if $self->bcc_addr;
421 foreach my $dest (@to) {
422 push @env_to, map { $_->address } Email::Address->parse($dest);
425 my $cust_msg = FS::cust_msg->new({
426 'custnum' => $cust_main ? $cust_main->custnum : '',
427 'msgnum' => $self->msgnum,
429 'env_from' => $env_from,
430 'env_to' => join(',', @env_to),
431 'header' => $message->header_as_string,
432 'body' => $message->body_as_string,
434 'status' => 'prepared',
435 'msgtype' => ($opt{'msgtype'} || ''),
436 'preview' => $body, # html content only
442 =item render OPTION => VALUE ...
444 Fills in the template and renders it to a PDF document. Returns the
445 name of the PDF file.
447 Options are as for 'prepare', but 'from' and 'to' are meaningless.
451 # will also have options to set paper size, margins, etc.
455 eval "use PDF::WebKit";
458 my %hash = $self->prepare(%opt);
459 my $html = $hash{'html_body'};
461 # Graphics/stylesheets should probably go in /var/www on the Freeside
463 my $script_path = `/usr/bin/which freeside-wkhtmltopdf`;
465 my $kit = PDF::WebKit->new(\$html); #%options
466 # hack to use our wrapper script
467 $kit->configure(sub { shift->wkhtmltopdf($script_path) });
474 Render a PDF and send it to the printer. OPTIONS are as for 'render'.
479 my( $self, %opt ) = @_;
480 do_print( [ $self->render(%opt) ], agentnum=>$opt{cust_main}->agentnum );
483 # helper sub for package dates
484 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
486 # helper sub for money amounts
487 my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) };
489 # helper sub for usage-related messages
490 my $usage_warning = sub {
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
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.
513 qsearchs('template_content',
514 { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
515 qsearchs('template_content',
516 { 'msgnum' => $self->msgnum, 'locale' => '' });
521 =item send_prepared CUST_MSG
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.
530 my $cust_msg = shift or die "cust_msg required";
532 if ( $FS::Misc::DISABLE_ALL_NOTICES ) {
533 warn 'send_prepared() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG;
537 my $domain = 'example.com';
538 if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) {
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);
546 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
549 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
550 $smtp_opt{'port'} = $port;
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 );
557 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
558 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
560 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
561 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
564 warn "$me sending message\n" if $DEBUG;
565 my $message = join("\n\n", $cust_msg->header, $cust_msg->body);
568 sendmail( $message, { transport => $transport,
569 from => $cust_msg->env_from,
573 if(ref($@) and $@->isa('Email::Sender::Failure')) {
574 $error = $@->code.' ' if $@->code;
575 $error .= $@->message;
581 $cust_msg->set('error', $error);
582 $cust_msg->set('status', $error ? 'failed' : 'sent');
583 if ( $cust_msg->custmsgnum ) {
599 # Every bit as pleasant as it sounds.
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.
607 my (@outside, @inside);
610 while($body || $chunk) {
611 my ($first, $delim, $rest);
612 # put all leading non-delimiters into $first
614 ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
616 # put a leading delimiter into $delim if there is one
618 ($rest =~ /^([{}]?)(.*)$/s);
620 if( $delim eq '{' ) {
623 push @outside, $chunk;
628 elsif( $delim eq '}' ) {
631 push @inside, $chunk;
639 push @outside, $chunk . $rest;
640 } # else ? something wrong
645 (\@outside, \@inside);
652 L<FS::Record>, schema.html from the base documentation.