FS/FS/msg_template.pm

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