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 _sendmail );
22 use FS::Record qw( qsearch qsearchs );
24 # needed to manage template_content objects
25 use FS::template_content;
26 use FS::UID qw( dbh );
28 # needed to manage prepared messages
31 FS::UID->install_callback( sub { $conf = new FS::Conf; } );
34 our $me = '[FS::msg_template::email]';
38 FS::msg_template::email - Construct email notices with Text::Template.
42 FS::msg_template::email is a message processor in which the template contains
43 L<Text::Template> strings for the message subject line and body, and the
44 message is delivered by email.
46 Currently the C<from_addr> and C<bcc_addr> fields used by this processor are
47 in the main msg_template table.
53 =item insert [ CONTENT ]
55 Adds this record to the database. If there is an error, returns the error,
56 otherwise returns false.
58 A default (no locale) L<FS::template_content> object will be created. CONTENT
59 is an optional hash containing 'subject' and 'body' for this object.
67 my $oldAutoCommit = $FS::UID::AutoCommit;
68 local $FS::UID::AutoCommit = 0;
71 my $error = $self->SUPER::insert;
73 $content{'msgnum'} = $self->msgnum;
74 $content{'subject'} ||= '';
75 $content{'body'} ||= '';
76 my $template_content = new FS::template_content (\%content);
77 $error = $template_content->insert;
81 $dbh->rollback if $oldAutoCommit;
85 $dbh->commit if $oldAutoCommit;
89 =item replace [ OLD_RECORD ] [ CONTENT ]
91 Replaces the OLD_RECORD with this one in the database. If there is an error,
92 returns the error, otherwise returns false.
94 CONTENT is an optional hash containing 'subject', 'body', and 'locale'. If
95 supplied, an L<FS::template_content> object will be created (or modified, if
96 one already exists for this locale).
102 my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') )
104 : $self->replace_old;
107 my $oldAutoCommit = $FS::UID::AutoCommit;
108 local $FS::UID::AutoCommit = 0;
111 my $error = $self->SUPER::replace($old);
113 if ( !$error and %content ) {
114 $content{'locale'} ||= '';
115 my $new_content = qsearchs('template_content', {
116 'msgnum' => $self->msgnum,
117 'locale' => $content{'locale'},
119 if ( $new_content ) {
120 $new_content->subject($content{'subject'});
121 $new_content->body($content{'body'});
122 $error = $new_content->replace;
125 $content{'msgnum'} = $self->msgnum;
126 $new_content = new FS::template_content \%content;
127 $error = $new_content->insert;
132 $dbh->rollback if $oldAutoCommit;
136 warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit;
137 $dbh->commit if $oldAutoCommit;
141 =item content_locales
143 Returns a hashref of the L<FS::template_content> objects attached to
144 this template, with the locale as key.
148 sub content_locales {
150 return $self->{'_content_locales'} ||= +{
151 map { $_->locale , $_ }
152 qsearch('template_content', { 'msgnum' => $self->msgnum })
156 =item prepare OPTION => VALUE
158 Fills in the template and returns an L<FS::cust_msg> object.
160 Options are passed as a list of name/value pairs:
170 Additional context object (currently, can be a cust_main, cust_pkg,
171 cust_bill, cust_pay, cust_pay_pending, or svc_(acct, phone, broadband,
172 domain) ). If the object is a svc_*, its cust_pkg will be fetched and
173 used for substitution.
175 As a special case, this may be an arrayref of two objects. Both
176 objects will be available for substitution, with their field names
177 prefixed with 'new_' and 'old_' respectively. This is used in the
178 rt_ticket export when exporting "replace" events.
182 Configuration option to use as the source address, based on the customer's
183 agentnum. If unspecified (or the named option is empty), 'invoice_from'
186 The I<from_addr> field in the template takes precedence over this.
190 Destination address. The default is to use the customer's
191 invoicing_list addresses. Multiple addresses may be comma-separated.
195 A hash reference of additional substitutions
199 A string identifying the kind of message this is. Currently can be "invoice",
200 "receipt", "admin", or null. Expand this list as necessary.
202 =item override_content
204 A string to use as the HTML body; if specified, replaces the entire
205 body of the message. This should be used ONLY by L<FS::report_batch> and may
206 go away in the future.
210 A L<MIME::Entity> (or arrayref of them) to attach to the message.
212 =item to_contact_classnum
214 Set a string containing a comma-separated list. This list may contain:
216 - the text "invoice" indicating contacts with invoice_dest flag should
218 - the text "message" indicating contacts with message_dest flag should
220 - numbers representing classnum id values for email contact classes.
221 If any classnum are present, emails should only be sent to contact_email
222 addresses where contact_email.classnum contains one of these classes.
223 The classnum 0 also includes where contact_email.classnum IS NULL
225 If neither 'invoice' nor 'message' has been specified, this method will
226 behave as if 'invoice' had been selected
236 my( $self, %opt ) = @_;
238 my $cust_main = $opt{'cust_main'}; # or die 'cust_main required';
239 my $object = $opt{'object'}; # or die 'object required';
241 my $hashref = $self->prepare_substitutions(%opt);
244 my $locale = $cust_main && $cust_main->locale || '';
245 warn "no locale for cust#".$cust_main->custnum."; using default content\n"
246 if $DEBUG and $cust_main && !$locale;
247 my $content = $self->content($locale);
249 warn "preparing template '".$self->msgname."\n"
252 $_ = encode_entities($_ || '') foreach values(%$hashref);
257 my $subject_tmpl = new Text::Template (
259 SOURCE => $content->subject,
262 warn "$me filling in subject template\n" if $DEBUG;
263 my $subject = $subject_tmpl->fill_in( HASH => $hashref );
265 my $body = $content->body;
266 my ($skin, $guts) = eviscerate($body);
268 $_ = decode_entities($_); # turn all punctuation back into itself
269 s/\r//gs; # remove \r's
270 s/<br[^>]*>/\n/gsi; # and <br /> tags
271 s/<p>/\n/gsi; # and <p>
272 s/<\/p>//gsi; # and </p>
273 s/\240/ /gs; # and
277 $body = '{ use Date::Format qw(time2str); "" }';
278 while(@$skin || @$guts) {
279 $body .= shift(@$skin) || '';
280 $body .= shift(@$guts) || '';
287 my $body_tmpl = new Text::Template (
292 warn "$me filling in body template\n" if $DEBUG;
293 $body = $body_tmpl->fill_in( HASH => $hashref );
295 # override $body if requested
296 if ( $opt{'override_content'} ) {
297 warn "$me overriding template body with requested content" if $DEBUG;
298 $body = $opt{'override_content'};
306 if ( exists($opt{'to'}) ) {
308 @to = map { $_->format } Email::Address->parse($opt{'to'});
310 } elsif ( $cust_main ) {
312 my $classnum = $opt{'to_contact_classnum'} || '';
313 my @classes = ref($classnum) ? @$classnum : split(',', $classnum);
315 # There are two e-mail opt-in flags per contact_email address.
316 # If neither 'invoice' nor 'message' has been specified, default
319 # This default supports the legacy behavior of
320 # send to all invoice recipients
321 push @classes,'invoice'
322 unless grep {$_ eq 'invoice' || $_ eq 'message'} @classes;
324 @to = $cust_main->contact_list_email(@classes);
325 # not guaranteed to produce contacts, but then customers aren't
326 # guaranteed to have email addresses on file. in that case, env_to
327 # will be null and sending this message will fail.
330 die 'no To: address or cust_main object specified';
333 my $from_addr = $self->from_addr;
337 my $agentnum = $cust_main ? $cust_main->agentnum : '';
339 if ( $opt{'from_config'} ) {
340 $from_addr = $conf->config($opt{'from_config'}, $agentnum);
342 $from_addr ||= $conf->invoice_from_full($agentnum);
345 my $text_body = encode('UTF-8',
346 HTML::FormatText->new(leftmargin => 0, rightmargin => 70)
347 ->format( HTML::TreeBuilder->new_from_content($body) )
350 warn "$me constructing MIME entities\n" if $DEBUG;
351 my %email = generate_email(
352 'from' => $from_addr,
354 'bcc' => $self->bcc_addr || undef,
355 'subject' => $subject,
356 'html_body' => $body,
357 'text_body' => $text_body,
360 warn "$me creating message headers\n" if $DEBUG;
361 # strip display-name from envelope addresses
362 # (use Email::Address for this? it chokes on non-ASCII characters in
363 # the display-name, which is not great for us)
364 my $env_from = $from_addr;
365 foreach ($env_from, @to) {
368 s/^(.*)\s*<(.*@.*)>$/$2/;
372 if ( $env_from =~ /\@([\w\.\-]+)/ ) {
375 warn 'no domain found in invoice from address '. $env_from .
376 '; constructing Message-ID (and saying HELO) @example.com';
377 $domain = 'example.com';
379 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
382 my $message = MIME::Entity->build(
383 'From' => $from_addr,
384 'To' => join(', ', @to),
385 'Sender' => $from_addr,
386 'Reply-To' => $from_addr,
387 'Date' => time2str("%a, %d %b %Y %X %z", $time),
388 'Subject' => Encode::encode('MIME-Header', $subject),
389 'Message-ID' => "<$message_id>",
390 'Encoding' => '7bit',
391 'Type' => 'multipart/related',
394 if ( $opt{'attach'} ) {
396 if (ref $opt{'attach'} eq 'ARRAY') {
397 @attach = @{ $opt{'attach'} };
399 @attach = $opt{'attach'};
402 $message->add_part($_);
406 #$message->head->replace('Content-type',
407 # 'multipart/related; '.
408 # 'boundary="' . $message->head->multipart_boundary . '"; ' .
409 # 'type=multipart/alternative'
412 foreach my $part (@{ $email{mimeparts} }) {
413 warn "$me appending part ".$part->mime_type."\n" if $DEBUG;
414 $message->add_part( $part );
417 # effective To: address (not in headers)
418 push @to, $self->bcc_addr if $self->bcc_addr;
420 foreach my $dest (@to) {
421 push @env_to, map { $_->address } Email::Address->parse($dest);
424 my $cust_msg = FS::cust_msg->new({
425 'custnum' => $cust_main ? $cust_main->custnum : '',
426 'msgnum' => $self->msgnum,
428 'env_from' => $env_from,
429 'env_to' => join(',', @env_to),
430 'header' => $message->header_as_string,
431 'body' => $message->body_as_string,
433 'status' => 'prepared',
434 'msgtype' => ($opt{'msgtype'} || ''),
435 'preview' => $body, # html content only
441 =item render OPTION => VALUE ...
443 Fills in the template and renders it to a PDF document. Returns the
444 name of the PDF file.
446 Options are as for 'prepare', but 'from' and 'to' are meaningless.
450 # will also have options to set paper size, margins, etc.
454 eval "use PDF::WebKit";
457 my %hash = $self->prepare(%opt);
458 my $html = $hash{'html_body'};
460 # Graphics/stylesheets should probably go in /var/www on the Freeside
462 my $script_path = `/usr/bin/which freeside-wkhtmltopdf`;
464 my $kit = PDF::WebKit->new(\$html); #%options
465 # hack to use our wrapper script
466 $kit->configure(sub { shift->wkhtmltopdf($script_path) });
473 Render a PDF and send it to the printer. OPTIONS are as for 'render'.
478 my( $self, %opt ) = @_;
479 do_print( [ $self->render(%opt) ], agentnum=>$opt{cust_main}->agentnum );
482 # helper sub for package dates
483 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
485 # helper sub for money amounts
486 my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) };
488 # helper sub for usage-related messages
489 my $usage_warning = sub {
491 foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
492 my $amount = $svc->$col; next if $amount eq '';
493 my $method = $col.'_threshold';
494 my $threshold = $svc->$method; next if $threshold eq '';
495 return [$col, $amount, $threshold] if $amount <= $threshold;
496 # this only returns the first one that's below threshold, if there are
504 Returns the L<FS::template_content> object appropriate to LOCALE, if there
505 is one. If not, returns the one with a NULL locale.
512 qsearchs('template_content',
513 { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
514 qsearchs('template_content',
515 { 'msgnum' => $self->msgnum, 'locale' => '' });
520 =item send_prepared CUST_MSG
522 Takes the CUST_MSG object and sends it to its recipient. The "smtpmachine"
523 configuration option will be used to find the outgoing mail server.
529 my $cust_msg = shift or die "cust_msg required";
531 if ( $FS::Misc::DISABLE_ALL_NOTICES ) {
532 warn 'send_prepared() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG;
536 my $domain = 'example.com';
537 if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) {
541 # in principle should already be a list of bare addresses, but run it
542 # through Email::Address to make sure
543 my @env_to = map { $_->address } Email::Address->parse($cust_msg->env_to);
545 my $message = join("\n", $cust_msg->header, $cust_msg->body);
547 my $error = _sendmail( $message, { 'from' => $cust_msg->env_from,
553 $cust_msg->set('error', $error);
554 $cust_msg->set('status', $error ? 'failed' : 'sent');
555 if ( $cust_msg->custmsgnum ) {
571 # Every bit as pleasant as it sounds.
573 # We do this because Text::Template::Preprocess doesn't
574 # actually work. It runs the entire template through
575 # the preprocessor, instead of the code segments. Which
576 # is a shame, because Text::Template already contains
577 # the code to do this operation.
579 my (@outside, @inside);
582 while($body || $chunk) {
583 my ($first, $delim, $rest);
584 # put all leading non-delimiters into $first
586 ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
588 # put a leading delimiter into $delim if there is one
590 ($rest =~ /^([{}]?)(.*)$/s);
592 if( $delim eq '{' ) {
595 push @outside, $chunk;
600 elsif( $delim eq '}' ) {
603 push @inside, $chunk;
611 push @outside, $chunk . $rest;
612 } # else ? something wrong
617 (\@outside, \@inside);
624 L<FS::Record>, schema.html from the base documentation.