1 package FS::msg_template;
4 use base qw( FS::Record );
6 use FS::Misc qw( generate_email send_email );
8 use FS::Record qw( qsearch qsearchs );
13 use FS::template_content;
15 use Date::Format qw( time2str );
16 use HTML::Entities qw( decode_entities encode_entities ) ;
18 use HTML::TreeBuilder;
19 use vars qw( $DEBUG $conf );
21 FS::UID->install_callback( sub { $conf = new FS::Conf; } );
27 FS::msg_template - Object methods for msg_template records
33 $record = new FS::msg_template \%hash;
34 $record = new FS::msg_template { 'column' => 'value' };
36 $error = $record->insert;
38 $error = $new_record->replace($old_record);
40 $error = $record->delete;
42 $error = $record->check;
46 An FS::msg_template object represents a customer message template.
47 FS::msg_template inherits from FS::Record. The following fields are currently
52 =item msgnum - primary key
54 =item msgname - Name of the template. This will appear in the user interface;
55 if it needs to be localized for some users, add it to the message catalog.
57 =item agentnum - Agent associated with this template. Can be NULL for a
60 =item mime_type - MIME type. Defaults to text/html.
62 =item from_addr - Source email address.
64 =item disabled - disabled ('Y' or NULL).
74 Creates a new template. To add the template to the database, see L<"insert">.
76 Note that this stores the hash reference, not a distinct copy of the hash it
77 points to. You can ask the object for a copy with the I<hash> method.
81 # the new method can be inherited from FS::Record, if a table method is defined
83 sub table { 'msg_template'; }
85 =item insert [ CONTENT ]
87 Adds this record to the database. If there is an error, returns the error,
88 otherwise returns false.
90 A default (no locale) L<FS::template_content> object will be created. CONTENT
91 is an optional hash containing 'subject' and 'body' for this object.
99 my $oldAutoCommit = $FS::UID::AutoCommit;
100 local $FS::UID::AutoCommit = 0;
103 my $error = $self->SUPER::insert;
105 $content{'msgnum'} = $self->msgnum;
106 $content{'subject'} ||= '';
107 $content{'body'} ||= '';
108 my $template_content = new FS::template_content (\%content);
109 $error = $template_content->insert;
113 $dbh->rollback if $oldAutoCommit;
117 $dbh->commit if $oldAutoCommit;
123 Delete this record from the database.
127 # the delete method can be inherited from FS::Record
129 =item replace [ OLD_RECORD ] [ CONTENT ]
131 Replaces the OLD_RECORD with this one in the database. If there is an error,
132 returns the error, otherwise returns false.
134 CONTENT is an optional hash containing 'subject', 'body', and 'locale'. If
135 supplied, an L<FS::template_content> object will be created (or modified, if
136 one already exists for this locale).
142 my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') )
144 : $self->replace_old;
147 my $oldAutoCommit = $FS::UID::AutoCommit;
148 local $FS::UID::AutoCommit = 0;
151 my $error = $self->SUPER::replace($old);
153 if ( !$error and %content ) {
154 $content{'locale'} ||= '';
155 my $new_content = qsearchs('template_content', {
156 'msgnum' => $self->msgnum,
157 'locale' => $content{'locale'},
159 if ( $new_content ) {
160 $new_content->subject($content{'subject'});
161 $new_content->body($content{'body'});
162 $error = $new_content->replace;
165 $content{'msgnum'} = $self->msgnum;
166 $new_content = new FS::template_content \%content;
167 $error = $new_content->insert;
172 $dbh->rollback if $oldAutoCommit;
176 warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit;
177 $dbh->commit if $oldAutoCommit;
185 Checks all fields to make sure this is a valid template. If there is
186 an error, returns the error, otherwise returns false. Called by the insert
191 # the check method should currently be supplied - FS::Record contains some
192 # data checking routines
198 $self->ut_numbern('msgnum')
199 || $self->ut_text('msgname')
200 || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
201 || $self->ut_textn('mime_type')
202 || $self->ut_enum('disabled', [ '', 'Y' ] )
203 || $self->ut_textn('from_addr')
205 return $error if $error;
207 $self->mime_type('text/html') unless $self->mime_type;
212 =item content_locales
214 Returns a hashref of the L<FS::template_content> objects attached to
215 this template, with the locale as key.
219 sub content_locales {
221 return $self->{'_content_locales'} ||= +{
222 map { $_->locale , $_ }
223 qsearch('template_content', { 'msgnum' => $self->msgnum })
227 =item prepare OPTION => VALUE
229 Fills in the template and returns a hash of the 'from' address, 'to'
230 addresses, subject line, and body.
232 Options are passed as a list of name/value pairs:
238 Customer object (required).
242 Additional context object (currently, can be a cust_main, cust_pkg,
243 cust_bill, cust_pay, cust_pay_pending, or svc_(acct, phone, broadband,
244 domain) ). If the object is a svc_*, its cust_pkg will be fetched and
245 used for substitution.
247 As a special case, this may be an arrayref of two objects. Both
248 objects will be available for substitution, with their field names
249 prefixed with 'new_' and 'old_' respectively. This is used in the
250 rt_ticket export when exporting "replace" events.
254 Configuration option to use as the source address, based on the customer's
255 agentnum. If unspecified (or the named option is empty), 'invoice_from'
258 The I<from_addr> field in the template takes precedence over this.
262 Destination address. The default is to use the customer's
263 invoicing_list addresses. Multiple addresses may be comma-separated.
267 A hash reference of additional substitutions
274 my( $self, %opt ) = @_;
276 my $cust_main = $opt{'cust_main'};
277 my $object = $opt{'object'};
280 my $locale = $cust_main->locale || '';
281 warn "no locale for cust#".$cust_main->custnum."; using default content\n"
282 if $DEBUG and !$locale;
283 my $content = $self->content($cust_main->locale);
284 warn "preparing template '".$self->msgname."' to cust#".$cust_main->custnum."\n"
287 my $subs = $self->substitutions;
290 # create substitution table
293 my @objects = ($cust_main);
297 if( ref($object) eq 'ARRAY' ) {
298 # [new, old], for provisioning tickets
299 push @objects, $object->[0], $object->[1];
300 push @prefixes, 'new_', 'old_';
301 $svc = $object->[0] if $object->[0]->isa('FS::svc_Common');
304 push @objects, $object;
306 $svc = $object if $object->isa('FS::svc_Common');
310 push @objects, $svc->cust_svc->cust_pkg;
314 foreach my $obj (@objects) {
315 my $prefix = shift @prefixes;
316 foreach my $name (@{ $subs->{$obj->table} }) {
319 $hash{$prefix.$name} = $obj->$name();
321 elsif( ref($name) eq 'ARRAY' ) {
322 # [ foo => sub { ... } ]
323 $hash{$prefix.($name->[0])} = $name->[1]->($obj);
326 warn "bad msg_template substitution: '$name'\n";
332 if ( $opt{substitutions} ) {
333 $hash{$_} = $opt{substitutions}->{$_} foreach keys %{$opt{substitutions}};
336 $_ = encode_entities($_ || '') foreach values(%hash);
341 my $subject_tmpl = new Text::Template (
343 SOURCE => $content->subject,
345 my $subject = $subject_tmpl->fill_in( HASH => \%hash );
347 my $body = $content->body;
348 my ($skin, $guts) = eviscerate($body);
350 $_ = decode_entities($_); # turn all punctuation back into itself
351 s/\r//gs; # remove \r's
352 s/<br[^>]*>/\n/gsi; # and <br /> tags
353 s/<p>/\n/gsi; # and <p>
354 s/<\/p>//gsi; # and </p>
355 s/\240/ /gs; # and
359 $body = '{ use Date::Format qw(time2str); "" }';
360 while(@$skin || @$guts) {
361 $body .= shift(@$skin) || '';
362 $body .= shift(@$guts) || '';
369 my $body_tmpl = new Text::Template (
374 $body = $body_tmpl->fill_in( HASH => \%hash );
381 if ( exists($opt{'to'}) ) {
382 @to = split(/\s*,\s*/, $opt{'to'});
385 @to = $cust_main->invoicing_list_emailonly;
387 # no warning when preparing with no destination
389 my $from_addr = $self->from_addr;
392 if ( $opt{'from_config'} ) {
393 $from_addr = scalar( $conf->config($opt{'from_config'},
394 $cust_main->agentnum) );
396 $from_addr ||= scalar( $conf->config('invoice_from',
397 $cust_main->agentnum) );
400 # if ( $conf->exists('log_sent_mail') and !$opt{'preview'} ) {
401 # my $cust_msg = FS::cust_msg->new({
402 # 'custnum' => $cust_main->custnum,
403 # 'msgnum' => $self->msgnum,
404 # 'status' => 'prepared',
407 # @cust_msg = ('cust_msg' => $cust_msg);
411 'custnum' => $cust_main->custnum,
412 'msgnum' => $self->msgnum,
413 'from' => $from_addr,
415 'bcc' => $self->bcc_addr || undef,
416 'subject' => $subject,
417 'html_body' => $body,
418 'text_body' => HTML::FormatText->new(leftmargin => 0, rightmargin => 70
419 )->format( HTML::TreeBuilder->new_from_content($body) ),
424 =item send OPTION => VALUE
426 Fills in the template and sends it to the customer. Options are as for
431 # broken out from prepare() in case we want to queue the sending,
435 send_email(generate_email($self->prepare(@_)));
438 # helper sub for package dates
439 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
441 # helper sub for usage-related messages
442 my $usage_warning = sub {
444 foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
445 my $amount = $svc->$col; next if $amount eq '';
446 my $method = $col.'_threshold';
447 my $threshold = $svc->$method; next if $threshold eq '';
448 return [$col, $amount, $threshold] if $amount <= $threshold;
449 # this only returns the first one that's below threshold, if there are
455 #my $conf = new FS::Conf;
457 #return contexts and fill-in values
458 # If you add anything, be sure to add a description in
459 # httemplate/edit/msg_template.html.
461 { 'cust_main' => [qw(
462 display_custnum agentnum agent_name
465 name name_short contact contact_firstlast
466 address1 address2 city county state zip
468 daytime night mobile fax
471 ship_name ship_name_short ship_contact ship_contact_firstlast
472 ship_address1 ship_address2 ship_city ship_county ship_state ship_zip
475 paymask payname paytype payip
476 num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
477 classname categoryname
480 invoicing_list_emailonly
481 cust_status ucfirst_cust_status cust_statuscolor
486 #compatibility: obsolete ship_ fields - use the non-ship versions
489 [ "ship_$field" => sub { shift->$field } ]
491 qw( last first company daytime night fax )
493 # ship_name, ship_name_short, ship_contact, ship_contact_firstlast
495 [ expdate => sub { shift->paydate_epoch } ], #compatibility
496 [ signupdate_ymd => sub { $ymd->(shift->signupdate) } ],
497 [ dundate_ymd => sub { $ymd->(shift->dundate) } ],
498 [ paydate_my => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
499 [ otaker_first => sub { shift->access_user->first } ],
500 [ otaker_last => sub { shift->access_user->last } ],
501 [ payby => sub { FS::payby->shortname(shift->payby) } ],
502 [ company_name => sub {
503 $conf->config('company_name', shift->agentnum)
505 [ company_address => sub {
506 $conf->config('company_address', shift->agentnum)
508 [ company_phonenum => sub {
509 $conf->config('company_phonenum', shift->agentnum)
514 pkgnum pkg_label pkg_label_long
518 start_date setup bill last_bill
522 [ pkg => sub { shift->part_pkg->pkg } ],
523 [ cancel => sub { shift->getfield('cancel') } ], # grrr...
524 [ start_ymd => sub { $ymd->(shift->getfield('start_date')) } ],
525 [ setup_ymd => sub { $ymd->(shift->getfield('setup')) } ],
526 [ next_bill_ymd => sub { $ymd->(shift->getfield('bill')) } ],
527 [ last_bill_ymd => sub { $ymd->(shift->getfield('last_bill')) } ],
528 [ adjourn_ymd => sub { $ymd->(shift->getfield('adjourn')) } ],
529 [ susp_ymd => sub { $ymd->(shift->getfield('susp')) } ],
530 [ expire_ymd => sub { $ymd->(shift->getfield('expire')) } ],
531 [ cancel_ymd => sub { $ymd->(shift->getfield('cancel')) } ],
537 #XXX not really thinking about cust_bill substitutions quite yet
539 # for welcome and limit warning messages
545 [ password => sub { shift->getfield('_password') } ],
546 [ column => sub { &$usage_warning(shift)->[0] } ],
547 [ amount => sub { &$usage_warning(shift)->[1] } ],
548 [ threshold => sub { &$usage_warning(shift)->[2] } ],
555 my $registrar = qsearchs('registrar',
556 { registrarnum => shift->registrarnum} );
557 $registrar ? $registrar->registrarname : ''
561 my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
562 $svc_acct ? $svc_acct->email : ''
573 'svc_broadband' => [qw(
581 # for payment receipts
586 [ paid => sub { sprintf("%.2f", shift->paid) } ],
587 # overrides the one in cust_main in cases where a cust_pay is passed
588 [ payby => sub { FS::payby->shortname(shift->payby) } ],
589 [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
591 my $cust_pay = shift;
592 ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ?
593 $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo)
596 # for payment decline messages
597 # try to support all cust_pay fields
598 # 'error' is a special case, it contains the raw error from the gateway
599 'cust_pay_pending' => [qw(
603 [ paid => sub { sprintf("%.2f", shift->paid) } ],
604 [ payby => sub { FS::payby->shortname(shift->payby) } ],
605 [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
608 ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ?
609 $pending->paymask : $pending->decrypt($pending->payinfo)
617 Returns the L<FS::template_content> object appropriate to LOCALE, if there
618 is one. If not, returns the one with a NULL locale.
625 qsearchs('template_content',
626 { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
627 qsearchs('template_content',
628 { 'msgnum' => $self->msgnum, 'locale' => '' });
633 Returns the L<FS::agent> object for this template.
638 qsearchs('agent', { 'agentnum' => $_[0]->agentnum });
642 my ($self, %opts) = @_;
645 [ 'alerter_msgnum', 'alerter_template', '', '', '' ],
646 [ 'cancel_msgnum', 'cancelmessage', 'cancelsubject', '', '' ],
647 [ 'decline_msgnum', 'declinetemplate', '', '', '' ],
648 [ 'impending_recur_msgnum', 'impending_recur_template', '', '', 'impending_recur_bcc' ],
649 [ 'payment_receipt_msgnum', 'payment_receipt_email', '', '', '' ],
650 [ 'welcome_msgnum', 'welcome_email', 'welcome_email-subject', 'welcome_email-from', '' ],
651 [ 'warning_msgnum', 'warning_email', 'warning_email-subject', 'warning_email-from', '' ],
654 my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
655 foreach my $agentnum (@agentnums) {
657 my ($newname, $oldname, $subject, $from, $bcc) = @$_;
658 if ($conf->exists($oldname, $agentnum)) {
659 my $new = new FS::msg_template({
660 'msgname' => $oldname,
661 'agentnum' => $agentnum,
662 'from_addr' => ($from && $conf->config($from, $agentnum)) || '',
663 'bcc_addr' => ($bcc && $conf->config($from, $agentnum)) || '',
664 'subject' => ($subject && $conf->config($subject, $agentnum)) || '',
665 'mime_type' => 'text/html',
666 'body' => join('<BR>',$conf->config($oldname, $agentnum)),
668 my $error = $new->insert;
669 die $error if $error;
670 $conf->set($newname, $new->msgnum, $agentnum);
671 $conf->delete($oldname, $agentnum);
672 $conf->delete($from, $agentnum) if $from;
673 $conf->delete($subject, $agentnum) if $subject;
677 foreach my $msg_template ( qsearch('msg_template', {}) ) {
678 if ( $msg_template->subject || $msg_template->body ) {
679 # create new default content
681 $content{subject} = $msg_template->subject;
682 $msg_template->set('subject', '');
684 # work around obscure Pg/DBD bug
685 # https://rt.cpan.org/Public/Bug/Display.html?id=60200
686 # (though the right fix is to upgrade DBD)
687 my $body = $msg_template->body;
688 if ( $body =~ /^x([0-9a-f]+)$/ ) {
689 # there should be no real message templates that look like that
690 warn "converting template body to TEXT\n";
691 $body = pack('H*', $1);
693 $content{body} = $body;
694 $msg_template->set('body', '');
696 my $error = $msg_template->replace(%content);
697 die $error if $error;
703 # Every bit as pleasant as it sounds.
705 # We do this because Text::Template::Preprocess doesn't
706 # actually work. It runs the entire template through
707 # the preprocessor, instead of the code segments. Which
708 # is a shame, because Text::Template already contains
709 # the code to do this operation.
711 my (@outside, @inside);
714 while($body || $chunk) {
715 my ($first, $delim, $rest);
716 # put all leading non-delimiters into $first
718 ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
720 # put a leading delimiter into $delim if there is one
722 ($rest =~ /^([{}]?)(.*)$/s);
724 if( $delim eq '{' ) {
727 push @outside, $chunk;
732 elsif( $delim eq '}' ) {
735 push @inside, $chunk;
743 push @outside, $chunk . $rest;
744 } # else ? something wrong
749 (\@outside, \@inside);
758 L<FS::Record>, schema.html from the base documentation.