FS/FS/msg_template.pm

   1 package FS::msg_template;
   2
   3 use strict;
   4 use base qw( FS::Record );
   5 use Text::Template;
   6 use FS::Misc qw( generate_email send_email );
   7 use FS::Conf;
   8 use FS::Record qw( qsearch qsearchs );
   9 use FS::UID qw( dbh );
  10
  11 use FS::cust_main;
  12 use FS::cust_msg;
  13 use FS::template_content;
  14
  15 use Date::Format qw( time2str );
  16 use HTML::Entities qw( decode_entities encode_entities ) ;
  17 use HTML::FormatText;
  18 use HTML::TreeBuilder;
  19 use vars qw( $DEBUG $conf );
  20
  21 FS::UID->install_callback( sub { $conf = new FS::Conf; } );
  22
  23 $DEBUG=0;
  24
  25 =head1 NAME
  26
  27 FS::msg_template - Object methods for msg_template records
  28
  29 =head1 SYNOPSIS
  30
  31   use FS::msg_template;
  32
  33   $record = new FS::msg_template \%hash;
  34   $record = new FS::msg_template { 'column' => 'value' };
  35
  36   $error = $record->insert;
  37
  38   $error = $new_record->replace($old_record);
  39
  40   $error = $record->delete;
  41
  42   $error = $record->check;
  43
  44 =head1 DESCRIPTION
  45
  46 An FS::msg_template object represents a customer message template.
  47 FS::msg_template inherits from FS::Record.  The following fields are currently
  48 supported:
  49
  50 =over 4
  51
  52 =item msgnum - primary key
  53
  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.
  56
  57 =item agentnum - Agent associated with this template.  Can be NULL for a
  58 global template.
  59
  60 =item mime_type - MIME type.  Defaults to text/html.
  61
  62 =item from_addr - Source email address.
  63
  64 =item disabled - disabled ('Y' or NULL).
  65
  66 =back
  67
  68 =head1 METHODS
  69
  70 =over 4
  71
  72 =item new HASHREF
  73
  74 Creates a new template.  To add the template to the database, see L<"insert">.
  75
  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.
  78
  79 =cut
  80
  81 # the new method can be inherited from FS::Record, if a table method is defined
  82
  83 sub table { 'msg_template'; }
  84
  85 =item insert [ CONTENT ]
  86
  87 Adds this record to the database.  If there is an error, returns the error,
  88 otherwise returns false.
  89
  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.
  92
  93 =cut
  94
  95 sub insert {
  96   my $self = shift;
  97   my %content = @_;
  98
  99   my $oldAutoCommit = $FS::UID::AutoCommit;
 100   local $FS::UID::AutoCommit = 0;
 101   my $dbh = dbh;
 102
 103   my $error = $self->SUPER::insert;
 104   if ( !$error ) {
 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;
 110   }
 111
 112   if ( $error ) {
 113     $dbh->rollback if $oldAutoCommit;
 114     return $error;
 115   }
 116
 117   $dbh->commit if $oldAutoCommit;
 118   return;
 119 }
 120
 121 =item delete
 122
 123 Delete this record from the database.
 124
 125 =cut
 126
 127 # the delete method can be inherited from FS::Record
 128
 129 =item replace [ OLD_RECORD ] [ CONTENT ]
 130
 131 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 132 returns the error, otherwise returns false.
 133
 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).
 137
 138 =cut
 139
 140 sub replace {
 141   my $self = shift;
 142   my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') )
 143               ? shift
 144               : $self->replace_old;
 145   my %content = @_;
 146
 147   my $oldAutoCommit = $FS::UID::AutoCommit;
 148   local $FS::UID::AutoCommit = 0;
 149   my $dbh = dbh;
 150
 151   my $error = $self->SUPER::replace($old);
 152
 153   if ( !$error and %content ) {
 154     $content{'locale'} ||= '';
 155     my $new_content = qsearchs('template_content', {
 156                         'msgnum' => $self->msgnum,
 157                         'locale' => $content{'locale'},
 158                       } );
 159     if ( $new_content ) {
 160       $new_content->subject($content{'subject'});
 161       $new_content->body($content{'body'});
 162       $error = $new_content->replace;
 163     }
 164     else {
 165       $content{'msgnum'} = $self->msgnum;
 166       $new_content = new FS::template_content \%content;
 167       $error = $new_content->insert;
 168     }
 169   }
 170
 171   if ( $error ) {
 172     $dbh->rollback if $oldAutoCommit;
 173     return $error;
 174   }
 175
 176   warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit;
 177   $dbh->commit if $oldAutoCommit;
 178   return;
 179 }
 180
 181
 182
 183 =item check
 184
 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
 187 and replace methods.
 188
 189 =cut
 190
 191 # the check method should currently be supplied - FS::Record contains some
 192 # data checking routines
 193
 194 sub check {
 195   my $self = shift;
 196
 197   my $error =
 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')
 204   ;
 205   return $error if $error;
 206
 207   $self->mime_type('text/html') unless $self->mime_type;
 208
 209   $self->SUPER::check;
 210 }
 211
 212 =item content_locales
 213
 214 Returns a hashref of the L<FS::template_content> objects attached to
 215 this template, with the locale as key.
 216
 217 =cut
 218
 219 sub content_locales {
 220   my $self = shift;
 221   return $self->{'_content_locales'} ||= +{
 222     map { $_->locale , $_ }
 223     qsearch('template_content', { 'msgnum' => $self->msgnum })
 224   };
 225 }
 226
 227 =item prepare OPTION => VALUE
 228
 229 Fills in the template and returns a hash of the 'from' address, 'to'
 230 addresses, subject line, and body.
 231
 232 Options are passed as a list of name/value pairs:
 233
 234 =over 4
 235
 236 =item cust_main
 237
 238 Customer object (required).
 239
 240 =item object
 241
 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.
 246
 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.
 251
 252 =item from_config
 253
 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'
 256 will be used.
 257
 258 The I<from_addr> field in the template takes precedence over this.
 259
 260 =item to
 261
 262 Destination address.  The default is to use the customer's
 263 invoicing_list addresses.  Multiple addresses may be comma-separated.
 264
 265 =back
 266
 267 =cut
 268
 269 sub prepare {
 270   my( $self, %opt ) = @_;
 271
 272   my $cust_main = $opt{'cust_main'};
 273   my $object = $opt{'object'};
 274
 275   # localization
 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"
 281     if($DEBUG);
 282
 283   my $subs = $self->substitutions;
 284
 285   ###
 286   # create substitution table
 287   ###
 288   my %hash;
 289   my @objects = ($cust_main);
 290   my @prefixes = ('');
 291   my $svc;
 292   if( ref $object ) {
 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');
 298     }
 299     else {
 300       push @objects, $object;
 301       push @prefixes, '';
 302       $svc = $object if $object->isa('FS::svc_Common');
 303     }
 304   }
 305   if( $svc ) {
 306     push @objects, $svc->cust_svc->cust_pkg;
 307     push @prefixes, '';
 308   }
 309
 310   foreach my $obj (@objects) {
 311     my $prefix = shift @prefixes;
 312     foreach my $name (@{ $subs->{$obj->table} }) {
 313       if(!ref($name)) {
 314         # simple case
 315         $hash{$prefix.$name} = $obj->$name();
 316       }
 317       elsif( ref($name) eq 'ARRAY' ) {
 318         # [ foo => sub { ... } ]
 319         $hash{$prefix.($name->[0])} = $name->[1]->($obj);
 320       }
 321       else {
 322         warn "bad msg_template substitution: '$name'\n";
 323         #skip it?
 324       }
 325     }
 326   }
 327   $_ = encode_entities($_ || '') foreach values(%hash);
 328
 329
 330   ###
 331   # clean up template
 332   ###
 333   my $subject_tmpl = new Text::Template (
 334     TYPE   => 'STRING',
 335     SOURCE => $content->subject,
 336   );
 337   my $subject = $subject_tmpl->fill_in( HASH => \%hash );
 338
 339   my $body = $content->body;
 340   my ($skin, $guts) = eviscerate($body);
 341   @$guts = map {
 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 &nbsp;
 348     $_
 349   } @$guts;
 350
 351   $body = '{ use Date::Format qw(time2str); "" }';
 352   while(@$skin || @$guts) {
 353     $body .= shift(@$skin) || '';
 354     $body .= shift(@$guts) || '';
 355   }
 356
 357   ###
 358   # fill-in
 359   ###
 360
 361   my $body_tmpl = new Text::Template (
 362     TYPE          => 'STRING',
 363     SOURCE        => $body,
 364   );
 365
 366   $body = $body_tmpl->fill_in( HASH => \%hash );
 367
 368   ###
 369   # and email
 370   ###
 371
 372   my @to;
 373   if ( exists($opt{'to'}) ) {
 374     @to = split(/\s*,\s*/, $opt{'to'});
 375   }
 376   else {
 377     @to = $cust_main->invoicing_list_emailonly;
 378   }
 379   # no warning when preparing with no destination
 380
 381   my $from_addr = $self->from_addr;
 382
 383   if ( !$from_addr ) {
 384     if ( $opt{'from_config'} ) {
 385       $from_addr = scalar( $conf->config($opt{'from_config'},
 386                                          $cust_main->agentnum) );
 387     }
 388     $from_addr ||= scalar( $conf->config('invoice_from',
 389                                          $cust_main->agentnum) );
 390   }
 391 #  my @cust_msg = ();
 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',
 397 #      });
 398 #    $cust_msg->insert;
 399 #    @cust_msg = ('cust_msg' => $cust_msg);
 400 #  }
 401
 402   (
 403     'custnum' => $cust_main->custnum,
 404     'msgnum'  => $self->msgnum,
 405     'from' => $from_addr,
 406     'to'   => \@to,
 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) ),
 412   );
 413
 414 }
 415
 416 =item send OPTION => VALUE
 417
 418 Fills in the template and sends it to the customer.  Options are as for
 419 'prepare'.
 420
 421 =cut
 422
 423 # broken out from prepare() in case we want to queue the sending,
 424 # preview it, etc.
 425 sub send {
 426   my $self = shift;
 427   send_email(generate_email($self->prepare(@_)));
 428 }
 429
 430 # helper sub for package dates
 431 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
 432
 433 #my $conf = new FS::Conf;
 434
 435 #return contexts and fill-in values
 436 # If you add anything, be sure to add a description in
 437 # httemplate/edit/msg_template.html.
 438 sub substitutions {
 439   { 'cust_main' => [qw(
 440       display_custnum agentnum agent_name
 441
 442       last first company
 443       name name_short contact contact_firstlast
 444       address1 address2 city county state zip
 445       country
 446       daytime night fax
 447
 448       has_ship_address
 449       ship_last ship_first ship_company
 450       ship_name ship_name_short ship_contact ship_contact_firstlast
 451       ship_address1 ship_address2 ship_city ship_county ship_state ship_zip
 452       ship_country
 453       ship_daytime ship_night ship_fax
 454
 455       paymask payname paytype payip
 456       num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
 457       classname categoryname
 458       balance
 459       credit_limit
 460       invoicing_list_emailonly
 461       cust_status ucfirst_cust_status cust_statuscolor
 462
 463       signupdate dundate
 464       packages recurdates
 465       ),
 466       [ expdate           => sub { shift->paydate_epoch } ], #compatibility
 467       [ signupdate_ymd    => sub { $ymd->(shift->signupdate) } ],
 468       [ dundate_ymd       => sub { $ymd->(shift->dundate) } ],
 469       [ paydate_my        => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
 470       [ otaker_first      => sub { shift->access_user->first } ],
 471       [ otaker_last       => sub { shift->access_user->last } ],
 472       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 473       [ company_name      => sub {
 474           $conf->config('company_name', shift->agentnum)
 475         } ],
 476       [ company_address   => sub {
 477           $conf->config('company_address', shift->agentnum)
 478         } ],
 479       [ company_phonenum  => sub {
 480           $conf->config('company_phonenum', shift->agentnum)
 481         } ],
 482     ],
 483     # next_bill_date
 484     'cust_pkg'  => [qw(
 485       pkgnum pkg_label pkg_label_long
 486       location_label
 487       status statuscolor
 488
 489       start_date setup bill last_bill
 490       adjourn susp expire
 491       labels_short
 492       ),
 493       [ pkg               => sub { shift->part_pkg->pkg } ],
 494       [ cancel            => sub { shift->getfield('cancel') } ], # grrr...
 495       [ start_ymd         => sub { $ymd->(shift->getfield('start_date')) } ],
 496       [ setup_ymd         => sub { $ymd->(shift->getfield('setup')) } ],
 497       [ next_bill_ymd     => sub { $ymd->(shift->getfield('bill')) } ],
 498       [ last_bill_ymd     => sub { $ymd->(shift->getfield('last_bill')) } ],
 499       [ adjourn_ymd       => sub { $ymd->(shift->getfield('adjourn')) } ],
 500       [ susp_ymd          => sub { $ymd->(shift->getfield('susp')) } ],
 501       [ expire_ymd        => sub { $ymd->(shift->getfield('expire')) } ],
 502       [ cancel_ymd        => sub { $ymd->(shift->getfield('cancel')) } ],
 503     ],
 504     'cust_bill' => [qw(
 505       invnum
 506       _date
 507     )],
 508     #XXX not really thinking about cust_bill substitutions quite yet
 509
 510     # for welcome and limit warning messages
 511     'svc_acct' => [qw(
 512       svcnum
 513       username
 514       domain
 515       ),
 516       [ password          => sub { shift->getfield('_password') } ],
 517     ],
 518     'svc_domain' => [qw(
 519       svcnum
 520       domain
 521       ),
 522       [ registrar         => sub {
 523           my $registrar = qsearchs('registrar',
 524             { registrarnum => shift->registrarnum} );
 525           $registrar ? $registrar->registrarname : ''
 526         }
 527       ],
 528       [ catchall          => sub {
 529           my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
 530           $svc_acct ? $svc_acct->email : ''
 531         }
 532       ],
 533     ],
 534     'svc_phone' => [qw(
 535       svcnum
 536       phonenum
 537       countrycode
 538       domain
 539       )
 540     ],
 541     'svc_broadband' => [qw(
 542       svcnum
 543       speed_up
 544       speed_down
 545       ip_addr
 546       mac_addr
 547       )
 548     ],
 549     # for payment receipts
 550     'cust_pay' => [qw(
 551       paynum
 552       _date
 553       ),
 554       [ paid              => sub { sprintf("%.2f", shift->paid) } ],
 555       # overrides the one in cust_main in cases where a cust_pay is passed
 556       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 557       [ date              => sub { time2str("%a %B %o, %Y", shift->_date) } ],
 558       [ payinfo           => sub {
 559           my $cust_pay = shift;
 560           ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ?
 561             $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo)
 562         } ],
 563     ],
 564     # for payment decline messages
 565     # try to support all cust_pay fields
 566     # 'error' is a special case, it contains the raw error from the gateway
 567     'cust_pay_pending' => [qw(
 568       _date
 569       error
 570       ),
 571       [ paid              => sub { sprintf("%.2f", shift->paid) } ],
 572       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 573       [ date              => sub { time2str("%a %B %o, %Y", shift->_date) } ],
 574       [ payinfo           => sub {
 575           my $pending = shift;
 576           ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ?
 577             $pending->paymask : $pending->decrypt($pending->payinfo)
 578         } ],
 579     ],
 580   };
 581 }
 582
 583 =item content LOCALE
 584
 585 Returns the L<FS::template_content> object appropriate to LOCALE, if there
 586 is one.  If not, returns the one with a NULL locale.
 587
 588 =cut
 589
 590 sub content {
 591   my $self = shift;
 592   my $locale = shift;
 593   qsearchs('template_content',
 594             { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
 595   qsearchs('template_content',
 596             { 'msgnum' => $self->msgnum, 'locale' => '' });
 597 }
 598
 599 =item agent
 600
 601 Returns the L<FS::agent> object for this template.
 602
 603 =cut
 604
 605 sub agent {
 606   qsearchs('agent', { 'agentnum' => $_[0]->agentnum });
 607 }
 608
 609 sub _upgrade_data {
 610   my ($self, %opts) = @_;
 611
 612   my @fixes = (
 613     [ 'alerter_msgnum',  'alerter_template',   '',               '', '' ],
 614     [ 'cancel_msgnum',   'cancelmessage',      'cancelsubject',  '', '' ],
 615     [ 'decline_msgnum',  'declinetemplate',    '',               '', '' ],
 616     [ 'impending_recur_msgnum', 'impending_recur_template', '',  '', 'impending_recur_bcc' ],
 617     [ 'payment_receipt_msgnum', 'payment_receipt_email', '',     '', '' ],
 618     [ 'welcome_msgnum',  'welcome_email',      'welcome_email-subject', 'welcome_email-from', '' ],
 619     [ 'warning_msgnum',  'warning_email',      'warning_email-subject', 'warning_email-from', '' ],
 620   );
 621
 622   my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
 623   foreach my $agentnum (@agentnums) {
 624     foreach (@fixes) {
 625       my ($newname, $oldname, $subject, $from, $bcc) = @$_;
 626       if ($conf->exists($oldname, $agentnum)) {
 627         my $new = new FS::msg_template({
 628           'msgname'   => $oldname,
 629           'agentnum'  => $agentnum,
 630           'from_addr' => ($from && $conf->config($from, $agentnum)) ||
 631                          $conf->config('invoice_from', $agentnum),
 632           'bcc_addr'  => ($bcc && $conf->config($from, $agentnum)) || '',
 633           'subject'   => ($subject && $conf->config($subject, $agentnum)) || '',
 634           'mime_type' => 'text/html',
 635           'body'      => join('<BR>',$conf->config($oldname, $agentnum)),
 636         });
 637         my $error = $new->insert;
 638         die $error if $error;
 639         $conf->set($newname, $new->msgnum, $agentnum);
 640         $conf->delete($oldname, $agentnum);
 641         $conf->delete($from, $agentnum) if $from;
 642         $conf->delete($subject, $agentnum) if $subject;
 643       }
 644     }
 645   }
 646   foreach my $msg_template ( qsearch('msg_template', {}) ) {
 647     if ( $msg_template->subject || $msg_template->body ) {
 648       # create new default content
 649       my %content;
 650       foreach ('subject','body') {
 651         $content{$_} = $msg_template->$_;
 652         $msg_template->setfield($_, '');
 653       }
 654
 655       my $error = $msg_template->replace(%content);
 656       die $error if $error;
 657     }
 658   }
 659 }
 660
 661 sub eviscerate {
 662   # Every bit as pleasant as it sounds.
 663   #
 664   # We do this because Text::Template::Preprocess doesn't
 665   # actually work.  It runs the entire template through
 666   # the preprocessor, instead of the code segments.  Which
 667   # is a shame, because Text::Template already contains
 668   # the code to do this operation.
 669   my $body = shift;
 670   my (@outside, @inside);
 671   my $depth = 0;
 672   my $chunk = '';
 673   while($body || $chunk) {
 674     my ($first, $delim, $rest);
 675     # put all leading non-delimiters into $first
 676     ($first, $rest) =
 677         ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
 678     $chunk .= $first;
 679     # put a leading delimiter into $delim if there is one
 680     ($delim, $rest) =
 681       ($rest =~ /^([{}]?)(.*)$/s);
 682
 683     if( $delim eq '{' ) {
 684       $chunk .= '{';
 685       if( $depth == 0 ) {
 686         push @outside, $chunk;
 687         $chunk = '';
 688       }
 689       $depth++;
 690     }
 691     elsif( $delim eq '}' ) {
 692       $depth--;
 693       if( $depth == 0 ) {
 694         push @inside, $chunk;
 695         $chunk = '';
 696       }
 697       $chunk .= '}';
 698     }
 699     else {
 700       # no more delimiters
 701       if( $depth == 0 ) {
 702         push @outside, $chunk . $rest;
 703       } # else ? something wrong
 704       last;
 705     }
 706     $body = $rest;
 707   }
 708   (\@outside, \@inside);
 709 }
 710
 711 =back
 712
 713 =head1 BUGS
 714
 715 =head1 SEE ALSO
 716
 717 L<FS::Record>, schema.html from the base documentation.
 718
 719 =cut
 720
 721 1;
 722