X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main_Mixin.pm;h=ba6fda146e71bac71ae8dd927c37669ae82156e1;hp=b446d69651348ed0972525ddb1ab547a1e9cc6cf;hb=3d9bb75680d19cb00307e57f4df2ac1c3514cd85;hpb=6c9cd1c36adbb9fc950fcf0a0b269fa6f16838a1 diff --git a/FS/FS/cust_main_Mixin.pm b/FS/FS/cust_main_Mixin.pm index b446d6965..ba6fda146 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 @@ -205,19 +210,9 @@ a customer. sub cust_status { my $self = shift; return $self->cust_unlinked_msg unless $self->cust_linked; - - #FS::cust_main::status($self) - #false laziness w/actual cust_main::status - # (make sure FS::cust_main methods are called) - for my $status (qw( prospect active inactive suspended cancelled )) { - my $method = $status.'_sql'; - my $sql = FS::cust_main->$method();; - my $numnum = ( $sql =~ s/cust_main\.custnum/?/g ); - my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr; - $sth->execute( ($self->custnum) x $numnum ) - or die "Error executing 'SELECT $sql': ". $sth->errstr; - return $status if $sth->fetchrow_arrayref->[0]; - } + my $cust_main = $self->cust_main; + return $self->cust_unlinked_msg unless $cust_main; + return $cust_main->cust_status; } =item ucfirst_cust_status @@ -230,12 +225,26 @@ linked to a customer. =cut sub ucfirst_cust_status { + carp "ucfirst_cust_status deprecated, use cust_status_label"; + local($FS::cust_main::ucfirst_nowarn) = 1; my $self = shift; $self->cust_linked ? ucfirst( $self->cust_status(@_) ) : $self->cust_unlinked_msg; } +=item cust_status_label + +=cut + +sub cust_status_label { + my $self = shift; + + $self->cust_linked + ? FS::cust_main::cust_status_label($self) + : $self->cust_unlinked_msg; +} + =item cust_statuscolor Given an object that contains fields from cust_main (say, from a JOINed @@ -253,6 +262,17 @@ sub cust_statuscolor { : '000000'; } +=item agent_name + +=cut + +sub agent_name { + my $self = shift; + $self->cust_linked + ? $self->cust_main->agent_name + : $self->cust_unlinked_msg; +} + =item prospect_sql =item active_sql @@ -294,8 +314,6 @@ in HASHREF. Valid parameters are: =item status -=item payby - =back =cut @@ -320,15 +338,6 @@ sub cust_search_sql { push @search, $class->$method(); } - #payby - my @payby = ref($param->{'payby'}) - ? @{ $param->{'payby'} } - : split(',', $param->{'payby'}); - @payby = grep /^([A-Z]{4})$/, @payby; - if ( @payby ) { - push @search, 'cust_main.payby IN ('. join(',', map "'$_'", @payby). ')'; - } - #here is the agent virtualization push @search, $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' ); @@ -339,10 +348,21 @@ sub cust_search_sql { =item email_search_result HASHREF -Emails a notice to the specified customers. Customers without -invoice email destinations will be skipped. +Emails a notice to the specified customer's contact_email addresses. + + +If the user has specified "Invoice recipients" on the send e-mail screen, +contact_email rows containing the invoice_dest flag will be included. +This option is default, if neither 'invoice' nor 'message' are present. + +If the user has specified "Message recipients" on the send e-mail screen, +contact_email rows containing the message_dest flag will be included. + +The selection is indicated by the presence of the text 'message' or +'invoice' within the to_contact_classnum argument. + -Parameters: +Parameters: =over 4 @@ -352,7 +372,7 @@ Queue job for status updates. Required. =item search -Hashref of params to the L method. Required. +Hashref of params to the L method. Required. =item msgnum @@ -375,6 +395,22 @@ HTML body Text body +=item to_contact_classnum + +This field contains 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 + =back Returns an error message, or false for success. @@ -388,17 +424,26 @@ 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) = @_; + my $conf = FS::Conf->new; + my $send_to_domain = $conf->config('email-to-voice_domain'); + my $msgnum = $param->{msgnum}; my $from = delete $param->{from}; 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 $emailtovoice_name = delete $param->{emailtovoice_contact}; + my $error = ''; + my $to = $emailtovoice_name . '@' . $send_to_domain unless !$emailtovoice_name; + my $job = delete $param->{'job'} or die "email_search_result must run from the job queue.\n"; @@ -406,12 +451,22 @@ sub email_search_result { if ( $msgnum ) { $msg_template = qsearchs('msg_template', { msgnum => $msgnum } ) or die "msgnum $msgnum not found\n"; + } else { + $msg_template = FS::msg_template->new({ + from_addr => $from, + msgname => $subject, # maybe a timestamp also? + disabled => 'D', # 'D'raft + # msgclass, maybe + }); + $error = $msg_template->insert( + subject => $subject, + body => $html_body, + ); + return "$error (when creating draft template)" if $error; } - $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) @@ -423,7 +478,13 @@ sub email_search_result { my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo my @retry_jobs = (); + my $dups = 0; my $success = 0; + my %sent_to = (); + + if ( !$msg_template ) { + die "email_search_result now requires a msg_template"; + } #eventually order+limit magic to reduce memory use? foreach my $obj ( qsearch($sql_query) ) { @@ -439,40 +500,46 @@ sub email_search_result { } my $cust_main = $obj->cust_main; - my @message; if ( !$cust_main ) { next; # unlinked object; nothing else we can do } - - if ( $msg_template ) { - # XXX add support for other context objects? - @message = $msg_template->prepare( 'cust_main' => $cust_main ); + + my %to = (); + if ($to) { $to{'to'} = $to; } + + my $cust_msg = $msg_template->prepare( + 'cust_main' => $cust_main, + 'object' => $obj, + 'to_contact_classnum' => $to_contact_classnum, + %to, + ); + + # For non-cust_main searches, we avoid duplicates based on message + # body text. + my $unique = $cust_main->custnum; + $unique .= sha1($cust_msg->text_body) if $class ne 'FS::cust_main'; + if( $sent_to{$unique} ) { + # avoid duplicates + $dups++; + next; } - else { - my $to = $cust_main->invoicing_list_emailonly_scalar; - next if !$to; - - @message = ( - 'from' => $from, - 'to' => $to, - 'subject' => $subject, - 'html_body' => $html_body, - 'text_body' => $text_body, - ); - } #if $msg_template - $error = send_email( generate_email( @message ) ); + $sent_to{$unique} = 1; + + $error = $cust_msg->send; if($error) { # queue the sending of this message so that the user can see what we # tried to do, and retry if desired + # (note the cust_msg itself also now has a status of 'failed'; that's + # fine, as it will get its status reset if we retry the job) my $queue = new FS::queue { - 'job' => 'FS::Misc::process_send_email', + 'job' => 'FS::cust_msg::process_send', 'custnum' => $cust_main->custnum, 'status' => 'failed', 'statustext' => $error, }; - $queue->insert(@message); + $queue->insert($cust_msg->custmsgnum); push @retry_jobs, $queue; } else { @@ -491,10 +558,18 @@ sub email_search_result { } } # foreach $obj + # if the message template was created as "draft", change its status to + # "completed" + if ($msg_template->disabled eq 'D') { + $msg_template->set('disabled' => 'C'); + my $error = $msg_template->replace; + warn "$error (setting draft message template status)" if $error; + } + if(@retry_jobs) { # fail the job, but with a status message that makes it clear # something was sent. - return "Sent $success, failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n"; + return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n"; } return ''; @@ -504,7 +579,7 @@ sub process_email_search_result { my $job = shift; #warn "$me process_re_X $method for job $job\n" if $DEBUG; - my $param = thaw(decode_base64(shift)); + my $param = shift; warn Dumper($param) if $DEBUG; $param->{'job'} = $job; @@ -512,9 +587,6 @@ sub process_email_search_result { $param->{'search'} = thaw(decode_base64($param->{'search'})) or die "process_email_search_result requires search params.\n"; -# $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ] -# unless ref($param->{'payby'}); - my $table = $param->{'table'} or die "process_email_search_result requires table.\n"; @@ -522,10 +594,258 @@ 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; } +sub customer_agent_transfer_search_result { + my($class, $param) = @_; + + my $newagentnum = $param->{agentnum}; + my $error = ''; + my @customers; + + my $job = delete $param->{'job'} + or die "customer_agent_transfer_search_result must run from the job queue.\n"; + + my $list = $param->{'list'}; + + if ($param->{'search'}) { + my $sql_query = $class->search($param->{'search'}); + $sql_query->{'select'} = $sql_query->{'table'} . '.*'; + @customers = qsearch($sql_query); + } + + @customers = @$list if !@customers && $list; + my $num_cust = scalar(@customers); + + my( $num, $last, $min_sec ) = (0, time, 5); #progresbar + + # Transactionize + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $obj ( @customers ) { + + #progressbar first, so that the count is right + $num++; + if ( time - $min_sec > $last ) { + my $error = $job->update_statustext( + int( 100 * $num / $num_cust ) + ); + die $error if $error; + $last = time; + } + + my $cust_main = $obj->cust_main; + if ( !$cust_main ) { + next; # unlinked object nothing to do + } + + $cust_main->agentnum($newagentnum); + $error = $cust_main->replace; + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "transfering to new agent: $error"; + } + + } # foreach $obj + + $dbh->commit if $oldAutoCommit; + return ''; +} + +=item process_customer_agent_transfer_search_result + +Mass transfers customers to new agent. + +Is Transactionized so entire list transfers or none. + +excepts either a list of cust_main objects in the base64 encoded cgi param list +or a list of search fields in the base64 encoded cgi param search. + +=cut + +sub process_customer_agent_transfer_search_result { + my $job = shift; + + my $param = shift; + warn Dumper($param) if $DEBUG; + + $param->{'job'} = $job; + + $param->{'search'} = thaw(decode_base64($param->{'search'})) + or die "process_customer_agent_transfer_search_result.\n" if $param->{'search'}; + + $param->{'list'} = thaw(decode_base64($param->{'list'})) + or die "process_customer_agent_transfer_search_result.\n" if $param->{'list'};; + + my $table = $param->{'table'} + or die "process_customer_agent_transfer_search_result.\n"; + + eval "use FS::$table;"; + die "error loading FS::$table: $@\n" if $@; + + my $error = "FS::$table"->customer_agent_transfer_search_result( $param ); + + 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 $locale = $self->cust_main->locale if $self->cust_main; + $locale ||= FS::Conf->new->config('locale') || 'en_US'; + + my %info = FS::Locales->locale_info($locale); + + $self->{_dh} = eval { Date::Language->new($info{'name'}) } + || Date::Language->new(); # fall back to English + } + + 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') or return; + 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( + 'reason_type' => $conf->config('unsuspend_reason_type') + ); + + push @errors, $cust_main->release_hold; + # side-fx with nested transactions? upstack rolls back? + warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ". + join(' / ', @errors) + if @errors; + } + return; +} + =back =head1 BUGS @@ -537,4 +857,3 @@ L, L =cut 1; -