X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main_Mixin.pm;h=94e6eaa29f903d0f055b12d3912e4f094e10f47a;hb=755159a8654a2eda89badd1498f8def3a472cb15;hp=8c8553c091d7631e7bc39f5f6858e3265d073c0c;hpb=0fb307c305e4bc2c9c27dc25a3308beae3a4d33c;p=freeside.git diff --git a/FS/FS/cust_main_Mixin.pm b/FS/FS/cust_main_Mixin.pm index 8c8553c09..94e6eaa29 100644 --- a/FS/FS/cust_main_Mixin.pm +++ b/FS/FS/cust_main_Mixin.pm @@ -2,11 +2,12 @@ package FS::cust_main_Mixin; use strict; use vars qw( $DEBUG $me ); -use Carp qw( confess ); +use Carp qw( confess carp cluck ); use FS::UID qw(dbh); use FS::cust_main; use FS::Record qw( qsearch qsearchs ); use FS::Misc qw( send_email generate_email ); +use HTML::Entities; $DEBUG = 0; $me = '[FS::cust_main_Mixin]'; @@ -37,6 +38,7 @@ sub cust_linked { $_[0]->custnum; } sub cust_main { my $self = shift; + cluck ref($self). '->cust_main called' if $DEBUG; $self->cust_linked ? qsearchs('cust_main', {custnum => $self->custnum}) : ''; } @@ -131,9 +133,12 @@ linked to a customer. sub country_full { my $self = shift; - $self->cust_linked - ? FS::cust_main::country_full($self) - : $self->cust_unlinked_msg; + if ( $self->locationnum ) { # cust_pkg has this + my $location = FS::cust_location->by_key($self->locationnum); + $location ? $location->country_full : ''; + } elsif ( $self->cust_linked ) { + $self->cust_main->bill_country_full; + } } =item invoicing_list_emailonly @@ -375,6 +380,12 @@ HTML body Text body +=item to_contact_classnum + +The customer contact class (or classes, as a comma-separated list) to send +the message to. If unspecified, will be sent to any contacts that are marked +as invoice destinations (the equivalent of specifying 'invoice'). + =back Returns an error message, or false for success. @@ -388,6 +399,7 @@ in the job fail, the entire job will abort and return an error. use Storable qw(thaw); use MIME::Base64; use Data::Dumper qw(Dumper); +use Digest::SHA qw(sha1); # for duplicate checking sub email_search_result { my($class, $param) = @_; @@ -397,6 +409,7 @@ sub email_search_result { my $subject = delete $param->{subject}; my $html_body = delete $param->{html_body}; my $text_body = delete $param->{text_body}; + my $to_contact_classnum = delete $param->{to_contact_classnum}; my $error = ''; my $job = delete $param->{'job'} @@ -408,10 +421,8 @@ sub email_search_result { or die "msgnum $msgnum not found\n"; } - $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ] - unless ref($param->{'payby'}); - my $sql_query = $class->search($param->{'search'}); + $sql_query->{'select'} = $sql_query->{'table'} . '.*'; my $count_query = delete($sql_query->{'count_query'}); my $count_sth = dbh->prepare($count_query) @@ -441,41 +452,56 @@ sub email_search_result { } my $cust_main = $obj->cust_main; - my @message; + tie my %message, 'Tie::IxHash'; if ( !$cust_main ) { next; # unlinked object; nothing else we can do } - if( $sent_to{$cust_main->custnum} ) { - # avoid duplicates - $dups++; - next; - } - - $sent_to{$cust_main->custnum} = 1; - if ( $msg_template ) { - # XXX add support for other context objects? - # If we do that, handling of "duplicates" will - # have to be smarter. Currently we limit to - # one message per custnum because they'd all - # be identical. - @message = $msg_template->prepare( 'cust_main' => $cust_main ); - } - else { - my $to = $cust_main->invoicing_list_emailonly_scalar; - next if !$to; + # Now supports other context objects. + %message = $msg_template->prepare( + 'cust_main' => $cust_main, + 'object' => $obj, + 'to_contact_classnum' => $to_contact_classnum, + ); - @message = ( + } else { + # 3.x: false laziness with msg_template.pm; on 4.x, all email notices + # are generated from templates and this case goes away + my @classes; + if ( $opt{'to_contact_classnum'} ) { + my $classnum = $opt{'to_contact_classnum'}; + @classes = ref($classnum) ? @$classnum : split(',', $classnum); + } + if (!@classes) { + @classes = ( 'invoice' ); + } + my @to = $cust_main->contact_list_email(@classes); + next if !@to; + + %message = ( 'from' => $from, - 'to' => $to, + 'to' => \@to, 'subject' => $subject, 'html_body' => $html_body, 'text_body' => $text_body, + 'custnum' => $cust_main->custnum, ); } #if $msg_template - $error = send_email( generate_email( @message ) ); + # For non-cust_main searches, we avoid duplicates based on message + # body text. + my $unique = $cust_main->custnum; + $unique .= sha1($message{'text_body'}) if $class ne 'FS::cust_main'; + if( $sent_to{$unique} ) { + # avoid duplicates + $dups++; + next; + } + + $sent_to{$unique} = 1; + + $error = send_email( generate_email( %message ) ); if($error) { # queue the sending of this message so that the user can see what we @@ -486,7 +512,7 @@ sub email_search_result { 'status' => 'failed', 'statustext' => $error, }; - $queue->insert(@message); + $queue->insert(%message); push @retry_jobs, $queue; } else { @@ -536,10 +562,158 @@ sub process_email_search_result { die "error loading FS::$table: $@\n" if $@; my $error = "FS::$table"->email_search_result( $param ); + dbh->commit; # save failed jobs before rethrowing the error die $error if $error; } +=item conf + +Returns a configuration handle (L) set to the customer's locale, +if they have one. If not, returns an FS::Conf with no locale. + +=cut + +sub conf { + my $self = shift; + return $self->{_conf} if (ref $self and $self->{_conf}); + my $cust_main = $self->cust_main; + my $conf = new FS::Conf { + 'locale' => ($cust_main ? $cust_main->locale : '') + }; + $self->{_conf} = $conf if ref $self; + return $conf; +} + +=item mt TEXT [, ARGS ] + +Localizes a text string (see L) for the customer's locale, +if they have one. + +=cut + +sub mt { + my $self = shift; + return $self->{_lh}->maketext(@_) if (ref $self and $self->{_lh}); + my $cust_main = $self->cust_main; + my $locale = $cust_main ? $cust_main->locale : ''; + my $lh = FS::L10N->get_handle($locale); + $self->{_lh} = $lh if ref $self; + return $lh->maketext(@_); +} + +=item time2str_local FORMAT, TIME[, ESCAPE] + +Localizes a date (see L) for the customer's locale. + +FORMAT can be a L string, or one of these special words: + +- "short": the value of the "date_format" config setting for the customer's + locale, defaulting to "%x". +- "rdate": the same as "short" except that the default has a four-digit year. +- "long": the value of the "date_format_long" config setting for the + customer's locale, defaulting to "%b %o, %Y". + +ESCAPE, if specified, is one of "latex" or "html", and will escape non-ASCII +characters and convert spaces to nonbreaking spaces. + +=cut + +sub time2str_local { + # renamed so that we don't have to change every single reference to + # time2str everywhere + my $self = shift; + my ($format, $time, $escape) = @_; + return '' unless $time > 0; # work around time2str's traditional stupidity + + $self->{_date_format} ||= {}; + if (!exists($self->{_dh})) { + my $cust_main = $self->cust_main; + my $locale = $cust_main->locale if $cust_main; + $locale ||= 'en_US'; + my %info = FS::Locales->locale_info($locale); + my $dh = eval { Date::Language->new($info{'name'}) } || + Date::Language->new(); # fall back to English + $self->{_dh} = $dh; + } + + if ($format eq 'short') { + $format = $self->{_date_format}->{short} + ||= $self->conf->config('date_format') || '%x'; + } elsif ($format eq 'rdate') { + $format = $self->{_date_format}->{rdate} + ||= $self->conf->config('date_format') || '%m/%d/%Y'; + } elsif ($format eq 'long') { + $format = $self->{_date_format}->{long} + ||= $self->conf->config('date_format_long') || '%b %o, %Y'; + } + + # actually render the date + my $string = $self->{_dh}->time2str($format, $time); + + if ($escape) { + if ($escape eq 'html') { + $string = encode_entities($string); + $string =~ s/ +/ /g; + } elsif ($escape eq 'latex') { # just do nbsp's here + $string =~ s/ +/~/g; + } + } + + $string; +} + +=item unsuspend_balance + +If conf I is set and customer's current balance is +beneath the set threshold, unsuspends customer packages. + +=cut + +sub unsuspend_balance { + my $self = shift; + my $cust_main = $self->cust_main; + my $conf = $self->conf; + my $setting = $conf->config('unsuspend_balance'); + my $maxbalance; + if ($setting eq 'Zero') { + $maxbalance = 0; + + # kind of a pain to load/check all cust_bill instead of just open ones, + # but if for some reason payment gets applied to later bills before + # earlier ones, we still want to consider the later ones as allowable balance + } elsif ($setting eq 'Latest invoice charges') { + my @cust_bill = $cust_main->cust_bill(); + my $cust_bill = $cust_bill[-1]; #always want the most recent one + if ($cust_bill) { + $maxbalance = $cust_bill->charged || 0; + } else { + $maxbalance = 0; + } + } elsif ($setting eq 'Charges not past due') { + my $now = time; + $maxbalance = 0; + foreach my $cust_bill ($cust_main->cust_bill()) { + next unless $now <= ($cust_bill->due_date || $cust_bill->_date); + $maxbalance += $cust_bill->charged || 0; + } + } elsif (length($setting)) { + warn "Unrecognized unsuspend_balance setting $setting"; + return; + } else { + return; + } + my $balance = $cust_main->balance || 0; + if ($balance <= $maxbalance) { + my @errors = $cust_main->unsuspend; + # side-fx with nested transactions? upstack rolls back? + warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ". + join(' / ', @errors) + if @errors; + } + return; +} + =back =head1 BUGS