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:
167 Customer object (required).
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.
209 my( $self, %opt ) = @_;
211 my $cust_main = $opt{'cust_main'}; # or die 'cust_main required';
212 my $object = $opt{'object'} or die 'object required';
214 my $hashref = $self->prepare_substitutions(%opt);
217 my $locale = $cust_main && $cust_main->locale || '';
218 warn "no locale for cust#".$cust_main->custnum."; using default content\n"
219 if $DEBUG and $cust_main && !$locale;
220 my $content = $self->content($locale);
222 warn "preparing template '".$self->msgname."\n"
225 $_ = encode_entities($_ || '') foreach values(%$hashref);
230 my $subject_tmpl = new Text::Template (
232 SOURCE => $content->subject,
235 warn "$me filling in subject template\n" if $DEBUG;
236 my $subject = $subject_tmpl->fill_in( HASH => $hashref );
238 my $body = $content->body;
239 my ($skin, $guts) = eviscerate($body);
241 $_ = decode_entities($_); # turn all punctuation back into itself
242 s/\r//gs; # remove \r's
243 s/<br[^>]*>/\n/gsi; # and <br /> tags
244 s/<p>/\n/gsi; # and <p>
245 s/<\/p>//gsi; # and </p>
246 s/\240/ /gs; # and
250 $body = '{ use Date::Format qw(time2str); "" }';
251 while(@$skin || @$guts) {
252 $body .= shift(@$skin) || '';
253 $body .= shift(@$guts) || '';
260 my $body_tmpl = new Text::Template (
265 warn "$me filling in body template\n" if $DEBUG;
266 $body = $body_tmpl->fill_in( HASH => $hashref );
273 if ( exists($opt{'to'}) ) {
274 @to = split(/\s*,\s*/, $opt{'to'});
275 } elsif ( $cust_main ) {
276 @to = $cust_main->invoicing_list_emailonly;
278 die 'no To: address or cust_main object specified';
281 my $from_addr = $self->from_addr;
285 my $agentnum = $cust_main ? $cust_main->agentnum : '';
287 if ( $opt{'from_config'} ) {
288 $from_addr = $conf->config($opt{'from_config'}, $agentnum);
290 $from_addr ||= $conf->invoice_from_full($agentnum);
293 my $text_body = encode('UTF-8',
294 HTML::FormatText->new(leftmargin => 0, rightmargin => 70)
295 ->format( HTML::TreeBuilder->new_from_content($body) )
298 warn "$me constructing MIME entities\n" if $DEBUG;
299 my %email = generate_email(
300 'from' => $from_addr,
302 'bcc' => $self->bcc_addr || undef,
303 'subject' => $subject,
304 'html_body' => $body,
305 'text_body' => $text_body,
308 warn "$me creating message headers\n" if $DEBUG;
309 my $env_from = $from_addr;
310 $env_from =~ s/^\s*//; $env_from =~ s/\s*$//;
311 if ( $env_from =~ /^(.*)\s*<(.*@.*)>$/ ) {
317 if ( $env_from =~ /\@([\w\.\-]+)/ ) {
320 warn 'no domain found in invoice from address '. $env_from .
321 '; constructing Message-ID (and saying HELO) @example.com';
322 $domain = 'example.com';
324 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
327 my $message = MIME::Entity->build(
328 'From' => $from_addr,
329 'To' => join(', ', @to),
330 'Sender' => $from_addr,
331 'Reply-To' => $from_addr,
332 'Date' => time2str("%a, %d %b %Y %X %z", $time),
333 'Subject' => Encode::encode('MIME-Header', $subject),
334 'Message-ID' => "<$message_id>",
335 'Encoding' => '7bit',
336 'Type' => 'multipart/related',
339 #$message->head->replace('Content-type',
340 # 'multipart/related; '.
341 # 'boundary="' . $message->head->multipart_boundary . '"; ' .
342 # 'type=multipart/alternative'
345 # XXX a facility to attach additional parts is necessary at some point
346 foreach my $part (@{ $email{mimeparts} }) {
347 warn "$me appending part ".$part->mime_type."\n" if $DEBUG;
348 $message->add_part( $part );
351 # effective To: address (not in headers)
352 push @to, $self->bcc_addr if $self->bcc_addr;
353 my $env_to = join(', ', @to);
355 my $cust_msg = FS::cust_msg->new({
356 'custnum' => $cust_main->custnum,
357 'msgnum' => $self->msgnum,
359 'env_from' => $env_from,
361 'header' => $message->header_as_string,
362 'body' => $message->body_as_string,
364 'status' => 'prepared',
365 'msgtype' => ($opt{'msgtype'} || ''),
366 'preview' => $body, # html content only
372 =item render OPTION => VALUE ...
374 Fills in the template and renders it to a PDF document. Returns the
375 name of the PDF file.
377 Options are as for 'prepare', but 'from' and 'to' are meaningless.
381 # will also have options to set paper size, margins, etc.
385 eval "use PDF::WebKit";
388 my %hash = $self->prepare(%opt);
389 my $html = $hash{'html_body'};
391 # Graphics/stylesheets should probably go in /var/www on the Freeside
393 my $script_path = `/usr/bin/which freeside-wkhtmltopdf`;
395 my $kit = PDF::WebKit->new(\$html); #%options
396 # hack to use our wrapper script
397 $kit->configure(sub { shift->wkhtmltopdf($script_path) });
404 Render a PDF and send it to the printer. OPTIONS are as for 'render'.
409 my( $self, %opt ) = @_;
410 do_print( [ $self->render(%opt) ], agentnum=>$opt{cust_main}->agentnum );
413 # helper sub for package dates
414 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
416 # helper sub for money amounts
417 my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) };
419 # helper sub for usage-related messages
420 my $usage_warning = sub {
422 foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
423 my $amount = $svc->$col; next if $amount eq '';
424 my $method = $col.'_threshold';
425 my $threshold = $svc->$method; next if $threshold eq '';
426 return [$col, $amount, $threshold] if $amount <= $threshold;
427 # this only returns the first one that's below threshold, if there are
435 Returns the L<FS::template_content> object appropriate to LOCALE, if there
436 is one. If not, returns the one with a NULL locale.
443 qsearchs('template_content',
444 { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
445 qsearchs('template_content',
446 { 'msgnum' => $self->msgnum, 'locale' => '' });
457 =item send_prepared CUST_MSG
459 Takes the CUST_MSG object and sends it to its recipient. This is a class
460 method because everything needed to send the message is stored in the
467 my $cust_msg = shift or die "cust_msg required";
469 my $domain = 'example.com';
470 if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) {
474 my @to = split(/\s*,\s*/, $cust_msg->env_to);
476 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
479 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
480 $smtp_opt{'port'} = $port;
483 if ( defined($enc) && $enc eq 'starttls' ) {
484 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
485 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
487 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
488 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
490 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
491 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
494 warn "$me sending message\n" if $DEBUG;
495 my $message = join("\n\n", $cust_msg->header, $cust_msg->body);
498 sendmail( $message, { transport => $transport,
499 from => $cust_msg->env_from,
503 if(ref($@) and $@->isa('Email::Sender::Failure')) {
504 $error = $@->code.' ' if $@->code;
505 $error .= $@->message;
511 $cust_msg->set('error', $error);
512 $cust_msg->set('status', $error ? 'failed' : 'sent');
513 if ( $cust_msg->custmsgnum ) {
529 # Every bit as pleasant as it sounds.
531 # We do this because Text::Template::Preprocess doesn't
532 # actually work. It runs the entire template through
533 # the preprocessor, instead of the code segments. Which
534 # is a shame, because Text::Template already contains
535 # the code to do this operation.
537 my (@outside, @inside);
540 while($body || $chunk) {
541 my ($first, $delim, $rest);
542 # put all leading non-delimiters into $first
544 ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
546 # put a leading delimiter into $delim if there is one
548 ($rest =~ /^([{}]?)(.*)$/s);
550 if( $delim eq '{' ) {
553 push @outside, $chunk;
558 elsif( $delim eq '}' ) {
561 push @inside, $chunk;
569 push @outside, $chunk . $rest;
570 } # else ? something wrong
575 (\@outside, \@inside);
582 L<FS::Record>, schema.html from the base documentation.