1 package FS::msg_template;
4 use base qw( FS::Record );
6 use FS::Misc qw( generate_email send_email do_print );
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;
23 use vars qw( $DEBUG $conf );
25 FS::UID->install_callback( sub { $conf = new FS::Conf; } );
31 FS::msg_template - Object methods for msg_template records
37 $record = new FS::msg_template \%hash;
38 $record = new FS::msg_template { 'column' => 'value' };
40 $error = $record->insert;
42 $error = $new_record->replace($old_record);
44 $error = $record->delete;
46 $error = $record->check;
50 An FS::msg_template object represents a customer message template.
51 FS::msg_template inherits from FS::Record. The following fields are currently
56 =item msgnum - primary key
58 =item msgname - Name of the template. This will appear in the user interface;
59 if it needs to be localized for some users, add it to the message catalog.
61 =item agentnum - Agent associated with this template. Can be NULL for a
64 =item mime_type - MIME type. Defaults to text/html.
66 =item from_addr - Source email address.
68 =item disabled - disabled ('Y' or NULL).
78 Creates a new template. To add the template to the database, see L<"insert">.
80 Note that this stores the hash reference, not a distinct copy of the hash it
81 points to. You can ask the object for a copy with the I<hash> method.
85 # the new method can be inherited from FS::Record, if a table method is defined
87 sub table { 'msg_template'; }
89 =item insert [ CONTENT ]
91 Adds this record to the database. If there is an error, returns the error,
92 otherwise returns false.
94 A default (no locale) L<FS::template_content> object will be created. CONTENT
95 is an optional hash containing 'subject' and 'body' for this object.
103 my $oldAutoCommit = $FS::UID::AutoCommit;
104 local $FS::UID::AutoCommit = 0;
107 my $error = $self->SUPER::insert;
109 $content{'msgnum'} = $self->msgnum;
110 $content{'subject'} ||= '';
111 $content{'body'} ||= '';
112 my $template_content = new FS::template_content (\%content);
113 $error = $template_content->insert;
117 $dbh->rollback if $oldAutoCommit;
121 $dbh->commit if $oldAutoCommit;
127 Delete this record from the database.
131 # the delete method can be inherited from FS::Record
133 =item replace [ OLD_RECORD ] [ CONTENT ]
135 Replaces the OLD_RECORD with this one in the database. If there is an error,
136 returns the error, otherwise returns false.
138 CONTENT is an optional hash containing 'subject', 'body', and 'locale'. If
139 supplied, an L<FS::template_content> object will be created (or modified, if
140 one already exists for this locale).
146 my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') )
148 : $self->replace_old;
151 my $oldAutoCommit = $FS::UID::AutoCommit;
152 local $FS::UID::AutoCommit = 0;
155 my $error = $self->SUPER::replace($old);
157 if ( !$error and %content ) {
158 $content{'locale'} ||= '';
159 my $new_content = qsearchs('template_content', {
160 'msgnum' => $self->msgnum,
161 'locale' => $content{'locale'},
163 if ( $new_content ) {
164 $new_content->subject($content{'subject'});
165 $new_content->body($content{'body'});
166 $error = $new_content->replace;
169 $content{'msgnum'} = $self->msgnum;
170 $new_content = new FS::template_content \%content;
171 $error = $new_content->insert;
176 $dbh->rollback if $oldAutoCommit;
180 warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit;
181 $dbh->commit if $oldAutoCommit;
189 Checks all fields to make sure this is a valid template. If there is
190 an error, returns the error, otherwise returns false. Called by the insert
195 # the check method should currently be supplied - FS::Record contains some
196 # data checking routines
202 $self->ut_numbern('msgnum')
203 || $self->ut_text('msgname')
204 || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
205 || $self->ut_textn('mime_type')
206 || $self->ut_enum('disabled', [ '', 'Y' ] )
207 || $self->ut_textn('from_addr')
209 return $error if $error;
211 $self->mime_type('text/html') unless $self->mime_type;
216 =item content_locales
218 Returns a hashref of the L<FS::template_content> objects attached to
219 this template, with the locale as key.
223 sub content_locales {
225 return $self->{'_content_locales'} ||= +{
226 map { $_->locale , $_ }
227 qsearch('template_content', { 'msgnum' => $self->msgnum })
231 =item prepare OPTION => VALUE
233 Fills in the template and returns a hash of the 'from' address, 'to'
234 addresses, subject line, and body.
236 Options are passed as a list of name/value pairs:
242 Customer object (required).
246 Additional context object (currently, can be a cust_main, cust_pkg,
247 cust_bill, cust_pay, cust_pay_pending, or svc_(acct, phone, broadband,
248 domain) ). If the object is a svc_*, its cust_pkg will be fetched and
249 used for substitution.
251 As a special case, this may be an arrayref of two objects. Both
252 objects will be available for substitution, with their field names
253 prefixed with 'new_' and 'old_' respectively. This is used in the
254 rt_ticket export when exporting "replace" events.
258 Configuration option to use as the source address, based on the customer's
259 agentnum. If unspecified (or the named option is empty), 'invoice_from'
262 The I<from_addr> field in the template takes precedence over this.
266 Destination address. The default is to use the customer's
267 invoicing_list addresses. Multiple addresses may be comma-separated.
271 A hash reference of additional substitutions
278 my( $self, %opt ) = @_;
280 my $cust_main = $opt{'cust_main'} or die 'cust_main required';
281 my $object = $opt{'object'} or die 'object required';
284 my $locale = $cust_main->locale || '';
285 warn "no locale for cust#".$cust_main->custnum."; using default content\n"
286 if $DEBUG and !$locale;
287 my $content = $self->content($cust_main->locale);
288 warn "preparing template '".$self->msgname."' to cust#".$cust_main->custnum."\n"
291 my $subs = $self->substitutions;
294 # create substitution table
297 my @objects = ($cust_main);
301 if( ref($object) eq 'ARRAY' ) {
302 # [new, old], for provisioning tickets
303 push @objects, $object->[0], $object->[1];
304 push @prefixes, 'new_', 'old_';
305 $svc = $object->[0] if $object->[0]->isa('FS::svc_Common');
308 push @objects, $object;
310 $svc = $object if $object->isa('FS::svc_Common');
314 push @objects, $svc->cust_svc->cust_pkg;
318 foreach my $obj (@objects) {
319 my $prefix = shift @prefixes;
320 foreach my $name (@{ $subs->{$obj->table} }) {
323 $hash{$prefix.$name} = $obj->$name();
325 elsif( ref($name) eq 'ARRAY' ) {
326 # [ foo => sub { ... } ]
327 $hash{$prefix.($name->[0])} = $name->[1]->($obj);
330 warn "bad msg_template substitution: '$name'\n";
336 if ( $opt{substitutions} ) {
337 $hash{$_} = $opt{substitutions}->{$_} foreach keys %{$opt{substitutions}};
340 $_ = encode_entities($_ || '') foreach values(%hash);
345 my $subject_tmpl = new Text::Template (
347 SOURCE => $content->subject,
349 my $subject = $subject_tmpl->fill_in( HASH => \%hash );
351 my $body = $content->body;
352 my ($skin, $guts) = eviscerate($body);
354 $_ = decode_entities($_); # turn all punctuation back into itself
355 s/\r//gs; # remove \r's
356 s/<br[^>]*>/\n/gsi; # and <br /> tags
357 s/<p>/\n/gsi; # and <p>
358 s/<\/p>//gsi; # and </p>
359 s/\240/ /gs; # and
363 $body = '{ use Date::Format qw(time2str); "" }';
364 while(@$skin || @$guts) {
365 $body .= shift(@$skin) || '';
366 $body .= shift(@$guts) || '';
373 my $body_tmpl = new Text::Template (
378 $body = $body_tmpl->fill_in( HASH => \%hash );
385 if ( exists($opt{'to'}) ) {
386 @to = split(/\s*,\s*/, $opt{'to'});
389 @to = $cust_main->invoicing_list_emailonly;
391 # no warning when preparing with no destination
393 my $from_addr = $self->from_addr;
396 if ( $opt{'from_config'} ) {
397 $from_addr = scalar( $conf->config($opt{'from_config'},
398 $cust_main->agentnum) );
400 $from_addr ||= scalar( $conf->config('invoice_from',
401 $cust_main->agentnum) );
404 # if ( $conf->exists('log_sent_mail') and !$opt{'preview'} ) {
405 # my $cust_msg = FS::cust_msg->new({
406 # 'custnum' => $cust_main->custnum,
407 # 'msgnum' => $self->msgnum,
408 # 'status' => 'prepared',
411 # @cust_msg = ('cust_msg' => $cust_msg);
414 my $text_body = encode('UTF-8',
415 HTML::FormatText->new(leftmargin => 0, rightmargin => 70)
416 ->format( HTML::TreeBuilder->new_from_content($body) )
419 'custnum' => $cust_main->custnum,
420 'msgnum' => $self->msgnum,
421 'from' => $from_addr,
423 'bcc' => $self->bcc_addr || undef,
424 'subject' => $subject,
425 'html_body' => $body,
426 'text_body' => $text_body
431 =item send OPTION => VALUE
433 Fills in the template and sends it to the customer. Options are as for
438 # broken out from prepare() in case we want to queue the sending,
442 send_email(generate_email($self->prepare(@_)));
445 =item render OPTION => VALUE ...
447 Fills in the template and renders it to a PDF document. Returns the
448 name of the PDF file.
450 Options are as for 'prepare', but 'from' and 'to' are meaningless.
454 # will also have options to set paper size, margins, etc.
458 eval "use PDF::WebKit";
461 my %hash = $self->prepare(%opt);
462 my $html = $hash{'html_body'};
464 # Graphics/stylesheets should probably go in /var/www on the Freeside
466 my $kit = PDF::WebKit->new(\$html); #%options
467 # hack to use our wrapper script
468 $kit->configure(sub { shift->wkhtmltopdf('freeside-wkhtmltopdf') });
475 Render a PDF and send it to the printer. OPTIONS are as for 'render'.
480 my( $self, %opt ) = @_;
481 do_print( [ $self->render(%opt) ], agentnum=>$opt{cust_main}->agentnum );
484 # helper sub for package dates
485 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
487 # helper sub for money amounts
488 my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) };
490 #my $conf = new FS::Conf;
492 #return contexts and fill-in values
493 # If you add anything, be sure to add a description in
494 # httemplate/edit/msg_template.html.
496 { 'cust_main' => [qw(
497 display_custnum agentnum agent_name
500 name name_short contact contact_firstlast
501 address1 address2 city county state zip
503 daytime night mobile fax
506 ship_last ship_first ship_company
507 ship_name ship_name_short ship_contact ship_contact_firstlast
508 ship_address1 ship_address2 ship_city ship_county ship_state ship_zip
510 ship_daytime ship_night ship_mobile ship_fax
512 paymask payname paytype payip
513 num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
514 classname categoryname
517 invoicing_list_emailonly
518 cust_status ucfirst_cust_status cust_statuscolor
523 [ expdate => sub { shift->paydate_epoch } ], #compatibility
524 [ signupdate_ymd => sub { $ymd->(shift->signupdate) } ],
525 [ dundate_ymd => sub { $ymd->(shift->dundate) } ],
526 [ paydate_my => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
527 [ otaker_first => sub { shift->access_user->first } ],
528 [ otaker_last => sub { shift->access_user->last } ],
529 [ payby => sub { FS::payby->shortname(shift->payby) } ],
530 [ company_name => sub {
531 $conf->config('company_name', shift->agentnum)
533 [ company_address => sub {
534 $conf->config('company_address', shift->agentnum)
536 [ invoicing_email => sub { shift->invoicing_list_emailonly_scalar } ],
537 [ company_phonenum => sub {
538 $conf->config('company_phonenum', shift->agentnum)
543 pkgnum pkg_label pkg_label_long
547 start_date setup bill last_bill
551 [ pkg => sub { shift->part_pkg->pkg } ],
552 [ pkg_category => sub { shift->part_pkg->categoryname } ],
553 [ pkg_class => sub { shift->part_pkg->classname } ],
554 [ cancel => sub { shift->getfield('cancel') } ], # grrr...
555 [ start_ymd => sub { $ymd->(shift->getfield('start_date')) } ],
556 [ setup_ymd => sub { $ymd->(shift->getfield('setup')) } ],
557 [ next_bill_ymd => sub { $ymd->(shift->getfield('bill')) } ],
558 [ last_bill_ymd => sub { $ymd->(shift->getfield('last_bill')) } ],
559 [ adjourn_ymd => sub { $ymd->(shift->getfield('adjourn')) } ],
560 [ susp_ymd => sub { $ymd->(shift->getfield('susp')) } ],
561 [ expire_ymd => sub { $ymd->(shift->getfield('expire')) } ],
562 [ cancel_ymd => sub { $ymd->(shift->getfield('cancel')) } ],
564 # not necessarily correct for non-flat packages
565 [ setup_fee => sub { shift->part_pkg->option('setup_fee') } ],
566 [ recur_fee => sub { shift->part_pkg->option('recur_fee') } ],
568 [ freq_pretty => sub { shift->part_pkg->freq_pretty } ],
575 #XXX not really thinking about cust_bill substitutions quite yet
577 # for welcome and limit warning messages
583 [ password => sub { shift->getfield('_password') } ],
590 my $registrar = qsearchs('registrar',
591 { registrarnum => shift->registrarnum} );
592 $registrar ? $registrar->registrarname : ''
596 my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
597 $svc_acct ? $svc_acct->email : ''
608 'svc_broadband' => [qw(
616 # for payment receipts
621 [ paid => sub { sprintf("%.2f", shift->paid) } ],
622 # overrides the one in cust_main in cases where a cust_pay is passed
623 [ payby => sub { FS::payby->shortname(shift->payby) } ],
624 [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
626 my $cust_pay = shift;
627 ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ?
628 $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo)
631 # for payment decline messages
632 # try to support all cust_pay fields
633 # 'error' is a special case, it contains the raw error from the gateway
634 'cust_pay_pending' => [qw(
638 [ paid => sub { sprintf("%.2f", shift->paid) } ],
639 [ payby => sub { FS::payby->shortname(shift->payby) } ],
640 [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
643 ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ?
644 $pending->paymask : $pending->decrypt($pending->payinfo)
652 Returns the L<FS::template_content> object appropriate to LOCALE, if there
653 is one. If not, returns the one with a NULL locale.
660 qsearchs('template_content',
661 { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
662 qsearchs('template_content',
663 { 'msgnum' => $self->msgnum, 'locale' => '' });
668 Returns the L<FS::agent> object for this template.
673 qsearchs('agent', { 'agentnum' => $_[0]->agentnum });
677 my ($self, %opts) = @_;
680 [ 'alerter_msgnum', 'alerter_template', '', '', '' ],
681 [ 'cancel_msgnum', 'cancelmessage', 'cancelsubject', '', '' ],
682 [ 'decline_msgnum', 'declinetemplate', '', '', '' ],
683 [ 'impending_recur_msgnum', 'impending_recur_template', '', '', 'impending_recur_bcc' ],
684 [ 'payment_receipt_msgnum', 'payment_receipt_email', '', '', '' ],
685 [ 'welcome_msgnum', 'welcome_email', 'welcome_email-subject', 'welcome_email-from', '' ],
686 [ 'warning_msgnum', 'warning_email', 'warning_email-subject', 'warning_email-from', '' ],
689 my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
690 foreach my $agentnum (@agentnums) {
692 my ($newname, $oldname, $subject, $from, $bcc) = @$_;
693 if ($conf->exists($oldname, $agentnum)) {
694 my $new = new FS::msg_template({
695 'msgname' => $oldname,
696 'agentnum' => $agentnum,
697 'from_addr' => ($from && $conf->config($from, $agentnum)) || '',
698 'bcc_addr' => ($bcc && $conf->config($from, $agentnum)) || '',
699 'subject' => ($subject && $conf->config($subject, $agentnum)) || '',
700 'mime_type' => 'text/html',
701 'body' => join('<BR>',$conf->config($oldname, $agentnum)),
703 my $error = $new->insert;
704 die $error if $error;
705 $conf->set($newname, $new->msgnum, $agentnum);
706 $conf->delete($oldname, $agentnum);
707 $conf->delete($from, $agentnum) if $from;
708 $conf->delete($subject, $agentnum) if $subject;
712 foreach my $msg_template ( qsearch('msg_template', {}) ) {
713 if ( $msg_template->subject || $msg_template->body ) {
714 # create new default content
716 $content{subject} = $msg_template->subject;
717 $msg_template->set('subject', '');
719 # work around obscure Pg/DBD bug
720 # https://rt.cpan.org/Public/Bug/Display.html?id=60200
721 # (though the right fix is to upgrade DBD)
722 my $body = $msg_template->body;
723 if ( $body =~ /^x([0-9a-f]+)$/ ) {
724 # there should be no real message templates that look like that
725 warn "converting template body to TEXT\n";
726 $body = pack('H*', $1);
728 $content{body} = $body;
729 $msg_template->set('body', '');
731 my $error = $msg_template->replace(%content);
732 die $error if $error;
738 # Every bit as pleasant as it sounds.
740 # We do this because Text::Template::Preprocess doesn't
741 # actually work. It runs the entire template through
742 # the preprocessor, instead of the code segments. Which
743 # is a shame, because Text::Template already contains
744 # the code to do this operation.
746 my (@outside, @inside);
749 while($body || $chunk) {
750 my ($first, $delim, $rest);
751 # put all leading non-delimiters into $first
753 ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
755 # put a leading delimiter into $delim if there is one
757 ($rest =~ /^([{}]?)(.*)$/s);
759 if( $delim eq '{' ) {
762 push @outside, $chunk;
767 elsif( $delim eq '}' ) {
770 push @inside, $chunk;
778 push @outside, $chunk . $rest;
779 } # else ? something wrong
784 (\@outside, \@inside);
793 L<FS::Record>, schema.html from the base documentation.