FS/FS/msg_template.pm

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