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