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