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_last ship_first ship_company
472 ship_name ship_name_short ship_contact ship_contact_firstlast
473 ship_address1 ship_address2 ship_city ship_county ship_state ship_zip
475 ship_daytime ship_night ship_mobile ship_fax
477 paymask payname paytype payip
478 num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
479 classname categoryname
482 invoicing_list_emailonly
483 cust_status ucfirst_cust_status cust_statuscolor
488 [ expdate => sub { shift->paydate_epoch } ], #compatibility
489 [ signupdate_ymd => sub { $ymd->(shift->signupdate) } ],
490 [ dundate_ymd => sub { $ymd->(shift->dundate) } ],
491 [ paydate_my => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
492 [ otaker_first => sub { shift->access_user->first } ],
493 [ otaker_last => sub { shift->access_user->last } ],
494 [ payby => sub { FS::payby->shortname(shift->payby) } ],
495 [ company_name => sub {
496 $conf->config('company_name', shift->agentnum)
498 [ company_address => sub {
499 $conf->config('company_address', shift->agentnum)
501 [ company_phonenum => sub {
502 $conf->config('company_phonenum', shift->agentnum)
507 pkgnum pkg_label pkg_label_long
511 start_date setup bill last_bill
515 [ pkg => sub { shift->part_pkg->pkg } ],
516 [ cancel => sub { shift->getfield('cancel') } ], # grrr...
517 [ start_ymd => sub { $ymd->(shift->getfield('start_date')) } ],
518 [ setup_ymd => sub { $ymd->(shift->getfield('setup')) } ],
519 [ next_bill_ymd => sub { $ymd->(shift->getfield('bill')) } ],
520 [ last_bill_ymd => sub { $ymd->(shift->getfield('last_bill')) } ],
521 [ adjourn_ymd => sub { $ymd->(shift->getfield('adjourn')) } ],
522 [ susp_ymd => sub { $ymd->(shift->getfield('susp')) } ],
523 [ expire_ymd => sub { $ymd->(shift->getfield('expire')) } ],
524 [ cancel_ymd => sub { $ymd->(shift->getfield('cancel')) } ],
530 #XXX not really thinking about cust_bill substitutions quite yet
532 # for welcome and limit warning messages
538 [ password => sub { shift->getfield('_password') } ],
539 [ column => sub { &$usage_warning(shift)->[0] } ],
540 [ amount => sub { &$usage_warning(shift)->[1] } ],
541 [ threshold => sub { &$usage_warning(shift)->[2] } ],
548 my $registrar = qsearchs('registrar',
549 { registrarnum => shift->registrarnum} );
550 $registrar ? $registrar->registrarname : ''
554 my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
555 $svc_acct ? $svc_acct->email : ''
566 'svc_broadband' => [qw(
574 # for payment receipts
579 [ paid => sub { sprintf("%.2f", shift->paid) } ],
580 # overrides the one in cust_main in cases where a cust_pay is passed
581 [ payby => sub { FS::payby->shortname(shift->payby) } ],
582 [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
584 my $cust_pay = shift;
585 ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ?
586 $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo)
589 # for payment decline messages
590 # try to support all cust_pay fields
591 # 'error' is a special case, it contains the raw error from the gateway
592 'cust_pay_pending' => [qw(
596 [ paid => sub { sprintf("%.2f", shift->paid) } ],
597 [ payby => sub { FS::payby->shortname(shift->payby) } ],
598 [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
601 ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ?
602 $pending->paymask : $pending->decrypt($pending->payinfo)
610 Returns the L<FS::template_content> object appropriate to LOCALE, if there
611 is one. If not, returns the one with a NULL locale.
618 qsearchs('template_content',
619 { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
620 qsearchs('template_content',
621 { 'msgnum' => $self->msgnum, 'locale' => '' });
626 Returns the L<FS::agent> object for this template.
631 qsearchs('agent', { 'agentnum' => $_[0]->agentnum });
635 my ($self, %opts) = @_;
638 [ 'alerter_msgnum', 'alerter_template', '', '', '' ],
639 [ 'cancel_msgnum', 'cancelmessage', 'cancelsubject', '', '' ],
640 [ 'decline_msgnum', 'declinetemplate', '', '', '' ],
641 [ 'impending_recur_msgnum', 'impending_recur_template', '', '', 'impending_recur_bcc' ],
642 [ 'payment_receipt_msgnum', 'payment_receipt_email', '', '', '' ],
643 [ 'welcome_msgnum', 'welcome_email', 'welcome_email-subject', 'welcome_email-from', '' ],
644 [ 'warning_msgnum', 'warning_email', 'warning_email-subject', 'warning_email-from', '' ],
647 my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
648 foreach my $agentnum (@agentnums) {
650 my ($newname, $oldname, $subject, $from, $bcc) = @$_;
651 if ($conf->exists($oldname, $agentnum)) {
652 my $new = new FS::msg_template({
653 'msgname' => $oldname,
654 'agentnum' => $agentnum,
655 'from_addr' => ($from && $conf->config($from, $agentnum)) || '',
656 'bcc_addr' => ($bcc && $conf->config($from, $agentnum)) || '',
657 'subject' => ($subject && $conf->config($subject, $agentnum)) || '',
658 'mime_type' => 'text/html',
659 'body' => join('<BR>',$conf->config($oldname, $agentnum)),
661 my $error = $new->insert;
662 die $error if $error;
663 $conf->set($newname, $new->msgnum, $agentnum);
664 $conf->delete($oldname, $agentnum);
665 $conf->delete($from, $agentnum) if $from;
666 $conf->delete($subject, $agentnum) if $subject;
670 foreach my $msg_template ( qsearch('msg_template', {}) ) {
671 if ( $msg_template->subject || $msg_template->body ) {
672 # create new default content
674 foreach ('subject','body') {
675 $content{$_} = $msg_template->$_;
676 $msg_template->setfield($_, '');
679 my $error = $msg_template->replace(%content);
680 die $error if $error;
686 # Every bit as pleasant as it sounds.
688 # We do this because Text::Template::Preprocess doesn't
689 # actually work. It runs the entire template through
690 # the preprocessor, instead of the code segments. Which
691 # is a shame, because Text::Template already contains
692 # the code to do this operation.
694 my (@outside, @inside);
697 while($body || $chunk) {
698 my ($first, $delim, $rest);
699 # put all leading non-delimiters into $first
701 ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
703 # put a leading delimiter into $delim if there is one
705 ($rest =~ /^([{}]?)(.*)$/s);
707 if( $delim eq '{' ) {
710 push @outside, $chunk;
715 elsif( $delim eq '}' ) {
718 push @inside, $chunk;
726 push @outside, $chunk . $rest;
727 } # else ? something wrong
732 (\@outside, \@inside);
741 L<FS::Record>, schema.html from the base documentation.