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 );
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:
166 Customer object (required).
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.
208 my( $self, %opt ) = @_;
210 my $cust_main = $opt{'cust_main'}; # or die 'cust_main required';
211 my $object = $opt{'object'} or die 'object required';
213 my $hashref = $self->prepare_substitutions(%opt);
216 my $locale = $cust_main && $cust_main->locale || '';
217 warn "no locale for cust#".$cust_main->custnum."; using default content\n"
218 if $DEBUG and $cust_main && !$locale;
219 my $content = $self->content($locale);
221 warn "preparing template '".$self->msgname."\n"
224 $_ = encode_entities($_ || '') foreach values(%$hashref);
229 my $subject_tmpl = new Text::Template (
231 SOURCE => $content->subject,
234 warn "$me filling in subject template\n" if $DEBUG;
235 my $subject = $subject_tmpl->fill_in( HASH => $hashref );
237 my $body = $content->body;
238 my ($skin, $guts) = eviscerate($body);
240 $_ = decode_entities($_); # turn all punctuation back into itself
241 s/\r//gs; # remove \r's
242 s/<br[^>]*>/\n/gsi; # and <br /> tags
243 s/<p>/\n/gsi; # and <p>
244 s/<\/p>//gsi; # and </p>
245 s/\240/ /gs; # and
249 $body = '{ use Date::Format qw(time2str); "" }';
250 while(@$skin || @$guts) {
251 $body .= shift(@$skin) || '';
252 $body .= shift(@$guts) || '';
259 my $body_tmpl = new Text::Template (
264 warn "$me filling in body template\n" if $DEBUG;
265 $body = $body_tmpl->fill_in( HASH => $hashref );
272 if ( exists($opt{'to'}) ) {
273 @to = split(/\s*,\s*/, $opt{'to'});
274 } elsif ( $cust_main ) {
275 @to = $cust_main->invoicing_list_emailonly;
277 die 'no To: address or cust_main object specified';
280 my $from_addr = $self->from_addr;
284 my $agentnum = $cust_main ? $cust_main->agentnum : '';
286 if ( $opt{'from_config'} ) {
287 $from_addr = $conf->config($opt{'from_config'}, $agentnum);
289 $from_addr ||= $conf->invoice_from_full($agentnum);
292 my $text_body = encode('UTF-8',
293 HTML::FormatText->new(leftmargin => 0, rightmargin => 70)
294 ->format( HTML::TreeBuilder->new_from_content($body) )
297 warn "$me constructing MIME entities\n" if $DEBUG;
298 my %email = generate_email(
299 'from' => $from_addr,
301 'bcc' => $self->bcc_addr || undef,
302 'subject' => $subject,
303 'html_body' => $body,
304 'text_body' => $text_body,
307 warn "$me creating message headers\n" if $DEBUG;
308 my $env_from = $from_addr;
309 $env_from =~ s/^\s*//; $env_from =~ s/\s*$//;
310 if ( $env_from =~ /^(.*)\s*<(.*@.*)>$/ ) {
316 if ( $env_from =~ /\@([\w\.\-]+)/ ) {
319 warn 'no domain found in invoice from address '. $env_from .
320 '; constructing Message-ID (and saying HELO) @example.com';
321 $domain = 'example.com';
323 my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
326 my $message = MIME::Entity->build(
327 'From' => $from_addr,
328 'To' => join(', ', @to),
329 'Sender' => $from_addr,
330 'Reply-To' => $from_addr,
331 'Date' => time2str("%a, %d %b %Y %X %z", $time),
332 'Subject' => Encode::encode('MIME-Header', $subject),
333 'Message-ID' => "<$message_id>",
334 'Encoding' => '7bit',
335 'Type' => 'multipart/related',
338 #$message->head->replace('Content-type',
339 # 'multipart/related; '.
340 # 'boundary="' . $message->head->multipart_boundary . '"; ' .
341 # 'type=multipart/alternative'
344 # XXX a facility to attach additional parts is necessary at some point
345 foreach my $part (@{ $email{mimeparts} }) {
346 warn "$me appending part ".$part->mime_type."\n" if $DEBUG;
347 $message->add_part( $part );
350 # effective To: address (not in headers)
351 push @to, $self->bcc_addr if $self->bcc_addr;
352 my $env_to = join(', ', @to);
354 my $cust_msg = FS::cust_msg->new({
355 'custnum' => $cust_main->custnum,
356 'msgnum' => $self->msgnum,
358 'env_from' => $env_from,
360 'header' => $message->header_as_string,
361 'body' => $message->body_as_string,
363 'status' => 'prepared',
364 'msgtype' => ($opt{'msgtype'} || ''),
370 =item send_prepared CUST_MSG
372 Takes the CUST_MSG object and sends it to its recipient.
378 my $cust_msg = shift or die "cust_msg required";
380 my $domain = 'example.com';
381 if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) {
385 my @to = split(/\s*,\s*/, $cust_msg->env_to);
387 my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
390 my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
391 $smtp_opt{'port'} = $port;
394 if ( defined($enc) && $enc eq 'starttls' ) {
395 $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
396 $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
398 if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
399 $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
401 $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
402 $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
405 warn "$me sending message\n" if $DEBUG;
406 my $message = join("\n\n", $cust_msg->header, $cust_msg->body);
409 sendmail( $message, { transport => $transport,
410 from => $cust_msg->env_from,
414 if(ref($@) and $@->isa('Email::Sender::Failure')) {
415 $error = $@->code.' ' if $@->code;
416 $error .= $@->message;
422 $cust_msg->set('error', $error);
423 $cust_msg->set('status', $error ? 'failed' : 'sent');
424 if ( $cust_msg->custmsgnum ) {
433 =item render OPTION => VALUE ...
435 Fills in the template and renders it to a PDF document. Returns the
436 name of the PDF file.
438 Options are as for 'prepare', but 'from' and 'to' are meaningless.
442 # will also have options to set paper size, margins, etc.
446 eval "use PDF::WebKit";
449 my %hash = $self->prepare(%opt);
450 my $html = $hash{'html_body'};
452 # Graphics/stylesheets should probably go in /var/www on the Freeside
454 my $script_path = `/usr/bin/which freeside-wkhtmltopdf`;
456 my $kit = PDF::WebKit->new(\$html); #%options
457 # hack to use our wrapper script
458 $kit->configure(sub { shift->wkhtmltopdf($script_path) });
465 Render a PDF and send it to the printer. OPTIONS are as for 'render'.
470 my( $self, %opt ) = @_;
471 do_print( [ $self->render(%opt) ], agentnum=>$opt{cust_main}->agentnum );
474 # helper sub for package dates
475 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
477 # helper sub for money amounts
478 my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) };
480 # helper sub for usage-related messages
481 my $usage_warning = sub {
483 foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
484 my $amount = $svc->$col; next if $amount eq '';
485 my $method = $col.'_threshold';
486 my $threshold = $svc->$method; next if $threshold eq '';
487 return [$col, $amount, $threshold] if $amount <= $threshold;
488 # this only returns the first one that's below threshold, if there are
494 #my $conf = new FS::Conf;
496 #return contexts and fill-in values
497 # If you add anything, be sure to add a description in
498 # httemplate/edit/msg_template.html.
500 { 'cust_main' => [qw(
501 display_custnum agentnum agent_name
504 name name_short contact contact_firstlast
505 address1 address2 city county state zip
507 daytime night mobile fax
510 ship_name ship_name_short ship_contact ship_contact_firstlast
511 ship_address1 ship_address2 ship_city ship_county ship_state ship_zip
514 paymask payname paytype payip
515 num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
516 classname categoryname
519 invoicing_list_emailonly
520 cust_status ucfirst_cust_status cust_statuscolor cust_status_label
525 [ invoicing_email => sub { shift->invoicing_list_emailonly_scalar } ],
526 #compatibility: obsolete ship_ fields - use the non-ship versions
529 [ "ship_$field" => sub { shift->$field } ]
531 qw( last first company daytime night fax )
533 # ship_name, ship_name_short, ship_contact, ship_contact_firstlast
535 [ expdate => sub { shift->paydate_epoch } ], #compatibility
536 [ signupdate_ymd => sub { $ymd->(shift->signupdate) } ],
537 [ dundate_ymd => sub { $ymd->(shift->dundate) } ],
538 [ paydate_my => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
539 [ otaker_first => sub { shift->access_user->first } ],
540 [ otaker_last => sub { shift->access_user->last } ],
541 [ payby => sub { FS::payby->shortname(shift->payby) } ],
542 [ company_name => sub {
543 $conf->config('company_name', shift->agentnum)
545 [ company_address => sub {
546 $conf->config('company_address', shift->agentnum)
548 [ company_phonenum => sub {
549 $conf->config('company_phonenum', shift->agentnum)
551 [ selfservice_server_base_url => sub {
552 $conf->config('selfservice_server-base_url') #, shift->agentnum)
557 pkgnum pkg_label pkg_label_long
561 start_date setup bill last_bill
565 [ pkg => sub { shift->part_pkg->pkg } ],
566 [ pkg_category => sub { shift->part_pkg->categoryname } ],
567 [ pkg_class => sub { shift->part_pkg->classname } ],
568 [ cancel => sub { shift->getfield('cancel') } ], # grrr...
569 [ start_ymd => sub { $ymd->(shift->getfield('start_date')) } ],
570 [ setup_ymd => sub { $ymd->(shift->getfield('setup')) } ],
571 [ next_bill_ymd => sub { $ymd->(shift->getfield('bill')) } ],
572 [ last_bill_ymd => sub { $ymd->(shift->getfield('last_bill')) } ],
573 [ adjourn_ymd => sub { $ymd->(shift->getfield('adjourn')) } ],
574 [ susp_ymd => sub { $ymd->(shift->getfield('susp')) } ],
575 [ expire_ymd => sub { $ymd->(shift->getfield('expire')) } ],
576 [ cancel_ymd => sub { $ymd->(shift->getfield('cancel')) } ],
578 # not necessarily correct for non-flat packages
579 [ setup_fee => sub { shift->part_pkg->option('setup_fee') } ],
580 [ recur_fee => sub { shift->part_pkg->option('recur_fee') } ],
582 [ freq_pretty => sub { shift->part_pkg->freq_pretty } ],
591 [ due_date2str => sub { shift->due_date2str('short') } ],
593 #XXX not really thinking about cust_bill substitutions quite yet
595 # for welcome and limit warning messages
601 [ password => sub { shift->getfield('_password') } ],
602 [ column => sub { &$usage_warning(shift)->[0] } ],
603 [ amount => sub { &$usage_warning(shift)->[1] } ],
604 [ threshold => sub { &$usage_warning(shift)->[2] } ],
611 my $registrar = qsearchs('registrar',
612 { registrarnum => shift->registrarnum} );
613 $registrar ? $registrar->registrarname : ''
617 my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
618 $svc_acct ? $svc_acct->email : ''
629 'svc_broadband' => [qw(
637 # for payment receipts
642 [ paid => sub { sprintf("%.2f", shift->paid) } ],
643 # overrides the one in cust_main in cases where a cust_pay is passed
644 [ payby => sub { FS::payby->shortname(shift->payby) } ],
645 [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
647 my $cust_pay = shift;
648 ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ?
649 $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo)
652 # for payment decline messages
653 # try to support all cust_pay fields
654 # 'error' is a special case, it contains the raw error from the gateway
655 'cust_pay_pending' => [qw(
659 [ paid => sub { sprintf("%.2f", shift->paid) } ],
660 [ payby => sub { FS::payby->shortname(shift->payby) } ],
661 [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
664 ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ?
665 $pending->paymask : $pending->decrypt($pending->payinfo)
673 Returns the L<FS::template_content> object appropriate to LOCALE, if there
674 is one. If not, returns the one with a NULL locale.
681 qsearchs('template_content',
682 { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
683 qsearchs('template_content',
684 { 'msgnum' => $self->msgnum, 'locale' => '' });
689 Returns the L<FS::agent> object for this template.
694 my ($self, %opts) = @_;
697 # First move any historical templates in config to real message templates
701 [ 'alerter_msgnum', 'alerter_template', '', '', '' ],
702 [ 'cancel_msgnum', 'cancelmessage', 'cancelsubject', '', '' ],
703 [ 'decline_msgnum', 'declinetemplate', '', '', '' ],
704 [ 'impending_recur_msgnum', 'impending_recur_template', '', '', 'impending_recur_bcc' ],
705 [ 'payment_receipt_msgnum', 'payment_receipt_email', '', '', '' ],
706 [ 'welcome_msgnum', 'welcome_email', 'welcome_email-subject', 'welcome_email-from', '' ],
707 [ 'warning_msgnum', 'warning_email', 'warning_email-subject', 'warning_email-from', '' ],
710 my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
711 foreach my $agentnum (@agentnums) {
713 my ($newname, $oldname, $subject, $from, $bcc) = @$_;
714 if ($conf->exists($oldname, $agentnum)) {
715 my $new = new FS::msg_template({
716 'msgname' => $oldname,
717 'agentnum' => $agentnum,
718 'from_addr' => ($from && $conf->config($from, $agentnum)) || '',
719 'bcc_addr' => ($bcc && $conf->config($from, $agentnum)) || '',
720 'subject' => ($subject && $conf->config($subject, $agentnum)) || '',
721 'mime_type' => 'text/html',
722 'body' => join('<BR>',$conf->config($oldname, $agentnum)),
724 my $error = $new->insert;
725 die $error if $error;
726 $conf->set($newname, $new->msgnum, $agentnum);
727 $conf->delete($oldname, $agentnum);
728 $conf->delete($from, $agentnum) if $from;
729 $conf->delete($subject, $agentnum) if $subject;
733 if ( $conf->exists('alert_expiration', $agentnum) ) {
734 my $msgnum = $conf->exists('alerter_msgnum', $agentnum);
735 my $template = FS::msg_template->by_key($msgnum) if $msgnum;
737 warn "template for alerter_msgnum $msgnum not found\n";
740 # this is now a set of billing events
741 foreach my $days (30, 15, 5) {
742 my $event = FS::part_event->new({
743 'agentnum' => $agentnum,
744 'event' => "Card expiration warning - $days days",
745 'eventtable' => 'cust_main',
746 'check_freq' => '1d',
747 'action' => 'notice',
748 'disabled' => 'Y', #initialize first
750 my $error = $event->insert( 'msgnum' => $msgnum );
752 warn "error creating expiration alert event:\n$error\n\n";
755 # make it work like before:
756 # only send each warning once before the card expires,
757 # only warn active customers,
758 # only warn customers with CARD/DCRD,
759 # only warn customers who get email invoices
761 'once_every' => { 'run_delay' => '30d' },
762 'cust_paydate_within' => { 'within' => $days.'d' },
763 'cust_status' => { 'status' => { 'active' => 1 } },
764 'payby' => { 'payby' => { 'CARD' => 1,
767 'message_email' => {},
769 foreach (keys %conds) {
770 my $condition = FS::part_event_condition->new({
771 'conditionname' => $_,
772 'eventpart' => $event->eventpart,
774 $error = $condition->insert( %{ $conds{$_} });
776 warn "error creating expiration alert event:\n$error\n\n";
780 $error = $event->initialize;
782 warn "expiration alert event was created, but not initialized:\n$error\n\n";
785 $conf->delete('alerter_msgnum', $agentnum);
786 $conf->delete('alert_expiration', $agentnum);
788 } # if alerter_msgnum
793 # Move subject and body from msg_template to template_content
796 foreach my $msg_template ( qsearch('msg_template', {}) ) {
797 if ( $msg_template->subject || $msg_template->body ) {
798 # create new default content
800 $content{subject} = $msg_template->subject;
801 $msg_template->set('subject', '');
803 # work around obscure Pg/DBD bug
804 # https://rt.cpan.org/Public/Bug/Display.html?id=60200
805 # (though the right fix is to upgrade DBD)
806 my $body = $msg_template->body;
807 if ( $body =~ /^x([0-9a-f]+)$/ ) {
808 # there should be no real message templates that look like that
809 warn "converting template body to TEXT\n";
810 $body = pack('H*', $1);
812 $content{body} = $body;
813 $msg_template->set('body', '');
815 my $error = $msg_template->replace(%content);
816 die $error if $error;
821 # Add new-style default templates if missing
823 $self->_populate_initial_data;
827 sub _populate_initial_data { #class method
828 #my($class, %opts) = @_;
831 eval "use FS::msg_template::InitialData;";
834 my $initial_data = FS::msg_template::InitialData->_initial_data;
836 foreach my $hash ( @$initial_data ) {
838 next if $hash->{_conf} && $conf->config( $hash->{_conf} );
840 my $msg_template = new FS::msg_template($hash);
841 my $error = $msg_template->insert( @{ $hash->{_insert_args} || [] } );
842 die $error if $error;
844 $conf->set( $hash->{_conf}, $msg_template->msgnum ) if $hash->{_conf};
851 # Every bit as pleasant as it sounds.
853 # We do this because Text::Template::Preprocess doesn't
854 # actually work. It runs the entire template through
855 # the preprocessor, instead of the code segments. Which
856 # is a shame, because Text::Template already contains
857 # the code to do this operation.
859 my (@outside, @inside);
862 while($body || $chunk) {
863 my ($first, $delim, $rest);
864 # put all leading non-delimiters into $first
866 ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
868 # put a leading delimiter into $delim if there is one
870 ($rest =~ /^([{}]?)(.*)$/s);
872 if( $delim eq '{' ) {
875 push @outside, $chunk;
880 elsif( $delim eq '}' ) {
883 push @inside, $chunk;
891 push @outside, $chunk . $rest;
892 } # else ? something wrong
897 (\@outside, \@inside);
906 L<FS::Record>, schema.html from the base documentation.