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.
221 my( $self, %opt ) = @_;
223 my $cust_main = $opt{'cust_main'}; # or die 'cust_main required';
224 my $object = $opt{'object'}; # or die 'object required';
226 my $hashref = $self->prepare_substitutions(%opt);
229 my $locale = $cust_main && $cust_main->locale || '';
230 warn "no locale for cust#".$cust_main->custnum."; using default content\n"
231 if $DEBUG and $cust_main && !$locale;
232 my $content = $self->content($locale);
234 warn "preparing template '".$self->msgname."\n"
237 $_ = encode_entities($_ || '') foreach values(%$hashref);
242 my $subject_tmpl = new Text::Template (
244 SOURCE => $content->subject,
247 warn "$me filling in subject template\n" if $DEBUG;
248 my $subject = $subject_tmpl->fill_in( HASH => $hashref );
250 my $body = $content->body;
251 my ($skin, $guts) = eviscerate($body);
253 $_ = decode_entities($_); # turn all punctuation back into itself
254 s/\r//gs; # remove \r's
255 s/<br[^>]*>/\n/gsi; # and <br /> tags
256 s/<p>/\n/gsi; # and <p>
257 s/<\/p>//gsi; # and </p>
258 s/\240/ /gs; # and
262 $body = '{ use Date::Format qw(time2str); "" }';
263 while(@$skin || @$guts) {
264 $body .= shift(@$skin) || '';
265 $body .= shift(@$guts) || '';
272 my $body_tmpl = new Text::Template (
277 warn "$me filling in body template\n" if $DEBUG;
278 $body = $body_tmpl->fill_in( HASH => $hashref );
280 # override $body if requested
281 if ( $opt{'override_content'} ) {
282 warn "$me overriding template body with requested content" if $DEBUG;
283 $body = $opt{'override_content'};
291 if ( exists($opt{'to'}) ) {
293 @to = map { $_->format } Email::Address->parse($opt{'to'});
295 } elsif ( $cust_main ) {
297 my $classnum = $opt{'to_contact_classnum'} || '';
298 my @classes = ref($classnum) ? @$classnum : split(',', $classnum);
299 # traditional behavior: send to all invoice recipients
300 @classes = ('invoice') unless @classes;
301 @to = $cust_main->contact_list_email(@classes);
302 # not guaranteed to produce contacts, but then customers aren't
303 # guaranteed to have email addresses on file. in that case, env_to
304 # will be null and sending this message will fail.
307 die 'no To: address or cust_main object specified';
310 my $from_addr = $self->from_addr;
314 my $agentnum = $cust_main ? $cust_main->agentnum : '';
316 if ( $opt{'from_config'} ) {
317 $from_addr = $conf->config($opt{'from_config'}, $agentnum);
319 $from_addr ||= $conf->invoice_from_full($agentnum);
322 my $text_body = encode('UTF-8',
323 HTML::FormatText->new(leftmargin => 0, rightmargin => 70)
324 ->format( HTML::TreeBuilder->new_from_content($body) )
327 warn "$me constructing MIME entities\n" if $DEBUG;
328 my %email = generate_email(
329 'from' => $from_addr,
331 'bcc' => $self->bcc_addr || undef,
332 'subject' => $subject,
333 'html_body' => $body,
334 'text_body' => $text_body,
337 warn "$me creating message headers\n" if $DEBUG;
338 # strip display-name from envelope addresses
339 # (use Email::Address for this? it chokes on non-ASCII characters in
340 # the display-name, which is not great for us)
341 my $env_from = $from_addr;
342 foreach ($env_from, @to) {
345 s/^(.*)\s*<(.*@.*)>$/$2/;
349 if ( $env_from =~ /\@([\w\.\-]+)/ ) {
352 warn 'no domain found in invoice from address '. $env_from .
353 '; constructing Message-ID (and saying HELO) @example.com';
354 $domain = 'example.com';
356 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
359 my $message = MIME::Entity->build(
360 'From' => $from_addr,
361 'To' => join(', ', @to),
362 'Sender' => $from_addr,
363 'Reply-To' => $from_addr,
364 'Date' => time2str("%a, %d %b %Y %X %z", $time),
365 'Subject' => Encode::encode('MIME-Header', $subject),
366 'Message-ID' => "<$message_id>",
367 'Encoding' => '7bit',
368 'Type' => 'multipart/related',
371 if ( $opt{'attach'} ) {
373 if (ref $opt{'attach'} eq 'ARRAY') {
374 @attach = @{ $opt{'attach'} };
376 @attach = $opt{'attach'};
379 $message->add_part($_);
383 #$message->head->replace('Content-type',
384 # 'multipart/related; '.
385 # 'boundary="' . $message->head->multipart_boundary . '"; ' .
386 # 'type=multipart/alternative'
389 foreach my $part (@{ $email{mimeparts} }) {
390 warn "$me appending part ".$part->mime_type."\n" if $DEBUG;
391 $message->add_part( $part );
394 # effective To: address (not in headers)
395 push @to, $self->bcc_addr if $self->bcc_addr;
397 foreach my $dest (@to) {
398 push @env_to, map { $_->address } Email::Address->parse($dest);
401 my $cust_msg = FS::cust_msg->new({
402 'custnum' => $cust_main ? $cust_main->custnum : '',
403 'msgnum' => $self->msgnum,
405 'env_from' => $env_from,
406 'env_to' => join(',', @env_to),
407 'header' => $message->header_as_string,
408 'body' => $message->body_as_string,
410 'status' => 'prepared',
411 'msgtype' => ($opt{'msgtype'} || ''),
412 'preview' => $body, # html content only
418 =item render OPTION => VALUE ...
420 Fills in the template and renders it to a PDF document. Returns the
421 name of the PDF file.
423 Options are as for 'prepare', but 'from' and 'to' are meaningless.
427 # will also have options to set paper size, margins, etc.
431 eval "use PDF::WebKit";
434 my %hash = $self->prepare(%opt);
435 my $html = $hash{'html_body'};
437 # Graphics/stylesheets should probably go in /var/www on the Freeside
439 my $script_path = `/usr/bin/which freeside-wkhtmltopdf`;
441 my $kit = PDF::WebKit->new(\$html); #%options
442 # hack to use our wrapper script
443 $kit->configure(sub { shift->wkhtmltopdf($script_path) });
450 Render a PDF and send it to the printer. OPTIONS are as for 'render'.
455 my( $self, %opt ) = @_;
456 do_print( [ $self->render(%opt) ], agentnum=>$opt{cust_main}->agentnum );
459 # helper sub for package dates
460 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
462 # helper sub for money amounts
463 my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) };
465 # helper sub for usage-related messages
466 my $usage_warning = sub {
468 foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
469 my $amount = $svc->$col; next if $amount eq '';
470 my $method = $col.'_threshold';
471 my $threshold = $svc->$method; next if $threshold eq '';
472 return [$col, $amount, $threshold] if $amount <= $threshold;
473 # this only returns the first one that's below threshold, if there are
481 Returns the L<FS::template_content> object appropriate to LOCALE, if there
482 is one. If not, returns the one with a NULL locale.
489 qsearchs('template_content',
490 { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
491 qsearchs('template_content',
492 { 'msgnum' => $self->msgnum, 'locale' => '' });
497 =item send_prepared CUST_MSG
499 Takes the CUST_MSG object and sends it to its recipient. The "smtpmachine"
500 configuration option will be used to find the outgoing mail server.
506 my $cust_msg = shift or die "cust_msg required";
508 my $domain = 'example.com';
509 if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) {
513 # in principle should already be a list of bare addresses, but run it
514 # through Email::Address to make sure
515 my @env_to = map { $_->address } Email::Address->parse($cust_msg->env_to);
517 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
520 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
521 $smtp_opt{'port'} = $port;
524 if ( defined($enc) && $enc eq 'starttls' ) {
525 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
526 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
528 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
529 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
531 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
532 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
535 warn "$me sending message\n" if $DEBUG;
536 my $message = join("\n\n", $cust_msg->header, $cust_msg->body);
539 sendmail( $message, { transport => $transport,
540 from => $cust_msg->env_from,
544 if(ref($@) and $@->isa('Email::Sender::Failure')) {
545 $error = $@->code.' ' if $@->code;
546 $error .= $@->message;
552 $cust_msg->set('error', $error);
553 $cust_msg->set('status', $error ? 'failed' : 'sent');
554 if ( $cust_msg->custmsgnum ) {
570 # Every bit as pleasant as it sounds.
572 # We do this because Text::Template::Preprocess doesn't
573 # actually work. It runs the entire template through
574 # the preprocessor, instead of the code segments. Which
575 # is a shame, because Text::Template already contains
576 # the code to do this operation.
578 my (@outside, @inside);
581 while($body || $chunk) {
582 my ($first, $delim, $rest);
583 # put all leading non-delimiters into $first
585 ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
587 # put a leading delimiter into $delim if there is one
589 ($rest =~ /^([{}]?)(.*)$/s);
591 if( $delim eq '{' ) {
594 push @outside, $chunk;
599 elsif( $delim eq '}' ) {
602 push @inside, $chunk;
610 push @outside, $chunk . $rest;
611 } # else ? something wrong
616 (\@outside, \@inside);
623 L<FS::Record>, schema.html from the base documentation.