1 package FS::cust_main_Mixin;
4 use vars qw( $DEBUG $me );
5 use Carp qw( confess carp cluck );
8 use FS::Record qw( qsearch qsearchs );
9 use FS::Misc qw( send_email generate_email );
13 $me = '[FS::cust_main_Mixin]';
17 FS::cust_main_Mixin - Mixin class for records that contain fields from cust_main
21 package FS::some_table;
23 @ISA = qw( FS::cust_main_Mixin FS::Record );
27 This is a mixin class for records that contain fields from the cust_main table,
28 for example, from a JOINed search. See httemplate/search/ for examples.
36 sub cust_unlinked_msg { '(unlinked)'; }
37 sub cust_linked { $_[0]->custnum; }
41 cluck ref($self). '->cust_main called' if $DEBUG;
42 $self->cust_linked ? qsearchs('cust_main', {custnum => $self->custnum}) : '';
47 Given an object that contains fields from cust_main (say, from a JOINed
48 search; see httemplate/search/ for examples), returns the equivalent of the
49 FS::cust_main I<name> method, or "(unlinked)" if this object is not linked to
57 ? FS::cust_main::display_custnum($self)
58 : $self->cust_unlinked_msg;
63 Given an object that contains fields from cust_main (say, from a JOINed
64 search; see httemplate/search/ for examples), returns the equivalent of the
65 FS::cust_main I<name> method, or "(unlinked)" if this object is not linked to
73 ? FS::cust_main::name($self)
74 : $self->cust_unlinked_msg;
79 Given an object that contains fields from cust_main (say, from a JOINed
80 search; see httemplate/search/ for examples), returns the equivalent of the
81 FS::cust_main I<ship_name> method, or "(unlinked)" if this object is not
89 ? FS::cust_main::ship_name($self)
90 : $self->cust_unlinked_msg;
95 Given an object that contains fields from cust_main (say, from a JOINed
96 search; see httemplate/search/ for examples), returns the equivalent of the
97 FS::cust_main I<contact> method, or "(unlinked)" if this object is not linked
105 ? FS::cust_main::contact($self)
106 : $self->cust_unlinked_msg;
111 Given an object that contains fields from cust_main (say, from a JOINed
112 search; see httemplate/search/ for examples), returns the equivalent of the
113 FS::cust_main I<ship_contact> method, or "(unlinked)" if this object is not
114 linked to a customer.
121 ? FS::cust_main::ship_contact($self)
122 : $self->cust_unlinked_msg;
127 Given an object that contains fields from cust_main (say, from a JOINed
128 search; see httemplate/search/ for examples), returns the equivalent of the
129 FS::cust_main I<country_full> method, or "(unlinked)" if this object is not
130 linked to a customer.
136 if ( $self->locationnum ) { # cust_pkg has this
137 my $location = FS::cust_location->by_key($self->locationnum);
138 $location ? $location->country_full : '';
139 } elsif ( $self->cust_linked ) {
140 $self->cust_main->bill_country_full;
144 =item invoicing_list_emailonly
146 Given an object that contains fields from cust_main (say, from a JOINed
147 search; see httemplate/search/ for examples), returns the equivalent of the
148 FS::cust_main I<invoicing_list_emailonly> method, or "(unlinked)" if this
149 object is not linked to a customer.
153 sub invoicing_list_emailonly {
155 warn "invoicing_list_email only called on $self, ".
156 "custnum ". $self->custnum. "\n"
159 ? FS::cust_main::invoicing_list_emailonly($self)
160 : $self->cust_unlinked_msg;
163 =item invoicing_list_emailonly_scalar
165 Given an object that contains fields from cust_main (say, from a JOINed
166 search; see httemplate/search/ for examples), returns the equivalent of the
167 FS::cust_main I<invoicing_list_emailonly_scalar> method, or "(unlinked)" if
168 this object is not linked to a customer.
172 sub invoicing_list_emailonly_scalar {
174 warn "invoicing_list_emailonly called on $self, ".
175 "custnum ". $self->custnum. "\n"
178 ? FS::cust_main::invoicing_list_emailonly_scalar($self)
179 : $self->cust_unlinked_msg;
184 Given an object that contains fields from cust_main (say, from a JOINed
185 search; see httemplate/search/ for examples), returns the equivalent of the
186 FS::cust_main I<invoicing_list> method, or "(unlinked)" if this object is not
187 linked to a customer.
189 Note: this method is read-only.
197 ? FS::cust_main::invoicing_list($self)
203 Given an object that contains fields from cust_main (say, from a JOINed
204 search; see httemplate/search/ for examples), returns the equivalent of the
205 FS::cust_main I<status> method, or "(unlinked)" if this object is not linked to
212 return $self->cust_unlinked_msg unless $self->cust_linked;
213 my $cust_main = $self->cust_main;
214 return $self->cust_unlinked_msg unless $cust_main;
215 return $cust_main->cust_status;
218 =item ucfirst_cust_status
220 Given an object that contains fields from cust_main (say, from a JOINed
221 search; see httemplate/search/ for examples), returns the equivalent of the
222 FS::cust_main I<ucfirst_status> method, or "(unlinked)" if this object is not
223 linked to a customer.
227 sub ucfirst_cust_status {
230 ? ucfirst( $self->cust_status(@_) )
231 : $self->cust_unlinked_msg;
234 =item cust_statuscolor
236 Given an object that contains fields from cust_main (say, from a JOINed
237 search; see httemplate/search/ for examples), returns the equivalent of the
238 FS::cust_main I<statuscol> method, or "000000" if this object is not linked to
243 sub cust_statuscolor {
247 ? FS::cust_main::cust_statuscolor($self)
258 ? $self->cust_main->agent_name
259 : $self->cust_unlinked_msg;
272 Class methods that return SQL framents, equivalent to the corresponding
273 FS::cust_main method.
278 # \$self->cust_linked
279 # ? FS::cust_main::${sub}_sql(\$self)
282 foreach my $sub (qw( prospect active inactive suspended cancelled )) {
285 confess 'cust_main_Mixin ${sub}_sql called with object' if ref(\$_[0]);
286 'cust_main.custnum IS NOT NULL AND '. FS::cust_main->${sub}_sql();
292 =item cust_search_sql
294 Returns a list of SQL WHERE fragments to search for parameters specified
295 in HASHREF. Valid parameters are:
309 sub cust_search_sql {
310 my($class, $param) = @_;
313 warn "$me cust_search_sql called with params: \n".
314 join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n";
319 if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) {
320 push @search, "cust_main.agentnum = $1";
323 #status (prospect active inactive suspended cancelled)
324 if ( grep { $param->{'status'} eq $_ } FS::cust_main->statuses() ) {
325 my $method = $param->{'status'}. '_sql';
326 push @search, $class->$method();
330 my @payby = ref($param->{'payby'})
331 ? @{ $param->{'payby'} }
332 : split(',', $param->{'payby'});
333 @payby = grep /^([A-Z]{4})$/, @payby;
335 push @search, 'cust_main.payby IN ('. join(',', map "'$_'", @payby). ')';
338 #here is the agent virtualization
340 $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' );
346 =item email_search_result HASHREF
348 Emails a notice to the specified customers. Customers without
349 invoice email destinations will be skipped.
357 Queue job for status updates. Required.
361 Hashref of params to the L<FS::Record/search> method. Required.
365 Message template number (see L<FS::msg_template>). Overrides all
366 of the following options.
384 =item to_contact_classnum
386 The customer contact class (or classes, as a comma-separated list) to send
387 the message to. If unspecified, will be sent to any contacts that are marked
388 as invoice destinations (the equivalent of specifying 'invoice').
392 Returns an error message, or false for success.
394 If any messages fail to send, they will be queued as individual
395 jobs which can be manually retried. If the first ten messages
396 in the job fail, the entire job will abort and return an error.
400 use Storable qw(thaw);
402 use Data::Dumper qw(Dumper);
403 use Digest::SHA qw(sha1); # for duplicate checking
405 sub email_search_result {
406 my($class, $param) = @_;
408 my $conf = FS::Conf->new;
409 my $send_to_domain = $conf->config('email-to-voice_domain');
411 my $msgnum = $param->{msgnum};
412 my $from = delete $param->{from};
413 my $subject = delete $param->{subject};
414 my $html_body = delete $param->{html_body};
415 my $text_body = delete $param->{text_body};
416 my $to_contact_classnum = delete $param->{to_contact_classnum};
417 my $emailtovoice_name = delete $param->{emailtovoice_contact};
421 my $to = $emailtovoice_name . '@' . $send_to_domain unless !$emailtovoice_name;
423 my $job = delete $param->{'job'}
424 or die "email_search_result must run from the job queue.\n";
428 $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
429 or die "msgnum $msgnum not found\n";
432 my $sql_query = $class->search($param->{'search'});
433 $sql_query->{'select'} = $sql_query->{'table'} . '.*';
435 my $count_query = delete($sql_query->{'count_query'});
436 my $count_sth = dbh->prepare($count_query)
437 or die "Error preparing $count_query: ". dbh->errstr;
439 or die "Error executing $count_query: ". $count_sth->errstr;
440 my $count_arrayref = $count_sth->fetchrow_arrayref;
441 my $num_cust = $count_arrayref->[0];
443 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
449 #eventually order+limit magic to reduce memory use?
450 foreach my $obj ( qsearch($sql_query) ) {
452 #progressbar first, so that the count is right
454 if ( time - $min_sec > $last ) {
455 my $error = $job->update_statustext(
456 int( 100 * $num / $num_cust )
458 die $error if $error;
462 my $cust_main = $obj->cust_main;
463 tie my %message, 'Tie::IxHash';
465 next; # unlinked object; nothing else we can do
468 my %to = ( to => $to ) if $to;
470 if ( $msg_template ) {
471 # Now supports other context objects.
472 %message = $msg_template->prepare(
473 'cust_main' => $cust_main,
475 'to_contact_classnum' => $to_contact_classnum,
480 # 3.x: false laziness with msg_template.pm; on 4.x, all email notices
481 # are generated from templates and this case goes away
483 if ( $to_contact_classnum ) {
484 @classes = ref($to_contact_classnum) ? @$to_contact_classnum : split(',', $to_contact_classnum);
487 @classes = ( 'invoice' );
489 my @to = $to ? split(',', $to) : $cust_main->contact_list_email(@classes);
495 'subject' => $subject,
496 'html_body' => $html_body,
497 'text_body' => $text_body,
498 'custnum' => $cust_main->custnum,
502 # For non-cust_main searches, we avoid duplicates based on message
504 my $unique = $cust_main->custnum;
505 $unique .= sha1($message{'text_body'}) if $class ne 'FS::cust_main';
506 if( $sent_to{$unique} ) {
512 $sent_to{$unique} = 1;
514 $error = send_email( generate_email( %message ) );
517 # queue the sending of this message so that the user can see what we
518 # tried to do, and retry if desired
519 my $queue = new FS::queue {
520 'job' => 'FS::Misc::process_send_email',
521 'custnum' => $cust_main->custnum,
522 'status' => 'failed',
523 'statustext' => $error,
525 $queue->insert(%message);
526 push @retry_jobs, $queue;
533 (scalar(@retry_jobs) > 10 or $num == $num_cust)
535 # 10 is arbitrary, but if we have enough failures, that's
536 # probably a configuration or network problem, and we
537 # abort the batch and run away screaming.
538 # We NEVER do this if anything was successfully sent.
539 $_->delete foreach (@retry_jobs);
540 return "multiple failures: '$error'\n";
545 # fail the job, but with a status message that makes it clear
546 # something was sent.
547 return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
553 sub process_email_search_result {
555 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
557 my $param = thaw(decode_base64(shift));
558 warn Dumper($param) if $DEBUG;
560 $param->{'job'} = $job;
562 $param->{'search'} = thaw(decode_base64($param->{'search'}))
563 or die "process_email_search_result requires search params.\n";
565 # $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
566 # unless ref($param->{'payby'});
568 my $table = $param->{'table'}
569 or die "process_email_search_result requires table.\n";
571 eval "use FS::$table;";
572 die "error loading FS::$table: $@\n" if $@;
574 my $error = "FS::$table"->email_search_result( $param );
575 dbh->commit; # save failed jobs before rethrowing the error
576 die $error if $error;
580 sub customer_agent_transfer_search_result {
581 my($class, $param) = @_;
583 my $newagentnum = $param->{agentnum};
587 my $job = delete $param->{'job'}
588 or die "customer_agent_transfer_search_result must run from the job queue.\n";
590 my $list = $param->{'list'};
592 if ($param->{'search'}) {
593 my $sql_query = $class->search($param->{'search'});
594 $sql_query->{'select'} = $sql_query->{'table'} . '.*';
595 @customers = qsearch($sql_query);
598 @customers = @$list if !@customers && $list;
599 my $num_cust = scalar(@customers);
601 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar
604 my $oldAutoCommit = $FS::UID::AutoCommit;
605 local $FS::UID::AutoCommit = 0;
608 foreach my $obj ( @customers ) {
610 #progressbar first, so that the count is right
612 if ( time - $min_sec > $last ) {
613 my $error = $job->update_statustext(
614 int( 100 * $num / $num_cust )
616 die $error if $error;
620 my $cust_main = $obj->cust_main;
622 next; # unlinked object nothing to do
625 $cust_main->agentnum($newagentnum);
626 $error = $cust_main->replace;
629 $dbh->rollback if $oldAutoCommit;
630 return "transfering to new agent: $error";
635 $dbh->commit if $oldAutoCommit;
639 =item process_customer_agent_transfer_search_result
641 Mass transfers customers to new agent.
643 Is Transactionized so entire list transfers or none.
645 excepts either a list of cust_main objects in the base64 encoded cgi param list
646 or a list of search fields in the base64 encoded cgi param search.
650 sub process_customer_agent_transfer_search_result {
653 my $param = thaw(decode_base64(shift));
654 warn Dumper($param) if $DEBUG;
656 $param->{'job'} = $job;
658 $param->{'search'} = thaw(decode_base64($param->{'search'}))
659 or die "process_customer_agent_transfer_search_result.\n" if $param->{'search'};
661 $param->{'list'} = thaw(decode_base64($param->{'list'}))
662 or die "process_customer_agent_transfer_search_result.\n" if $param->{'list'};;
664 my $table = $param->{'table'}
665 or die "process_customer_agent_transfer_search_result.\n";
667 eval "use FS::$table;";
668 die "error loading FS::$table: $@\n" if $@;
670 my $error = "FS::$table"->customer_agent_transfer_search_result( $param );
672 die $error if $error;
678 Returns a configuration handle (L<FS::Conf>) set to the customer's locale,
679 if they have one. If not, returns an FS::Conf with no locale.
685 return $self->{_conf} if (ref $self and $self->{_conf});
686 my $cust_main = $self->cust_main;
687 my $conf = new FS::Conf {
688 'locale' => ($cust_main ? $cust_main->locale : '')
690 $self->{_conf} = $conf if ref $self;
694 =item mt TEXT [, ARGS ]
696 Localizes a text string (see L<Locale::Maketext>) for the customer's locale,
703 return $self->{_lh}->maketext(@_) if (ref $self and $self->{_lh});
704 my $cust_main = $self->cust_main;
705 my $locale = $cust_main ? $cust_main->locale : '';
706 my $lh = FS::L10N->get_handle($locale);
707 $self->{_lh} = $lh if ref $self;
708 return $lh->maketext(@_);
711 =item time2str_local FORMAT, TIME[, ESCAPE]
713 Localizes a date (see L<Date::Language>) for the customer's locale.
715 FORMAT can be a L<Date::Format> string, or one of these special words:
717 - "short": the value of the "date_format" config setting for the customer's
718 locale, defaulting to "%x".
719 - "rdate": the same as "short" except that the default has a four-digit year.
720 - "long": the value of the "date_format_long" config setting for the
721 customer's locale, defaulting to "%b %o, %Y".
723 ESCAPE, if specified, is one of "latex" or "html", and will escape non-ASCII
724 characters and convert spaces to nonbreaking spaces.
729 # renamed so that we don't have to change every single reference to
730 # time2str everywhere
732 my ($format, $time, $escape) = @_;
733 return '' unless $time > 0; # work around time2str's traditional stupidity
735 $self->{_date_format} ||= {};
736 if (!exists($self->{_dh})) {
737 my $cust_main = $self->cust_main;
738 my $locale = $cust_main->locale if $cust_main;
740 my %info = FS::Locales->locale_info($locale);
741 my $dh = eval { Date::Language->new($info{'name'}) } ||
742 Date::Language->new(); # fall back to English
746 if ($format eq 'short') {
747 $format = $self->{_date_format}->{short}
748 ||= $self->conf->config('date_format') || '%x';
749 } elsif ($format eq 'rdate') {
750 $format = $self->{_date_format}->{rdate}
751 ||= $self->conf->config('date_format') || '%m/%d/%Y';
752 } elsif ($format eq 'long') {
753 $format = $self->{_date_format}->{long}
754 ||= $self->conf->config('date_format_long') || '%b %o, %Y';
757 # actually render the date
758 my $string = $self->{_dh}->time2str($format, $time);
761 if ($escape eq 'html') {
762 $string = encode_entities($string);
763 $string =~ s/ +/ /g;
764 } elsif ($escape eq 'latex') { # just do nbsp's here
772 =item unsuspend_balance
774 If conf I<unsuspend_balance> is set and customer's current balance is
775 beneath the set threshold, unsuspends customer packages.
779 sub unsuspend_balance {
781 my $cust_main = $self->cust_main;
782 my $conf = $self->conf;
783 my $setting = $conf->config('unsuspend_balance');
785 if ($setting eq 'Zero') {
788 # kind of a pain to load/check all cust_bill instead of just open ones,
789 # but if for some reason payment gets applied to later bills before
790 # earlier ones, we still want to consider the later ones as allowable balance
791 } elsif ($setting eq 'Latest invoice charges') {
792 my @cust_bill = $cust_main->cust_bill();
793 my $cust_bill = $cust_bill[-1]; #always want the most recent one
795 $maxbalance = $cust_bill->charged || 0;
799 } elsif ($setting eq 'Charges not past due') {
802 foreach my $cust_bill ($cust_main->cust_bill()) {
803 next unless $now <= ($cust_bill->due_date || $cust_bill->_date);
804 $maxbalance += $cust_bill->charged || 0;
806 } elsif (length($setting)) {
807 warn "Unrecognized unsuspend_balance setting $setting";
812 my $balance = $cust_main->balance || 0;
813 if ($balance <= $maxbalance) {
814 my @errors = $cust_main->unsuspend(
815 'reason_type' => $conf->config('unsuspend_reason_type')
818 push @errors, $cust_main->release_hold if $conf->exists('unsuspend-unhold');
819 # side-fx with nested transactions? upstack rolls back?
820 warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
833 L<FS::cust_main>, L<FS::Record>