X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fmsg_template%2Femail.pm;h=aebac74b7f160558af2d7e5fe27335b704d8d374;hp=377dbb17b45715090514401c3cac9a61bb7eb615;hb=3adb46fccf9f631e188ea5383bd147b340477639;hpb=c0c5709fb022b83a482d0b35f7094505766d5868 diff --git a/FS/FS/msg_template/email.pm b/FS/FS/msg_template/email.pm index 377dbb17b..aebac74b7 100644 --- a/FS/FS/msg_template/email.pm +++ b/FS/FS/msg_template/email.pm @@ -16,7 +16,7 @@ use HTML::TreeBuilder; use Encode; # needed to send email -use FS::Misc qw( generate_email ); +use FS::Misc qw( generate_email email_sender_transport_or_error ); use FS::Conf; use Email::Sender::Simple qw( sendmail ); @@ -164,7 +164,7 @@ Options are passed as a list of name/value pairs: =item cust_main -Customer object (required). +Customer object =item object @@ -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 and may go away in the future. +=item attach + +A L (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 contacts with invoice_dest flag should + be included +- the text "message" indicating contacts with message_dest flag should + be included +- 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 @@ -215,7 +237,7 @@ sub prepare { my( $self, %opt ) = @_; my $cust_main = $opt{'cust_main'}; # or die 'cust_main required'; - my $object = $opt{'object'} or die 'object required'; + my $object = $opt{'object'}; # or die 'object required'; my $hashref = $self->prepare_substitutions(%opt); @@ -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->custnum, + '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' => '', @@ -471,46 +529,42 @@ sub send_prepared { my $self = shift; my $cust_msg = shift or die "cust_msg required"; + if ( $FS::Misc::DISABLE_ALL_NOTICES ) { + warn 'send_prepared() disabled by $FS::Misc::DISABLE_ALL_NOTICES' if $DEBUG; + return; + } + my $domain = 'example.com'; if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) { $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 ); + my $transport = email_sender_transport_or_error($domain); - my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') ); - $smtp_opt{'port'} = $port; - - my $transport; - if ( defined($enc) && $enc eq 'starttls' ) { - $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password); - $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt ); - } else { - if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) { - $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password); - } - $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls'; - $transport = Email::Sender::Transport::SMTP->new( %smtp_opt ); - } - - warn "$me sending message\n" if $DEBUG; - my $message = join("\n", $cust_msg->header, $cust_msg->body); - local $@; - eval { - sendmail( $message, { transport => $transport, - from => $cust_msg->env_from, - to => \@to }) - }; my $error = ''; - if(ref($@) and $@->isa('Email::Sender::Failure')) { - $error = $@->code.' ' if $@->code; - $error .= $@->message; - } - else { - $error = $@; + if ( ref($transport) ) { + + warn "$me sending message\n" if $DEBUG; + my $message = join("\n", $cust_msg->header, $cust_msg->body); + + local $SIG{__DIE__}; # don't want Mason __DIE__ handler active + local $@; + eval { sendmail( $message, { transport => $transport, + from => $cust_msg->env_from, + to => \@env_to }) + }; + if (ref($@) and $@->isa('Email::Sender::Failure')) { + $error = $@->code.' ' if $@->code; + $error .= $@->message; + } else { + $error = $@; + } + } else { + $error = $transport; } $cust_msg->set('error', $error); @@ -589,4 +643,3 @@ L, schema.html from the base documentation. =cut 1; -