FS/FS/msg_template/email.pm

   1 package FS::msg_template::email;
   2 use base qw( FS::msg_template );
   3
   4 use strict;
   5 use vars qw( $DEBUG $conf );
   6
   7 # stuff needed for template generation
   8 use Date::Format qw( time2str );
   9 use File::Temp;
  10 use IPC::Run qw(run);
  11 use Text::Template;
  12
  13 use HTML::Entities qw( decode_entities encode_entities ) ;
  14 use HTML::FormatText;
  15 use HTML::TreeBuilder;
  16 use Encode;
  17
  18 # needed to send email
  19 use FS::Misc qw( generate_email );
  20 use FS::Conf;
  21 use Email::Sender::Simple qw( sendmail );
  22
  23 use FS::Record qw( qsearch qsearchs );
  24
  25 # needed to manage template_content objects
  26 use FS::template_content;
  27 use FS::UID qw( dbh );
  28
  29 # needed to manage prepared messages
  30 use FS::cust_msg;
  31
  32 FS::UID->install_callback( sub { $conf = new FS::Conf; } );
  33
  34 our $DEBUG = 0;
  35 our $me = '[FS::msg_template::email]';
  36
  37 =head1 NAME
  38
  39 FS::msg_template::email - Construct email notices with Text::Template.
  40
  41 =head1 DESCRIPTION
  42
  43 FS::msg_template::email is a message processor in which the template contains
  44 L<Text::Template> strings for the message subject line and body, and the
  45 message is delivered by email.
  46
  47 Currently the C<from_addr> and C<bcc_addr> fields used by this processor are
  48 in the main msg_template table.
  49
  50 =head1 METHODS
  51
  52 =over 4
  53
  54 =item insert [ CONTENT ]
  55
  56 Adds this record to the database.  If there is an error, returns the error,
  57 otherwise returns false.
  58
  59 A default (no locale) L<FS::template_content> object will be created.  CONTENT
  60 is an optional hash containing 'subject' and 'body' for this object.
  61
  62 =cut
  63
  64 sub insert {
  65   my $self = shift;
  66   my %content = @_;
  67
  68   my $oldAutoCommit = $FS::UID::AutoCommit;
  69   local $FS::UID::AutoCommit = 0;
  70   my $dbh = dbh;
  71
  72   my $error = $self->SUPER::insert;
  73   if ( !$error ) {
  74     $content{'msgnum'} = $self->msgnum;
  75     $content{'subject'} ||= '';
  76     $content{'body'} ||= '';
  77     my $template_content = new FS::template_content (\%content);
  78     $error = $template_content->insert;
  79   }
  80
  81   if ( $error ) {
  82     $dbh->rollback if $oldAutoCommit;
  83     return $error;
  84   }
  85
  86   $dbh->commit if $oldAutoCommit;
  87   return;
  88 }
  89
  90 =item replace [ OLD_RECORD ] [ CONTENT ]
  91
  92 Replaces the OLD_RECORD with this one in the database.  If there is an error,
  93 returns the error, otherwise returns false.
  94
  95 CONTENT is an optional hash containing 'subject', 'body', and 'locale'.  If
  96 supplied, an L<FS::template_content> object will be created (or modified, if
  97 one already exists for this locale).
  98
  99 =cut
 100
 101 sub replace {
 102   my $self = shift;
 103   my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') )
 104               ? shift
 105               : $self->replace_old;
 106   my %content = @_;
 107
 108   my $oldAutoCommit = $FS::UID::AutoCommit;
 109   local $FS::UID::AutoCommit = 0;
 110   my $dbh = dbh;
 111
 112   my $error = $self->SUPER::replace($old);
 113
 114   if ( !$error and %content ) {
 115     $content{'locale'} ||= '';
 116     my $new_content = qsearchs('template_content', {
 117                         'msgnum' => $self->msgnum,
 118                         'locale' => $content{'locale'},
 119                       } );
 120     if ( $new_content ) {
 121       $new_content->subject($content{'subject'});
 122       $new_content->body($content{'body'});
 123       $error = $new_content->replace;
 124     }
 125     else {
 126       $content{'msgnum'} = $self->msgnum;
 127       $new_content = new FS::template_content \%content;
 128       $error = $new_content->insert;
 129     }
 130   }
 131
 132   if ( $error ) {
 133     $dbh->rollback if $oldAutoCommit;
 134     return $error;
 135   }
 136
 137   warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit;
 138   $dbh->commit if $oldAutoCommit;
 139   return;
 140 }
 141
 142 =item content_locales
 143
 144 Returns a hashref of the L<FS::template_content> objects attached to
 145 this template, with the locale as key.
 146
 147 =cut
 148
 149 sub content_locales {
 150   my $self = shift;
 151   return $self->{'_content_locales'} ||= +{
 152     map { $_->locale , $_ }
 153     qsearch('template_content', { 'msgnum' => $self->msgnum })
 154   };
 155 }
 156
 157 =item prepare OPTION => VALUE
 158
 159 Fills in the template and returns an L<FS::cust_msg> object.
 160
 161 Options are passed as a list of name/value pairs:
 162
 163 =over 4
 164
 165 =item cust_main
 166
 167 Customer object
 168
 169 =item object
 170
 171 Additional context object (currently, can be a cust_main, cust_pkg,
 172 cust_bill, cust_pay, cust_pay_pending, or svc_(acct, phone, broadband,
 173 domain) ).  If the object is a svc_*, its cust_pkg will be fetched and
 174 used for substitution.
 175
 176 As a special case, this may be an arrayref of two objects.  Both
 177 objects will be available for substitution, with their field names
 178 prefixed with 'new_' and 'old_' respectively.  This is used in the
 179 rt_ticket export when exporting "replace" events.
 180
 181 =item from_config
 182
 183 Configuration option to use as the source address, based on the customer's
 184 agentnum.  If unspecified (or the named option is empty), 'invoice_from'
 185 will be used.
 186
 187 The I<from_addr> field in the template takes precedence over this.
 188
 189 =item to
 190
 191 Destination address.  The default is to use the customer's
 192 invoicing_list addresses.  Multiple addresses may be comma-separated.
 193
 194 =item substitutions
 195
 196 A hash reference of additional substitutions
 197
 198 =item msgtype
 199
 200 A string identifying the kind of message this is. Currently can be "invoice",
 201 "receipt", "admin", or null. Expand this list as necessary.
 202
 203 =item override_content
 204
 205 A string to use as the HTML body; if specified, replaces the entire
 206 body of the message. This should be used ONLY by L<FS::report_batch> and may
 207 go away in the future.
 208
 209 =item attach
 210
 211 A L<MIME::Entity> (or arrayref of them) to attach to the message.
 212
 213 =item to_contact_classnum
 214
 215 Set a string containing a comma-separated list.  This list may contain:
 216
 217 - the text "invoice" indicating contacts with invoice_dest flag should
 218   be included
 219 - the text "message" indicating contacts with message_dest flag should
 220   be included
 221 - numbers representing classnum id values for email contact classes.
 222   If any classnum are present, emails should only be sent to contact_email
 223   addresses where contact_email.classnum contains one of these classes.
 224   The classnum 0 also includes where contact_email.classnum IS NULL
 225
 226 If neither 'invoice' nor 'message' has been specified, this method will
 227 behave as if 'invoice' had been selected
 228
 229 =cut
 230
 231 =back
 232
 233 =cut
 234
 235 sub prepare {
 236
 237   my( $self, %opt ) = @_;
 238
 239   my $cust_main = $opt{'cust_main'}; # or die 'cust_main required';
 240   my $object = $opt{'object'}; # or die 'object required';
 241
 242   my $hashref = $self->prepare_substitutions(%opt);
 243
 244   # localization
 245   my $locale = $cust_main && $cust_main->locale || '';
 246   warn "no locale for cust#".$cust_main->custnum."; using default content\n"
 247     if $DEBUG and $cust_main && !$locale;
 248   my $content = $self->content($locale);
 249
 250   warn "preparing template '".$self->msgname."\n"
 251     if $DEBUG;
 252
 253   $_ = encode_entities($_ || '') foreach values(%$hashref);
 254
 255   ###
 256   # clean up template
 257   ###
 258   my $subject_tmpl = new Text::Template (
 259     TYPE   => 'STRING',
 260     SOURCE => $content->subject,
 261   );
 262
 263   warn "$me filling in subject template\n" if $DEBUG;
 264   my $subject = $subject_tmpl->fill_in( HASH => $hashref );
 265
 266   my $body = $content->body;
 267   my ($skin, $guts) = eviscerate($body);
 268   @$guts = map {
 269     $_ = decode_entities($_); # turn all punctuation back into itself
 270     s/\r//gs;           # remove \r's
 271     s/<br[^>]*>/\n/gsi; # and <br /> tags
 272     s/<p>/\n/gsi;       # and <p>
 273     s/<\/p>//gsi;       # and </p>
 274     s/\240/ /gs;        # and &nbsp;
 275     $_
 276   } @$guts;
 277
 278   $body = '{ use Date::Format qw(time2str); "" }';
 279   while(@$skin || @$guts) {
 280     $body .= shift(@$skin) || '';
 281     $body .= shift(@$guts) || '';
 282   }
 283
 284   ###
 285   # fill-in
 286   ###
 287
 288   my $body_tmpl = new Text::Template (
 289     TYPE          => 'STRING',
 290     SOURCE        => $body,
 291   );
 292
 293   warn "$me filling in body template\n" if $DEBUG;
 294   $body = $body_tmpl->fill_in( HASH => $hashref );
 295
 296   # override $body if requested
 297   if ( $opt{'override_content'} ) {
 298     warn "$me overriding template body with requested content" if $DEBUG;
 299     $body = $opt{'override_content'};
 300   }
 301
 302   ###
 303   # and email
 304   ###
 305
 306   my @to;
 307   if ( exists($opt{'to'}) ) {
 308
 309     @to = map { $_->format } Email::Address->parse($opt{'to'});
 310
 311   } elsif ( $cust_main ) {
 312
 313     my $classnum = $opt{'to_contact_classnum'} || '';
 314     my @classes = ref($classnum) ? @$classnum : split(',', $classnum);
 315
 316     # There are two e-mail opt-in flags per contact_email address.
 317     # If neither 'invoice' nor 'message' has been specified, default
 318     # to 'invoice'.
 319     #
 320     # This default supports the legacy behavior of
 321     #    send to all invoice recipients
 322     push @classes,'invoice'
 323       unless grep {$_ eq 'invoice' || $_ eq 'message'} @classes;
 324
 325     @to = $cust_main->contact_list_email(@classes);
 326     # not guaranteed to produce contacts, but then customers aren't
 327     # guaranteed to have email addresses on file. in that case, env_to
 328     # will be null and sending this message will fail.
 329
 330   } else {
 331     die 'no To: address or cust_main object specified';
 332   }
 333
 334   my $from_addr = $self->from_addr;
 335
 336   if ( !$from_addr ) {
 337
 338     my $agentnum = $cust_main ? $cust_main->agentnum : '';
 339
 340     if ( $opt{'from_config'} ) {
 341       $from_addr = $conf->config($opt{'from_config'}, $agentnum);
 342     }
 343     $from_addr ||= $conf->invoice_from_full($agentnum);
 344   }
 345
 346   my $text_body = encode('UTF-8',
 347                   HTML::FormatText->new(leftmargin => 0, rightmargin => 70)
 348                       ->format( HTML::TreeBuilder->new_from_content($body) )
 349                   );
 350
 351   warn "$me constructing MIME entities\n" if $DEBUG;
 352   my %email = generate_email(
 353     'from'      => $from_addr,
 354     'to'        => \@to,
 355     'bcc'       => $self->bcc_addr || undef,
 356     'subject'   => $subject,
 357     'html_body' => $body,
 358     'text_body' => $text_body,
 359   );
 360
 361   warn "$me creating message headers\n" if $DEBUG;
 362   # strip display-name from envelope addresses
 363   # (use Email::Address for this? it chokes on non-ASCII characters in
 364   # the display-name, which is not great for us)
 365   my $env_from = $from_addr;
 366   foreach ($env_from, @to) {
 367     s/^\s*//;
 368     s/\s*$//;
 369     s/^(.*)\s*<(.*@.*)>$/$2/;
 370   }
 371
 372   my $domain;
 373   if ( $env_from =~ /\@([\w\.\-]+)/ ) {
 374     $domain = $1;
 375   } else {
 376     warn 'no domain found in invoice from address '. $env_from .
 377          '; constructing Message-ID (and saying HELO) @example.com';
 378     $domain = 'example.com';
 379   }
 380   my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
 381
 382   my $time = time;
 383   my $message = MIME::Entity->build(
 384     'From'        => $from_addr,
 385     'To'          => join(', ', @to),
 386     'Sender'      => $from_addr,
 387     'Reply-To'    => $from_addr,
 388     'Date'        => time2str("%a, %d %b %Y %X %z", $time),
 389     'Subject'     => Encode::encode('MIME-Header', $subject),
 390     'Message-ID'  => "<$message_id>",
 391     'Encoding'    => '7bit',
 392     'Type'        => 'multipart/related',
 393   );
 394
 395   if ( $opt{'attach'} ) {
 396     my @attach;
 397     if (ref $opt{'attach'} eq 'ARRAY') {
 398       @attach = @{ $opt{'attach'} };
 399     } else {
 400       @attach = $opt{'attach'};
 401     }
 402     foreach (@attach) {
 403       $message->add_part($_);
 404     }
 405   }
 406
 407   #$message->head->replace('Content-type',
 408   #  'multipart/related; '.
 409   #  'boundary="' . $message->head->multipart_boundary . '"; ' .
 410   #  'type=multipart/alternative'
 411   #);
 412
 413   foreach my $part (@{ $email{mimeparts} }) {
 414     warn "$me appending part ".$part->mime_type."\n" if $DEBUG;
 415     $message->add_part( $part );
 416   }
 417
 418   # effective To: address (not in headers)
 419   push @to, $self->bcc_addr if $self->bcc_addr;
 420   my @env_to;
 421   foreach my $dest (@to) {
 422     push @env_to, map { $_->address } Email::Address->parse($dest);
 423   }
 424
 425   my $cust_msg = FS::cust_msg->new({
 426       'custnum'   => $cust_main ? $cust_main->custnum : '',
 427       'msgnum'    => $self->msgnum,
 428       '_date'     => $time,
 429       'env_from'  => $env_from,
 430       'env_to'    => join(',', @env_to),
 431       'header'    => $message->header_as_string,
 432       'body'      => $message->body_as_string,
 433       'error'     => '',
 434       'status'    => 'prepared',
 435       'msgtype'   => ($opt{'msgtype'} || ''),
 436       'preview'   => $body, # html content only
 437   });
 438
 439   return $cust_msg;
 440 }
 441
 442 =item render OPTION => VALUE ...
 443
 444 Fills in the template and renders it to a PDF document.  Returns the
 445 name of the PDF file.
 446
 447 Options are as for 'prepare', but 'from' and 'to' are meaningless.
 448
 449 =cut
 450
 451 # will also have options to set paper size, margins, etc.
 452
 453 sub render {
 454   my $self = shift;
 455   eval "use PDF::WebKit";
 456   die $@ if $@;
 457   my %opt = @_;
 458   my %hash = $self->prepare(%opt);
 459   my $html = $hash{'html_body'};
 460
 461   # Graphics/stylesheets should probably go in /var/www on the Freeside
 462   # machine.
 463   my $script_path = `/usr/bin/which freeside-wkhtmltopdf`;
 464   chomp $script_path;
 465   my $kit = PDF::WebKit->new(\$html); #%options
 466   # hack to use our wrapper script
 467   $kit->configure(sub { shift->wkhtmltopdf($script_path) });
 468
 469   $kit->to_pdf;
 470 }
 471
 472 =item print OPTIONS
 473
 474 Render a PDF and send it to the printer.  OPTIONS are as for 'render'.
 475
 476 =cut
 477
 478 sub print {
 479   my( $self, %opt ) = @_;
 480   do_print( [ $self->render(%opt) ], agentnum=>$opt{cust_main}->agentnum );
 481 }
 482
 483 # helper sub for package dates
 484 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
 485
 486 # helper sub for money amounts
 487 my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) };
 488
 489 # helper sub for usage-related messages
 490 my $usage_warning = sub {
 491   my $svc = shift;
 492   foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
 493     my $amount = $svc->$col; next if $amount eq '';
 494     my $method = $col.'_threshold';
 495     my $threshold = $svc->$method; next if $threshold eq '';
 496     return [$col, $amount, $threshold] if $amount <= $threshold;
 497     # this only returns the first one that's below threshold, if there are
 498     # several.
 499   }
 500   return ['', '', ''];
 501 };
 502
 503 =item content LOCALE
 504
 505 Returns the L<FS::template_content> object appropriate to LOCALE, if there
 506 is one.  If not, returns the one with a NULL locale.
 507
 508 =cut
 509
 510 sub content {
 511   my $self = shift;
 512   my $locale = shift;
 513   qsearchs('template_content',
 514             { 'msgnum' => $self->msgnum, 'locale' => $locale }) ||
 515   qsearchs('template_content',
 516             { 'msgnum' => $self->msgnum, 'locale' => '' });
 517 }
 518
 519 =cut
 520
 521 =item send_prepared CUST_MSG
 522
 523 Takes the CUST_MSG object and sends it to its recipient. The "smtpmachine"
 524 configuration option will be used to find the outgoing mail server.
 525
 526 =cut
 527
 528 sub send_prepared {
 529   my $self = shift;
 530   my $cust_msg = shift or die "cust_msg required";
 531
 532   my $domain = 'example.com';
 533   if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) {
 534     $domain = $1;
 535   }
 536
 537   # in principle should already be a list of bare addresses, but run it
 538   # through Email::Address to make sure
 539   my @env_to = map { $_->address } Email::Address->parse($cust_msg->env_to);
 540
 541   my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
 542                    'helo' => $domain );
 543
 544   my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
 545   $smtp_opt{'port'} = $port;
 546
 547   my $transport;
 548   if ( defined($enc) && $enc eq 'starttls' ) {
 549     $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password);
 550     $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt );
 551   } else {
 552     if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) {
 553       $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password);
 554     }
 555     $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls';
 556     $transport = Email::Sender::Transport::SMTP->new( %smtp_opt );
 557   }
 558
 559   warn "$me sending message\n" if $DEBUG;
 560   my $message = join("\n", $cust_msg->header, $cust_msg->body);
 561   local $@;
 562   eval {
 563     sendmail( $message, { transport => $transport,
 564                           from      => $cust_msg->env_from,
 565                           to        => \@env_to })
 566   };
 567   my $error = '';
 568   if(ref($@) and $@->isa('Email::Sender::Failure')) {
 569     $error = $@->code.' ' if $@->code;
 570     $error .= $@->message;
 571   }
 572   else {
 573     $error = $@;
 574   }
 575
 576   $cust_msg->set('error', $error);
 577   $cust_msg->set('status', $error ? 'failed' : 'sent');
 578   if ( $cust_msg->custmsgnum ) {
 579     $cust_msg->replace;
 580   } else {
 581     $cust_msg->insert;
 582   }
 583
 584   $error;
 585 }
 586
 587 =back
 588
 589 =cut
 590
 591 # internal use only
 592
 593 sub eviscerate {
 594   # Every bit as pleasant as it sounds.
 595   #
 596   # We do this because Text::Template::Preprocess doesn't
 597   # actually work.  It runs the entire template through
 598   # the preprocessor, instead of the code segments.  Which
 599   # is a shame, because Text::Template already contains
 600   # the code to do this operation.
 601   my $body = shift;
 602   my (@outside, @inside);
 603   my $depth = 0;
 604   my $chunk = '';
 605   while($body || $chunk) {
 606     my ($first, $delim, $rest);
 607     # put all leading non-delimiters into $first
 608     ($first, $rest) =
 609         ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
 610     $chunk .= $first;
 611     # put a leading delimiter into $delim if there is one
 612     ($delim, $rest) =
 613       ($rest =~ /^([{}]?)(.*)$/s);
 614
 615     if( $delim eq '{' ) {
 616       $chunk .= '{';
 617       if( $depth == 0 ) {
 618         push @outside, $chunk;
 619         $chunk = '';
 620       }
 621       $depth++;
 622     }
 623     elsif( $delim eq '}' ) {
 624       $depth--;
 625       if( $depth == 0 ) {
 626         push @inside, $chunk;
 627         $chunk = '';
 628       }
 629       $chunk .= '}';
 630     }
 631     else {
 632       # no more delimiters
 633       if( $depth == 0 ) {
 634         push @outside, $chunk . $rest;
 635       } # else ? something wrong
 636       last;
 637     }
 638     $body = $rest;
 639   }
 640   (\@outside, \@inside);
 641 }
 642
 643 =head1 BUGS
 644
 645 =head1 SEE ALSO
 646
 647 L<FS::Record>, schema.html from the base documentation.
 648
 649 =cut
 650
 651 1;