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 {
228 carp "ucfirst_cust_status deprecated, use cust_status_label";
229 local($FS::cust_main::ucfirst_nowarn) = 1;
232 ? ucfirst( $self->cust_status(@_) )
233 : $self->cust_unlinked_msg;
236 =item cust_status_label
240 sub cust_status_label {
244 ? FS::cust_main::cust_status_label($self)
245 : $self->cust_unlinked_msg;
248 =item cust_statuscolor
250 Given an object that contains fields from cust_main (say, from a JOINed
251 search; see httemplate/search/ for examples), returns the equivalent of the
252 FS::cust_main I<statuscol> method, or "000000" if this object is not linked to
257 sub cust_statuscolor {
261 ? FS::cust_main::cust_statuscolor($self)
272 ? $self->cust_main->agent_name
273 : $self->cust_unlinked_msg;
286 Class methods that return SQL framents, equivalent to the corresponding
287 FS::cust_main method.
292 # \$self->cust_linked
293 # ? FS::cust_main::${sub}_sql(\$self)
296 foreach my $sub (qw( prospect active inactive suspended cancelled )) {
299 confess 'cust_main_Mixin ${sub}_sql called with object' if ref(\$_[0]);
300 'cust_main.custnum IS NOT NULL AND '. FS::cust_main->${sub}_sql();
306 =item cust_search_sql
308 Returns a list of SQL WHERE fragments to search for parameters specified
309 in HASHREF. Valid parameters are:
321 sub cust_search_sql {
322 my($class, $param) = @_;
325 warn "$me cust_search_sql called with params: \n".
326 join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n";
331 if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) {
332 push @search, "cust_main.agentnum = $1";
335 #status (prospect active inactive suspended cancelled)
336 if ( grep { $param->{'status'} eq $_ } FS::cust_main->statuses() ) {
337 my $method = $param->{'status'}. '_sql';
338 push @search, $class->$method();
341 #here is the agent virtualization
343 $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' );
349 =item email_search_result HASHREF
351 Emails a notice to the specified customer's contact_email addresses.
354 If the user has specified "Invoice recipients" on the send e-mail screen,
355 contact_email rows containing the invoice_dest flag will be included.
356 This option is default, if neither 'invoice' nor 'message' are present.
358 If the user has specified "Message recipients" on the send e-mail screen,
359 contact_email rows containing the message_dest flag will be included.
361 The selection is indicated by the presence of the text 'message' or
362 'invoice' within the to_contact_classnum argument.
371 Queue job for status updates. Required.
375 Hashref of params to the L<search()> method. Required.
379 Message template number (see L<FS::msg_template>). Overrides all
380 of the following options.
398 =item to_contact_classnum
400 This field contains a comma-separated list. This list may contain:
402 - the text "invoice" indicating contacts with invoice_dest flag should
404 - the text "message" indicating contacts with message_dest flag should
406 - numbers representing classnum id values for email contact classes.
407 If any classnum are present, emails should only be sent to contact_email
408 addresses where contact_email.classnum contains one of these classes.
409 The classnum 0 also includes where contact_email.classnum IS NULL
411 If neither 'invoice' nor 'message' has been specified, this method will
412 behave as if 'invoice' had been selected
416 Returns an error message, or false for success.
418 If any messages fail to send, they will be queued as individual
419 jobs which can be manually retried. If the first ten messages
420 in the job fail, the entire job will abort and return an error.
424 use Storable qw(thaw);
426 use Data::Dumper qw(Dumper);
427 use Digest::SHA qw(sha1); # for duplicate checking
429 sub email_search_result {
430 my($class, $param) = @_;
432 my $conf = FS::Conf->new;
433 my $send_to_domain = $conf->config('email-to-voice_domain');
435 my $msgnum = $param->{msgnum};
436 my $from = delete $param->{from};
437 my $subject = delete $param->{subject};
438 my $html_body = delete $param->{html_body};
439 my $text_body = delete $param->{text_body};
440 my $to_contact_classnum = delete $param->{to_contact_classnum};
441 my $emailtovoice_name = delete $param->{emailtovoice_contact};
445 my $to = $emailtovoice_name . '@' . $send_to_domain unless !$emailtovoice_name;
447 my $job = delete $param->{'job'}
448 or die "email_search_result must run from the job queue.\n";
452 $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
453 or die "msgnum $msgnum not found\n";
455 $msg_template = FS::msg_template->new({
457 msgname => $subject, # maybe a timestamp also?
458 disabled => 'D', # 'D'raft
461 $error = $msg_template->insert(
465 return "$error (when creating draft template)" if $error;
468 my $sql_query = $class->search($param->{'search'});
469 $sql_query->{'select'} = $sql_query->{'table'} . '.*';
471 my $count_query = delete($sql_query->{'count_query'});
472 my $count_sth = dbh->prepare($count_query)
473 or die "Error preparing $count_query: ". dbh->errstr;
475 or die "Error executing $count_query: ". $count_sth->errstr;
476 my $count_arrayref = $count_sth->fetchrow_arrayref;
477 my $num_cust = $count_arrayref->[0];
479 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
485 if ( !$msg_template ) {
486 die "email_search_result now requires a msg_template";
489 #eventually order+limit magic to reduce memory use?
490 foreach my $obj ( qsearch($sql_query) ) {
492 #progressbar first, so that the count is right
494 if ( time - $min_sec > $last ) {
495 my $error = $job->update_statustext(
496 int( 100 * $num / $num_cust )
498 die $error if $error;
502 my $cust_main = $obj->cust_main;
504 next; # unlinked object; nothing else we can do
508 if ($to) { $to{'to'} = $to; }
510 my $cust_msg = $msg_template->prepare(
511 'cust_main' => $cust_main,
513 'to_contact_classnum' => $to_contact_classnum,
517 # For non-cust_main searches, we avoid duplicates based on message
519 my $unique = $cust_main->custnum;
520 $unique .= sha1($cust_msg->text_body) if $class ne 'FS::cust_main';
521 if( $sent_to{$unique} ) {
527 $sent_to{$unique} = 1;
529 $error = $cust_msg->send;
532 # queue the sending of this message so that the user can see what we
533 # tried to do, and retry if desired
534 # (note the cust_msg itself also now has a status of 'failed'; that's
535 # fine, as it will get its status reset if we retry the job)
536 my $queue = new FS::queue {
537 'job' => 'FS::cust_msg::process_send',
538 'custnum' => $cust_main->custnum,
539 'status' => 'failed',
540 'statustext' => $error,
542 $queue->insert($cust_msg->custmsgnum);
543 push @retry_jobs, $queue;
550 (scalar(@retry_jobs) > 10 or $num == $num_cust)
552 # 10 is arbitrary, but if we have enough failures, that's
553 # probably a configuration or network problem, and we
554 # abort the batch and run away screaming.
555 # We NEVER do this if anything was successfully sent.
556 $_->delete foreach (@retry_jobs);
557 return "multiple failures: '$error'\n";
561 # if the message template was created as "draft", change its status to
563 if ($msg_template->disabled eq 'D') {
564 $msg_template->set('disabled' => 'C');
565 my $error = $msg_template->replace;
566 warn "$error (setting draft message template status)" if $error;
570 # fail the job, but with a status message that makes it clear
571 # something was sent.
572 return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
578 sub process_email_search_result {
580 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
583 warn Dumper($param) if $DEBUG;
585 $param->{'job'} = $job;
587 $param->{'search'} = thaw(decode_base64($param->{'search'}))
588 or die "process_email_search_result requires search params.\n";
590 my $table = $param->{'table'}
591 or die "process_email_search_result requires table.\n";
593 eval "use FS::$table;";
594 die "error loading FS::$table: $@\n" if $@;
596 my $error = "FS::$table"->email_search_result( $param );
597 dbh->commit; # save failed jobs before rethrowing the error
598 die $error if $error;
604 Returns a configuration handle (L<FS::Conf>) set to the customer's locale,
605 if they have one. If not, returns an FS::Conf with no locale.
611 return $self->{_conf} if (ref $self and $self->{_conf});
612 my $cust_main = $self->cust_main;
613 my $conf = new FS::Conf {
614 'locale' => ($cust_main ? $cust_main->locale : '')
616 $self->{_conf} = $conf if ref $self;
620 =item mt TEXT [, ARGS ]
622 Localizes a text string (see L<Locale::Maketext>) for the customer's locale,
629 return $self->{_lh}->maketext(@_) if (ref $self and $self->{_lh});
630 my $cust_main = $self->cust_main;
631 my $locale = $cust_main ? $cust_main->locale : '';
632 my $lh = FS::L10N->get_handle($locale);
633 $self->{_lh} = $lh if ref $self;
634 return $lh->maketext(@_);
637 =item time2str_local FORMAT, TIME[, ESCAPE]
639 Localizes a date (see L<Date::Language>) for the customer's locale.
641 FORMAT can be a L<Date::Format> string, or one of these special words:
643 - "short": the value of the "date_format" config setting for the customer's
644 locale, defaulting to "%x".
645 - "rdate": the same as "short" except that the default has a four-digit year.
646 - "long": the value of the "date_format_long" config setting for the
647 customer's locale, defaulting to "%b %o, %Y".
649 ESCAPE, if specified, is one of "latex" or "html", and will escape non-ASCII
650 characters and convert spaces to nonbreaking spaces.
655 # renamed so that we don't have to change every single reference to
656 # time2str everywhere
658 my ($format, $time, $escape) = @_;
659 return '' unless $time > 0; # work around time2str's traditional stupidity
661 $self->{_date_format} ||= {};
662 if (!exists($self->{_dh})) {
663 my $cust_main = $self->cust_main;
664 my $locale = $cust_main->locale if $cust_main;
666 my %info = FS::Locales->locale_info($locale);
667 my $dh = eval { Date::Language->new($info{'name'}) } ||
668 Date::Language->new(); # fall back to English
672 if ($format eq 'short') {
673 $format = $self->{_date_format}->{short}
674 ||= $self->conf->config('date_format') || '%x';
675 } elsif ($format eq 'rdate') {
676 $format = $self->{_date_format}->{rdate}
677 ||= $self->conf->config('date_format') || '%m/%d/%Y';
678 } elsif ($format eq 'long') {
679 $format = $self->{_date_format}->{long}
680 ||= $self->conf->config('date_format_long') || '%b %o, %Y';
683 # actually render the date
684 my $string = $self->{_dh}->time2str($format, $time);
687 if ($escape eq 'html') {
688 $string = encode_entities($string);
689 $string =~ s/ +/ /g;
690 } elsif ($escape eq 'latex') { # just do nbsp's here
698 =item unsuspend_balance
700 If conf I<unsuspend_balance> is set and customer's current balance is
701 beneath the set threshold, unsuspends customer packages.
705 sub unsuspend_balance {
707 my $cust_main = $self->cust_main;
708 my $conf = $self->conf;
709 my $setting = $conf->config('unsuspend_balance') or return;
711 if ($setting eq 'Zero') {
714 # kind of a pain to load/check all cust_bill instead of just open ones,
715 # but if for some reason payment gets applied to later bills before
716 # earlier ones, we still want to consider the later ones as allowable balance
717 } elsif ($setting eq 'Latest invoice charges') {
718 my @cust_bill = $cust_main->cust_bill();
719 my $cust_bill = $cust_bill[-1]; #always want the most recent one
721 $maxbalance = $cust_bill->charged || 0;
725 } elsif ($setting eq 'Charges not past due') {
728 foreach my $cust_bill ($cust_main->cust_bill()) {
729 next unless $now <= ($cust_bill->due_date || $cust_bill->_date);
730 $maxbalance += $cust_bill->charged || 0;
732 } elsif (length($setting)) {
733 warn "Unrecognized unsuspend_balance setting $setting";
738 my $balance = $cust_main->balance || 0;
739 if ($balance <= $maxbalance) {
740 my @errors = $cust_main->unsuspend(
741 'reason_type' => $conf->config('unsuspend_reason_type')
743 # side-fx with nested transactions? upstack rolls back?
744 warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
757 L<FS::cust_main>, L<FS::Record>