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 do_print );
   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 Encode;
  20
  21 use File::Temp;
  22 use IPC::Run qw(run);
  23 use vars qw( $DEBUG $conf );
  24
  25 FS::UID->install_callback( sub { $conf = new FS::Conf; } );
  26
  27 $DEBUG=0;
  28
  29 =head1 NAME
  30
  31 FS::msg_template - Object methods for msg_template records
  32
  33 =head1 SYNOPSIS
  34
  35   use FS::msg_template;
  36
  37   $record = new FS::msg_template \%hash;
  38   $record = new FS::msg_template { 'column' => 'value' };
  39
  40   $error = $record->insert;
  41
  42   $error = $new_record->replace($old_record);
  43
  44   $error = $record->delete;
  45
  46   $error = $record->check;
  47
  48 =head1 DESCRIPTION
  49
  50 An FS::msg_template object represents a customer message template.
  51 FS::msg_template inherits from FS::Record.  The following fields are currently
  52 supported:
  53
  54 =over 4
  55
  56 =item msgnum - primary key
  57
  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.
  60
  61 =item agentnum - Agent associated with this template.  Can be NULL for a
  62 global template.
  63
  64 =item mime_type - MIME type.  Defaults to text/html.
  65
  66 =item from_addr - Source email address.
  67
  68 =item disabled - disabled ('Y' or NULL).
  69
  70 =back
  71
  72 =head1 METHODS
  73
  74 =over 4
  75
  76 =item new HASHREF
  77
  78 Creates a new template.  To add the template to the database, see L<"insert">.
  79
  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.
  82
  83 =cut
  84
  85 # the new method can be inherited from FS::Record, if a table method is defined
  86
  87 sub table { 'msg_template'; }
  88
  89 =item insert [ CONTENT ]
  90
  91 Adds this record to the database.  If there is an error, returns the error,
  92 otherwise returns false.
  93
  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.
  96
  97 =cut
  98
  99 sub insert {
 100   my $self = shift;
 101   my %content = @_;
 102
 103   my $oldAutoCommit = $FS::UID::AutoCommit;
 104   local $FS::UID::AutoCommit = 0;
 105   my $dbh = dbh;
 106
 107   my $error = $self->SUPER::insert;
 108   if ( !$error ) {
 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;
 114   }
 115
 116   if ( $error ) {
 117     $dbh->rollback if $oldAutoCommit;
 118     return $error;
 119   }
 120
 121   $dbh->commit if $oldAutoCommit;
 122   return;
 123 }
 124
 125 =item delete
 126
 127 Delete this record from the database.
 128
 129 =cut
 130
 131 # the delete method can be inherited from FS::Record
 132
 133 =item replace [ OLD_RECORD ] [ CONTENT ]
 134
 135 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 136 returns the error, otherwise returns false.
 137
 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).
 141
 142 =cut
 143
 144 sub replace {
 145   my $self = shift;
 146   my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') )
 147               ? shift
 148               : $self->replace_old;
 149   my %content = @_;
 150
 151   my $oldAutoCommit = $FS::UID::AutoCommit;
 152   local $FS::UID::AutoCommit = 0;
 153   my $dbh = dbh;
 154
 155   my $error = $self->SUPER::replace($old);
 156
 157   if ( !$error and %content ) {
 158     $content{'locale'} ||= '';
 159     my $new_content = qsearchs('template_content', {
 160                         'msgnum' => $self->msgnum,
 161                         'locale' => $content{'locale'},
 162                       } );
 163     if ( $new_content ) {
 164       $new_content->subject($content{'subject'});
 165       $new_content->body($content{'body'});
 166       $error = $new_content->replace;
 167     }
 168     else {
 169       $content{'msgnum'} = $self->msgnum;
 170       $new_content = new FS::template_content \%content;
 171       $error = $new_content->insert;
 172     }
 173   }
 174
 175   if ( $error ) {
 176     $dbh->rollback if $oldAutoCommit;
 177     return $error;
 178   }
 179
 180   warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit;
 181   $dbh->commit if $oldAutoCommit;
 182   return;
 183 }
 184
 185
 186
 187 =item check
 188
 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
 191 and replace methods.
 192
 193 =cut
 194
 195 # the check method should currently be supplied - FS::Record contains some
 196 # data checking routines
 197
 198 sub check {
 199   my $self = shift;
 200
 201   my $error =
 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')
 208   ;
 209   return $error if $error;
 210
 211   $self->mime_type('text/html') unless $self->mime_type;
 212
 213   $self->SUPER::check;
 214 }
 215
 216 =item content_locales
 217
 218 Returns a hashref of the L<FS::template_content> objects attached to
 219 this template, with the locale as key.
 220
 221 =cut
 222
 223 sub content_locales {
 224   my $self = shift;
 225   return $self->{'_content_locales'} ||= +{
 226     map { $_->locale , $_ }
 227     qsearch('template_content', { 'msgnum' => $self->msgnum })
 228   };
 229 }
 230
 231 =item prepare OPTION => VALUE
 232
 233 Fills in the template and returns a hash of the 'from' address, 'to'
 234 addresses, subject line, and body.
 235
 236 Options are passed as a list of name/value pairs:
 237
 238 =over 4
 239
 240 =item cust_main
 241
 242 Customer object (optional)
 243
 244 =item object
 245
 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.
 250
 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.
 255
 256 =item from_config
 257
 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'
 260 will be used.
 261
 262 The I<from_addr> field in the template takes precedence over this.
 263
 264 =item to
 265
 266 Destination address.  The default is to use the customer's
 267 invoicing_list addresses.  Multiple addresses may be comma-separated.
 268
 269 =item substitutions
 270
 271 A hash reference of additional substitutions
 272
 273 =back
 274
 275 =cut
 276
 277 sub prepare {
 278   my( $self, %opt ) = @_;
 279
 280   my $cust_main = $opt{'cust_main'}; # or die 'cust_main required';
 281   my $object = $opt{'object'}; # or die 'object required';
 282
 283   my $locale = $cust_main ? $cust_main->locale : '';
 284
 285   warn "no locale for cust#".$cust_main->custnum."; using default content\n"
 286     if $DEBUG and $cust_main and !$locale;
 287
 288   my $content = $self->content( $locale );
 289
 290   warn sprintf(
 291     "preparing template '%s' to cust#%s\n",
 292     $self->msgname,
 293     $cust_main ? $cust_main->custnum : 'none'
 294   ) if $DEBUG;
 295
 296   my $subs = $self->substitutions;
 297
 298   ###
 299   # create substitution table
 300   ###
 301   my %hash;
 302   my ( @objects, @prefixes );
 303   if ( $cust_main ) {
 304     @objects  = ( $cust_main );
 305     @prefixes = ( '' );
 306   }
 307   my $svc;
 308   if( ref $object ) {
 309     if( ref($object) eq 'ARRAY' ) {
 310       # [new, old], for provisioning tickets
 311       push @objects, $object->[0], $object->[1];
 312       push @prefixes, 'new_', 'old_';
 313       $svc = $object->[0] if $object->[0]->isa('FS::svc_Common');
 314     }
 315     else {
 316       push @objects, $object;
 317       push @prefixes, '';
 318       $svc = $object if $object->isa('FS::svc_Common');
 319     }
 320   }
 321   if( $svc ) {
 322     push @objects, $svc->cust_svc->cust_pkg;
 323     push @prefixes, '';
 324   }
 325
 326   foreach my $obj (@objects) {
 327     my $prefix = shift @prefixes;
 328     foreach my $name (@{ $subs->{$obj->table} }) {
 329       if(!ref($name)) {
 330         # simple case
 331         $hash{$prefix.$name} = $obj->$name();
 332       }
 333       elsif( ref($name) eq 'ARRAY' ) {
 334         # [ foo => sub { ... } ]
 335         $hash{$prefix.($name->[0])} = $name->[1]->($obj);
 336       }
 337       else {
 338         warn "bad msg_template substitution: '$name'\n";
 339         #skip it?
 340       }
 341     }
 342   }
 343
 344   if ( $opt{substitutions} ) {
 345     $hash{$_} = $opt{substitutions}->{$_} foreach keys %{$opt{substitutions}};
 346   }
 347
 348   $_ = encode_entities($_ || '') foreach values(%hash);
 349
 350   ###
 351   # clean up template
 352   ###
 353   my $subject_tmpl = new Text::Template (
 354     TYPE   => 'STRING',
 355     SOURCE => $content->subject,
 356   );
 357   my $subject = $subject_tmpl->fill_in( HASH => \%hash );
 358
 359   my $body = $content->body;
 360   my ($skin, $guts) = eviscerate($body);
 361   @$guts = map {
 362     $_ = decode_entities($_); # turn all punctuation back into itself
 363     s/\r//gs;           # remove \r's
 364     s/<br[^>]*>/\n/gsi; # and <br /> tags
 365     s/<p>/\n/gsi;       # and <p>
 366     s/<\/p>//gsi;       # and </p>
 367     s/\240/ /gs;        # and &nbsp;
 368     $_
 369   } @$guts;
 370
 371   $body = '{ use Date::Format qw(time2str); "" }';
 372   while(@$skin || @$guts) {
 373     $body .= shift(@$skin) || '';
 374     $body .= shift(@$guts) || '';
 375   }
 376
 377   ###
 378   # fill-in
 379   ###
 380
 381   my $body_tmpl = new Text::Template (
 382     TYPE          => 'STRING',
 383     SOURCE        => $body,
 384   );
 385
 386   $body = $body_tmpl->fill_in( HASH => \%hash );
 387
 388   ###
 389   # and email
 390   ###
 391
 392   my @to;
 393   if ( exists($opt{'to'}) ) {
 394
 395     @to = split(/\s*,\s*/, $opt{'to'});
 396
 397   } elsif ( $cust_main ) {
 398
 399     my @classes;
 400     if ( $opt{'to_contact_classnum'} ) {
 401       my $classnum = $opt{'to_contact_classnum'};
 402       @classes = ref($classnum) ? @$classnum : split(',', $classnum);
 403     }
 404     if (!@classes) {
 405       @classes = ( 'invoice' );
 406     }
 407     @to = $cust_main->contact_list_email(@classes);
 408
 409   } else {
 410
 411     die 'no To: address or cust_main object specified';
 412
 413   }
 414
 415   my $from_addr = $self->from_addr;
 416
 417   if ( !$from_addr ) {
 418     my @agentnum = ( $cust_main->agentnum ) if $cust_main;
 419     if ( $opt{'from_config'} ) {
 420       $from_addr = scalar( $conf->config( $opt{'from_config'}, @agentnum ));
 421     }
 422     $from_addr ||= $conf->invoice_from_full( @agentnum );
 423   }
 424 #  my @cust_msg = ();
 425 #  if ( $conf->exists('log_sent_mail') and !$opt{'preview'} ) {
 426 #    my $cust_msg = FS::cust_msg->new({
 427 #        'custnum' => $cust_main->custnum,
 428 #        'msgnum'  => $self->msgnum,
 429 #        'status'  => 'prepared',
 430 #      });
 431 #    $cust_msg->insert;
 432 #    @cust_msg = ('cust_msg' => $cust_msg);
 433 #  }
 434
 435   my $text_body = encode('UTF-8',
 436                   HTML::FormatText->new(leftmargin => 0, rightmargin => 70)
 437                       ->format( HTML::TreeBuilder->new_from_content($body) )
 438                   );
 439   (
 440     'custnum'   => $cust_main ? $cust_main->custnum : undef,
 441     'msgnum'    => $self->msgnum,
 442     'from'      => $from_addr,
 443     'to'        => \@to,
 444     'bcc'       => $self->bcc_addr || undef,
 445     'subject'   => $subject,
 446     'html_body' => $body,
 447     'text_body' => $text_body,
 448   );
 449
 450 }
 451
 452 =item send OPTION => VALUE
 453
 454 Fills in the template and sends it to the customer.  Options are as for
 455 'prepare', plus 'attach', a L<MIME::Entity> (or arrayref of them) to attach
 456 to the message.
 457
 458 =cut
 459
 460 # broken out from prepare() in case we want to queue the sending,
 461 # preview it, etc.
 462 sub send {
 463   my $self = shift;
 464   my %opt = @_;
 465
 466   my %email = generate_email($self->prepare(%opt));
 467   if ( $opt{'attach'} ) {
 468     my @attach;
 469     if (ref($opt{'attach'}) eq 'ARRAY') {
 470       @attach = @{ $opt{'attach'} };
 471     } else {
 472       @attach = $opt{'attach'};
 473     }
 474     push @{ $email{mimeparts} }, @attach;
 475   }
 476
 477   send_email(%email);
 478 }
 479
 480 =item render OPTION => VALUE ...
 481
 482 Fills in the template and renders it to a PDF document.  Returns the
 483 name of the PDF file.
 484
 485 Options are as for 'prepare', but 'from' and 'to' are meaningless.
 486
 487 =cut
 488
 489 # will also have options to set paper size, margins, etc.
 490
 491 sub render {
 492   my $self = shift;
 493   eval "use PDF::WebKit";
 494   die $@ if $@;
 495   my %opt = @_;
 496   my %hash = $self->prepare(%opt);
 497   my $html = $hash{'html_body'};
 498
 499   # Graphics/stylesheets should probably go in /var/www on the Freeside
 500   # machine.
 501   my $script_path = `/usr/bin/which freeside-wkhtmltopdf`;
 502   chomp $script_path;
 503   my $kit = PDF::WebKit->new(\$html); #%options
 504   # hack to use our wrapper script
 505   $kit->configure(sub { shift->wkhtmltopdf($script_path) });
 506
 507   $kit->to_pdf;
 508 }
 509
 510 =item print OPTIONS
 511
 512 Render a PDF and send it to the printer.  OPTIONS are as for 'render'.
 513
 514 =cut
 515
 516 sub print {
 517   my( $self, %opt ) = @_;
 518   do_print( [ $self->render(%opt) ], agentnum=>$opt{cust_main}->agentnum );
 519 }
 520
 521 # helper sub for package dates
 522 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
 523
 524 # helper sub for money amounts
 525 my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) };
 526
 527 # helper sub for usage-related messages
 528 my $usage_warning = sub {
 529   my $svc = shift;
 530   foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
 531     my $amount = $svc->$col; next if $amount eq '';
 532     my $method = $col.'_threshold';
 533     my $threshold = $svc->$method; next if $threshold eq '';
 534     return [$col, $amount, $threshold] if $amount <= $threshold;
 535     # this only returns the first one that's below threshold, if there are
 536     # several.
 537   }
 538   return ['', '', ''];
 539 };
 540
 541 #my $conf = new FS::Conf;
 542
 543 #return contexts and fill-in values
 544 # If you add anything, be sure to add a description in
 545 # httemplate/edit/msg_template.html.
 546 sub substitutions {
 547   my $payinfo_sub = sub {
 548     my $obj = shift;
 549     ($obj->payby eq 'CARD' || $obj->payby eq 'CHEK')
 550     ? $obj->paymask
 551     : $obj->decrypt($obj->payinfo)
 552   };
 553   my $payinfo_end = sub {
 554     my $obj = shift;
 555     my $payinfo = &$payinfo_sub($obj);
 556     substr($payinfo, -4);
 557   };
 558   { 'cust_main' => [qw(
 559       display_custnum agentnum agent_name
 560
 561       last first company
 562       name name_short contact contact_firstlast
 563       address1 address2 city county state zip
 564       country
 565       daytime night mobile fax
 566
 567       has_ship_address
 568       ship_name ship_name_short ship_contact ship_contact_firstlast
 569       ship_address1 ship_address2 ship_city ship_county ship_state ship_zip
 570       ship_country
 571
 572       paymask payname paytype payip
 573       num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
 574       classname categoryname
 575       balance
 576       credit_limit
 577       invoicing_list_emailonly
 578       cust_status ucfirst_cust_status cust_statuscolor
 579
 580       signupdate dundate
 581       packages recurdates
 582       ),
 583       [ invoicing_email => sub { shift->invoicing_list_emailonly_scalar } ],
 584       #compatibility: obsolete ship_ fields - use the non-ship versions
 585       map (
 586         { my $field = $_;
 587           [ "ship_$field"   => sub { shift->$field } ]
 588         }
 589         qw( last first company daytime night fax )
 590       ),
 591       # ship_name, ship_name_short, ship_contact, ship_contact_firstlast
 592       # still work, though
 593       [ expdate           => sub { shift->paydate_epoch } ], #compatibility
 594       [ signupdate_ymd    => sub { $ymd->(shift->signupdate) } ],
 595       [ dundate_ymd       => sub { $ymd->(shift->dundate) } ],
 596       [ paydate_my        => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
 597       [ otaker_first      => sub { shift->access_user->first } ],
 598       [ otaker_last       => sub { shift->access_user->last } ],
 599       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 600       [ company_name      => sub {
 601           $conf->config('company_name', shift->agentnum)
 602         } ],
 603       [ company_address   => sub {
 604           $conf->config('company_address', shift->agentnum)
 605         } ],
 606       [ company_phonenum  => sub {
 607           $conf->config('company_phonenum', shift->agentnum)
 608         } ],
 609       [ selfservice_server_base_url => sub {
 610           $conf->config('selfservice_server-base_url') #, shift->agentnum)
 611         } ],
 612     ],
 613     # next_bill_date
 614     'cust_pkg'  => [qw(
 615       pkgnum pkg_label pkg_label_long
 616       location_label
 617       status statuscolor
 618
 619       start_date setup bill last_bill
 620       adjourn susp expire
 621       labels_short
 622       ),
 623       [ pkg               => sub { shift->part_pkg->pkg } ],
 624       [ pkg_category      => sub { shift->part_pkg->categoryname } ],
 625       [ pkg_class         => sub { shift->part_pkg->classname } ],
 626       [ cancel            => sub { shift->getfield('cancel') } ], # grrr...
 627       [ start_ymd         => sub { $ymd->(shift->getfield('start_date')) } ],
 628       [ setup_ymd         => sub { $ymd->(shift->getfield('setup')) } ],
 629       [ next_bill_ymd     => sub { $ymd->(shift->getfield('bill')) } ],
 630       [ last_bill_ymd     => sub { $ymd->(shift->getfield('last_bill')) } ],
 631       [ adjourn_ymd       => sub { $ymd->(shift->getfield('adjourn')) } ],
 632       [ susp_ymd          => sub { $ymd->(shift->getfield('susp')) } ],
 633       [ expire_ymd        => sub { $ymd->(shift->getfield('expire')) } ],
 634       [ cancel_ymd        => sub { $ymd->(shift->getfield('cancel')) } ],
 635
 636       # not necessarily correct for non-flat packages
 637       [ setup_fee         => sub { shift->part_pkg->option('setup_fee') } ],
 638       [ recur_fee         => sub { shift->part_pkg->option('recur_fee') } ],
 639
 640       [ freq_pretty       => sub { shift->part_pkg->freq_pretty } ],
 641
 642     ],
 643     'cust_bill' => [qw(
 644       invnum
 645       _date
 646       _date_pretty
 647       due_date
 648     ),
 649       [ due_date2str      => sub { shift->due_date2str('short') } ],
 650     ],
 651     #XXX not really thinking about cust_bill substitutions quite yet
 652
 653     # for welcome and limit warning messages
 654     'svc_acct' => [qw(
 655       svcnum
 656       username
 657       domain
 658       ),
 659       [ password          => sub { shift->getfield('_password') } ],
 660       [ column            => sub { &$usage_warning(shift)->[0] } ],
 661       [ amount            => sub { &$usage_warning(shift)->[1] } ],
 662       [ threshold         => sub { &$usage_warning(shift)->[2] } ],
 663     ],
 664     'svc_domain' => [qw(
 665       svcnum
 666       domain
 667       ),
 668       [ registrar         => sub {
 669           my $registrar = qsearchs('registrar',
 670             { registrarnum => shift->registrarnum} );
 671           $registrar ? $registrar->registrarname : ''
 672         }
 673       ],
 674       [ catchall          => sub {
 675           my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
 676           $svc_acct ? $svc_acct->email : ''
 677         }
 678       ],
 679     ],
 680     'svc_phone' => [qw(
 681       svcnum
 682       phonenum
 683       countrycode
 684       domain
 685       )
 686     ],
 687     'svc_broadband' => [qw(
 688       svcnum
 689       speed_up
 690       speed_down
 691       ip_addr
 692       mac_addr
 693       )
 694     ],
 695     # for payment receipts
 696     'cust_pay' => [qw(
 697       paynum
 698       _date
 699       ),
 700       [ paid              => sub { sprintf("%.2f", shift->paid) } ],
 701       # overrides the one in cust_main in cases where a cust_pay is passed
 702       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 703       [ date              => sub { time2str("%a %B %o, %Y", shift->_date) } ],
 704       [ 'payinfo' => $payinfo_sub ],
 705       [ 'payinfo_end' => $payinfo_end ],
 706     ],
 707     # for refund receipts
 708     'cust_refund' => [
 709       'refundnum',
 710       [ refund            => sub { sprintf("%.2f", shift->refund) } ],
 711       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 712       [ date              => sub { time2str("%a %B %o, %Y", shift->_date) } ],
 713       [ 'payinfo' => $payinfo_sub ],
 714       [ 'payinfo_end' => $payinfo_end ],
 715     ],
 716     # for payment decline messages
 717     # try to support all cust_pay fields
 718     # 'error' is a special case, it contains the raw error from the gateway
 719     'cust_pay_pending' => [qw(
 720       _date
 721       error
 722       ),
 723       [ paid              => sub { sprintf("%.2f", shift->paid) } ],
 724       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 725       [ date              => sub { time2str("%a %B %o, %Y", shift->_date) } ],
 726       [ 'payinfo' => $payinfo_sub ],
 727       [ 'payinfo_end' => $payinfo_end ],
 728     ],
 729   };
 730 }
 731
 732 =item content LOCALE
 733
 734 Returns the L<FS::template_content> object appropriate to LOCALE, if there
 735 is one.  If not, returns the one with a NULL locale.
 736
 737 =cut
 738
 739 sub content {
 740   my $self = shift;
 741   my $locale = shift;
 742   qsearchs('template_content',
 743             { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
 744   qsearchs('template_content',
 745             { 'msgnum' => $self->msgnum, 'locale' => '' });
 746 }
 747
 748 =item agent
 749
 750 Returns the L<FS::agent> object for this template.
 751
 752 =cut
 753
 754 sub agent {
 755   qsearchs('agent', { 'agentnum' => $_[0]->agentnum });
 756 }
 757
 758 sub _upgrade_data {
 759   my ($self, %opts) = @_;
 760
 761   ###
 762   # First move any historical templates in config to real message templates
 763   ###
 764
 765   my @fixes = (
 766     [ 'alerter_msgnum',  'alerter_template',   '',               '', '' ],
 767     [ 'cancel_msgnum',   'cancelmessage',      'cancelsubject',  '', '' ],
 768     [ 'decline_msgnum',  'declinetemplate',    '',               '', '' ],
 769     [ 'impending_recur_msgnum', 'impending_recur_template', '',  '', 'impending_recur_bcc' ],
 770     [ 'payment_receipt_msgnum', 'payment_receipt_email', '',     '', '' ],
 771     [ 'welcome_msgnum',  'welcome_email',      'welcome_email-subject', 'welcome_email-from', '' ],
 772     [ 'warning_msgnum',  'warning_email',      'warning_email-subject', 'warning_email-from', '' ],
 773   );
 774
 775   my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
 776   foreach my $agentnum (@agentnums) {
 777     foreach (@fixes) {
 778       my ($newname, $oldname, $subject, $from, $bcc) = @$_;
 779       if ($conf->exists($oldname, $agentnum)) {
 780         my $new = new FS::msg_template({
 781           'msgname'   => $oldname,
 782           'agentnum'  => $agentnum,
 783           'from_addr' => ($from && $conf->config($from, $agentnum)) || '',
 784           'bcc_addr'  => ($bcc && $conf->config($from, $agentnum)) || '',
 785           'subject'   => ($subject && $conf->config($subject, $agentnum)) || '',
 786           'mime_type' => 'text/html',
 787           'body'      => join('<BR>',$conf->config($oldname, $agentnum)),
 788         });
 789         my $error = $new->insert;
 790         die $error if $error;
 791         $conf->set($newname, $new->msgnum, $agentnum);
 792         $conf->delete($oldname, $agentnum);
 793         $conf->delete($from, $agentnum) if $from;
 794         $conf->delete($subject, $agentnum) if $subject;
 795       }
 796     }
 797
 798     if ( $conf->exists('alert_expiration', $agentnum) ) {
 799       my $msgnum = $conf->exists('alerter_msgnum', $agentnum);
 800       my $template = FS::msg_template->by_key($msgnum) if $msgnum;
 801       if (!$template) {
 802         warn "template for alerter_msgnum $msgnum not found\n";
 803         next;
 804       }
 805       # this is now a set of billing events
 806       foreach my $days (30, 15, 5) {
 807         my $event = FS::part_event->new({
 808             'agentnum'    => $agentnum,
 809             'event'       => "Card expiration warning - $days days",
 810             'eventtable'  => 'cust_main',
 811             'check_freq'  => '1d',
 812             'action'      => 'notice',
 813             'disabled'    => 'Y', #initialize first
 814         });
 815         my $error = $event->insert( 'msgnum' => $msgnum );
 816         if ($error) {
 817           warn "error creating expiration alert event:\n$error\n\n";
 818           next;
 819         }
 820         # make it work like before:
 821         # only send each warning once before the card expires,
 822         # only warn active customers,
 823         # only warn customers with CARD/DCRD,
 824         # only warn customers who get email invoices
 825         my %conds = (
 826           'once_every'          => { 'run_delay' => '30d' },
 827           'cust_paydate_within' => { 'within' => $days.'d' },
 828           'cust_status'         => { 'status' => { 'active' => 1 } },
 829           'payby'               => { 'payby'  => { 'CARD' => 1,
 830                                                    'DCRD' => 1, }
 831                                    },
 832           'message_email'       => {},
 833         );
 834         foreach (keys %conds) {
 835           my $condition = FS::part_event_condition->new({
 836               'conditionname' => $_,
 837               'eventpart'     => $event->eventpart,
 838           });
 839           $error = $condition->insert( %{ $conds{$_} });
 840           if ( $error ) {
 841             warn "error creating expiration alert event:\n$error\n\n";
 842             next;
 843           }
 844         }
 845         $error = $event->initialize;
 846         if ( $error ) {
 847           warn "expiration alert event was created, but not initialized:\n$error\n\n";
 848         }
 849       } # foreach $days
 850       $conf->delete('alerter_msgnum', $agentnum);
 851       $conf->delete('alert_expiration', $agentnum);
 852
 853     } # if alerter_msgnum
 854
 855   }
 856
 857   ###
 858   # Move subject and body from msg_template to template_content
 859   ###
 860
 861   foreach my $msg_template ( qsearch('msg_template', {}) ) {
 862     if ( $msg_template->subject || $msg_template->body ) {
 863       # create new default content
 864       my %content;
 865       $content{subject} = $msg_template->subject;
 866       $msg_template->set('subject', '');
 867
 868       # work around obscure Pg/DBD bug
 869       # https://rt.cpan.org/Public/Bug/Display.html?id=60200
 870       # (though the right fix is to upgrade DBD)
 871       my $body = $msg_template->body;
 872       if ( $body =~ /^x([0-9a-f]+)$/ ) {
 873         # there should be no real message templates that look like that
 874         warn "converting template body to TEXT\n";
 875         $body = pack('H*', $1);
 876       }
 877       $content{body} = $body;
 878       $msg_template->set('body', '');
 879
 880       my $error = $msg_template->replace(%content);
 881       die $error if $error;
 882     }
 883   }
 884
 885   ###
 886   # Add new-style default templates if missing
 887   ###
 888   $self->_populate_initial_data;
 889
 890   ### Fix dump-email_to (needs to happen after _populate_initial_data)
 891   if ($conf->config('dump-email_to')) {
 892     # anyone who still uses dump-email_to should have just had this created
 893     my ($msg_template) = qsearch('msg_template',{ msgname => 'System log' });
 894     if ($msg_template) {
 895       eval "use FS::log_email;";
 896       die $@ if $@;
 897       my $log_email = new FS::log_email {
 898         'context' => 'Cron::backup',
 899         'min_level' => 1,
 900         'msgnum' => $msg_template->msgnum,
 901         'to_addr' => $conf->config('dump-email_to'),
 902       };
 903       my $error = $log_email->insert;
 904       die $error if $error;
 905       $conf->delete('dump-email_to');
 906     }
 907   }
 908
 909 }
 910
 911 sub _populate_initial_data { #class method
 912   #my($class, %opts) = @_;
 913   #my $class = shift;
 914
 915   eval "use FS::msg_template::InitialData;";
 916   die $@ if $@;
 917   eval "use FS::upgrade_journal;";
 918   die $@ if $@;
 919
 920   my $initial_data = FS::msg_template::InitialData->_initial_data;
 921
 922   foreach my $hash ( @$initial_data ) {
 923
 924     next if $hash->{_conf} && $conf->config( $hash->{_conf} );
 925     next if $hash->{_upgrade_journal} && FS::upgrade_journal->is_done( $hash->{_upgrade_journal} );
 926
 927     my $msg_template = new FS::msg_template($hash);
 928     my $error = $msg_template->insert( @{ $hash->{_insert_args} || [] } );
 929     die $error if $error;
 930
 931     $conf->set( $hash->{_conf}, $msg_template->msgnum ) if $hash->{_conf};
 932     FS::upgrade_journal->set_done( $hash->{_upgrade_journal} );
 933
 934   }
 935
 936 }
 937
 938 sub eviscerate {
 939   # Every bit as pleasant as it sounds.
 940   #
 941   # We do this because Text::Template::Preprocess doesn't
 942   # actually work.  It runs the entire template through
 943   # the preprocessor, instead of the code segments.  Which
 944   # is a shame, because Text::Template already contains
 945   # the code to do this operation.
 946   my $body = shift;
 947   my (@outside, @inside);
 948   my $depth = 0;
 949   my $chunk = '';
 950   while($body || $chunk) {
 951     my ($first, $delim, $rest);
 952     # put all leading non-delimiters into $first
 953     ($first, $rest) =
 954         ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
 955     $chunk .= $first;
 956     # put a leading delimiter into $delim if there is one
 957     ($delim, $rest) =
 958       ($rest =~ /^([{}]?)(.*)$/s);
 959
 960     if( $delim eq '{' ) {
 961       $chunk .= '{';
 962       if( $depth == 0 ) {
 963         push @outside, $chunk;
 964         $chunk = '';
 965       }
 966       $depth++;
 967     }
 968     elsif( $delim eq '}' ) {
 969       $depth--;
 970       if( $depth == 0 ) {
 971         push @inside, $chunk;
 972         $chunk = '';
 973       }
 974       $chunk .= '}';
 975     }
 976     else {
 977       # no more delimiters
 978       if( $depth == 0 ) {
 979         push @outside, $chunk . $rest;
 980       } # else ? something wrong
 981       last;
 982     }
 983     $body = $rest;
 984   }
 985   (\@outside, \@inside);
 986 }
 987
 988 =back
 989
 990 =head1 BUGS
 991
 992 =head1 SEE ALSO
 993
 994 L<FS::Record>, schema.html from the base documentation.
 995
 996 =cut
 997
 998 1;
 999