X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fmsg_template%2Femail.pm;h=aebac74b7f160558af2d7e5fe27335b704d8d374;hp=1133faafe085e213b25c3b88e9fce85ffacba002;hb=3adb46fccf9f631e188ea5383bd147b340477639;hpb=33f1c704766af0621159d5a8453379b6706d8c8a diff --git a/FS/FS/msg_template/email.pm b/FS/FS/msg_template/email.pm index 1133faafe..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 ); @@ -26,11 +26,12 @@ use FS::Record qw( qsearch qsearchs ); use FS::template_content; use FS::UID qw( dbh ); +# needed to manage prepared messages use FS::cust_msg; FS::UID->install_callback( sub { $conf = new FS::Conf; } ); -our $DEBUG = 1; +our $DEBUG = 0; our $me = '[FS::msg_template::email]'; =head1 NAME @@ -163,7 +164,7 @@ Options are passed as a list of name/value pairs: =item cust_main -Customer object (required). +Customer object =item object @@ -199,6 +200,34 @@ A hash reference of additional substitutions A string identifying the kind of message this is. Currently can be "invoice", "receipt", "admin", or null. Expand this list as necessary. +=item override_content + +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 @@ -208,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); @@ -264,15 +293,40 @@ sub prepare { warn "$me filling in body template\n" if $DEBUG; $body = $body_tmpl->fill_in( HASH => $hashref ); + # override $body if requested + if ( $opt{'override_content'} ) { + warn "$me overriding template body with requested content" if $DEBUG; + $body = $opt{'override_content'}; + } + ### # and email ### 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'; } @@ -305,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; @@ -335,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 ); @@ -349,87 +417,28 @@ 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' => '', 'status' => 'prepared', 'msgtype' => ($opt{'msgtype'} || ''), + 'preview' => $body, # html content only }); return $cust_msg; } -=item send_prepared CUST_MSG - -Takes the CUST_MSG object and sends it to its recipient. - -=cut - -sub send_prepared { - my $self = shift; - my $cust_msg = shift or die "cust_msg required"; - - my $domain = 'example.com'; - if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) { - $domain = $1; - } - - my @to = split(/\s*,\s*/, $cust_msg->env_to); - - my %smtp_opt = ( 'host' => $conf->config('smtpmachine'), - 'helo' => $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\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 = $@; - } - - $cust_msg->set('error', $error); - $cust_msg->set('status', $error ? 'failed' : 'sent'); - if ( $cust_msg->custmsgnum ) { - $cust_msg->replace; - } else { - $cust_msg->insert; - } - - $error; -} - =item render OPTION => VALUE ... Fills in the template and renders it to a PDF document. Returns the @@ -491,183 +500,6 @@ my $usage_warning = sub { return ['', '', '']; }; -#my $conf = new FS::Conf; - -#return contexts and fill-in values -# If you add anything, be sure to add a description in -# httemplate/edit/msg_template.html. -sub substitutions { - { 'cust_main' => [qw( - display_custnum agentnum agent_name - - last first company - name name_short contact contact_firstlast - address1 address2 city county state zip - country - daytime night mobile fax - - has_ship_address - ship_name ship_name_short ship_contact ship_contact_firstlast - ship_address1 ship_address2 ship_city ship_county ship_state ship_zip - ship_country - - paymask payname paytype payip - num_cancelled_pkgs num_ncancelled_pkgs num_pkgs - classname categoryname - balance - credit_limit - invoicing_list_emailonly - cust_status ucfirst_cust_status cust_statuscolor cust_status_label - - signupdate dundate - packages recurdates - ), - [ invoicing_email => sub { shift->invoicing_list_emailonly_scalar } ], - #compatibility: obsolete ship_ fields - use the non-ship versions - map ( - { my $field = $_; - [ "ship_$field" => sub { shift->$field } ] - } - qw( last first company daytime night fax ) - ), - # ship_name, ship_name_short, ship_contact, ship_contact_firstlast - # still work, though - [ expdate => sub { shift->paydate_epoch } ], #compatibility - [ signupdate_ymd => sub { $ymd->(shift->signupdate) } ], - [ dundate_ymd => sub { $ymd->(shift->dundate) } ], - [ paydate_my => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ], - [ otaker_first => sub { shift->access_user->first } ], - [ otaker_last => sub { shift->access_user->last } ], - [ payby => sub { FS::payby->shortname(shift->payby) } ], - [ company_name => sub { - $conf->config('company_name', shift->agentnum) - } ], - [ company_address => sub { - $conf->config('company_address', shift->agentnum) - } ], - [ company_phonenum => sub { - $conf->config('company_phonenum', shift->agentnum) - } ], - [ selfservice_server_base_url => sub { - $conf->config('selfservice_server-base_url') #, shift->agentnum) - } ], - ], - # next_bill_date - 'cust_pkg' => [qw( - pkgnum pkg_label pkg_label_long - location_label - status statuscolor - - start_date setup bill last_bill - adjourn susp expire - labels_short - ), - [ pkg => sub { shift->part_pkg->pkg } ], - [ pkg_category => sub { shift->part_pkg->categoryname } ], - [ pkg_class => sub { shift->part_pkg->classname } ], - [ cancel => sub { shift->getfield('cancel') } ], # grrr... - [ start_ymd => sub { $ymd->(shift->getfield('start_date')) } ], - [ setup_ymd => sub { $ymd->(shift->getfield('setup')) } ], - [ next_bill_ymd => sub { $ymd->(shift->getfield('bill')) } ], - [ last_bill_ymd => sub { $ymd->(shift->getfield('last_bill')) } ], - [ adjourn_ymd => sub { $ymd->(shift->getfield('adjourn')) } ], - [ susp_ymd => sub { $ymd->(shift->getfield('susp')) } ], - [ expire_ymd => sub { $ymd->(shift->getfield('expire')) } ], - [ cancel_ymd => sub { $ymd->(shift->getfield('cancel')) } ], - - # not necessarily correct for non-flat packages - [ setup_fee => sub { shift->part_pkg->option('setup_fee') } ], - [ recur_fee => sub { shift->part_pkg->option('recur_fee') } ], - - [ freq_pretty => sub { shift->part_pkg->freq_pretty } ], - - ], - 'cust_bill' => [qw( - invnum - _date - _date_pretty - due_date - ), - [ due_date2str => sub { shift->due_date2str('short') } ], - ], - #XXX not really thinking about cust_bill substitutions quite yet - - # for welcome and limit warning messages - 'svc_acct' => [qw( - svcnum - username - domain - ), - [ password => sub { shift->getfield('_password') } ], - [ column => sub { &$usage_warning(shift)->[0] } ], - [ amount => sub { &$usage_warning(shift)->[1] } ], - [ threshold => sub { &$usage_warning(shift)->[2] } ], - ], - 'svc_domain' => [qw( - svcnum - domain - ), - [ registrar => sub { - my $registrar = qsearchs('registrar', - { registrarnum => shift->registrarnum} ); - $registrar ? $registrar->registrarname : '' - } - ], - [ catchall => sub { - my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall }); - $svc_acct ? $svc_acct->email : '' - } - ], - ], - 'svc_phone' => [qw( - svcnum - phonenum - countrycode - domain - ) - ], - 'svc_broadband' => [qw( - svcnum - speed_up - speed_down - ip_addr - mac_addr - ) - ], - # for payment receipts - 'cust_pay' => [qw( - paynum - _date - ), - [ paid => sub { sprintf("%.2f", shift->paid) } ], - # overrides the one in cust_main in cases where a cust_pay is passed - [ payby => sub { FS::payby->shortname(shift->payby) } ], - [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ], - [ payinfo => sub { - my $cust_pay = shift; - ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ? - $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo) - } ], - ], - # for payment decline messages - # try to support all cust_pay fields - # 'error' is a special case, it contains the raw error from the gateway - 'cust_pay_pending' => [qw( - _date - error - ), - [ paid => sub { sprintf("%.2f", shift->paid) } ], - [ payby => sub { FS::payby->shortname(shift->payby) } ], - [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ], - [ payinfo => sub { - my $pending = shift; - ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ? - $pending->paymask : $pending->decrypt($pending->payinfo) - } ], - ], - }; -} - =item content LOCALE Returns the L object appropriate to LOCALE, if there @@ -684,168 +516,73 @@ sub content { { 'msgnum' => $self->msgnum, 'locale' => '' }); } -=item agent - -Returns the L object for this template. - =cut -sub _upgrade_data { - my ($self, %opts) = @_; +=item send_prepared CUST_MSG - ### - # First move any historical templates in config to real message templates - ### +Takes the CUST_MSG object and sends it to its recipient. The "smtpmachine" +configuration option will be used to find the outgoing mail server. - my @fixes = ( - [ 'alerter_msgnum', 'alerter_template', '', '', '' ], - [ 'cancel_msgnum', 'cancelmessage', 'cancelsubject', '', '' ], - [ 'decline_msgnum', 'declinetemplate', '', '', '' ], - [ 'impending_recur_msgnum', 'impending_recur_template', '', '', 'impending_recur_bcc' ], - [ 'payment_receipt_msgnum', 'payment_receipt_email', '', '', '' ], - [ 'welcome_msgnum', 'welcome_email', 'welcome_email-subject', 'welcome_email-from', '' ], - [ 'warning_msgnum', 'warning_email', 'warning_email-subject', 'warning_email-from', '' ], - ); - - my @agentnums = ('', map {$_->agentnum} qsearch('agent', {})); - foreach my $agentnum (@agentnums) { - foreach (@fixes) { - my ($newname, $oldname, $subject, $from, $bcc) = @$_; - if ($conf->exists($oldname, $agentnum)) { - my $new = new FS::msg_template({ - 'msgname' => $oldname, - 'agentnum' => $agentnum, - 'from_addr' => ($from && $conf->config($from, $agentnum)) || '', - 'bcc_addr' => ($bcc && $conf->config($from, $agentnum)) || '', - 'subject' => ($subject && $conf->config($subject, $agentnum)) || '', - 'mime_type' => 'text/html', - 'body' => join('
',$conf->config($oldname, $agentnum)), - }); - my $error = $new->insert; - die $error if $error; - $conf->set($newname, $new->msgnum, $agentnum); - $conf->delete($oldname, $agentnum); - $conf->delete($from, $agentnum) if $from; - $conf->delete($subject, $agentnum) if $subject; - } - } +=cut - if ( $conf->exists('alert_expiration', $agentnum) ) { - my $msgnum = $conf->exists('alerter_msgnum', $agentnum); - my $template = FS::msg_template->by_key($msgnum) if $msgnum; - if (!$template) { - warn "template for alerter_msgnum $msgnum not found\n"; - next; - } - # this is now a set of billing events - foreach my $days (30, 15, 5) { - my $event = FS::part_event->new({ - 'agentnum' => $agentnum, - 'event' => "Card expiration warning - $days days", - 'eventtable' => 'cust_main', - 'check_freq' => '1d', - 'action' => 'notice', - 'disabled' => 'Y', #initialize first - }); - my $error = $event->insert( 'msgnum' => $msgnum ); - if ($error) { - warn "error creating expiration alert event:\n$error\n\n"; - next; - } - # make it work like before: - # only send each warning once before the card expires, - # only warn active customers, - # only warn customers with CARD/DCRD, - # only warn customers who get email invoices - my %conds = ( - 'once_every' => { 'run_delay' => '30d' }, - 'cust_paydate_within' => { 'within' => $days.'d' }, - 'cust_status' => { 'status' => { 'active' => 1 } }, - 'payby' => { 'payby' => { 'CARD' => 1, - 'DCRD' => 1, } - }, - 'message_email' => {}, - ); - foreach (keys %conds) { - my $condition = FS::part_event_condition->new({ - 'conditionname' => $_, - 'eventpart' => $event->eventpart, - }); - $error = $condition->insert( %{ $conds{$_} }); - if ( $error ) { - warn "error creating expiration alert event:\n$error\n\n"; - next; - } - } - $error = $event->initialize; - if ( $error ) { - warn "expiration alert event was created, but not initialized:\n$error\n\n"; - } - } # foreach $days - $conf->delete('alerter_msgnum', $agentnum); - $conf->delete('alert_expiration', $agentnum); - - } # if alerter_msgnum +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; } - ### - # Move subject and body from msg_template to template_content - ### + my $domain = 'example.com'; + if ( $cust_msg->env_from =~ /\@([\w\.\-]+)/ ) { + $domain = $1; + } - foreach my $msg_template ( qsearch('msg_template', {}) ) { - if ( $msg_template->subject || $msg_template->body ) { - # create new default content - my %content; - $content{subject} = $msg_template->subject; - $msg_template->set('subject', ''); - - # work around obscure Pg/DBD bug - # https://rt.cpan.org/Public/Bug/Display.html?id=60200 - # (though the right fix is to upgrade DBD) - my $body = $msg_template->body; - if ( $body =~ /^x([0-9a-f]+)$/ ) { - # there should be no real message templates that look like that - warn "converting template body to TEXT\n"; - $body = pack('H*', $1); - } - $content{body} = $body; - $msg_template->set('body', ''); + # 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 $transport = email_sender_transport_or_error($domain); - my $error = $msg_template->replace(%content); - die $error if $error; + my $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; } - ### - # Add new-style default templates if missing - ### - $self->_populate_initial_data; + $cust_msg->set('error', $error); + $cust_msg->set('status', $error ? 'failed' : 'sent'); + if ( $cust_msg->custmsgnum ) { + $cust_msg->replace; + } else { + $cust_msg->insert; + } + $error; } -sub _populate_initial_data { #class method - #my($class, %opts) = @_; - #my $class = shift; - - eval "use FS::msg_template::InitialData;"; - die $@ if $@; - - my $initial_data = FS::msg_template::InitialData->_initial_data; - - foreach my $hash ( @$initial_data ) { - - next if $hash->{_conf} && $conf->config( $hash->{_conf} ); - - my $msg_template = new FS::msg_template($hash); - my $error = $msg_template->insert( @{ $hash->{_insert_args} || [] } ); - die $error if $error; +=back - $conf->set( $hash->{_conf}, $msg_template->msgnum ) if $hash->{_conf}; - - } +=cut -} +# internal use only sub eviscerate { # Every bit as pleasant as it sounds. @@ -897,8 +634,6 @@ sub eviscerate { (\@outside, \@inside); } -=back - =head1 BUGS =head1 SEE ALSO @@ -908,4 +643,3 @@ L, schema.html from the base documentation. =cut 1; -