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 && $cust_main->locale || '';
 286   warn "no locale for cust#".$cust_main->custnum."; using default content\n"
 287     if $DEBUG and $cust_main && !$locale;
 288   my $content = $self->content($locale);
 289
 290   warn "preparing template '".$self->msgname."\n"
 291     if $DEBUG;
 292
 293   my $subs = $self->substitutions;
 294
 295   ###
 296   # create substitution table
 297   ###
 298   my %hash;
 299   my @objects = ();
 300   push @objects, $cust_main if $cust_main;
 301   my @prefixes = ('');
 302   my $svc;
 303   if( ref $object ) {
 304     if( ref($object) eq 'ARRAY' ) {
 305       # [new, old], for provisioning tickets
 306       push @objects, $object->[0], $object->[1];
 307       push @prefixes, 'new_', 'old_';
 308       $svc = $object->[0] if $object->[0]->isa('FS::svc_Common');
 309     }
 310     else {
 311       push @objects, $object;
 312       push @prefixes, '';
 313       $svc = $object if $object->isa('FS::svc_Common');
 314     }
 315   }
 316   if( $svc ) {
 317     push @objects, $svc->cust_svc->cust_pkg;
 318     push @prefixes, '';
 319   }
 320
 321   foreach my $obj (@objects) {
 322     my $prefix = shift @prefixes;
 323     foreach my $name (@{ $subs->{$obj->table} }) {
 324       if(!ref($name)) {
 325         # simple case
 326         $hash{$prefix.$name} = $obj->$name();
 327       }
 328       elsif( ref($name) eq 'ARRAY' ) {
 329         # [ foo => sub { ... } ]
 330         $hash{$prefix.($name->[0])} = $name->[1]->($obj);
 331       }
 332       else {
 333         warn "bad msg_template substitution: '$name'\n";
 334         #skip it?
 335       }
 336     }
 337   }
 338
 339   if ( $opt{substitutions} ) {
 340     $hash{$_} = $opt{substitutions}->{$_} foreach keys %{$opt{substitutions}};
 341   }
 342
 343   $_ = encode_entities($_ || '') foreach values(%hash);
 344
 345   ###
 346   # clean up template
 347   ###
 348   my $subject_tmpl = new Text::Template (
 349     TYPE   => 'STRING',
 350     SOURCE => $content->subject,
 351   );
 352   my $subject = $subject_tmpl->fill_in( HASH => \%hash );
 353
 354   my $body = $content->body;
 355   my ($skin, $guts) = eviscerate($body);
 356   @$guts = map {
 357     $_ = decode_entities($_); # turn all punctuation back into itself
 358     s/\r//gs;           # remove \r's
 359     s/<br[^>]*>/\n/gsi; # and <br /> tags
 360     s/<p>/\n/gsi;       # and <p>
 361     s/<\/p>//gsi;       # and </p>
 362     s/\240/ /gs;        # and &nbsp;
 363     $_
 364   } @$guts;
 365
 366   $body = '{ use Date::Format qw(time2str); "" }';
 367   while(@$skin || @$guts) {
 368     $body .= shift(@$skin) || '';
 369     $body .= shift(@$guts) || '';
 370   }
 371
 372   ###
 373   # fill-in
 374   ###
 375
 376   my $body_tmpl = new Text::Template (
 377     TYPE          => 'STRING',
 378     SOURCE        => $body,
 379   );
 380
 381   $body = $body_tmpl->fill_in( HASH => \%hash );
 382
 383   ###
 384   # and email
 385   ###
 386
 387   my @to;
 388   if ( exists($opt{'to'}) ) {
 389     @to = split(/\s*,\s*/, $opt{'to'});
 390   } elsif ( $cust_main ) {
 391     @to = $cust_main->invoicing_list_emailonly;
 392   } else {
 393     die 'no To: address or cust_main object specified';
 394   }
 395
 396   my $from_addr = $self->from_addr;
 397
 398   if ( !$from_addr ) {
 399
 400     my $agentnum = $cust_main ? $cust_main->agentnum : '';
 401
 402     if ( $opt{'from_config'} ) {
 403       $from_addr = $conf->config($opt{'from_config'}, $agentnum);
 404     }
 405     $from_addr ||= $conf->invoice_from_full($agentnum);
 406   }
 407 #  my @cust_msg = ();
 408 #  if ( $conf->exists('log_sent_mail') and !$opt{'preview'} ) {
 409 #    my $cust_msg = FS::cust_msg->new({
 410 #        'custnum' => $cust_main->custnum,
 411 #        'msgnum'  => $self->msgnum,
 412 #        'status'  => 'prepared',
 413 #      });
 414 #    $cust_msg->insert;
 415 #    @cust_msg = ('cust_msg' => $cust_msg);
 416 #  }
 417
 418   my $text_body = encode('UTF-8',
 419                   HTML::FormatText->new(leftmargin => 0, rightmargin => 70)
 420                       ->format( HTML::TreeBuilder->new_from_content($body) )
 421                   );
 422   (
 423     'custnum'   => ( $cust_main ? $cust_main->custnum : ''),
 424     'msgnum'    => $self->msgnum,
 425     'from'      => $from_addr,
 426     'to'        => \@to,
 427     'bcc'       => $self->bcc_addr || undef,
 428     'subject'   => $subject,
 429     'html_body' => $body,
 430     'text_body' => $text_body
 431   );
 432
 433 }
 434
 435 =item send OPTION => VALUE
 436
 437 Fills in the template and sends it to the customer.  Options are as for
 438 'prepare'.
 439
 440 =cut
 441
 442 # broken out from prepare() in case we want to queue the sending,
 443 # preview it, etc.
 444 sub send {
 445   my $self = shift;
 446   send_email(generate_email($self->prepare(@_)));
 447 }
 448
 449 =item render OPTION => VALUE ...
 450
 451 Fills in the template and renders it to a PDF document.  Returns the
 452 name of the PDF file.
 453
 454 Options are as for 'prepare', but 'from' and 'to' are meaningless.
 455
 456 =cut
 457
 458 # will also have options to set paper size, margins, etc.
 459
 460 sub render {
 461   my $self = shift;
 462   eval "use PDF::WebKit";
 463   die $@ if $@;
 464   my %opt = @_;
 465   my %hash = $self->prepare(%opt);
 466   my $html = $hash{'html_body'};
 467
 468   # Graphics/stylesheets should probably go in /var/www on the Freeside
 469   # machine.
 470   my $script_path = `/usr/bin/which freeside-wkhtmltopdf`;
 471   chomp $script_path;
 472   my $kit = PDF::WebKit->new(\$html); #%options
 473   # hack to use our wrapper script
 474   $kit->configure(sub { shift->wkhtmltopdf($script_path) });
 475
 476   $kit->to_pdf;
 477 }
 478
 479 =item print OPTIONS
 480
 481 Render a PDF and send it to the printer.  OPTIONS are as for 'render'.
 482
 483 =cut
 484
 485 sub print {
 486   my( $self, %opt ) = @_;
 487   do_print( [ $self->render(%opt) ], agentnum=>$opt{cust_main}->agentnum );
 488 }
 489
 490 # helper sub for package dates
 491 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
 492
 493 # helper sub for money amounts
 494 my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) };
 495
 496 # helper sub for usage-related messages
 497 my $usage_warning = sub {
 498   my $svc = shift;
 499   foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
 500     my $amount = $svc->$col; next if $amount eq '';
 501     my $method = $col.'_threshold';
 502     my $threshold = $svc->$method; next if $threshold eq '';
 503     return [$col, $amount, $threshold] if $amount <= $threshold;
 504     # this only returns the first one that's below threshold, if there are
 505     # several.
 506   }
 507   return ['', '', ''];
 508 };
 509
 510 #my $conf = new FS::Conf;
 511
 512 #return contexts and fill-in values
 513 # If you add anything, be sure to add a description in
 514 # httemplate/edit/msg_template.html.
 515 sub substitutions {
 516   { 'cust_main' => [qw(
 517       display_custnum agentnum agent_name
 518
 519       last first company
 520       name name_short contact contact_firstlast
 521       address1 address2 city county state zip
 522       country
 523       daytime night mobile fax
 524
 525       has_ship_address
 526       ship_name ship_name_short ship_contact ship_contact_firstlast
 527       ship_address1 ship_address2 ship_city ship_county ship_state ship_zip
 528       ship_country
 529
 530       paymask payname paytype payip
 531       num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
 532       classname categoryname
 533       balance
 534       credit_limit
 535       invoicing_list_emailonly
 536       cust_status ucfirst_cust_status cust_statuscolor cust_status_label
 537
 538       signupdate dundate
 539       packages recurdates
 540       ),
 541       [ invoicing_email => sub { shift->invoicing_list_emailonly_scalar } ],
 542       #compatibility: obsolete ship_ fields - use the non-ship versions
 543       map (
 544         { my $field = $_;
 545           [ "ship_$field"   => sub { shift->$field } ]
 546         }
 547         qw( last first company daytime night fax )
 548       ),
 549       # ship_name, ship_name_short, ship_contact, ship_contact_firstlast
 550       # still work, though
 551       [ expdate           => sub { shift->paydate_epoch } ], #compatibility
 552       [ signupdate_ymd    => sub { $ymd->(shift->signupdate) } ],
 553       [ dundate_ymd       => sub { $ymd->(shift->dundate) } ],
 554       [ paydate_my        => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
 555       [ otaker_first      => sub { shift->access_user->first } ],
 556       [ otaker_last       => sub { shift->access_user->last } ],
 557       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 558       [ company_name      => sub {
 559           $conf->config('company_name', shift->agentnum)
 560         } ],
 561       [ company_address   => sub {
 562           $conf->config('company_address', shift->agentnum)
 563         } ],
 564       [ company_phonenum  => sub {
 565           $conf->config('company_phonenum', shift->agentnum)
 566         } ],
 567       [ selfservice_server_base_url => sub {
 568           $conf->config('selfservice_server-base_url') #, shift->agentnum)
 569         } ],
 570     ],
 571     # next_bill_date
 572     'cust_pkg'  => [qw(
 573       pkgnum pkg_label pkg_label_long
 574       location_label
 575       status statuscolor
 576
 577       start_date setup bill last_bill
 578       adjourn susp expire
 579       labels_short
 580       ),
 581       [ pkg               => sub { shift->part_pkg->pkg } ],
 582       [ pkg_category      => sub { shift->part_pkg->categoryname } ],
 583       [ pkg_class         => sub { shift->part_pkg->classname } ],
 584       [ cancel            => sub { shift->getfield('cancel') } ], # grrr...
 585       [ start_ymd         => sub { $ymd->(shift->getfield('start_date')) } ],
 586       [ setup_ymd         => sub { $ymd->(shift->getfield('setup')) } ],
 587       [ next_bill_ymd     => sub { $ymd->(shift->getfield('bill')) } ],
 588       [ last_bill_ymd     => sub { $ymd->(shift->getfield('last_bill')) } ],
 589       [ adjourn_ymd       => sub { $ymd->(shift->getfield('adjourn')) } ],
 590       [ susp_ymd          => sub { $ymd->(shift->getfield('susp')) } ],
 591       [ expire_ymd        => sub { $ymd->(shift->getfield('expire')) } ],
 592       [ cancel_ymd        => sub { $ymd->(shift->getfield('cancel')) } ],
 593
 594       # not necessarily correct for non-flat packages
 595       [ setup_fee         => sub { shift->part_pkg->option('setup_fee') } ],
 596       [ recur_fee         => sub { shift->part_pkg->option('recur_fee') } ],
 597
 598       [ freq_pretty       => sub { shift->part_pkg->freq_pretty } ],
 599
 600     ],
 601     'cust_bill' => [qw(
 602       invnum
 603       _date
 604       _date_pretty
 605       due_date
 606     ),
 607       [ due_date2str      => sub { shift->due_date2str('short') } ],
 608     ],
 609     #XXX not really thinking about cust_bill substitutions quite yet
 610
 611     # for welcome and limit warning messages
 612     'svc_acct' => [qw(
 613       svcnum
 614       username
 615       domain
 616       ),
 617       [ password          => sub { shift->getfield('_password') } ],
 618       [ column            => sub { &$usage_warning(shift)->[0] } ],
 619       [ amount            => sub { &$usage_warning(shift)->[1] } ],
 620       [ threshold         => sub { &$usage_warning(shift)->[2] } ],
 621     ],
 622     'svc_domain' => [qw(
 623       svcnum
 624       domain
 625       ),
 626       [ registrar         => sub {
 627           my $registrar = qsearchs('registrar',
 628             { registrarnum => shift->registrarnum} );
 629           $registrar ? $registrar->registrarname : ''
 630         }
 631       ],
 632       [ catchall          => sub {
 633           my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
 634           $svc_acct ? $svc_acct->email : ''
 635         }
 636       ],
 637     ],
 638     'svc_phone' => [qw(
 639       svcnum
 640       phonenum
 641       countrycode
 642       domain
 643       )
 644     ],
 645     'svc_broadband' => [qw(
 646       svcnum
 647       speed_up
 648       speed_down
 649       ip_addr
 650       mac_addr
 651       )
 652     ],
 653     # for payment receipts
 654     'cust_pay' => [qw(
 655       paynum
 656       _date
 657       ),
 658       [ paid              => sub { sprintf("%.2f", shift->paid) } ],
 659       # overrides the one in cust_main in cases where a cust_pay is passed
 660       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 661       [ date              => sub { time2str("%a %B %o, %Y", shift->_date) } ],
 662       [ payinfo           => sub {
 663           my $cust_pay = shift;
 664           ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ?
 665             $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo)
 666         } ],
 667     ],
 668     # for payment decline messages
 669     # try to support all cust_pay fields
 670     # 'error' is a special case, it contains the raw error from the gateway
 671     'cust_pay_pending' => [qw(
 672       _date
 673       error
 674       ),
 675       [ paid              => sub { sprintf("%.2f", shift->paid) } ],
 676       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
 677       [ date              => sub { time2str("%a %B %o, %Y", shift->_date) } ],
 678       [ payinfo           => sub {
 679           my $pending = shift;
 680           ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ?
 681             $pending->paymask : $pending->decrypt($pending->payinfo)
 682         } ],
 683     ],
 684   };
 685 }
 686
 687 =item content LOCALE
 688
 689 Returns the L<FS::template_content> object appropriate to LOCALE, if there
 690 is one.  If not, returns the one with a NULL locale.
 691
 692 =cut
 693
 694 sub content {
 695   my $self = shift;
 696   my $locale = shift;
 697   qsearchs('template_content',
 698             { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
 699   qsearchs('template_content',
 700             { 'msgnum' => $self->msgnum, 'locale' => '' });
 701 }
 702
 703 =item agent
 704
 705 Returns the L<FS::agent> object for this template.
 706
 707 =cut
 708
 709 sub _upgrade_data {
 710   my ($self, %opts) = @_;
 711
 712   ###
 713   # First move any historical templates in config to real message templates
 714   ###
 715
 716   my @fixes = (
 717     [ 'alerter_msgnum',  'alerter_template',   '',               '', '' ],
 718     [ 'cancel_msgnum',   'cancelmessage',      'cancelsubject',  '', '' ],
 719     [ 'decline_msgnum',  'declinetemplate',    '',               '', '' ],
 720     [ 'impending_recur_msgnum', 'impending_recur_template', '',  '', 'impending_recur_bcc' ],
 721     [ 'payment_receipt_msgnum', 'payment_receipt_email', '',     '', '' ],
 722     [ 'welcome_msgnum',  'welcome_email',      'welcome_email-subject', 'welcome_email-from', '' ],
 723     [ 'warning_msgnum',  'warning_email',      'warning_email-subject', 'warning_email-from', '' ],
 724   );
 725
 726   my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
 727   foreach my $agentnum (@agentnums) {
 728     foreach (@fixes) {
 729       my ($newname, $oldname, $subject, $from, $bcc) = @$_;
 730       if ($conf->exists($oldname, $agentnum)) {
 731         my $new = new FS::msg_template({
 732           'msgname'   => $oldname,
 733           'agentnum'  => $agentnum,
 734           'from_addr' => ($from && $conf->config($from, $agentnum)) || '',
 735           'bcc_addr'  => ($bcc && $conf->config($from, $agentnum)) || '',
 736           'subject'   => ($subject && $conf->config($subject, $agentnum)) || '',
 737           'mime_type' => 'text/html',
 738           'body'      => join('<BR>',$conf->config($oldname, $agentnum)),
 739         });
 740         my $error = $new->insert;
 741         die $error if $error;
 742         $conf->set($newname, $new->msgnum, $agentnum);
 743         $conf->delete($oldname, $agentnum);
 744         $conf->delete($from, $agentnum) if $from;
 745         $conf->delete($subject, $agentnum) if $subject;
 746       }
 747     }
 748
 749     if ( $conf->exists('alert_expiration', $agentnum) ) {
 750       my $msgnum = $conf->exists('alerter_msgnum', $agentnum);
 751       my $template = FS::msg_template->by_key($msgnum) if $msgnum;
 752       if (!$template) {
 753         warn "template for alerter_msgnum $msgnum not found\n";
 754         next;
 755       }
 756       # this is now a set of billing events
 757       foreach my $days (30, 15, 5) {
 758         my $event = FS::part_event->new({
 759             'agentnum'    => $agentnum,
 760             'event'       => "Card expiration warning - $days days",
 761             'eventtable'  => 'cust_main',
 762             'check_freq'  => '1d',
 763             'action'      => 'notice',
 764             'disabled'    => 'Y', #initialize first
 765         });
 766         my $error = $event->insert( 'msgnum' => $msgnum );
 767         if ($error) {
 768           warn "error creating expiration alert event:\n$error\n\n";
 769           next;
 770         }
 771         # make it work like before:
 772         # only send each warning once before the card expires,
 773         # only warn active customers,
 774         # only warn customers with CARD/DCRD,
 775         # only warn customers who get email invoices
 776         my %conds = (
 777           'once_every'          => { 'run_delay' => '30d' },
 778           'cust_paydate_within' => { 'within' => $days.'d' },
 779           'cust_status'         => { 'status' => { 'active' => 1 } },
 780           'payby'               => { 'payby'  => { 'CARD' => 1,
 781                                                    'DCRD' => 1, }
 782                                    },
 783           'message_email'       => {},
 784         );
 785         foreach (keys %conds) {
 786           my $condition = FS::part_event_condition->new({
 787               'conditionname' => $_,
 788               'eventpart'     => $event->eventpart,
 789           });
 790           $error = $condition->insert( %{ $conds{$_} });
 791           if ( $error ) {
 792             warn "error creating expiration alert event:\n$error\n\n";
 793             next;
 794           }
 795         }
 796         $error = $event->initialize;
 797         if ( $error ) {
 798           warn "expiration alert event was created, but not initialized:\n$error\n\n";
 799         }
 800       } # foreach $days
 801       $conf->delete('alerter_msgnum', $agentnum);
 802       $conf->delete('alert_expiration', $agentnum);
 803
 804     } # if alerter_msgnum
 805
 806   }
 807
 808   ###
 809   # Move subject and body from msg_template to template_content
 810   ###
 811
 812   foreach my $msg_template ( qsearch('msg_template', {}) ) {
 813     if ( $msg_template->subject || $msg_template->body ) {
 814       # create new default content
 815       my %content;
 816       $content{subject} = $msg_template->subject;
 817       $msg_template->set('subject', '');
 818
 819       # work around obscure Pg/DBD bug
 820       # https://rt.cpan.org/Public/Bug/Display.html?id=60200
 821       # (though the right fix is to upgrade DBD)
 822       my $body = $msg_template->body;
 823       if ( $body =~ /^x([0-9a-f]+)$/ ) {
 824         # there should be no real message templates that look like that
 825         warn "converting template body to TEXT\n";
 826         $body = pack('H*', $1);
 827       }
 828       $content{body} = $body;
 829       $msg_template->set('body', '');
 830
 831       my $error = $msg_template->replace(%content);
 832       die $error if $error;
 833     }
 834   }
 835
 836   ###
 837   # Add new-style default templates if missing
 838   ###
 839   $self->_populate_initial_data;
 840
 841 }
 842
 843 sub _populate_initial_data { #class method
 844   #my($class, %opts) = @_;
 845   #my $class = shift;
 846
 847   eval "use FS::msg_template::InitialData;";
 848   die $@ if $@;
 849
 850   my $initial_data = FS::msg_template::InitialData->_initial_data;
 851
 852   foreach my $hash ( @$initial_data ) {
 853
 854     next if $hash->{_conf} && $conf->config( $hash->{_conf} );
 855
 856     my $msg_template = new FS::msg_template($hash);
 857     my $error = $msg_template->insert( @{ $hash->{_insert_args} || [] } );
 858     die $error if $error;
 859
 860     $conf->set( $hash->{_conf}, $msg_template->msgnum ) if $hash->{_conf};
 861
 862   }
 863
 864 }
 865
 866 sub eviscerate {
 867   # Every bit as pleasant as it sounds.
 868   #
 869   # We do this because Text::Template::Preprocess doesn't
 870   # actually work.  It runs the entire template through
 871   # the preprocessor, instead of the code segments.  Which
 872   # is a shame, because Text::Template already contains
 873   # the code to do this operation.
 874   my $body = shift;
 875   my (@outside, @inside);
 876   my $depth = 0;
 877   my $chunk = '';
 878   while($body || $chunk) {
 879     my ($first, $delim, $rest);
 880     # put all leading non-delimiters into $first
 881     ($first, $rest) =
 882         ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
 883     $chunk .= $first;
 884     # put a leading delimiter into $delim if there is one
 885     ($delim, $rest) =
 886       ($rest =~ /^([{}]?)(.*)$/s);
 887
 888     if( $delim eq '{' ) {
 889       $chunk .= '{';
 890       if( $depth == 0 ) {
 891         push @outside, $chunk;
 892         $chunk = '';
 893       }
 894       $depth++;
 895     }
 896     elsif( $delim eq '}' ) {
 897       $depth--;
 898       if( $depth == 0 ) {
 899         push @inside, $chunk;
 900         $chunk = '';
 901       }
 902       $chunk .= '}';
 903     }
 904     else {
 905       # no more delimiters
 906       if( $depth == 0 ) {
 907         push @outside, $chunk . $rest;
 908       } # else ? something wrong
 909       last;
 910     }
 911     $body = $rest;
 912   }
 913   (\@outside, \@inside);
 914 }
 915
 916 =back
 917
 918 =head1 BUGS
 919
 920 =head1 SEE ALSO
 921
 922 L<FS::Record>, schema.html from the base documentation.
 923
 924 =cut
 925
 926 1;
 927