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
  10 use FS::cust_main;
  11 use FS::cust_msg;
  12
  13 use Date::Format qw( time2str );
  14 use HTML::Entities qw( decode_entities encode_entities ) ;
  15 use HTML::FormatText;
  16 use HTML::TreeBuilder;
  17 use vars qw( $DEBUG $conf );
  18
  19 FS::UID->install_callback( sub { $conf = new FS::Conf; } );
  20
  21 $DEBUG=0;
  22
  23 =head1 NAME
  24
  25 FS::msg_template - Object methods for msg_template records
  26
  27 =head1 SYNOPSIS
  28
  29   use FS::msg_template;
  30
  31   $record = new FS::msg_template \%hash;
  32   $record = new FS::msg_template { 'column' => 'value' };
  33
  34   $error = $record->insert;
  35
  36   $error = $new_record->replace($old_record);
  37
  38   $error = $record->delete;
  39
  40   $error = $record->check;
  41
  42 =head1 DESCRIPTION
  43
  44 An FS::msg_template object represents a customer message template.
  45 FS::msg_template inherits from FS::Record.  The following fields are currently
  46 supported:
  47
  48 =over 4
  49
  50 =item msgnum
  51
  52 primary key
  53
  54 =item msgname
  55
  56 Template name.
  57
  58 =item agentnum
  59
  60 Agent associated with this template.  Can be NULL for a global template.
  61
  62 =item mime_type
  63
  64 MIME type.  Defaults to text/html.
  65
  66 =item from_addr
  67
  68 Source email address.
  69
  70 =item subject
  71
  72 The message subject line, in L<Text::Template> format.
  73
  74 =item body
  75
  76 The message body, as plain text or HTML, in L<Text::Template> format.
  77
  78 =item disabled
  79
  80 disabled
  81
  82 =back
  83
  84 =head1 METHODS
  85
  86 =over 4
  87
  88 =item new HASHREF
  89
  90 Creates a new template.  To add the template to the database, see L<"insert">.
  91
  92 Note that this stores the hash reference, not a distinct copy of the hash it
  93 points to.  You can ask the object for a copy with the I<hash> method.
  94
  95 =cut
  96
  97 # the new method can be inherited from FS::Record, if a table method is defined
  98
  99 sub table { 'msg_template'; }
 100
 101 =item insert
 102
 103 Adds this record to the database.  If there is an error, returns the error,
 104 otherwise returns false.
 105
 106 =cut
 107
 108 # the insert method can be inherited from FS::Record
 109
 110 =item delete
 111
 112 Delete this record from the database.
 113
 114 =cut
 115
 116 # the delete method can be inherited from FS::Record
 117
 118 =item replace OLD_RECORD
 119
 120 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 121 returns the error, otherwise returns false.
 122
 123 =cut
 124
 125 # the replace method can be inherited from FS::Record
 126
 127 =item check
 128
 129 Checks all fields to make sure this is a valid template.  If there is
 130 an error, returns the error, otherwise returns false.  Called by the insert
 131 and replace methods.
 132
 133 =cut
 134
 135 # the check method should currently be supplied - FS::Record contains some
 136 # data checking routines
 137
 138 sub check {
 139   my $self = shift;
 140
 141   my $error =
 142     $self->ut_numbern('msgnum')
 143     || $self->ut_text('msgname')
 144     || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
 145     || $self->ut_textn('mime_type')
 146     || $self->ut_anything('subject')
 147     || $self->ut_anything('body')
 148     || $self->ut_enum('disabled', [ '', 'Y' ] )
 149     || $self->ut_textn('from_addr')
 150   ;
 151   return $error if $error;
 152
 153   $self->mime_type('text/html') unless $self->mime_type;
 154
 155   $self->SUPER::check;
 156 }
 157
 158 =item prepare OPTION => VALUE
 159
 160 Fills in the template and returns a hash of the 'from' address, 'to'
 161 addresses, subject line, and body.
 162
 163 Options are passed as a list of name/value pairs:
 164
 165 =over 4
 166
 167 =item cust_main
 168
 169 Customer object (required).
 170
 171 =item object
 172
 173 Additional context object (currently, can be a cust_main, cust_pkg,
 174 cust_bill, cust_pay, cust_pay_pending, or svc_(acct, phone, broadband,
 175 domain) ).  If the object is a svc_*, its cust_pkg will be fetched and
 176 used for substitution.
 177
 178 As a special case, this may be an arrayref of two objects.  Both
 179 objects will be available for substitution, with their field names
 180 prefixed with 'new_' and 'old_' respectively.  This is used in the
 181 rt_ticket export when exporting "replace" events.
 182
 183 =item from_config
 184
 185 Configuration option to use as the source address, based on the customer's
 186 agentnum.  If unspecified (or the named option is empty), 'invoice_from'
 187 will be used.
 188
 189 The I<from_addr> field in the template takes precedence over this.
 190
 191 =item to
 192
 193 Destination address.  The default is to use the customer's
 194 invoicing_list addresses.  Multiple addresses may be comma-separated.
 195
 196 =item preview
 197
 198 Set to true when preparing a message for previewing, rather than to actually
 199 send it.  This turns off logging.
 200
 201 =back
 202
 203 =cut
 204
 205 sub prepare {
 206   my( $self, %opt ) = @_;
 207
 208   my $cust_main = $opt{'cust_main'};
 209   my $object = $opt{'object'};
 210   warn "preparing template '".$self->msgname."' to cust#".$cust_main->custnum."\n"
 211     if($DEBUG);
 212
 213   my $subs = $self->substitutions;
 214
 215   ###
 216   # create substitution table
 217   ###
 218   my %hash;
 219   my @objects = ($cust_main);
 220   my @prefixes = ('');
 221   my $svc;
 222   if( ref $object ) {
 223     if( ref($object) eq 'ARRAY' ) {
 224       # [new, old], for provisioning tickets
 225       push @objects, $object->[0], $object->[1];
 226       push @prefixes, 'new_', 'old_';
 227       $svc = $object->[0] if $object->[0]->isa('FS::svc_Common');
 228     }
 229     else {
 230       push @objects, $object;
 231       push @prefixes, '';
 232       $svc = $object if $object->isa('FS::svc_Common');
 233     }
 234   }
 235   if( $svc ) {
 236     push @objects, $svc->cust_svc->cust_pkg;
 237     push @prefixes, '';
 238   }
 239
 240   foreach my $obj (@objects) {
 241     my $prefix = shift @prefixes;
 242     foreach my $name (@{ $subs->{$obj->table} }) {
 243       if(!ref($name)) {
 244         # simple case
 245         $hash{$prefix.$name} = $obj->$name();
 246       }
 247       elsif( ref($name) eq 'ARRAY' ) {
 248         # [ foo => sub { ... } ]
 249         $hash{$prefix.($name->[0])} = $name->[1]->($obj);
 250       }
 251       else {
 252         warn "bad msg_template substitution: '$name'\n";
 253         #skip it?
 254       }
 255     }
 256   }
 257   $_ = encode_entities($_) foreach values(%hash);
 258
 259
 260   ###
 261   # clean up template
 262   ###
 263   my $subject_tmpl = new Text::Template (
 264     TYPE   => 'STRING',
 265     SOURCE => $self->subject,
 266   );
 267   my $subject = $subject_tmpl->fill_in( HASH => \%hash );
 268
 269   my $body = $self->body;
 270   my ($skin, $guts) = eviscerate($body);
 271   @$guts = map {
 272     $_ = decode_entities($_); # turn all punctuation back into itself
 273     s/\r//gs;           # remove \r's
 274     s/<br[^>]*>/\n/gsi; # and <br /> tags
 275     s/<p>/\n/gsi;       # and <p>
 276     s/<\/p>//gsi;       # and </p>
 277     s/\240/ /gs;        # and &nbsp;
 278     $_
 279   } @$guts;
 280
 281   $body = '{ use Date::Format qw(time2str); "" }';
 282   while(@$skin || @$guts) {
 283     $body .= shift(@$skin) || '';
 284     $body .= shift(@$guts) || '';
 285   }
 286
 287   ###
 288   # fill-in
 289   ###
 290
 291   my $body_tmpl = new Text::Template (
 292     TYPE          => 'STRING',
 293     SOURCE        => $body,
 294   );
 295
 296   $body = $body_tmpl->fill_in( HASH => \%hash );
 297
 298   ###
 299   # and email
 300   ###
 301
 302   my @to;
 303   if ( exists($opt{'to'}) ) {
 304     @to = split(/\s*,\s*/, $opt{'to'});
 305   }
 306   else {
 307     @to = $cust_main->invoicing_list_emailonly;
 308   }
 309   # no warning when preparing with no destination
 310
 311   my $from_addr = $self->from_addr;
 312
 313   if ( !$from_addr ) {
 314     if ( $opt{'from_config'} ) {
 315       $from_addr = scalar( $conf->config($opt{'from_config'},
 316                                          $cust_main->agentnum) );
 317     }
 318     $from_addr ||= scalar( $conf->config('invoice_from',
 319                                          $cust_main->agentnum) );
 320   }
 321   my @cust_msg = ();
 322   if ( $conf->exists('log_sent_mail') and !$opt{'preview'} ) {
 323     my $cust_msg = FS::cust_msg->new({
 324         'custnum' => $cust_main->custnum,
 325         'msgnum'  => $self->msgnum,
 326         'status'  => 'prepared',
 327       });
 328     $cust_msg->insert;
 329     @cust_msg = ('cust_msg' => $cust_msg);
 330   }
 331
 332   (
 333     'custnum' => $cust_main->custnum,
 334     'msgnum'  => $self->msgnum,
 335     'from' => $from_addr,
 336     'to'   => \@to,
 337     'bcc'  => $self->bcc_addr || undef,
 338     'subject'   => $subject,
 339     'html_body' => $body,
 340     'text_body' => HTML::FormatText->new(leftmargin => 0, rightmargin => 70
 341                     )->format( HTML::TreeBuilder->new_from_content($body) ),
 342     @cust_msg,
 343   );
 344
 345 }
 346
 347 =item send OPTION => VALUE
 348
 349 Fills in the template and sends it to the customer.  Options are as for
 350 'prepare'.
 351
 352 =cut
 353
 354 # broken out from prepare() in case we want to queue the sending,
 355 # preview it, etc.
 356 sub send {
 357   my $self = shift;
 358   send_email(generate_email($self->prepare(@_)));
 359 }
 360
 361 # helper sub for package dates
 362 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
 363
 364 #my $conf = new FS::Conf;
 365
 366 #return contexts and fill-in values
 367 # If you add anything, be sure to add a description in
 368 # httemplate/edit/msg_template.html.
 369 sub substitutions {
 370   { 'cust_main' => [qw(
 371       display_custnum agentnum agent_name
 372
 373       last first company
 374       name name_short contact contact_firstlast
 375       address1 address2 city county state zip
 376       country
 377       daytime night fax
 378
 379       has_ship_address
 380       ship_last ship_first ship_company
 381       ship_name ship_name_short ship_contact ship_contact_firstlast
 382       ship_address1 ship_address2 ship_city ship_county ship_state ship_zip
 383       ship_country
 384       ship_daytime ship_night ship_fax
 385
 386       paymask payname paytype payip
 387       num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
 388       classname categoryname
 389       balance
 390       credit_limit
 391       invoicing_list_emailonly
 392       cust_status ucfirst_cust_status cust_statuscolor
 393
 394       signupdate dundate
 395       expdate
 396       packages recurdates
 397       ),
 398       # expdate is a special case
 399       [ signupdate_ymd    => sub { time2str('%Y-%m-%d', shift->signupdate) } ],
 400       [ dundate_ymd       => sub { time2str('%Y-%m-%d', shift->dundate) } ],
 401       [ paydate_my        => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
 402       [ otaker_first      => sub { shift->access_user->first } ],
 403       [ otaker_last       => sub { shift->access_user->last } ],
 404       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 405       [ company_name      => sub {
 406           $conf->config('company_name', shift->agentnum)
 407         } ],
 408       [ company_address   => sub {
 409           $conf->config('company_address', shift->agentnum)
 410         } ],
 411       [ company_phonenum  => sub {
 412           $conf->config('company_phonenum', shift->agentnum)
 413         } ],
 414     ],
 415     # next_bill_date
 416     'cust_pkg'  => [qw(
 417       pkgnum pkg_label pkg_label_long
 418       location_label
 419       status statuscolor
 420
 421       start_date setup bill last_bill
 422       adjourn susp expire
 423       labels_short
 424       ),
 425       [ pkg               => sub { shift->part_pkg->pkg } ],
 426       [ cancel            => sub { shift->getfield('cancel') } ], # grrr...
 427       [ start_ymd         => sub { $ymd->(shift->getfield('start_date')) } ],
 428       [ setup_ymd         => sub { $ymd->(shift->getfield('setup')) } ],
 429       [ next_bill_ymd     => sub { $ymd->(shift->getfield('bill')) } ],
 430       [ last_bill_ymd     => sub { $ymd->(shift->getfield('last_bill')) } ],
 431       [ adjourn_ymd       => sub { $ymd->(shift->getfield('adjourn')) } ],
 432       [ susp_ymd          => sub { $ymd->(shift->getfield('susp')) } ],
 433       [ expire_ymd        => sub { $ymd->(shift->getfield('expire')) } ],
 434       [ cancel_ymd        => sub { $ymd->(shift->getfield('cancel')) } ],
 435     ],
 436     'cust_bill' => [qw(
 437       invnum
 438       _date
 439     )],
 440     #XXX not really thinking about cust_bill substitutions quite yet
 441
 442     # for welcome and limit warning messages
 443     'svc_acct' => [qw(
 444       svcnum
 445       username
 446       domain
 447       ),
 448       [ password          => sub { shift->getfield('_password') } ],
 449     ],
 450     'svc_domain' => [qw(
 451       svcnum
 452       domain
 453       ),
 454       [ registrar         => sub {
 455           my $registrar = qsearchs('registrar',
 456             { registrarnum => shift->registrarnum} );
 457           $registrar ? $registrar->registrarname : ''
 458         }
 459       ],
 460       [ catchall          => sub {
 461           my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
 462           $svc_acct ? $svc_acct->email : ''
 463         }
 464       ],
 465     ],
 466     'svc_phone' => [qw(
 467       svcnum
 468       phonenum
 469       countrycode
 470       domain
 471       )
 472     ],
 473     'svc_broadband' => [qw(
 474       svcnum
 475       speed_up
 476       speed_down
 477       ip_addr
 478       mac_addr
 479       )
 480     ],
 481     # for payment receipts
 482     'cust_pay' => [qw(
 483       paynum
 484       _date
 485       ),
 486       [ paid              => sub { sprintf("%.2f", shift->paid) } ],
 487       # overrides the one in cust_main in cases where a cust_pay is passed
 488       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 489       [ date              => sub { time2str("%a %B %o, %Y", shift->_date) } ],
 490       [ payinfo           => sub {
 491           my $cust_pay = shift;
 492           ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ?
 493             $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo)
 494         } ],
 495     ],
 496     # for payment decline messages
 497     # try to support all cust_pay fields
 498     # 'error' is a special case, it contains the raw error from the gateway
 499     'cust_pay_pending' => [qw(
 500       _date
 501       error
 502       ),
 503       [ paid              => sub { sprintf("%.2f", shift->paid) } ],
 504       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 505       [ date              => sub { time2str("%a %B %o, %Y", shift->_date) } ],
 506       [ payinfo           => sub {
 507           my $pending = shift;
 508           ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ?
 509             $pending->paymask : $pending->decrypt($pending->payinfo)
 510         } ],
 511     ],
 512   };
 513 }
 514
 515 sub _upgrade_data {
 516   my ($self, %opts) = @_;
 517
 518   my @fixes = (
 519     [ 'alerter_msgnum',  'alerter_template',   '',               '', '' ],
 520     [ 'cancel_msgnum',   'cancelmessage',      'cancelsubject',  '', '' ],
 521     [ 'decline_msgnum',  'declinetemplate',    '',               '', '' ],
 522     [ 'impending_recur_msgnum', 'impending_recur_template', '',  '', 'impending_recur_bcc' ],
 523     [ 'payment_receipt_msgnum', 'payment_receipt_email', '',     '', '' ],
 524     [ 'welcome_msgnum',  'welcome_email',      'welcome_email-subject', 'welcome_email-from', '' ],
 525     [ 'warning_msgnum',  'warning_email',      'warning_email-subject', 'warning_email-from', '' ],
 526   );
 527
 528   my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
 529   foreach my $agentnum (@agentnums) {
 530     foreach (@fixes) {
 531       my ($newname, $oldname, $subject, $from, $bcc) = @$_;
 532       if ($conf->exists($oldname, $agentnum)) {
 533         my $new = new FS::msg_template({
 534            'msgname'   => $oldname,
 535            'agentnum'  => $agentnum,
 536            'from_addr' => ($from && $conf->config($from, $agentnum)) ||
 537                           $conf->config('invoice_from', $agentnum),
 538            'bcc_addr'  => ($bcc && $conf->config($from, $agentnum)) || '',
 539            'subject'   => ($subject && $conf->config($subject, $agentnum)) || '',
 540            'mime_type' => 'text/html',
 541            'body'      => join('<BR>',$conf->config($oldname, $agentnum)),
 542         });
 543         my $error = $new->insert;
 544         die $error if $error;
 545         $conf->set($newname, $new->msgnum, $agentnum);
 546         $conf->delete($oldname, $agentnum);
 547         $conf->delete($from, $agentnum) if $from;
 548         $conf->delete($subject, $agentnum) if $subject;
 549       }
 550     }
 551   }
 552 }
 553
 554 sub eviscerate {
 555   # Every bit as pleasant as it sounds.
 556   #
 557   # We do this because Text::Template::Preprocess doesn't
 558   # actually work.  It runs the entire template through
 559   # the preprocessor, instead of the code segments.  Which
 560   # is a shame, because Text::Template already contains
 561   # the code to do this operation.
 562   my $body = shift;
 563   my (@outside, @inside);
 564   my $depth = 0;
 565   my $chunk = '';
 566   while($body || $chunk) {
 567     my ($first, $delim, $rest);
 568     # put all leading non-delimiters into $first
 569     ($first, $rest) =
 570         ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
 571     $chunk .= $first;
 572     # put a leading delimiter into $delim if there is one
 573     ($delim, $rest) =
 574       ($rest =~ /^([{}]?)(.*)$/s);
 575
 576     if( $delim eq '{' ) {
 577       $chunk .= '{';
 578       if( $depth == 0 ) {
 579         push @outside, $chunk;
 580         $chunk = '';
 581       }
 582       $depth++;
 583     }
 584     elsif( $delim eq '}' ) {
 585       $depth--;
 586       if( $depth == 0 ) {
 587         push @inside, $chunk;
 588         $chunk = '';
 589       }
 590       $chunk .= '}';
 591     }
 592     else {
 593       # no more delimiters
 594       if( $depth == 0 ) {
 595         push @outside, $chunk . $rest;
 596       } # else ? something wrong
 597       last;
 598     }
 599     $body = $rest;
 600   }
 601   (\@outside, \@inside);
 602 }
 603
 604 =back
 605
 606 =head1 BUGS
 607
 608 =head1 SEE ALSO
 609
 610 L<FS::Record>, schema.html from the base documentation.
 611
 612 =cut
 613
 614 1;
 615