FS/FS/msg_template.pm

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