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.
270 my( $self, %opt ) = @_;
272 my $cust_main = $opt{'cust_main'};
273 my $object = $opt{'object'};
276 my $locale = $cust_main->locale || '';
277 warn "no locale for cust#".$cust_main->custnum."; using default content\n"
278 if $DEBUG and !$locale;
279 my $content = $self->content($cust_main->locale);
280 warn "preparing template '".$self->msgname."' to cust#".$cust_main->custnum."\n"
283 my $subs = $self->substitutions;
286 # create substitution table
289 my @objects = ($cust_main);
293 if( ref($object) eq 'ARRAY' ) {
294 # [new, old], for provisioning tickets
295 push @objects, $object->[0], $object->[1];
296 push @prefixes, 'new_', 'old_';
297 $svc = $object->[0] if $object->[0]->isa('FS::svc_Common');
300 push @objects, $object;
302 $svc = $object if $object->isa('FS::svc_Common');
306 push @objects, $svc->cust_svc->cust_pkg;
310 foreach my $obj (@objects) {
311 my $prefix = shift @prefixes;
312 foreach my $name (@{ $subs->{$obj->table} }) {
315 $hash{$prefix.$name} = $obj->$name();
317 elsif( ref($name) eq 'ARRAY' ) {
318 # [ foo => sub { ... } ]
319 $hash{$prefix.($name->[0])} = $name->[1]->($obj);
322 warn "bad msg_template substitution: '$name'\n";
327 $_ = encode_entities($_ || '') foreach values(%hash);
333 my $subject_tmpl = new Text::Template (
335 SOURCE => $content->subject,
337 my $subject = $subject_tmpl->fill_in( HASH => \%hash );
339 my $body = $content->body;
340 my ($skin, $guts) = eviscerate($body);
342 $_ = decode_entities($_); # turn all punctuation back into itself
343 s/\r//gs; # remove \r's
344 s/<br[^>]*>/\n/gsi; # and <br /> tags
345 s/<p>/\n/gsi; # and <p>
346 s/<\/p>//gsi; # and </p>
347 s/\240/ /gs; # and
351 $body = '{ use Date::Format qw(time2str); "" }';
352 while(@$skin || @$guts) {
353 $body .= shift(@$skin) || '';
354 $body .= shift(@$guts) || '';
361 my $body_tmpl = new Text::Template (
366 $body = $body_tmpl->fill_in( HASH => \%hash );
373 if ( exists($opt{'to'}) ) {
374 @to = split(/\s*,\s*/, $opt{'to'});
377 @to = $cust_main->invoicing_list_emailonly;
379 # no warning when preparing with no destination
381 my $from_addr = $self->from_addr;
384 if ( $opt{'from_config'} ) {
385 $from_addr = scalar( $conf->config($opt{'from_config'},
386 $cust_main->agentnum) );
388 $from_addr ||= scalar( $conf->config('invoice_from',
389 $cust_main->agentnum) );
392 # if ( $conf->exists('log_sent_mail') and !$opt{'preview'} ) {
393 # my $cust_msg = FS::cust_msg->new({
394 # 'custnum' => $cust_main->custnum,
395 # 'msgnum' => $self->msgnum,
396 # 'status' => 'prepared',
399 # @cust_msg = ('cust_msg' => $cust_msg);
403 'custnum' => $cust_main->custnum,
404 'msgnum' => $self->msgnum,
405 'from' => $from_addr,
407 'bcc' => $self->bcc_addr || undef,
408 'subject' => $subject,
409 'html_body' => $body,
410 'text_body' => HTML::FormatText->new(leftmargin => 0, rightmargin => 70
411 )->format( HTML::TreeBuilder->new_from_content($body) ),
416 =item send OPTION => VALUE
418 Fills in the template and sends it to the customer. Options are as for
423 # broken out from prepare() in case we want to queue the sending,
427 send_email(generate_email($self->prepare(@_)));
430 # helper sub for package dates
431 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
433 # helper sub for usage-related messages
434 my $usage_warning = sub {
436 foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
437 my $amount = $svc->$col; next if $amount eq '';
438 my $method = $col.'_threshold';
439 my $threshold = $svc->$method; next if $threshold eq '';
440 return [$col, $amount, $threshold] if $amount <= $threshold;
441 # this only returns the first one that's below threshold, if there are
447 #my $conf = new FS::Conf;
449 #return contexts and fill-in values
450 # If you add anything, be sure to add a description in
451 # httemplate/edit/msg_template.html.
453 { 'cust_main' => [qw(
454 display_custnum agentnum agent_name
457 name name_short contact contact_firstlast
458 address1 address2 city county state zip
463 ship_last ship_first ship_company
464 ship_name ship_name_short ship_contact ship_contact_firstlast
465 ship_address1 ship_address2 ship_city ship_county ship_state ship_zip
467 ship_daytime ship_night ship_fax
469 paymask payname paytype payip
470 num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
471 classname categoryname
474 invoicing_list_emailonly
475 cust_status ucfirst_cust_status cust_statuscolor
480 [ expdate => sub { shift->paydate_epoch } ], #compatibility
481 [ signupdate_ymd => sub { $ymd->(shift->signupdate) } ],
482 [ dundate_ymd => sub { $ymd->(shift->dundate) } ],
483 [ paydate_my => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
484 [ otaker_first => sub { shift->access_user->first } ],
485 [ otaker_last => sub { shift->access_user->last } ],
486 [ payby => sub { FS::payby->shortname(shift->payby) } ],
487 [ company_name => sub {
488 $conf->config('company_name', shift->agentnum)
490 [ company_address => sub {
491 $conf->config('company_address', shift->agentnum)
493 [ company_phonenum => sub {
494 $conf->config('company_phonenum', shift->agentnum)
499 pkgnum pkg_label pkg_label_long
503 start_date setup bill last_bill
507 [ pkg => sub { shift->part_pkg->pkg } ],
508 [ cancel => sub { shift->getfield('cancel') } ], # grrr...
509 [ start_ymd => sub { $ymd->(shift->getfield('start_date')) } ],
510 [ setup_ymd => sub { $ymd->(shift->getfield('setup')) } ],
511 [ next_bill_ymd => sub { $ymd->(shift->getfield('bill')) } ],
512 [ last_bill_ymd => sub { $ymd->(shift->getfield('last_bill')) } ],
513 [ adjourn_ymd => sub { $ymd->(shift->getfield('adjourn')) } ],
514 [ susp_ymd => sub { $ymd->(shift->getfield('susp')) } ],
515 [ expire_ymd => sub { $ymd->(shift->getfield('expire')) } ],
516 [ cancel_ymd => sub { $ymd->(shift->getfield('cancel')) } ],
522 #XXX not really thinking about cust_bill substitutions quite yet
524 # for welcome and limit warning messages
530 [ password => sub { shift->getfield('_password') } ],
531 [ column => sub { &$usage_warning(shift)->[0] } ],
532 [ amount => sub { &$usage_warning(shift)->[1] } ],
533 [ threshold => sub { &$usage_warning(shift)->[2] } ],
540 my $registrar = qsearchs('registrar',
541 { registrarnum => shift->registrarnum} );
542 $registrar ? $registrar->registrarname : ''
546 my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
547 $svc_acct ? $svc_acct->email : ''
558 'svc_broadband' => [qw(
566 # for payment receipts
571 [ paid => sub { sprintf("%.2f", shift->paid) } ],
572 # overrides the one in cust_main in cases where a cust_pay is passed
573 [ payby => sub { FS::payby->shortname(shift->payby) } ],
574 [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
576 my $cust_pay = shift;
577 ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ?
578 $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo)
581 # for payment decline messages
582 # try to support all cust_pay fields
583 # 'error' is a special case, it contains the raw error from the gateway
584 'cust_pay_pending' => [qw(
588 [ paid => sub { sprintf("%.2f", shift->paid) } ],
589 [ payby => sub { FS::payby->shortname(shift->payby) } ],
590 [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
593 ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ?
594 $pending->paymask : $pending->decrypt($pending->payinfo)
602 Returns the L<FS::template_content> object appropriate to LOCALE, if there
603 is one. If not, returns the one with a NULL locale.
610 qsearchs('template_content',
611 { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
612 qsearchs('template_content',
613 { 'msgnum' => $self->msgnum, 'locale' => '' });
618 Returns the L<FS::agent> object for this template.
623 qsearchs('agent', { 'agentnum' => $_[0]->agentnum });
627 my ($self, %opts) = @_;
630 [ 'alerter_msgnum', 'alerter_template', '', '', '' ],
631 [ 'cancel_msgnum', 'cancelmessage', 'cancelsubject', '', '' ],
632 [ 'decline_msgnum', 'declinetemplate', '', '', '' ],
633 [ 'impending_recur_msgnum', 'impending_recur_template', '', '', 'impending_recur_bcc' ],
634 [ 'payment_receipt_msgnum', 'payment_receipt_email', '', '', '' ],
635 [ 'welcome_msgnum', 'welcome_email', 'welcome_email-subject', 'welcome_email-from', '' ],
636 [ 'warning_msgnum', 'warning_email', 'warning_email-subject', 'warning_email-from', '' ],
639 my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
640 foreach my $agentnum (@agentnums) {
642 my ($newname, $oldname, $subject, $from, $bcc) = @$_;
643 if ($conf->exists($oldname, $agentnum)) {
644 my $new = new FS::msg_template({
645 'msgname' => $oldname,
646 'agentnum' => $agentnum,
647 'from_addr' => ($from && $conf->config($from, $agentnum)) ||
648 $conf->config('invoice_from', $agentnum),
649 'bcc_addr' => ($bcc && $conf->config($from, $agentnum)) || '',
650 'subject' => ($subject && $conf->config($subject, $agentnum)) || '',
651 'mime_type' => 'text/html',
652 'body' => join('<BR>',$conf->config($oldname, $agentnum)),
654 my $error = $new->insert;
655 die $error if $error;
656 $conf->set($newname, $new->msgnum, $agentnum);
657 $conf->delete($oldname, $agentnum);
658 $conf->delete($from, $agentnum) if $from;
659 $conf->delete($subject, $agentnum) if $subject;
663 foreach my $msg_template ( qsearch('msg_template', {}) ) {
664 if ( $msg_template->subject || $msg_template->body ) {
665 # create new default content
667 foreach ('subject','body') {
668 $content{$_} = $msg_template->$_;
669 $msg_template->setfield($_, '');
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.