package FS::cust_main_Mixin; use strict; use vars qw( $DEBUG $me ); 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]'; =head1 NAME FS::cust_main_Mixin - Mixin class for records that contain fields from cust_main =head1 SYNOPSIS package FS::some_table; use vars qw(@ISA); @ISA = qw( FS::cust_main_Mixin FS::Record ); =head1 DESCRIPTION This is a mixin class for records that contain fields from the cust_main table, for example, from a JOINed search. See httemplate/search/ for examples. =head1 METHODS =over 4 =cut sub cust_unlinked_msg { '(unlinked)'; } 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}) : ''; } =item display_custnum Given an object that contains fields from cust_main (say, from a JOINed search; see httemplate/search/ for examples), returns the equivalent of the FS::cust_main I method, or "(unlinked)" if this object is not linked to a customer. =cut sub display_custnum { my $self = shift; $self->cust_linked ? FS::cust_main::display_custnum($self) : $self->cust_unlinked_msg; } =item name Given an object that contains fields from cust_main (say, from a JOINed search; see httemplate/search/ for examples), returns the equivalent of the FS::cust_main I method, or "(unlinked)" if this object is not linked to a customer. =cut sub name { my $self = shift; $self->cust_linked ? FS::cust_main::name($self) : $self->cust_unlinked_msg; } =item ship_name Given an object that contains fields from cust_main (say, from a JOINed search; see httemplate/search/ for examples), returns the equivalent of the FS::cust_main I method, or "(unlinked)" if this object is not linked to a customer. =cut sub ship_name { my $self = shift; $self->cust_linked ? FS::cust_main::ship_name($self) : $self->cust_unlinked_msg; } =item contact Given an object that contains fields from cust_main (say, from a JOINed search; see httemplate/search/ for examples), returns the equivalent of the FS::cust_main I method, or "(unlinked)" if this object is not linked to a customer. =cut sub contact { my $self = shift; $self->cust_linked ? FS::cust_main::contact($self) : $self->cust_unlinked_msg; } =item ship_contact Given an object that contains fields from cust_main (say, from a JOINed search; see httemplate/search/ for examples), returns the equivalent of the FS::cust_main I method, or "(unlinked)" if this object is not linked to a customer. =cut sub ship_contact { my $self = shift; $self->cust_linked ? FS::cust_main::ship_contact($self) : $self->cust_unlinked_msg; } =item country_full Given an object that contains fields from cust_main (say, from a JOINed search; see httemplate/search/ for examples), returns the equivalent of the FS::cust_main I method, or "(unlinked)" if this object is not linked to a customer. =cut sub country_full { my $self = shift; 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 Given an object that contains fields from cust_main (say, from a JOINed search; see httemplate/search/ for examples), returns the equivalent of the FS::cust_main I method, or "(unlinked)" if this object is not linked to a customer. =cut sub invoicing_list_emailonly { my $self = shift; warn "invoicing_list_email only called on $self, ". "custnum ". $self->custnum. "\n" if $DEBUG; $self->cust_linked ? FS::cust_main::invoicing_list_emailonly($self) : $self->cust_unlinked_msg; } =item invoicing_list_emailonly_scalar Given an object that contains fields from cust_main (say, from a JOINed search; see httemplate/search/ for examples), returns the equivalent of the FS::cust_main I method, or "(unlinked)" if this object is not linked to a customer. =cut sub invoicing_list_emailonly_scalar { my $self = shift; warn "invoicing_list_emailonly called on $self, ". "custnum ". $self->custnum. "\n" if $DEBUG; $self->cust_linked ? FS::cust_main::invoicing_list_emailonly_scalar($self) : $self->cust_unlinked_msg; } =item invoicing_list Given an object that contains fields from cust_main (say, from a JOINed search; see httemplate/search/ for examples), returns the equivalent of the FS::cust_main I method, or "(unlinked)" if this object is not linked to a customer. Note: this method is read-only. =cut #read-only sub invoicing_list { my $self = shift; $self->cust_linked ? FS::cust_main::invoicing_list($self) : (); } =item status Given an object that contains fields from cust_main (say, from a JOINed search; see httemplate/search/ for examples), returns the equivalent of the FS::cust_main I method, or "(unlinked)" if this object is not linked to a customer. =cut sub cust_status { my $self = shift; return $self->cust_unlinked_msg unless $self->cust_linked; my $cust_main = $self->cust_main; return $self->cust_unlinked_msg unless $cust_main; return $cust_main->cust_status; } =item ucfirst_cust_status Given an object that contains fields from cust_main (say, from a JOINed search; see httemplate/search/ for examples), returns the equivalent of the FS::cust_main I method, or "(unlinked)" if this object is not 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 search; see httemplate/search/ for examples), returns the equivalent of the FS::cust_main I method, or "000000" if this object is not linked to a customer. =cut sub cust_statuscolor { my $self = shift; $self->cust_linked ? FS::cust_main::cust_statuscolor($self) : '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 =item inactive_sql =item suspended_sql =item cancelled_sql Class methods that return SQL framents, equivalent to the corresponding FS::cust_main method. =cut # my \$self = shift; # \$self->cust_linked # ? FS::cust_main::${sub}_sql(\$self) # : '0'; foreach my $sub (qw( prospect active inactive suspended cancelled )) { eval " sub ${sub}_sql { confess 'cust_main_Mixin ${sub}_sql called with object' if ref(\$_[0]); 'cust_main.custnum IS NOT NULL AND '. FS::cust_main->${sub}_sql(); } "; die $@ if $@; } =item cust_search_sql Returns a list of SQL WHERE fragments to search for parameters specified in HASHREF. Valid parameters are: =over 4 =item agentnum =item status =back =cut sub cust_search_sql { my($class, $param) = @_; if ( $DEBUG ) { warn "$me cust_search_sql called with params: \n". join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n"; } my @search = (); if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) { push @search, "cust_main.agentnum = $1"; } #status (prospect active inactive suspended cancelled) if ( grep { $param->{'status'} eq $_ } FS::cust_main->statuses() ) { my $method = $param->{'status'}. '_sql'; push @search, $class->$method(); } #here is the agent virtualization push @search, $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' ); return @search; } =item email_search_result HASHREF 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: =over 4 =item job Queue job for status updates. Required. =item search Hashref of params to the L method. Required. =item msgnum Message template number (see L). Overrides all of the following options. =item from From: address =item subject Email Subject: =item html_body HTML body =item text_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. If any messages fail to send, they will be queued as individual jobs which can be manually retried. If the first ten messages in the job fail, the entire job will abort and return an error. =cut 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"; my $msg_template; 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; } 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) or die "Error preparing $count_query: ". dbh->errstr; $count_sth->execute or die "Error executing $count_query: ". $count_sth->errstr; my $count_arrayref = $count_sth->fetchrow_arrayref; my $num_cust = $count_arrayref->[0]; 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) ) { #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 else we can do } 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; } $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::cust_msg::process_send', 'custnum' => $cust_main->custnum, 'status' => 'failed', 'statustext' => $error, }; $queue->insert($cust_msg->custmsgnum); push @retry_jobs, $queue; } else { $success++; } if($success == 0 and (scalar(@retry_jobs) > 10 or $num == $num_cust) ) { # 10 is arbitrary, but if we have enough failures, that's # probably a configuration or network problem, and we # abort the batch and run away screaming. # We NEVER do this if anything was successfully sent. $_->delete foreach (@retry_jobs); return "multiple failures: '$error'\n"; } } # 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, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n"; } return ''; } sub process_email_search_result { my $job = shift; #warn "$me process_re_X $method for job $job\n" if $DEBUG; my $param = shift; warn Dumper($param) if $DEBUG; $param->{'job'} = $job; $param->{'search'} = thaw(decode_base64($param->{'search'})) or die "process_email_search_result requires search params.\n"; my $table = $param->{'table'} or die "process_email_search_result requires table.\n"; eval "use FS::$table;"; 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 =head1 SEE ALSO L, L =cut 1;