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;
22 use vars qw( $DEBUG $conf );
24 FS::UID->install_callback( sub { $conf = new FS::Conf; } );
30 FS::msg_template - Object methods for msg_template records
36 $record = new FS::msg_template \%hash;
37 $record = new FS::msg_template { 'column' => 'value' };
39 $error = $record->insert;
41 $error = $new_record->replace($old_record);
43 $error = $record->delete;
45 $error = $record->check;
49 An FS::msg_template object represents a customer message template.
50 FS::msg_template inherits from FS::Record. The following fields are currently
55 =item msgnum - primary key
57 =item msgname - Name of the template. This will appear in the user interface;
58 if it needs to be localized for some users, add it to the message catalog.
60 =item agentnum - Agent associated with this template. Can be NULL for a
63 =item mime_type - MIME type. Defaults to text/html.
65 =item from_addr - Source email address.
67 =item disabled - disabled ('Y' or NULL).
77 Creates a new template. To add the template to the database, see L<"insert">.
79 Note that this stores the hash reference, not a distinct copy of the hash it
80 points to. You can ask the object for a copy with the I<hash> method.
84 # the new method can be inherited from FS::Record, if a table method is defined
86 sub table { 'msg_template'; }
88 =item insert [ CONTENT ]
90 Adds this record to the database. If there is an error, returns the error,
91 otherwise returns false.
93 A default (no locale) L<FS::template_content> object will be created. CONTENT
94 is an optional hash containing 'subject' and 'body' for this object.
102 my $oldAutoCommit = $FS::UID::AutoCommit;
103 local $FS::UID::AutoCommit = 0;
106 my $error = $self->SUPER::insert;
108 $content{'msgnum'} = $self->msgnum;
109 $content{'subject'} ||= '';
110 $content{'body'} ||= '';
111 my $template_content = new FS::template_content (\%content);
112 $error = $template_content->insert;
116 $dbh->rollback if $oldAutoCommit;
120 $dbh->commit if $oldAutoCommit;
126 Delete this record from the database.
130 # the delete method can be inherited from FS::Record
132 =item replace [ OLD_RECORD ] [ CONTENT ]
134 Replaces the OLD_RECORD with this one in the database. If there is an error,
135 returns the error, otherwise returns false.
137 CONTENT is an optional hash containing 'subject', 'body', and 'locale'. If
138 supplied, an L<FS::template_content> object will be created (or modified, if
139 one already exists for this locale).
145 my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') )
147 : $self->replace_old;
150 my $oldAutoCommit = $FS::UID::AutoCommit;
151 local $FS::UID::AutoCommit = 0;
154 my $error = $self->SUPER::replace($old);
156 if ( !$error and %content ) {
157 $content{'locale'} ||= '';
158 my $new_content = qsearchs('template_content', {
159 'msgnum' => $self->msgnum,
160 'locale' => $content{'locale'},
162 if ( $new_content ) {
163 $new_content->subject($content{'subject'});
164 $new_content->body($content{'body'});
165 $error = $new_content->replace;
168 $content{'msgnum'} = $self->msgnum;
169 $new_content = new FS::template_content \%content;
170 $error = $new_content->insert;
175 $dbh->rollback if $oldAutoCommit;
179 warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit;
180 $dbh->commit if $oldAutoCommit;
188 Checks all fields to make sure this is a valid template. If there is
189 an error, returns the error, otherwise returns false. Called by the insert
194 # the check method should currently be supplied - FS::Record contains some
195 # data checking routines
201 $self->ut_numbern('msgnum')
202 || $self->ut_text('msgname')
203 || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
204 || $self->ut_textn('mime_type')
205 || $self->ut_enum('disabled', [ '', 'Y' ] )
206 || $self->ut_textn('from_addr')
208 return $error if $error;
210 $self->mime_type('text/html') unless $self->mime_type;
215 =item content_locales
217 Returns a hashref of the L<FS::template_content> objects attached to
218 this template, with the locale as key.
222 sub content_locales {
224 return $self->{'_content_locales'} ||= +{
225 map { $_->locale , $_ }
226 qsearch('template_content', { 'msgnum' => $self->msgnum })
230 =item prepare OPTION => VALUE
232 Fills in the template and returns a hash of the 'from' address, 'to'
233 addresses, subject line, and body.
235 Options are passed as a list of name/value pairs:
241 Customer object (required).
245 Additional context object (currently, can be a cust_main, cust_pkg,
246 cust_bill, cust_pay, cust_pay_pending, or svc_(acct, phone, broadband,
247 domain) ). If the object is a svc_*, its cust_pkg will be fetched and
248 used for substitution.
250 As a special case, this may be an arrayref of two objects. Both
251 objects will be available for substitution, with their field names
252 prefixed with 'new_' and 'old_' respectively. This is used in the
253 rt_ticket export when exporting "replace" events.
257 Configuration option to use as the source address, based on the customer's
258 agentnum. If unspecified (or the named option is empty), 'invoice_from'
261 The I<from_addr> field in the template takes precedence over this.
265 Destination address. The default is to use the customer's
266 invoicing_list addresses. Multiple addresses may be comma-separated.
270 A hash reference of additional substitutions
277 my( $self, %opt ) = @_;
279 my $cust_main = $opt{'cust_main'} or die 'cust_main required';
280 my $object = $opt{'object'} or die 'object required';
283 my $locale = $cust_main->locale || '';
284 warn "no locale for cust#".$cust_main->custnum."; using default content\n"
285 if $DEBUG and !$locale;
286 my $content = $self->content($cust_main->locale);
287 warn "preparing template '".$self->msgname."' to cust#".$cust_main->custnum."\n"
290 my $subs = $self->substitutions;
293 # create substitution table
296 my @objects = ($cust_main);
300 if( ref($object) eq 'ARRAY' ) {
301 # [new, old], for provisioning tickets
302 push @objects, $object->[0], $object->[1];
303 push @prefixes, 'new_', 'old_';
304 $svc = $object->[0] if $object->[0]->isa('FS::svc_Common');
307 push @objects, $object;
309 $svc = $object if $object->isa('FS::svc_Common');
313 push @objects, $svc->cust_svc->cust_pkg;
317 foreach my $obj (@objects) {
318 my $prefix = shift @prefixes;
319 foreach my $name (@{ $subs->{$obj->table} }) {
322 $hash{$prefix.$name} = $obj->$name();
324 elsif( ref($name) eq 'ARRAY' ) {
325 # [ foo => sub { ... } ]
326 $hash{$prefix.($name->[0])} = $name->[1]->($obj);
329 warn "bad msg_template substitution: '$name'\n";
335 if ( $opt{substitutions} ) {
336 $hash{$_} = $opt{substitutions}->{$_} foreach keys %{$opt{substitutions}};
339 $_ = encode_entities($_ || '') foreach values(%hash);
344 my $subject_tmpl = new Text::Template (
346 SOURCE => $content->subject,
348 my $subject = $subject_tmpl->fill_in( HASH => \%hash );
350 my $body = $content->body;
351 my ($skin, $guts) = eviscerate($body);
353 $_ = decode_entities($_); # turn all punctuation back into itself
354 s/\r//gs; # remove \r's
355 s/<br[^>]*>/\n/gsi; # and <br /> tags
356 s/<p>/\n/gsi; # and <p>
357 s/<\/p>//gsi; # and </p>
358 s/\240/ /gs; # and
362 $body = '{ use Date::Format qw(time2str); "" }';
363 while(@$skin || @$guts) {
364 $body .= shift(@$skin) || '';
365 $body .= shift(@$guts) || '';
372 my $body_tmpl = new Text::Template (
377 $body = $body_tmpl->fill_in( HASH => \%hash );
384 if ( exists($opt{'to'}) ) {
385 @to = split(/\s*,\s*/, $opt{'to'});
388 @to = $cust_main->invoicing_list_emailonly;
390 # no warning when preparing with no destination
392 my $from_addr = $self->from_addr;
395 if ( $opt{'from_config'} ) {
396 $from_addr = scalar( $conf->config($opt{'from_config'},
397 $cust_main->agentnum) );
399 $from_addr ||= scalar( $conf->config('invoice_from',
400 $cust_main->agentnum) );
403 # if ( $conf->exists('log_sent_mail') and !$opt{'preview'} ) {
404 # my $cust_msg = FS::cust_msg->new({
405 # 'custnum' => $cust_main->custnum,
406 # 'msgnum' => $self->msgnum,
407 # 'status' => 'prepared',
410 # @cust_msg = ('cust_msg' => $cust_msg);
414 'custnum' => $cust_main->custnum,
415 'msgnum' => $self->msgnum,
416 'from' => $from_addr,
418 'bcc' => $self->bcc_addr || undef,
419 'subject' => $subject,
420 'html_body' => $body,
421 'text_body' => HTML::FormatText->new(leftmargin => 0, rightmargin => 70
422 )->format( HTML::TreeBuilder->new_from_content($body) ),
427 =item send OPTION => VALUE
429 Fills in the template and sends it to the customer. Options are as for
434 # broken out from prepare() in case we want to queue the sending,
438 send_email(generate_email($self->prepare(@_)));
441 =item render OPTION => VALUE ...
443 Fills in the template and renders it to a PDF document. Returns the
444 name of the PDF file.
446 Options are as for 'prepare', but 'from' and 'to' are meaningless.
450 # will also have options to set paper size, margins, etc.
454 eval "use PDF::WebKit";
457 my %hash = $self->prepare(%opt);
458 my $html = $hash{'html_body'};
460 my $tmp = 'msg'.$self->msgnum.'-'.time2str('%Y%m%d', time).'-XXXXXXXX';
461 my $dir = "$FS::UID::cache_dir/cache.$FS::UID::datasrc";
463 # Graphics/stylesheets should probably go in /var/www on the Freeside
465 my $kit = PDF::WebKit->new(\$html); #%options
466 # hack to use our wrapper script
467 $kit->configure(sub { shift->wkhtmltopdf('freeside-wkhtmltopdf') });
468 my $fh = File::Temp->new(
475 print $fh $kit->to_pdf;
477 return $fh->filename;
482 Render a PDF and send it to the printer. OPTIONS are as for 'render'.
487 my( $self, %opt ) = @_;
488 my $file = $self->render(%opt);
490 my $lpr = $conf->config('lpr', $opt{'cust_main'}->agentnum );
492 run ( $lpr, '<', $file)
493 or die "lpr error:\n$?\n";
496 # helper sub for package dates
497 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
499 # helper sub for money amounts
500 my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) };
502 # helper sub for usage-related messages
503 my $usage_warning = sub {
505 foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
506 my $amount = $svc->$col; next if $amount eq '';
507 my $method = $col.'_threshold';
508 my $threshold = $svc->$method; next if $threshold eq '';
509 return [$col, $amount, $threshold] if $amount <= $threshold;
510 # this only returns the first one that's below threshold, if there are
516 #my $conf = new FS::Conf;
518 #return contexts and fill-in values
519 # If you add anything, be sure to add a description in
520 # httemplate/edit/msg_template.html.
522 { 'cust_main' => [qw(
523 display_custnum agentnum agent_name
526 name name_short contact contact_firstlast
527 address1 address2 city county state zip
529 daytime night mobile fax
532 ship_name ship_name_short ship_contact ship_contact_firstlast
533 ship_address1 ship_address2 ship_city ship_county ship_state ship_zip
536 paymask payname paytype payip
537 num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
538 classname categoryname
541 invoicing_list_emailonly
542 cust_status ucfirst_cust_status cust_statuscolor
547 [ invoicing_email => sub { shift->invoicing_list_emailonly_scalar } ],
548 #compatibility: obsolete ship_ fields - use the non-ship versions
551 [ "ship_$field" => sub { shift->$field } ]
553 qw( last first company daytime night fax )
555 # ship_name, ship_name_short, ship_contact, ship_contact_firstlast
557 [ expdate => sub { shift->paydate_epoch } ], #compatibility
558 [ signupdate_ymd => sub { $ymd->(shift->signupdate) } ],
559 [ dundate_ymd => sub { $ymd->(shift->dundate) } ],
560 [ paydate_my => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
561 [ otaker_first => sub { shift->access_user->first } ],
562 [ otaker_last => sub { shift->access_user->last } ],
563 [ payby => sub { FS::payby->shortname(shift->payby) } ],
564 [ company_name => sub {
565 $conf->config('company_name', shift->agentnum)
567 [ company_address => sub {
568 $conf->config('company_address', shift->agentnum)
570 [ company_phonenum => sub {
571 $conf->config('company_phonenum', shift->agentnum)
576 pkgnum pkg_label pkg_label_long
580 start_date setup bill last_bill
584 [ pkg => sub { shift->part_pkg->pkg } ],
585 [ pkg_category => sub { shift->part_pkg->categoryname } ],
586 [ pkg_class => sub { shift->part_pkg->classname } ],
587 [ cancel => sub { shift->getfield('cancel') } ], # grrr...
588 [ start_ymd => sub { $ymd->(shift->getfield('start_date')) } ],
589 [ setup_ymd => sub { $ymd->(shift->getfield('setup')) } ],
590 [ next_bill_ymd => sub { $ymd->(shift->getfield('bill')) } ],
591 [ last_bill_ymd => sub { $ymd->(shift->getfield('last_bill')) } ],
592 [ adjourn_ymd => sub { $ymd->(shift->getfield('adjourn')) } ],
593 [ susp_ymd => sub { $ymd->(shift->getfield('susp')) } ],
594 [ expire_ymd => sub { $ymd->(shift->getfield('expire')) } ],
595 [ cancel_ymd => sub { $ymd->(shift->getfield('cancel')) } ],
597 # not necessarily correct for non-flat packages
598 [ setup_fee => sub { shift->part_pkg->option('setup_fee') } ],
599 [ recur_fee => sub { shift->part_pkg->option('recur_fee') } ],
601 [ freq_pretty => sub { shift->part_pkg->freq_pretty } ],
608 #XXX not really thinking about cust_bill substitutions quite yet
610 # for welcome and limit warning messages
616 [ password => sub { shift->getfield('_password') } ],
617 [ column => sub { &$usage_warning(shift)->[0] } ],
618 [ amount => sub { &$usage_warning(shift)->[1] } ],
619 [ threshold => sub { &$usage_warning(shift)->[2] } ],
626 my $registrar = qsearchs('registrar',
627 { registrarnum => shift->registrarnum} );
628 $registrar ? $registrar->registrarname : ''
632 my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
633 $svc_acct ? $svc_acct->email : ''
644 'svc_broadband' => [qw(
652 # for payment receipts
657 [ paid => sub { sprintf("%.2f", shift->paid) } ],
658 # overrides the one in cust_main in cases where a cust_pay is passed
659 [ payby => sub { FS::payby->shortname(shift->payby) } ],
660 [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
662 my $cust_pay = shift;
663 ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ?
664 $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo)
667 # for payment decline messages
668 # try to support all cust_pay fields
669 # 'error' is a special case, it contains the raw error from the gateway
670 'cust_pay_pending' => [qw(
674 [ paid => sub { sprintf("%.2f", shift->paid) } ],
675 [ payby => sub { FS::payby->shortname(shift->payby) } ],
676 [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
679 ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ?
680 $pending->paymask : $pending->decrypt($pending->payinfo)
688 Returns the L<FS::template_content> object appropriate to LOCALE, if there
689 is one. If not, returns the one with a NULL locale.
696 qsearchs('template_content',
697 { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
698 qsearchs('template_content',
699 { 'msgnum' => $self->msgnum, 'locale' => '' });
704 Returns the L<FS::agent> object for this template.
709 qsearchs('agent', { 'agentnum' => $_[0]->agentnum });
713 my ($self, %opts) = @_;
716 [ 'alerter_msgnum', 'alerter_template', '', '', '' ],
717 [ 'cancel_msgnum', 'cancelmessage', 'cancelsubject', '', '' ],
718 [ 'decline_msgnum', 'declinetemplate', '', '', '' ],
719 [ 'impending_recur_msgnum', 'impending_recur_template', '', '', 'impending_recur_bcc' ],
720 [ 'payment_receipt_msgnum', 'payment_receipt_email', '', '', '' ],
721 [ 'welcome_msgnum', 'welcome_email', 'welcome_email-subject', 'welcome_email-from', '' ],
722 [ 'warning_msgnum', 'warning_email', 'warning_email-subject', 'warning_email-from', '' ],
725 my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
726 foreach my $agentnum (@agentnums) {
728 my ($newname, $oldname, $subject, $from, $bcc) = @$_;
729 if ($conf->exists($oldname, $agentnum)) {
730 my $new = new FS::msg_template({
731 'msgname' => $oldname,
732 'agentnum' => $agentnum,
733 'from_addr' => ($from && $conf->config($from, $agentnum)) || '',
734 'bcc_addr' => ($bcc && $conf->config($from, $agentnum)) || '',
735 'subject' => ($subject && $conf->config($subject, $agentnum)) || '',
736 'mime_type' => 'text/html',
737 'body' => join('<BR>',$conf->config($oldname, $agentnum)),
739 my $error = $new->insert;
740 die $error if $error;
741 $conf->set($newname, $new->msgnum, $agentnum);
742 $conf->delete($oldname, $agentnum);
743 $conf->delete($from, $agentnum) if $from;
744 $conf->delete($subject, $agentnum) if $subject;
748 foreach my $msg_template ( qsearch('msg_template', {}) ) {
749 if ( $msg_template->subject || $msg_template->body ) {
750 # create new default content
752 $content{subject} = $msg_template->subject;
753 $msg_template->set('subject', '');
755 # work around obscure Pg/DBD bug
756 # https://rt.cpan.org/Public/Bug/Display.html?id=60200
757 # (though the right fix is to upgrade DBD)
758 my $body = $msg_template->body;
759 if ( $body =~ /^x([0-9a-f]+)$/ ) {
760 # there should be no real message templates that look like that
761 warn "converting template body to TEXT\n";
762 $body = pack('H*', $1);
764 $content{body} = $body;
765 $msg_template->set('body', '');
767 my $error = $msg_template->replace(%content);
768 die $error if $error;
774 # Every bit as pleasant as it sounds.
776 # We do this because Text::Template::Preprocess doesn't
777 # actually work. It runs the entire template through
778 # the preprocessor, instead of the code segments. Which
779 # is a shame, because Text::Template already contains
780 # the code to do this operation.
782 my (@outside, @inside);
785 while($body || $chunk) {
786 my ($first, $delim, $rest);
787 # put all leading non-delimiters into $first
789 ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
791 # put a leading delimiter into $delim if there is one
793 ($rest =~ /^([{}]?)(.*)$/s);
795 if( $delim eq '{' ) {
798 push @outside, $chunk;
803 elsif( $delim eq '}' ) {
806 push @inside, $chunk;
814 push @outside, $chunk . $rest;
815 } # else ? something wrong
820 (\@outside, \@inside);
829 L<FS::Record>, schema.html from the base documentation.