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 );
22 use Email::Sender::Transport::SMTP;
24 use FS::Record qw( qsearch qsearchs );
26 # needed to manage template_content objects
27 use FS::template_content;
28 use FS::UID qw( dbh );
30 # needed to manage prepared messages
33 FS::UID->install_callback( sub { $conf = new FS::Conf; } );
36 our $me = '[FS::msg_template::email]';
40 FS::msg_template::email - Construct email notices with Text::Template.
44 FS::msg_template::email is a message processor in which the template contains
45 L<Text::Template> strings for the message subject line and body, and the
46 message is delivered by email.
48 Currently the C<from_addr> and C<bcc_addr> fields used by this processor are
49 in the main msg_template table.
55 =item insert [ CONTENT ]
57 Adds this record to the database. If there is an error, returns the error,
58 otherwise returns false.
60 A default (no locale) L<FS::template_content> object will be created. CONTENT
61 is an optional hash containing 'subject' and 'body' for this object.
69 my $oldAutoCommit = $FS::UID::AutoCommit;
70 local $FS::UID::AutoCommit = 0;
73 my $error = $self->SUPER::insert;
75 $content{'msgnum'} = $self->msgnum;
76 $content{'subject'} ||= '';
77 $content{'body'} ||= '';
78 my $template_content = new FS::template_content (\%content);
79 $error = $template_content->insert;
83 $dbh->rollback if $oldAutoCommit;
87 $dbh->commit if $oldAutoCommit;
91 =item replace [ OLD_RECORD ] [ CONTENT ]
93 Replaces the OLD_RECORD with this one in the database. If there is an error,
94 returns the error, otherwise returns false.
96 CONTENT is an optional hash containing 'subject', 'body', and 'locale'. If
97 supplied, an L<FS::template_content> object will be created (or modified, if
98 one already exists for this locale).
104 my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') )
106 : $self->replace_old;
109 my $oldAutoCommit = $FS::UID::AutoCommit;
110 local $FS::UID::AutoCommit = 0;
113 my $error = $self->SUPER::replace($old);
115 if ( !$error and %content ) {
116 $content{'locale'} ||= '';
117 my $new_content = qsearchs('template_content', {
118 'msgnum' => $self->msgnum,
119 'locale' => $content{'locale'},
121 if ( $new_content ) {
122 $new_content->subject($content{'subject'});
123 $new_content->body($content{'body'});
124 $error = $new_content->replace;
127 $content{'msgnum'} = $self->msgnum;
128 $new_content = new FS::template_content \%content;
129 $error = $new_content->insert;
134 $dbh->rollback if $oldAutoCommit;
138 warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit;
139 $dbh->commit if $oldAutoCommit;
143 =item content_locales
145 Returns a hashref of the L<FS::template_content> objects attached to
146 this template, with the locale as key.
150 sub content_locales {
152 return $self->{'_content_locales'} ||= +{
153 map { $_->locale , $_ }
154 qsearch('template_content', { 'msgnum' => $self->msgnum })
158 =item prepare OPTION => VALUE
160 Fills in the template and returns an L<FS::cust_msg> object.
162 Options are passed as a list of name/value pairs:
172 Additional context object (currently, can be a cust_main, cust_pkg,
173 cust_bill, cust_pay, cust_pay_pending, or svc_(acct, phone, broadband,
174 domain) ). If the object is a svc_*, its cust_pkg will be fetched and
175 used for substitution.
177 As a special case, this may be an arrayref of two objects. Both
178 objects will be available for substitution, with their field names
179 prefixed with 'new_' and 'old_' respectively. This is used in the
180 rt_ticket export when exporting "replace" events.
184 Configuration option to use as the source address, based on the customer's
185 agentnum. If unspecified (or the named option is empty), 'invoice_from'
188 The I<from_addr> field in the template takes precedence over this.
192 Destination address. The default is to use the customer's
193 invoicing_list addresses. Multiple addresses may be comma-separated.
197 A hash reference of additional substitutions
201 A string identifying the kind of message this is. Currently can be "invoice",
202 "receipt", "admin", or null. Expand this list as necessary.
204 =item override_content
206 A string to use as the HTML body; if specified, replaces the entire
207 body of the message. This should be used ONLY by L<FS::report_batch> and may
208 go away in the future.
212 A L<MIME::Entity> (or arrayref of them) to attach to the message.
214 =item to_contact_classnum
216 Set a string containing a comma-separated list. This list may contain:
218 - the text "invoice" indicating contacts with invoice_dest flag should
220 - the text "message" indicating contacts with message_dest flag should
222 - numbers representing classnum id values for email contact classes.
223 If any classnum are present, emails should only be sent to contact_email
224 addresses where contact_email.classnum contains one of these classes.
225 The classnum 0 also includes where contact_email.classnum IS NULL
227 If neither 'invoice' nor 'message' has been specified, this method will
228 behave as if 'invoice' had been selected
238 my( $self, %opt ) = @_;
240 my $cust_main = $opt{'cust_main'}; # or die 'cust_main required';
241 my $object = $opt{'object'}; # or die 'object required';
243 my $hashref = $self->prepare_substitutions(%opt);
246 my $locale = $cust_main && $cust_main->locale || '';
247 warn "no locale for cust#".$cust_main->custnum."; using default content\n"
248 if $DEBUG and $cust_main && !$locale;
249 my $content = $self->content($locale);
251 warn "preparing template '".$self->msgname."\n"
254 $_ = encode_entities($_ || '') foreach values(%$hashref);
259 my $subject_tmpl = new Text::Template (
261 SOURCE => $content->subject,
264 warn "$me filling in subject template\n" if $DEBUG;
265 my $subject = $subject_tmpl->fill_in( HASH => $hashref );
267 my $body = $content->body;
268 my ($skin, $guts) = eviscerate($body);
270 $_ = decode_entities($_); # turn all punctuation back into itself
271 s/\r//gs; # remove \r's
272 s/<br[^>]*>/\n/gsi; # and <br /> tags
273 s/<p>/\n/gsi; # and <p>
274 s/<\/p>//gsi; # and </p>
275 s/\240/ /gs; # and
279 $body = '{ use Date::Format qw(time2str); "" }';
280 while(@$skin || @$guts) {
281 $body .= shift(@$skin) || '';
282 $body .= shift(@$guts) || '';
289 my $body_tmpl = new Text::Template (
294 warn "$me filling in body template\n" if $DEBUG;
295 $body = $body_tmpl->fill_in( HASH => $hashref );
297 # override $body if requested
298 if ( $opt{'override_content'} ) {
299 warn "$me overriding template body with requested content" if $DEBUG;
300 $body = $opt{'override_content'};
308 if ( exists($opt{'to'}) ) {
310 @to = map { $_->format } Email::Address->parse($opt{'to'});
312 } elsif ( $cust_main ) {
314 my $classnum = $opt{'to_contact_classnum'} || '';
315 my @classes = ref($classnum) ? @$classnum : split(',', $classnum);
317 # There are two e-mail opt-in flags per contact_email address.
318 # If neither 'invoice' nor 'message' has been specified, default
321 # This default supports the legacy behavior of
322 # send to all invoice recipients
323 push @classes,'invoice'
324 unless grep {$_ eq 'invoice' || $_ eq 'message'} @classes;
326 @to = $cust_main->contact_list_email(@classes);
327 # not guaranteed to produce contacts, but then customers aren't
328 # guaranteed to have email addresses on file. in that case, env_to
329 # will be null and sending this message will fail.
332 die 'no To: address or cust_main object specified';
335 my $from_addr = $self->from_addr;
339 my $agentnum = $cust_main ? $cust_main->agentnum : '';
341 if ( $opt{'from_config'} ) {
342 $from_addr = $conf->config($opt{'from_config'}, $agentnum);
344 $from_addr ||= $conf->invoice_from_full($agentnum);
347 my $text_body = encode('UTF-8',
348 HTML::FormatText->new(leftmargin => 0, rightmargin => 70)
349 ->format( HTML::TreeBuilder->new_from_content($body) )
352 warn "$me constructing MIME entities\n" if $DEBUG;
353 my %email = generate_email(
354 'from' => $from_addr,
356 'bcc' => $self->bcc_addr || undef,
357 'subject' => $subject,
358 'html_body' => $body,
359 'text_body' => $text_body,
362 warn "$me creating message headers\n" if $DEBUG;
363 # strip display-name from envelope addresses
364 # (use Email::Address for this? it chokes on non-ASCII characters in
365 # the display-name, which is not great for us)
366 my $env_from = $from_addr;
367 foreach ($env_from, @to) {
370 s/^(.*)\s*<(.*@.*)>$/$2/;
374 if ( $env_from =~ /\@([\w\.\-]+)/ ) {
377 warn 'no domain found in invoice from address '. $env_from .
378 '; constructing Message-ID (and saying HELO) @example.com';
379 $domain = 'example.com';
381 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
384 my $message = MIME::Entity->build(
385 'From' => $from_addr,
386 'To' => join(', ', @to),
387 'Sender' => $from_addr,
388 'Reply-To' => $from_addr,
389 'Date' => time2str("%a, %d %b %Y %X %z", $time),
390 'Subject' => Encode::encode('MIME-Header', $subject),
391 'Message-ID' => "<$message_id>",
392 'Encoding' => '7bit',
393 'Type' => 'multipart/related',
396 if ( $opt{'attach'} ) {
398 if (ref $opt{'attach'} eq 'ARRAY') {
399 @attach = @{ $opt{'attach'} };
401 @attach = $opt{'attach'};
404 $message->add_part($_);
408 #$message->head->replace('Content-type',
409 # 'multipart/related; '.
410 # 'boundary="' . $message->head->multipart_boundary . '"; ' .
411 # 'type=multipart/alternative'
414 foreach my $part (@{ $email{mimeparts} }) {
415 warn "$me appending part ".$part->mime_type."\n" if $DEBUG;
416 $message->add_part( $part );
419 # effective To: address (not in headers)
420 push @to, $self->bcc_addr if $self->bcc_addr;
422 foreach my $dest (@to) {
423 push @env_to, map { $_->address } Email::Address->parse($dest);
426 my $cust_msg = FS::cust_msg->new({
427 'custnum' => $cust_main ? $cust_main->custnum : '',
428 'msgnum' => $self->msgnum,
430 'env_from' => $env_from,
431 'env_to' => join(',', @env_to),
432 'header' => $message->header_as_string,
433 'body' => $message->body_as_string,
435 'status' => 'prepared',
436 'msgtype' => ($opt{'msgtype'} || ''),
437 'preview' => $body, # html content only
443 =item render OPTION => VALUE ...
445 Fills in the template and renders it to a PDF document. Returns the
446 name of the PDF file.
448 Options are as for 'prepare', but 'from' and 'to' are meaningless.
452 # will also have options to set paper size, margins, etc.
456 eval "use PDF::WebKit";
459 my %hash = $self->prepare(%opt);
460 my $html = $hash{'html_body'};
462 # Graphics/stylesheets should probably go in /var/www on the Freeside
464 my $script_path = `/usr/bin/which freeside-wkhtmltopdf`;
466 my $kit = PDF::WebKit->new(\$html); #%options
467 # hack to use our wrapper script
468 $kit->configure(sub { shift->wkhtmltopdf($script_path) });
475 Render a PDF and send it to the printer. OPTIONS are as for 'render'.
480 my( $self, %opt ) = @_;
481 do_print( [ $self->render(%opt) ], agentnum=>$opt{cust_main}->agentnum );
484 # helper sub for package dates
485 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
487 # helper sub for money amounts
488 my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) };
490 # helper sub for usage-related messages
491 my $usage_warning = sub {
493 foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
494 my $amount = $svc->$col; next if $amount eq '';
495 my $method = $col.'_threshold';
496 my $threshold = $svc->$method; next if $threshold eq '';
497 return [$col, $amount, $threshold] if $amount <= $threshold;
498 # this only returns the first one that's below threshold, if there are
506 Returns the L<FS::template_content> object appropriate to LOCALE, if there
507 is one. If not, returns the one with a NULL locale.
514 qsearchs('template_content',
515 { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
516 qsearchs('template_content',
517 { 'msgnum' => $self->msgnum, 'locale' => '' });
522 =item send_prepared CUST_MSG
524 Takes the CUST_MSG object and sends it to its recipient. The "smtpmachine"
525 configuration option will be used to find the outgoing mail server.
531 my $cust_msg = shift or die "cust_msg required";
533 if ( $FS::Misc::DISABLE_ALL_NOTICES ) {
534 warn 'send_prepared() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG;
538 my $domain = 'example.com';
539 if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) {
543 # in principle should already be a list of bare addresses, but run it
544 # through Email::Address to make sure
545 my @env_to = map { $_->address } Email::Address->parse($cust_msg->env_to);
547 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
550 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
551 $smtp_opt{'port'} = $port;
553 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
554 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
555 } elsif ( defined($enc) && $enc eq 'starttls') {
556 $error = "SMTP settings misconfiguration: STARTTLS enabled in ".
557 "smtp-encryption but smtp-username or smtp-password missing";
560 if ( defined($enc) ) {
561 $smtp_opt{'ssl'} = 'starttls' if $enc eq 'starttls';
562 $smtp_opt{'ssl'} = 1 if $enc eq 'tls';
565 my $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
567 warn "$me sending message\n" if $DEBUG;
568 my $message = join("\n", $cust_msg->header, $cust_msg->body);
571 sendmail( $message, { transport => $transport,
572 from => $cust_msg->env_from,
576 if(ref($@) and $@->isa('Email::Sender::Failure')) {
577 $error = $@->code.' ' if $@->code;
578 $error .= $@->message;
584 $cust_msg->set('error', $error);
585 $cust_msg->set('status', $error ? 'failed' : 'sent');
586 if ( $cust_msg->custmsgnum ) {
602 # Every bit as pleasant as it sounds.
604 # We do this because Text::Template::Preprocess doesn't
605 # actually work. It runs the entire template through
606 # the preprocessor, instead of the code segments. Which
607 # is a shame, because Text::Template already contains
608 # the code to do this operation.
610 my (@outside, @inside);
613 while($body || $chunk) {
614 my ($first, $delim, $rest);
615 # put all leading non-delimiters into $first
617 ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
619 # put a leading delimiter into $delim if there is one
621 ($rest =~ /^([{}]?)(.*)$/s);
623 if( $delim eq '{' ) {
626 push @outside, $chunk;
631 elsif( $delim eq '}' ) {
634 push @inside, $chunk;
642 push @outside, $chunk . $rest;
643 } # else ? something wrong
648 (\@outside, \@inside);
655 L<FS::Record>, schema.html from the base documentation.