RT# 73421 Fixed E-Mail pipeline to obey contact opt-in flags

[freeside.git] / FS / FS / msg_template / email.pm

diff --git a/FS/FS/msg_template/email.pm b/FS/FS/msg_template/email.pm
index 83ff18f..753fd3d 100644 (file)
--- a/FS/FS/msg_template/email.pm
+++ b/FS/FS/msg_template/email.pm
@@ -206,6 +206,28 @@ A string to use as the HTML body; if specified, replaces the entire
 body of the message. This should be used ONLY by L<FS::report_batch> and may
 go away in the future.
 
+=item attach
+
+A L<MIME::Entity> (or arrayref of them) to attach to the message.
+
+=item to_contact_classnum
+
+Set a string containing a comma-separated list.  This list may contain:
+
+- the text "invoice" indicating emails should only be sent to contact_email
+  addresses with the invoice_dest flag set
+- the text "message" indicating emails should only be sent to contact_email
+  addresses with the message_dest flag set
+  - numbers representing classnum id values for email contact classes.
+    If any classnum are present, emails should only be sent to contact_email
+    addresses where contact_email.classnum contains one of these classes.
+    The classnum 0 also includes where contact_email.classnum IS NULL
+
+If neither 'invoice' nor 'message' has been specified, this method will
+behave as if 'invoice' had been selected
+
+=cut
+
 =back
 
 =cut
@@ -283,9 +305,28 @@ sub prepare {
 
   my @to;
   if ( exists($opt{'to'}) ) {
-    @to = split(/\s*,\s*/, $opt{'to'});
+
+    @to = map { $_->format } Email::Address->parse($opt{'to'});
+
   } elsif ( $cust_main ) {
-    @to = $cust_main->invoicing_list_emailonly;
+
+    my $classnum = $opt{'to_contact_classnum'} || '';
+    my @classes = ref($classnum) ? @$classnum : split(',', $classnum);
+
+    # There are two e-mail opt-in flags per contact_email address.
+    # If neither 'invoice' nor 'message' has been specified, default
+    # to 'invoice'.
+    #
+    # This default supports the legacy behavior of
+    #    send to all invoice recipients
+    push @classes,'invoice'
+      unless grep {$_ eq 'invoice' || $_ eq 'message'} @classes;
+
+    @to = $cust_main->contact_list_email(@classes);
+    # not guaranteed to produce contacts, but then customers aren't
+    # guaranteed to have email addresses on file. in that case, env_to
+    # will be null and sending this message will fail.
+
   } else {
     die 'no To: address or cust_main object specified';
   }
@@ -318,13 +359,16 @@ sub prepare {
   );
 
   warn "$me creating message headers\n" if $DEBUG;
+  # strip display-name from envelope addresses
+  # (use Email::Address for this? it chokes on non-ASCII characters in
+  # the display-name, which is not great for us)
   my $env_from = $from_addr;
-  $env_from =~ s/^\s*//; $env_from =~ s/\s*$//;
-  if ( $env_from =~ /^(.*)\s*<(.*@.*)>$/ ) {
-    # a common idiom
-    $env_from = $2;
-  } 
-  
+  foreach ($env_from, @to) {
+    s/^\s*//;
+    s/\s*$//;
+    s/^(.*)\s*<(.*@.*)>$/$2/;
+  }
+
   my $domain;
   if ( $env_from =~ /\@([\w\.\-]+)/ ) {
     $domain = $1;
@@ -348,13 +392,24 @@ sub prepare {
     'Type'        => 'multipart/related',
   );
 
+  if ( $opt{'attach'} ) {
+    my @attach;
+    if (ref $opt{'attach'} eq 'ARRAY') {
+      @attach = @{ $opt{'attach'} };
+    } else {
+      @attach = $opt{'attach'};
+    }
+    foreach (@attach) {
+      $message->add_part($_);
+    }
+  }
+
   #$message->head->replace('Content-type',
   #  'multipart/related; '.
   #  'boundary="' . $message->head->multipart_boundary . '"; ' .
   #  'type=multipart/alternative'
   #);
-  
-  # XXX a facility to attach additional parts is necessary at some point
+
   foreach my $part (@{ $email{mimeparts} }) {
     warn "$me appending part ".$part->mime_type."\n" if $DEBUG;
     $message->add_part( $part );
@@ -362,14 +417,17 @@ sub prepare {
 
   # effective To: address (not in headers)
   push @to, $self->bcc_addr if $self->bcc_addr;
-  my $env_to = join(', ', @to);
+  my @env_to;
+  foreach my $dest (@to) {
+    push @env_to, map { $_->address } Email::Address->parse($dest);
+  }
 
   my $cust_msg = FS::cust_msg->new({
       'custnum'   => $cust_main ? $cust_main->custnum : '',
       'msgnum'    => $self->msgnum,
       '_date'     => $time,
       'env_from'  => $env_from,
-      'env_to'    => $env_to,
+      'env_to'    => join(',', @env_to),
       'header'    => $message->header_as_string,
       'body'      => $message->body_as_string,
       'error'     => '',
@@ -476,7 +534,9 @@ sub send_prepared {
     $domain = $1;
   }
 
-  my @to = split(/\s*,\s*/, $cust_msg->env_to);
+  # in principle should already be a list of bare addresses, but run it
+  # through Email::Address to make sure
+  my @env_to = map { $_->address } Email::Address->parse($cust_msg->env_to);
 
   my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
                    'helo' => $domain );
@@ -502,7 +562,7 @@ sub send_prepared {
   eval {
     sendmail( $message, { transport => $transport,
                           from      => $cust_msg->env_from,
-                          to        => \@to })
+                          to        => \@env_to })
   };
   my $error = '';
   if(ref($@) and $@->isa('Email::Sender::Failure')) {
@@ -589,4 +649,3 @@ L<FS::Record>, schema.html from the base documentation.
 =cut
 
 1;
-