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