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.
215 my( $self, %opt ) = @_;
217 my $cust_main = $opt{'cust_main'}; # or die 'cust_main required';
218 my $object = $opt{'object'}; # or die 'object required';
220 my $hashref = $self->prepare_substitutions(%opt);
223 my $locale = $cust_main && $cust_main->locale || '';
224 warn "no locale for cust#".$cust_main->custnum."; using default content\n"
225 if $DEBUG and $cust_main && !$locale;
226 my $content = $self->content($locale);
228 warn "preparing template '".$self->msgname."\n"
231 $_ = encode_entities($_ || '') foreach values(%$hashref);
236 my $subject_tmpl = new Text::Template (
238 SOURCE => $content->subject,
241 warn "$me filling in subject template\n" if $DEBUG;
242 my $subject = $subject_tmpl->fill_in( HASH => $hashref );
244 my $body = $content->body;
245 my ($skin, $guts) = eviscerate($body);
247 $_ = decode_entities($_); # turn all punctuation back into itself
248 s/\r//gs; # remove \r's
249 s/<br[^>]*>/\n/gsi; # and <br /> tags
250 s/<p>/\n/gsi; # and <p>
251 s/<\/p>//gsi; # and </p>
252 s/\240/ /gs; # and
256 $body = '{ use Date::Format qw(time2str); "" }';
257 while(@$skin || @$guts) {
258 $body .= shift(@$skin) || '';
259 $body .= shift(@$guts) || '';
266 my $body_tmpl = new Text::Template (
271 warn "$me filling in body template\n" if $DEBUG;
272 $body = $body_tmpl->fill_in( HASH => $hashref );
274 # override $body if requested
275 if ( $opt{'override_content'} ) {
276 warn "$me overriding template body with requested content" if $DEBUG;
277 $body = $opt{'override_content'};
285 if ( exists($opt{'to'}) ) {
286 @to = split(/\s*,\s*/, $opt{'to'});
287 } elsif ( $cust_main ) {
288 @to = $cust_main->invoicing_list_emailonly;
290 die 'no To: address or cust_main object specified';
293 my $from_addr = $self->from_addr;
297 my $agentnum = $cust_main ? $cust_main->agentnum : '';
299 if ( $opt{'from_config'} ) {
300 $from_addr = $conf->config($opt{'from_config'}, $agentnum);
302 $from_addr ||= $conf->invoice_from_full($agentnum);
305 my $text_body = encode('UTF-8',
306 HTML::FormatText->new(leftmargin => 0, rightmargin => 70)
307 ->format( HTML::TreeBuilder->new_from_content($body) )
310 warn "$me constructing MIME entities\n" if $DEBUG;
311 my %email = generate_email(
312 'from' => $from_addr,
314 'bcc' => $self->bcc_addr || undef,
315 'subject' => $subject,
316 'html_body' => $body,
317 'text_body' => $text_body,
320 warn "$me creating message headers\n" if $DEBUG;
321 my $env_from = $from_addr;
322 $env_from =~ s/^\s*//; $env_from =~ s/\s*$//;
323 if ( $env_from =~ /^(.*)\s*<(.*@.*)>$/ ) {
329 if ( $env_from =~ /\@([\w\.\-]+)/ ) {
332 warn 'no domain found in invoice from address '. $env_from .
333 '; constructing Message-ID (and saying HELO) @example.com';
334 $domain = 'example.com';
336 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
339 my $message = MIME::Entity->build(
340 'From' => $from_addr,
341 'To' => join(', ', @to),
342 'Sender' => $from_addr,
343 'Reply-To' => $from_addr,
344 'Date' => time2str("%a, %d %b %Y %X %z", $time),
345 'Subject' => Encode::encode('MIME-Header', $subject),
346 'Message-ID' => "<$message_id>",
347 'Encoding' => '7bit',
348 'Type' => 'multipart/related',
351 #$message->head->replace('Content-type',
352 # 'multipart/related; '.
353 # 'boundary="' . $message->head->multipart_boundary . '"; ' .
354 # 'type=multipart/alternative'
357 # XXX a facility to attach additional parts is necessary at some point
358 foreach my $part (@{ $email{mimeparts} }) {
359 warn "$me appending part ".$part->mime_type."\n" if $DEBUG;
360 $message->add_part( $part );
363 # effective To: address (not in headers)
364 push @to, $self->bcc_addr if $self->bcc_addr;
365 my $env_to = join(', ', @to);
367 my $cust_msg = FS::cust_msg->new({
368 'custnum' => $cust_main ? $cust_main->custnum : '',
369 'msgnum' => $self->msgnum,
371 'env_from' => $env_from,
373 'header' => $message->header_as_string,
374 'body' => $message->body_as_string,
376 'status' => 'prepared',
377 'msgtype' => ($opt{'msgtype'} || ''),
378 'preview' => $body, # html content only
384 =item render OPTION => VALUE ...
386 Fills in the template and renders it to a PDF document. Returns the
387 name of the PDF file.
389 Options are as for 'prepare', but 'from' and 'to' are meaningless.
393 # will also have options to set paper size, margins, etc.
397 eval "use PDF::WebKit";
400 my %hash = $self->prepare(%opt);
401 my $html = $hash{'html_body'};
403 # Graphics/stylesheets should probably go in /var/www on the Freeside
405 my $script_path = `/usr/bin/which freeside-wkhtmltopdf`;
407 my $kit = PDF::WebKit->new(\$html); #%options
408 # hack to use our wrapper script
409 $kit->configure(sub { shift->wkhtmltopdf($script_path) });
416 Render a PDF and send it to the printer. OPTIONS are as for 'render'.
421 my( $self, %opt ) = @_;
422 do_print( [ $self->render(%opt) ], agentnum=>$opt{cust_main}->agentnum );
425 # helper sub for package dates
426 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
428 # helper sub for money amounts
429 my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) };
431 # helper sub for usage-related messages
432 my $usage_warning = sub {
434 foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
435 my $amount = $svc->$col; next if $amount eq '';
436 my $method = $col.'_threshold';
437 my $threshold = $svc->$method; next if $threshold eq '';
438 return [$col, $amount, $threshold] if $amount <= $threshold;
439 # this only returns the first one that's below threshold, if there are
447 Returns the L<FS::template_content> object appropriate to LOCALE, if there
448 is one. If not, returns the one with a NULL locale.
455 qsearchs('template_content',
456 { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
457 qsearchs('template_content',
458 { 'msgnum' => $self->msgnum, 'locale' => '' });
463 =item send_prepared CUST_MSG
465 Takes the CUST_MSG object and sends it to its recipient. The "smtpmachine"
466 configuration option will be used to find the outgoing mail server.
472 my $cust_msg = shift or die "cust_msg required";
474 my $domain = 'example.com';
475 if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) {
479 my @to = split(/\s*,\s*/, $cust_msg->env_to);
481 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
484 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
485 $smtp_opt{'port'} = $port;
488 if ( defined($enc) && $enc eq 'starttls' ) {
489 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
490 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
492 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
493 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
495 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
496 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
499 warn "$me sending message\n" if $DEBUG;
500 my $message = join("\n\n", $cust_msg->header, $cust_msg->body);
503 sendmail( $message, { transport => $transport,
504 from => $cust_msg->env_from,
508 if(ref($@) and $@->isa('Email::Sender::Failure')) {
509 $error = $@->code.' ' if $@->code;
510 $error .= $@->message;
516 $cust_msg->set('error', $error);
517 $cust_msg->set('status', $error ? 'failed' : 'sent');
518 if ( $cust_msg->custmsgnum ) {
534 # Every bit as pleasant as it sounds.
536 # We do this because Text::Template::Preprocess doesn't
537 # actually work. It runs the entire template through
538 # the preprocessor, instead of the code segments. Which
539 # is a shame, because Text::Template already contains
540 # the code to do this operation.
542 my (@outside, @inside);
545 while($body || $chunk) {
546 my ($first, $delim, $rest);
547 # put all leading non-delimiters into $first
549 ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
551 # put a leading delimiter into $delim if there is one
553 ($rest =~ /^([{}]?)(.*)$/s);
555 if( $delim eq '{' ) {
558 push @outside, $chunk;
563 elsif( $delim eq '}' ) {
566 push @inside, $chunk;
574 push @outside, $chunk . $rest;
575 } # else ? something wrong
580 (\@outside, \@inside);
587 L<FS::Record>, schema.html from the base documentation.