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 #my $conf = new FS::Conf;
443 #return contexts and fill-in values
444 # If you add anything, be sure to add a description in
445 # httemplate/edit/msg_template.html.
447 { 'cust_main' => [qw(
448 display_custnum agentnum agent_name
451 name name_short contact contact_firstlast
452 address1 address2 city county state zip
454 daytime night mobile fax
457 ship_last ship_first ship_company
458 ship_name ship_name_short ship_contact ship_contact_firstlast
459 ship_address1 ship_address2 ship_city ship_county ship_state ship_zip
461 ship_daytime ship_night ship_mobile ship_fax
463 paymask payname paytype payip
464 num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
465 classname categoryname
468 invoicing_list_emailonly
469 cust_status ucfirst_cust_status cust_statuscolor
474 [ expdate => sub { shift->paydate_epoch } ], #compatibility
475 [ signupdate_ymd => sub { $ymd->(shift->signupdate) } ],
476 [ dundate_ymd => sub { $ymd->(shift->dundate) } ],
477 [ paydate_my => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
478 [ otaker_first => sub { shift->access_user->first } ],
479 [ otaker_last => sub { shift->access_user->last } ],
480 [ payby => sub { FS::payby->shortname(shift->payby) } ],
481 [ company_name => sub {
482 $conf->config('company_name', shift->agentnum)
484 [ company_address => sub {
485 $conf->config('company_address', shift->agentnum)
487 [ company_phonenum => sub {
488 $conf->config('company_phonenum', shift->agentnum)
493 pkgnum pkg_label pkg_label_long
497 start_date setup bill last_bill
501 [ pkg => sub { shift->part_pkg->pkg } ],
502 [ cancel => sub { shift->getfield('cancel') } ], # grrr...
503 [ start_ymd => sub { $ymd->(shift->getfield('start_date')) } ],
504 [ setup_ymd => sub { $ymd->(shift->getfield('setup')) } ],
505 [ next_bill_ymd => sub { $ymd->(shift->getfield('bill')) } ],
506 [ last_bill_ymd => sub { $ymd->(shift->getfield('last_bill')) } ],
507 [ adjourn_ymd => sub { $ymd->(shift->getfield('adjourn')) } ],
508 [ susp_ymd => sub { $ymd->(shift->getfield('susp')) } ],
509 [ expire_ymd => sub { $ymd->(shift->getfield('expire')) } ],
510 [ cancel_ymd => sub { $ymd->(shift->getfield('cancel')) } ],
516 #XXX not really thinking about cust_bill substitutions quite yet
518 # for welcome and limit warning messages
524 [ password => sub { shift->getfield('_password') } ],
531 my $registrar = qsearchs('registrar',
532 { registrarnum => shift->registrarnum} );
533 $registrar ? $registrar->registrarname : ''
537 my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
538 $svc_acct ? $svc_acct->email : ''
549 'svc_broadband' => [qw(
557 # for payment receipts
562 [ paid => sub { sprintf("%.2f", shift->paid) } ],
563 # overrides the one in cust_main in cases where a cust_pay is passed
564 [ payby => sub { FS::payby->shortname(shift->payby) } ],
565 [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
567 my $cust_pay = shift;
568 ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ?
569 $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo)
572 # for payment decline messages
573 # try to support all cust_pay fields
574 # 'error' is a special case, it contains the raw error from the gateway
575 'cust_pay_pending' => [qw(
579 [ paid => sub { sprintf("%.2f", shift->paid) } ],
580 [ payby => sub { FS::payby->shortname(shift->payby) } ],
581 [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
584 ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ?
585 $pending->paymask : $pending->decrypt($pending->payinfo)
593 Returns the L<FS::template_content> object appropriate to LOCALE, if there
594 is one. If not, returns the one with a NULL locale.
601 qsearchs('template_content',
602 { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
603 qsearchs('template_content',
604 { 'msgnum' => $self->msgnum, 'locale' => '' });
609 Returns the L<FS::agent> object for this template.
614 qsearchs('agent', { 'agentnum' => $_[0]->agentnum });
618 my ($self, %opts) = @_;
621 [ 'alerter_msgnum', 'alerter_template', '', '', '' ],
622 [ 'cancel_msgnum', 'cancelmessage', 'cancelsubject', '', '' ],
623 [ 'decline_msgnum', 'declinetemplate', '', '', '' ],
624 [ 'impending_recur_msgnum', 'impending_recur_template', '', '', 'impending_recur_bcc' ],
625 [ 'payment_receipt_msgnum', 'payment_receipt_email', '', '', '' ],
626 [ 'welcome_msgnum', 'welcome_email', 'welcome_email-subject', 'welcome_email-from', '' ],
627 [ 'warning_msgnum', 'warning_email', 'warning_email-subject', 'warning_email-from', '' ],
630 my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
631 foreach my $agentnum (@agentnums) {
633 my ($newname, $oldname, $subject, $from, $bcc) = @$_;
634 if ($conf->exists($oldname, $agentnum)) {
635 my $new = new FS::msg_template({
636 'msgname' => $oldname,
637 'agentnum' => $agentnum,
638 'from_addr' => ($from && $conf->config($from, $agentnum)) || '',
639 'bcc_addr' => ($bcc && $conf->config($from, $agentnum)) || '',
640 'subject' => ($subject && $conf->config($subject, $agentnum)) || '',
641 'mime_type' => 'text/html',
642 'body' => join('<BR>',$conf->config($oldname, $agentnum)),
644 my $error = $new->insert;
645 die $error if $error;
646 $conf->set($newname, $new->msgnum, $agentnum);
647 $conf->delete($oldname, $agentnum);
648 $conf->delete($from, $agentnum) if $from;
649 $conf->delete($subject, $agentnum) if $subject;
653 foreach my $msg_template ( qsearch('msg_template', {}) ) {
654 if ( $msg_template->subject || $msg_template->body ) {
655 # create new default content
657 $content{subject} = $msg_template->subject;
658 $msg_template->set('subject', '');
660 # work around obscure Pg/DBD bug
661 # https://rt.cpan.org/Public/Bug/Display.html?id=60200
662 # (though the right fix is to upgrade DBD)
663 my $body = $msg_template->body;
664 if ( $body =~ /^x([0-9a-f]+)$/ ) {
665 # there should be no real message templates that look like that
666 warn "converting template body to TEXT\n";
667 $body = pack('H*', $1);
669 $content{body} = $body;
670 $msg_template->set('body', '');
672 my $error = $msg_template->replace(%content);
673 die $error if $error;
679 # Every bit as pleasant as it sounds.
681 # We do this because Text::Template::Preprocess doesn't
682 # actually work. It runs the entire template through
683 # the preprocessor, instead of the code segments. Which
684 # is a shame, because Text::Template already contains
685 # the code to do this operation.
687 my (@outside, @inside);
690 while($body || $chunk) {
691 my ($first, $delim, $rest);
692 # put all leading non-delimiters into $first
694 ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
696 # put a leading delimiter into $delim if there is one
698 ($rest =~ /^([{}]?)(.*)$/s);
700 if( $delim eq '{' ) {
703 push @outside, $chunk;
708 elsif( $delim eq '}' ) {
711 push @inside, $chunk;
719 push @outside, $chunk . $rest;
720 } # else ? something wrong
725 (\@outside, \@inside);
734 L<FS::Record>, schema.html from the base documentation.