From: Mark Wells Date: Thu, 27 Aug 2015 21:46:31 +0000 (-0700) Subject: external message services: core refactoring of msg_template X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=commitdiff_plain;h=33f1c704766af0621159d5a8453379b6706d8c8a external message services: core refactoring of msg_template --- diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index a799ceebe..311313a4e 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -6320,8 +6320,11 @@ sub tables_hashref { 'mime_type', 'varchar', '', $char_d, '', '', 'body', 'blob', 'NULL', '', '', '', 'disabled', 'char', 'NULL', 1, '', '', + # migrate these to msg_template_email 'from_addr', 'varchar', 'NULL', 255, '', '', 'bcc_addr', 'varchar', 'NULL', 255, '', '', + # change to not null on v5 + 'msgclass', 'varchar', 'NULL', 16, '', '', ], 'primary_key' => 'msgnum', 'unique' => [ ], @@ -6333,6 +6336,26 @@ sub tables_hashref { ], }, + 'msg_template_http' => { + 'columns' => [ + 'num', 'serial', '', '', '', '', + 'msgnum', 'int', '', '', '', '', + 'prepare_url', 'varchar', 'NULL', 255, '', '', + 'send_url', 'varchar', 'NULL', 255, '', '', + 'username', 'varchar', 'NULL', $char_d, '', '', + 'password', 'varchar', 'NULL', $char_d, '', '', + 'content', 'text', 'NULL', '', '', '', + ], + 'primary_key' => 'num', + 'unique' => [ [ 'msgnum' ], ], + 'index' => [ ], + 'foreign_keys' => [ + { columns => [ 'msgnum' ], + table => 'msg_template', + }, + ], + }, + 'template_content' => { 'columns' => [ 'contentnum', 'serial', '', '', '', '', diff --git a/FS/FS/cust_msg.pm b/FS/FS/cust_msg.pm index 72f64b9c5..934632725 100644 --- a/FS/FS/cust_msg.pm +++ b/FS/FS/cust_msg.pm @@ -45,7 +45,7 @@ from FS::Record. The following fields are currently supported: =item header - message header -=item body - message body +=item body - message body (as a complete MIME document) =item error - Email::Sender error message (or null for success) @@ -150,10 +150,27 @@ sub check { $self->SUPER::check; } +=item send + +Sends the message through its parent L. Returns an error +message on error, or an empty string. + +=cut + +sub send { + my $self = shift; + my $msg_template = $self->msg_template + or return 'message was created without a template object'; + $msg_template->send_prepared($self); +} + =item entity Returns the complete message as a L. +XXX this only works if the message in fact contains a MIME entity. Messages +created by external APIs may not look like that. + =item parts Returns a list of the MIME parts contained in the message, as L diff --git a/FS/FS/msg_template.pm b/FS/FS/msg_template.pm index c52b6336e..180e9de4d 100644 --- a/FS/FS/msg_template.pm +++ b/FS/FS/msg_template.pm @@ -4,22 +4,9 @@ use base qw( FS::Record ); use strict; use vars qw( $DEBUG $conf ); -use Date::Format qw( time2str ); -use File::Temp; -use IPC::Run qw(run); -use Text::Template; - -use HTML::Entities qw( decode_entities encode_entities ) ; -use HTML::FormatText; -use HTML::TreeBuilder; -use Encode; - -use FS::Misc qw( generate_email send_email do_print ); use FS::Conf; use FS::Record qw( qsearch qsearchs ); -use FS::UID qw( dbh ); -use FS::cust_main; use FS::cust_msg; use FS::template_content; @@ -59,6 +46,9 @@ supported: =item msgname - Name of the template. This will appear in the user interface; if it needs to be localized for some users, add it to the message catalog. +=item msgclass - The L subclass that this should belong to. +Defaults to 'email'. + =item agentnum - Agent associated with this template. Can be NULL for a global template. @@ -66,6 +56,8 @@ global template. =item from_addr - Source email address. +=item bcc_addr - Bcc all mail to this address. + =item disabled - disabled ('Y' or NULL). =back @@ -87,41 +79,20 @@ points to. You can ask the object for a copy with the I method. sub table { 'msg_template'; } +sub _rebless { + my $self = shift; + my $class = 'FS::msg_template::' . $self->msgclass; + eval "use $class;"; + bless($self, $class) unless $@; + $self; +} + =item insert [ CONTENT ] Adds this record to the database. If there is an error, returns the error, otherwise returns false. -A default (no locale) L object will be created. CONTENT -is an optional hash containing 'subject' and 'body' for this object. - -=cut - -sub insert { - my $self = shift; - my %content = @_; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::insert; - if ( !$error ) { - $content{'msgnum'} = $self->msgnum; - $content{'subject'} ||= ''; - $content{'body'} ||= ''; - my $template_content = new FS::template_content (\%content); - $error = $template_content->insert; - } - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $dbh->commit if $oldAutoCommit; - return; -} +# inherited =item delete @@ -129,61 +100,31 @@ Delete this record from the database. =cut -# the delete method can be inherited from FS::Record +# inherited =item replace [ OLD_RECORD ] [ CONTENT ] Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -CONTENT is an optional hash containing 'subject', 'body', and 'locale'. If -supplied, an L object will be created (or modified, if -one already exists for this locale). - =cut -sub replace { +# inherited + +sub replace_check { my $self = shift; - my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') ) - ? shift - : $self->replace_old; - my %content = @_; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::replace($old); - - if ( !$error and %content ) { - $content{'locale'} ||= ''; - my $new_content = qsearchs('template_content', { - 'msgnum' => $self->msgnum, - 'locale' => $content{'locale'}, - } ); - if ( $new_content ) { - $new_content->subject($content{'subject'}); - $new_content->body($content{'body'}); - $error = $new_content->replace; - } - else { - $content{'msgnum'} = $self->msgnum; - $new_content = new FS::template_content \%content; - $error = $new_content->insert; + my $old = $self->replace_old; + # don't allow changing msgclass, except null to not-null (for upgrade) + if ( $old->msgclass ) { + if ( !$self->msgclass ) { + $self->set('msgclass', $old->msgclass); + } else { + return "Can't change message template class from ".$old->msgclass. + " to ".$self->msgclass."."; } } - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit; - $dbh->commit if $oldAutoCommit; - return; + ''; } - - =item check @@ -206,6 +147,10 @@ sub check { || $self->ut_textn('mime_type') || $self->ut_enum('disabled', [ '', 'Y' ] ) || $self->ut_textn('from_addr') + || $self->ut_textn('bcc_addr') + # fine for now, but change this to some kind of dynamic check if we + # ever have more than two msgclasses + || $self->ut_enum('msgclass', [ qw(email http) ]), ; return $error if $error; @@ -214,25 +159,10 @@ sub check { $self->SUPER::check; } -=item content_locales - -Returns a hashref of the L objects attached to -this template, with the locale as key. - -=cut - -sub content_locales { - my $self = shift; - return $self->{'_content_locales'} ||= +{ - map { $_->locale , $_ } - qsearch('template_content', { 'msgnum' => $self->msgnum }) - }; -} - =item prepare OPTION => VALUE -Fills in the template and returns a hash of the 'from' address, 'to' -addresses, subject line, and body. +Fills in the template and returns an L object, containing the +message to be sent. This method must be provided by the subclass. Options are passed as a list of name/value pairs: @@ -276,18 +206,23 @@ A hash reference of additional substitutions =cut sub prepare { + die "unimplemented"; +} + +=item prepare_substitutions OPTION => VALUE ... + +Takes the same arguments as L, and returns a hashref of the +substitution variables. + +=cut + +sub prepare_substitutions { my( $self, %opt ) = @_; my $cust_main = $opt{'cust_main'}; # or die 'cust_main required'; my $object = $opt{'object'} or die 'object required'; - # localization - my $locale = $cust_main && $cust_main->locale || ''; - warn "no locale for cust#".$cust_main->custnum."; using default content\n" - if $DEBUG and $cust_main && !$locale; - my $content = $self->content($locale); - - warn "preparing template '".$self->msgname."\n" + warn "preparing substitutions for '".$self->msgname."'\n" if $DEBUG; my $subs = $self->substitutions; @@ -340,110 +275,19 @@ sub prepare { $hash{$_} = $opt{substitutions}->{$_} foreach keys %{$opt{substitutions}}; } - $_ = encode_entities($_ || '') foreach values(%hash); - - ### - # clean up template - ### - my $subject_tmpl = new Text::Template ( - TYPE => 'STRING', - SOURCE => $content->subject, - ); - my $subject = $subject_tmpl->fill_in( HASH => \%hash ); - - my $body = $content->body; - my ($skin, $guts) = eviscerate($body); - @$guts = map { - $_ = decode_entities($_); # turn all punctuation back into itself - s/\r//gs; # remove \r's - s/]*>/\n/gsi; # and
tags - s/

/\n/gsi; # and

- s/<\/p>//gsi; # and

- s/\240/ /gs; # and   - $_ - } @$guts; - - $body = '{ use Date::Format qw(time2str); "" }'; - while(@$skin || @$guts) { - $body .= shift(@$skin) || ''; - $body .= shift(@$guts) || ''; - } - - ### - # fill-in - ### - - my $body_tmpl = new Text::Template ( - TYPE => 'STRING', - SOURCE => $body, - ); - - $body = $body_tmpl->fill_in( HASH => \%hash ); - - ### - # and email - ### - - my @to; - if ( exists($opt{'to'}) ) { - @to = split(/\s*,\s*/, $opt{'to'}); - } elsif ( $cust_main ) { - @to = $cust_main->invoicing_list_emailonly; - } else { - die 'no To: address or cust_main object specified'; - } - - my $from_addr = $self->from_addr; - - if ( !$from_addr ) { - - my $agentnum = $cust_main ? $cust_main->agentnum : ''; - - if ( $opt{'from_config'} ) { - $from_addr = $conf->config($opt{'from_config'}, $agentnum); - } - $from_addr ||= $conf->invoice_from_full($agentnum); - } -# my @cust_msg = (); -# if ( $conf->exists('log_sent_mail') and !$opt{'preview'} ) { -# my $cust_msg = FS::cust_msg->new({ -# 'custnum' => $cust_main->custnum, -# 'msgnum' => $self->msgnum, -# 'status' => 'prepared', -# }); -# $cust_msg->insert; -# @cust_msg = ('cust_msg' => $cust_msg); -# } - - my $text_body = encode('UTF-8', - HTML::FormatText->new(leftmargin => 0, rightmargin => 70) - ->format( HTML::TreeBuilder->new_from_content($body) ) - ); - ( - 'custnum' => ( $cust_main ? $cust_main->custnum : ''), - 'msgnum' => $self->msgnum, - 'from' => $from_addr, - 'to' => \@to, - 'bcc' => $self->bcc_addr || undef, - 'subject' => $subject, - 'html_body' => $body, - 'text_body' => $text_body - ); - + return \%hash; } -=item send OPTION => VALUE +=item send OPTION => VALUE ... -Fills in the template and sends it to the customer. Options are as for -'prepare'. +Creates a message with L (taking all the same options) and sends it. =cut -# broken out from prepare() in case we want to queue the sending, -# preview it, etc. sub send { my $self = shift; - send_email(generate_email($self->prepare(@_))); + my $cust_msg = $self->prepare(@_); + $self->send_prepared($cust_msg); } =item render OPTION => VALUE ... @@ -455,6 +299,9 @@ Options are as for 'prepare', but 'from' and 'to' are meaningless. =cut +# XXX not sure where this ends up post-refactoring--a separate template +# class? it doesn't use the same rendering OR output machinery as ::email + # will also have options to set paper size, margins, etc. sub render { @@ -507,8 +354,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. @@ -686,19 +531,11 @@ sub substitutions { =item content LOCALE -Returns the L object appropriate to LOCALE, if there -is one. If not, returns the one with a NULL locale. +Stub, returns nothing. =cut -sub content { - my $self = shift; - my $locale = shift; - qsearchs('template_content', - { 'msgnum' => $self->msgnum, 'locale' => $locale }) || - qsearchs('template_content', - { 'msgnum' => $self->msgnum, 'locale' => '' }); -} +sub content {} =item agent @@ -827,10 +664,16 @@ sub _upgrade_data { } $content{body} = $body; $msg_template->set('body', ''); - my $error = $msg_template->replace(%content); die $error if $error; } + + if ( !$msg_template->msgclass ) { + # set default message class + $msg_template->set('msgclass', 'email'); + my $error = $msg_template->replace; + die $error if $error; + } } ### @@ -863,56 +706,6 @@ sub _populate_initial_data { #class method } -sub eviscerate { - # Every bit as pleasant as it sounds. - # - # We do this because Text::Template::Preprocess doesn't - # actually work. It runs the entire template through - # the preprocessor, instead of the code segments. Which - # is a shame, because Text::Template already contains - # the code to do this operation. - my $body = shift; - my (@outside, @inside); - my $depth = 0; - my $chunk = ''; - while($body || $chunk) { - my ($first, $delim, $rest); - # put all leading non-delimiters into $first - ($first, $rest) = - ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s); - $chunk .= $first; - # put a leading delimiter into $delim if there is one - ($delim, $rest) = - ($rest =~ /^([{}]?)(.*)$/s); - - if( $delim eq '{' ) { - $chunk .= '{'; - if( $depth == 0 ) { - push @outside, $chunk; - $chunk = ''; - } - $depth++; - } - elsif( $delim eq '}' ) { - $depth--; - if( $depth == 0 ) { - push @inside, $chunk; - $chunk = ''; - } - $chunk .= '}'; - } - else { - # no more delimiters - if( $depth == 0 ) { - push @outside, $chunk . $rest; - } # else ? something wrong - last; - } - $body = $rest; - } - (\@outside, \@inside); -} - =back =head1 BUGS diff --git a/FS/FS/msg_template/email.pm b/FS/FS/msg_template/email.pm new file mode 100644 index 000000000..1133faafe --- /dev/null +++ b/FS/FS/msg_template/email.pm @@ -0,0 +1,911 @@ +package FS::msg_template::email; +use base qw( FS::msg_template ); + +use strict; +use vars qw( $DEBUG $conf ); + +# stuff needed for template generation +use Date::Format qw( time2str ); +use File::Temp; +use IPC::Run qw(run); +use Text::Template; + +use HTML::Entities qw( decode_entities encode_entities ) ; +use HTML::FormatText; +use HTML::TreeBuilder; +use Encode; + +# needed to send email +use FS::Misc qw( generate_email ); +use FS::Conf; +use Email::Sender::Simple qw( sendmail ); + +use FS::Record qw( qsearch qsearchs ); + +# needed to manage template_content objects +use FS::template_content; +use FS::UID qw( dbh ); + +use FS::cust_msg; + +FS::UID->install_callback( sub { $conf = new FS::Conf; } ); + +our $DEBUG = 1; +our $me = '[FS::msg_template::email]'; + +=head1 NAME + +FS::msg_template::email - Construct email notices with Text::Template. + +=head1 DESCRIPTION + +FS::msg_template::email is a message processor in which the template contains +L strings for the message subject line and body, and the +message is delivered by email. + +Currently the C and C fields used by this processor are +in the main msg_template table. + +=head1 METHODS + +=over 4 + +=item insert [ CONTENT ] + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +A default (no locale) L object will be created. CONTENT +is an optional hash containing 'subject' and 'body' for this object. + +=cut + +sub insert { + my $self = shift; + my %content = @_; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::insert; + if ( !$error ) { + $content{'msgnum'} = $self->msgnum; + $content{'subject'} ||= ''; + $content{'body'} ||= ''; + my $template_content = new FS::template_content (\%content); + $error = $template_content->insert; + } + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit if $oldAutoCommit; + return; +} + +=item replace [ OLD_RECORD ] [ CONTENT ] + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +CONTENT is an optional hash containing 'subject', 'body', and 'locale'. If +supplied, an L object will be created (or modified, if +one already exists for this locale). + +=cut + +sub replace { + my $self = shift; + my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') ) + ? shift + : $self->replace_old; + my %content = @_; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::replace($old); + + if ( !$error and %content ) { + $content{'locale'} ||= ''; + my $new_content = qsearchs('template_content', { + 'msgnum' => $self->msgnum, + 'locale' => $content{'locale'}, + } ); + if ( $new_content ) { + $new_content->subject($content{'subject'}); + $new_content->body($content{'body'}); + $error = $new_content->replace; + } + else { + $content{'msgnum'} = $self->msgnum; + $new_content = new FS::template_content \%content; + $error = $new_content->insert; + } + } + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit; + $dbh->commit if $oldAutoCommit; + return; +} + +=item content_locales + +Returns a hashref of the L objects attached to +this template, with the locale as key. + +=cut + +sub content_locales { + my $self = shift; + return $self->{'_content_locales'} ||= +{ + map { $_->locale , $_ } + qsearch('template_content', { 'msgnum' => $self->msgnum }) + }; +} + +=item prepare OPTION => VALUE + +Fills in the template and returns an L object. + +Options are passed as a list of name/value pairs: + +=over 4 + +=item cust_main + +Customer object (required). + +=item object + +Additional context object (currently, can be a cust_main, cust_pkg, +cust_bill, cust_pay, cust_pay_pending, or svc_(acct, phone, broadband, +domain) ). If the object is a svc_*, its cust_pkg will be fetched and +used for substitution. + +As a special case, this may be an arrayref of two objects. Both +objects will be available for substitution, with their field names +prefixed with 'new_' and 'old_' respectively. This is used in the +rt_ticket export when exporting "replace" events. + +=item from_config + +Configuration option to use as the source address, based on the customer's +agentnum. If unspecified (or the named option is empty), 'invoice_from' +will be used. + +The I field in the template takes precedence over this. + +=item to + +Destination address. The default is to use the customer's +invoicing_list addresses. Multiple addresses may be comma-separated. + +=item substitutions + +A hash reference of additional substitutions + +=item msgtype + +A string identifying the kind of message this is. Currently can be "invoice", +"receipt", "admin", or null. Expand this list as necessary. + +=back + +=cut + +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 $hashref = $self->prepare_substitutions(%opt); + + # localization + my $locale = $cust_main && $cust_main->locale || ''; + warn "no locale for cust#".$cust_main->custnum."; using default content\n" + if $DEBUG and $cust_main && !$locale; + my $content = $self->content($locale); + + warn "preparing template '".$self->msgname."\n" + if $DEBUG; + + $_ = encode_entities($_ || '') foreach values(%$hashref); + + ### + # clean up template + ### + my $subject_tmpl = new Text::Template ( + TYPE => 'STRING', + SOURCE => $content->subject, + ); + + warn "$me filling in subject template\n" if $DEBUG; + my $subject = $subject_tmpl->fill_in( HASH => $hashref ); + + my $body = $content->body; + my ($skin, $guts) = eviscerate($body); + @$guts = map { + $_ = decode_entities($_); # turn all punctuation back into itself + s/\r//gs; # remove \r's + s/]*>/\n/gsi; # and
tags + s/

/\n/gsi; # and

+ s/<\/p>//gsi; # and

+ s/\240/ /gs; # and   + $_ + } @$guts; + + $body = '{ use Date::Format qw(time2str); "" }'; + while(@$skin || @$guts) { + $body .= shift(@$skin) || ''; + $body .= shift(@$guts) || ''; + } + + ### + # fill-in + ### + + my $body_tmpl = new Text::Template ( + TYPE => 'STRING', + SOURCE => $body, + ); + + warn "$me filling in body template\n" if $DEBUG; + $body = $body_tmpl->fill_in( HASH => $hashref ); + + ### + # and email + ### + + my @to; + if ( exists($opt{'to'}) ) { + @to = split(/\s*,\s*/, $opt{'to'}); + } elsif ( $cust_main ) { + @to = $cust_main->invoicing_list_emailonly; + } else { + die 'no To: address or cust_main object specified'; + } + + my $from_addr = $self->from_addr; + + if ( !$from_addr ) { + + my $agentnum = $cust_main ? $cust_main->agentnum : ''; + + if ( $opt{'from_config'} ) { + $from_addr = $conf->config($opt{'from_config'}, $agentnum); + } + $from_addr ||= $conf->invoice_from_full($agentnum); + } + + my $text_body = encode('UTF-8', + HTML::FormatText->new(leftmargin => 0, rightmargin => 70) + ->format( HTML::TreeBuilder->new_from_content($body) ) + ); + + warn "$me constructing MIME entities\n" if $DEBUG; + my %email = generate_email( + 'from' => $from_addr, + 'to' => \@to, + 'bcc' => $self->bcc_addr || undef, + 'subject' => $subject, + 'html_body' => $body, + 'text_body' => $text_body, + ); + + warn "$me creating message headers\n" if $DEBUG; + my $env_from = $from_addr; + $env_from =~ s/^\s*//; $env_from =~ s/\s*$//; + if ( $env_from =~ /^(.*)\s*<(.*@.*)>$/ ) { + # a common idiom + $env_from = $2; + } + + my $domain; + if ( $env_from =~ /\@([\w\.\-]+)/ ) { + $domain = $1; + } else { + warn 'no domain found in invoice from address '. $env_from . + '; constructing Message-ID (and saying HELO) @example.com'; + $domain = 'example.com'; + } + my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain"; + + my $time = time; + my $message = MIME::Entity->build( + 'From' => $from_addr, + 'To' => join(', ', @to), + 'Sender' => $from_addr, + 'Reply-To' => $from_addr, + 'Date' => time2str("%a, %d %b %Y %X %z", $time), + 'Subject' => Encode::encode('MIME-Header', $subject), + 'Message-ID' => "<$message_id>", + 'Encoding' => '7bit', + 'Type' => 'multipart/related', + ); + + #$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 ); + } + + # effective To: address (not in headers) + push @to, $self->bcc_addr if $self->bcc_addr; + my $env_to = join(', ', @to); + + my $cust_msg = FS::cust_msg->new({ + 'custnum' => $cust_main->custnum, + 'msgnum' => $self->msgnum, + '_date' => $time, + 'env_from' => $env_from, + 'env_to' => $env_to, + 'header' => $message->header_as_string, + 'body' => $message->body_as_string, + 'error' => '', + 'status' => 'prepared', + 'msgtype' => ($opt{'msgtype'} || ''), + }); + + 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 +name of the PDF file. + +Options are as for 'prepare', but 'from' and 'to' are meaningless. + +=cut + +# will also have options to set paper size, margins, etc. + +sub render { + my $self = shift; + eval "use PDF::WebKit"; + die $@ if $@; + my %opt = @_; + my %hash = $self->prepare(%opt); + my $html = $hash{'html_body'}; + + # Graphics/stylesheets should probably go in /var/www on the Freeside + # machine. + my $script_path = `/usr/bin/which freeside-wkhtmltopdf`; + chomp $script_path; + my $kit = PDF::WebKit->new(\$html); #%options + # hack to use our wrapper script + $kit->configure(sub { shift->wkhtmltopdf($script_path) }); + + $kit->to_pdf; +} + +=item print OPTIONS + +Render a PDF and send it to the printer. OPTIONS are as for 'render'. + +=cut + +sub print { + my( $self, %opt ) = @_; + do_print( [ $self->render(%opt) ], agentnum=>$opt{cust_main}->agentnum ); +} + +# helper sub for package dates +my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' }; + +# helper sub for money amounts +my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) }; + +# helper sub for usage-related messages +my $usage_warning = sub { + my $svc = shift; + foreach my $col (qw(seconds upbytes downbytes totalbytes)) { + my $amount = $svc->$col; next if $amount eq ''; + my $method = $col.'_threshold'; + my $threshold = $svc->$method; next if $threshold eq ''; + return [$col, $amount, $threshold] if $amount <= $threshold; + # this only returns the first one that's below threshold, if there are + # several. + } + 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 +is one. If not, returns the one with a NULL locale. + +=cut + +sub content { + my $self = shift; + my $locale = shift; + qsearchs('template_content', + { 'msgnum' => $self->msgnum, 'locale' => $locale }) || + qsearchs('template_content', + { 'msgnum' => $self->msgnum, 'locale' => '' }); +} + +=item agent + +Returns the L object for this template. + +=cut + +sub _upgrade_data { + my ($self, %opts) = @_; + + ### + # First move any historical templates in config to real message templates + ### + + 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; + } + } + + 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 + + } + + ### + # Move subject and body from msg_template to template_content + ### + + 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', ''); + + my $error = $msg_template->replace(%content); + die $error if $error; + } + } + + ### + # Add new-style default templates if missing + ### + $self->_populate_initial_data; + +} + +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; + + $conf->set( $hash->{_conf}, $msg_template->msgnum ) if $hash->{_conf}; + + } + +} + +sub eviscerate { + # Every bit as pleasant as it sounds. + # + # We do this because Text::Template::Preprocess doesn't + # actually work. It runs the entire template through + # the preprocessor, instead of the code segments. Which + # is a shame, because Text::Template already contains + # the code to do this operation. + my $body = shift; + my (@outside, @inside); + my $depth = 0; + my $chunk = ''; + while($body || $chunk) { + my ($first, $delim, $rest); + # put all leading non-delimiters into $first + ($first, $rest) = + ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s); + $chunk .= $first; + # put a leading delimiter into $delim if there is one + ($delim, $rest) = + ($rest =~ /^([{}]?)(.*)$/s); + + if( $delim eq '{' ) { + $chunk .= '{'; + if( $depth == 0 ) { + push @outside, $chunk; + $chunk = ''; + } + $depth++; + } + elsif( $delim eq '}' ) { + $depth--; + if( $depth == 0 ) { + push @inside, $chunk; + $chunk = ''; + } + $chunk .= '}'; + } + else { + # no more delimiters + if( $depth == 0 ) { + push @outside, $chunk . $rest; + } # else ? something wrong + last; + } + $body = $rest; + } + (\@outside, \@inside); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; +